111 files changed, 121721 insertions, 74371 deletions

diff --git a/generic/README b/generic/README
index 3311690..d1c078e 100644
--- a/generic/README
+++ b/generic/README
@@ -1,3 +1,3 @@
 This directory contains Tcl source files that work on all the platforms
-where Tcl runs (e.g. UNIX, PCs).  Platform-specific
+where Tcl runs (e.g. UNIX, PCs, and MacOSX).  Platform-specific
 sources are in the directories ../unix, ../win, and ../macosx.
diff --git a/generic/regc_color.c b/generic/regc_color.c
index f6716be..ba1f668 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -2,24 +2,24 @@
  * colorings of characters
  * This file is #included by regcomp.c.
  *
- * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
  * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
@@ -28,662 +28,712 @@
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
- *
- *
- * Note that there are some incestuous relationships between this code and
- * NFA arc maintenance, which perhaps ought to be cleaned up sometime.
+ * Note that there are some incestuous relationships between this code and NFA
+ * arc maintenance, which perhaps ought to be cleaned up sometime.
  */
 
-
-
 #define	CISERR()	VISERR(cm->v)
 #define	CERR(e)		VERR(cm->v, (e))
-
-
-
+
 /*
  - initcm - set up new colormap
  ^ static VOID initcm(struct vars *, struct colormap *);
  */
-static VOID
-initcm(v, cm)
-struct vars *v;
-struct colormap *cm;
+static void
+initcm(
+    struct vars *v,
+    struct colormap *cm)
 {
-	int i;
-	int j;
-	union tree *t;
-	union tree *nextt;
-	struct colordesc *cd;
-
-	cm->magic = CMMAGIC;
-	cm->v = v;
-
-	cm->ncds = NINLINECDS;
-	cm->cd = cm->cdspace;
-	cm->max = 0;
-	cm->free = 0;
-
-	cd = cm->cd;			/* cm->cd[WHITE] */
-	cd->sub = NOSUB;
-	cd->arcs = NULL;
-	cd->flags = 0;
-	cd->nchrs = CHR_MAX - CHR_MIN + 1;
-
-	/* upper levels of tree */
-	for (t = &cm->tree[0], j = NBYTS-1; j > 0; t = nextt, j--) {
-		nextt = t + 1;
-		for (i = BYTTAB-1; i >= 0; i--)
-			t->tptr[i] = nextt;
+    int i;
+    int j;
+    union tree *t;
+    union tree *nextt;
+    struct colordesc *cd;
+
+    cm->magic = CMMAGIC;
+    cm->v = v;
+
+    cm->ncds = NINLINECDS;
+    cm->cd = cm->cdspace;
+    cm->max = 0;
+    cm->free = 0;
+
+    cd = cm->cd;		/* cm->cd[WHITE] */
+    cd->sub = NOSUB;
+    cd->arcs = NULL;
+    cd->flags = 0;
+    cd->nchrs = CHR_MAX - CHR_MIN + 1;
+
+    /*
+     * Upper levels of tree.
+     */
+
+    for (t=&cm->tree[0], j=NBYTS-1 ; j>0 ; t=nextt, j--) {
+	nextt = t + 1;
+	for (i=BYTTAB-1 ; i>=0 ; i--) {
+	    t->tptr[i] = nextt;
 	}
-	/* bottom level is solid white */
-	t = &cm->tree[NBYTS-1];
-	for (i = BYTTAB-1; i >= 0; i--)
-		t->tcolor[i] = WHITE;
-	cd->block = t;
-}
+    }
 
+    /*
+     * Bottom level is solid white.
+     */
+
+    t = &cm->tree[NBYTS-1];
+    for (i=BYTTAB-1 ; i>=0 ; i--) {
+	t->tcolor[i] = WHITE;
+    }
+    cd->block = t;
+}
+
 /*
  - freecm - free dynamically-allocated things in a colormap
  ^ static VOID freecm(struct colormap *);
  */
-static VOID
-freecm(cm)
-struct colormap *cm;
+static void
+freecm(
+    struct colormap *cm)
 {
-	size_t i;
-	union tree *cb;
-
-	cm->magic = 0;
-	if (NBYTS > 1)
-		cmtreefree(cm, cm->tree, 0);
-	for (i = 1; i <= cm->max; i++)		/* skip WHITE */
-		if (!UNUSEDCOLOR(&cm->cd[i])) {
-			cb = cm->cd[i].block;
-			if (cb != NULL)
-				FREE(cb);
-		}
-	if (cm->cd != cm->cdspace)
-		FREE(cm->cd);
+    size_t i;
+    union tree *cb;
+
+    cm->magic = 0;
+    if (NBYTS > 1) {
+	cmtreefree(cm, cm->tree, 0);
+    }
+    for (i=1 ; i<=cm->max ; i++) {	/* skip WHITE */
+	if (!UNUSEDCOLOR(&cm->cd[i])) {
+	    cb = cm->cd[i].block;
+	    if (cb != NULL) {
+		FREE(cb);
+	    }
+	}
+    }
+    if (cm->cd != cm->cdspace) {
+	FREE(cm->cd);
+    }
 }
-
+
 /*
  - cmtreefree - free a non-terminal part of a colormap tree
  ^ static VOID cmtreefree(struct colormap *, union tree *, int);
  */
-static VOID
-cmtreefree(cm, tree, level)
-struct colormap *cm;
-union tree *tree;
-int level;			/* level number (top == 0) of this block */
+static void
+cmtreefree(
+    struct colormap *cm,
+    union tree *tree,
+    int level)			/* level number (top == 0) of this block */
 {
-	int i;
-	union tree *t;
-	union tree *fillt = &cm->tree[level+1];
-	union tree *cb;
-
-	assert(level < NBYTS-1);	/* this level has pointers */
-	for (i = BYTTAB-1; i >= 0; i--) {
-		t = tree->tptr[i];
-		assert(t != NULL);
-		if (t != fillt) {
-			if (level < NBYTS-2) {	/* more pointer blocks below */
-				cmtreefree(cm, t, level+1);
-				FREE(t);
-			} else {		/* color block below */
-				cb = cm->cd[t->tcolor[0]].block;
-				if (t != cb)	/* not a solid block */
-					FREE(t);
-			}
+    int i;
+    union tree *t;
+    union tree *fillt = &cm->tree[level+1];
+    union tree *cb;
+
+    assert(level < NBYTS-1);	/* this level has pointers */
+    for (i=BYTTAB-1 ; i>=0 ; i--) {
+	t = tree->tptr[i];
+	assert(t != NULL);
+	if (t != fillt) {
+	    if (level < NBYTS-2) {	/* more pointer blocks below */
+		cmtreefree(cm, t, level+1);
+		FREE(t);
+	    } else {		/* color block below */
+		cb = cm->cd[t->tcolor[0]].block;
+		if (t != cb) {	/* not a solid block */
+		    FREE(t);
 		}
+	    }
 	}
+    }
 }
-
+
 /*
  - setcolor - set the color of a character in a colormap
  ^ static color setcolor(struct colormap *, pchr, pcolor);
  */
 static color			/* previous color */
-setcolor(cm, c, co)
-struct colormap *cm;
-pchr c;
-pcolor co;
+setcolor(
+    struct colormap *cm,
+    pchr c,
+    pcolor co)
 {
-	uchr uc = c;
-	int shift;
-	int level;
-	int b;
-	int bottom;
-	union tree *t;
-	union tree *newt;
-	union tree *fillt;
-	union tree *lastt;
-	union tree *cb;
-	color prev;
-
-	assert(cm->magic == CMMAGIC);
-	if (CISERR() || co == COLORLESS)
+    uchr uc = c;
+    int shift;
+    int level;
+    int b;
+    int bottom;
+    union tree *t;
+    union tree *newt;
+    union tree *fillt;
+    union tree *lastt;
+    union tree *cb;
+    color prev;
+
+    assert(cm->magic == CMMAGIC);
+    if (CISERR() || co == COLORLESS) {
+	return COLORLESS;
+    }
+
+    t = cm->tree;
+    for (level=0, shift=BYTBITS*(NBYTS-1) ; shift>0; level++, shift-=BYTBITS){
+	b = (uc >> shift) & BYTMASK;
+	lastt = t;
+	t = lastt->tptr[b];
+	assert(t != NULL);
+	fillt = &cm->tree[level+1];
+	bottom = (shift <= BYTBITS) ? 1 : 0;
+	cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
+	if (t == fillt || t == cb) {	/* must allocate a new block */
+	    newt = (union tree *) MALLOC((bottom) ?
+		    sizeof(struct colors) : sizeof(struct ptrs));
+	    if (newt == NULL) {
+		CERR(REG_ESPACE);
 		return COLORLESS;
-
-	t = cm->tree;
-	for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
-						level++, shift -= BYTBITS) {
-		b = (uc >> shift) & BYTMASK;
-		lastt = t;
-		t = lastt->tptr[b];
-		assert(t != NULL);
-		fillt = &cm->tree[level+1];
-		bottom = (shift <= BYTBITS) ? 1 : 0;
-		cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
-		if (t == fillt || t == cb) {	/* must allocate a new block */
-			newt = (union tree *)MALLOC((bottom) ?
-				sizeof(struct colors) : sizeof(struct ptrs));
-			if (newt == NULL) {
-				CERR(REG_ESPACE);
-				return COLORLESS;
-			}
-			if (bottom)
-				memcpy(VS(newt->tcolor), VS(t->tcolor),
-							BYTTAB*sizeof(color));
-			else
-				memcpy(VS(newt->tptr), VS(t->tptr),
-						BYTTAB*sizeof(union tree *));
-			t = newt;
-			lastt->tptr[b] = t;
-		}
+	    }
+	    if (bottom) {
+		memcpy(newt->tcolor, t->tcolor, BYTTAB*sizeof(color));
+	    } else {
+		memcpy(newt->tptr, t->tptr, BYTTAB*sizeof(union tree *));
+	    }
+	    t = newt;
+	    lastt->tptr[b] = t;
 	}
+    }
 
-	b = uc & BYTMASK;
-	prev = t->tcolor[b];
-	t->tcolor[b] = (color)co;
-	return prev;
+    b = uc & BYTMASK;
+    prev = t->tcolor[b];
+    t->tcolor[b] = (color) co;
+    return prev;
 }
-
+
 /*
  - maxcolor - report largest color number in use
  ^ static color maxcolor(struct colormap *);
  */
 static color
-maxcolor(cm)
-struct colormap *cm;
+maxcolor(
+    struct colormap *cm)
 {
-	if (CISERR())
-		return COLORLESS;
+    if (CISERR()) {
+	return COLORLESS;
+    }
 
-	return (color)cm->max;
+    return (color) cm->max;
 }
-
+
 /*
  - newcolor - find a new color (must be subject of setcolor at once)
- * Beware:  may relocate the colordescs.
+ * Beware: may relocate the colordescs.
  ^ static color newcolor(struct colormap *);
  */
 static color			/* COLORLESS for error */
-newcolor(cm)
-struct colormap *cm;
+newcolor(
+    struct colormap *cm)
 {
-	struct colordesc *cd;
-	struct colordesc *new;
-	size_t n;
-
-	if (CISERR())
-		return COLORLESS;
-
-	if (cm->free != 0) {
-		assert(cm->free > 0);
-		assert((size_t)cm->free < cm->ncds);
-		cd = &cm->cd[cm->free];
-		assert(UNUSEDCOLOR(cd));
-		assert(cd->arcs == NULL);
-		cm->free = cd->sub;
-	} else if (cm->max < cm->ncds - 1) {
-		cm->max++;
-		cd = &cm->cd[cm->max];
+    struct colordesc *cd;
+    size_t n;
+
+    if (CISERR()) {
+	return COLORLESS;
+    }
+
+    if (cm->free != 0) {
+	assert(cm->free > 0);
+	assert((size_t) cm->free < cm->ncds);
+	cd = &cm->cd[cm->free];
+	assert(UNUSEDCOLOR(cd));
+	assert(cd->arcs == NULL);
+	cm->free = cd->sub;
+    } else if (cm->max < cm->ncds - 1) {
+	cm->max++;
+	cd = &cm->cd[cm->max];
+    } else {
+	struct colordesc *newCd;
+
+	/*
+	 * Oops, must allocate more.
+	 */
+
+	n = cm->ncds * 2;
+	if (cm->cd == cm->cdspace) {
+	    newCd = (struct colordesc *) MALLOC(n * sizeof(struct colordesc));
+	    if (newCd != NULL) {
+		memcpy(newCd, cm->cdspace,
+			cm->ncds * sizeof(struct colordesc));
+	    }
 	} else {
-		/* oops, must allocate more */
-		n = cm->ncds * 2;
-		if (cm->cd == cm->cdspace) {
-			new = (struct colordesc *)MALLOC(n *
-						sizeof(struct colordesc));
-			if (new != NULL)
-				memcpy(VS(new), VS(cm->cdspace), cm->ncds *
-						sizeof(struct colordesc));
-		} else
-			new = (struct colordesc *)REALLOC(cm->cd,
-						n * sizeof(struct colordesc));
-		if (new == NULL) {
-			CERR(REG_ESPACE);
-			return COLORLESS;
-		}
-		cm->cd = new;
-		cm->ncds = n;
-		assert(cm->max < cm->ncds - 1);
-		cm->max++;
-		cd = &cm->cd[cm->max];
+	    newCd = (struct colordesc *)
+		    REALLOC(cm->cd, n * sizeof(struct colordesc));
 	}
-
-	cd->nchrs = 0;
-	cd->sub = NOSUB;
-	cd->arcs = NULL;
-	cd->flags = 0;
-	cd->block = NULL;
-
-	return (color)(cd - cm->cd);
+	if (newCd == NULL) {
+	    CERR(REG_ESPACE);
+	    return COLORLESS;
+	}
+	cm->cd = newCd;
+	cm->ncds = n;
+	assert(cm->max < cm->ncds - 1);
+	cm->max++;
+	cd = &cm->cd[cm->max];
+    }
+
+    cd->nchrs = 0;
+    cd->sub = NOSUB;
+    cd->arcs = NULL;
+    cd->flags = 0;
+    cd->block = NULL;
+
+    return (color) (cd - cm->cd);
 }
-
+
 /*
  - freecolor - free a color (must have no arcs or subcolor)
  ^ static VOID freecolor(struct colormap *, pcolor);
  */
-static VOID
-freecolor(cm, co)
-struct colormap *cm;
-pcolor co;
+static void
+freecolor(
+    struct colormap *cm,
+    pcolor co)
 {
-	struct colordesc *cd = &cm->cd[co];
-	color pco, nco;			/* for freelist scan */
-
-	assert(co >= 0);
-	if (co == WHITE)
-		return;
-
-	assert(cd->arcs == NULL);
-	assert(cd->sub == NOSUB);
-	assert(cd->nchrs == 0);
-	cd->flags = FREECOL;
-	if (cd->block != NULL) {
-		FREE(cd->block);
-		cd->block = NULL;	/* just paranoia */
+    struct colordesc *cd = &cm->cd[co];
+    color pco, nco;		/* for freelist scan */
+
+    assert(co >= 0);
+    if (co == WHITE) {
+	return;
+    }
+
+    assert(cd->arcs == NULL);
+    assert(cd->sub == NOSUB);
+    assert(cd->nchrs == 0);
+    cd->flags = FREECOL;
+    if (cd->block != NULL) {
+	FREE(cd->block);
+	cd->block = NULL;	/* just paranoia */
+    }
+
+    if ((size_t) co == cm->max) {
+	while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max])) {
+	    cm->max--;
 	}
-
-	if ((size_t)co == cm->max) {
-		while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max]))
-			cm->max--;
-		assert(cm->free >= 0);
-		while ((size_t)cm->free > cm->max)
-			cm->free = cm->cd[cm->free].sub;
-		if (cm->free > 0) {
-			assert(cm->free < cm->max);
-			pco = cm->free;
-			nco = cm->cd[pco].sub;
-			while (nco > 0)
-				if ((size_t)nco > cm->max) {
-					/* take this one out of freelist */
-					nco = cm->cd[nco].sub;
-					cm->cd[pco].sub = nco;
-				} else {
-					assert(nco < cm->max);
-					pco = nco;
-					nco = cm->cd[pco].sub;
-				}
+	assert(cm->free >= 0);
+	while ((size_t) cm->free > cm->max) {
+	    cm->free = cm->cd[cm->free].sub;
+	}
+	if (cm->free > 0) {
+	    assert(cm->free < cm->max);
+	    pco = cm->free;
+	    nco = cm->cd[pco].sub;
+	    while (nco > 0) {
+		if ((size_t) nco > cm->max) {
+		    /*
+		     * Take this one out of freelist.
+		     */
+
+		    nco = cm->cd[nco].sub;
+		    cm->cd[pco].sub = nco;
+		} else {
+		    assert(nco < cm->max);
+		    pco = nco;
+		    nco = cm->cd[pco].sub;
 		}
-	} else {
-		cd->sub = cm->free;
-		cm->free = (color)(cd - cm->cd);
+	    }
 	}
+    } else {
+	cd->sub = cm->free;
+	cm->free = (color) (cd - cm->cd);
+    }
 }
-
+
 /*
  - pseudocolor - allocate a false color, to be managed by other means
  ^ static color pseudocolor(struct colormap *);
  */
 static color
-pseudocolor(cm)
-struct colormap *cm;
+pseudocolor(
+    struct colormap *cm)
 {
-	color co;
-
-	co = newcolor(cm);
-	if (CISERR())
-		return COLORLESS;
-	cm->cd[co].nchrs = 1;
-	cm->cd[co].flags = PSEUDO;
-	return co;
+    color co;
+
+    co = newcolor(cm);
+    if (CISERR()) {
+	return COLORLESS;
+    }
+    cm->cd[co].nchrs = 1;
+    cm->cd[co].flags = PSEUDO;
+    return co;
 }
-
+
 /*
  - subcolor - allocate a new subcolor (if necessary) to this chr
  ^ static color subcolor(struct colormap *, pchr c);
  */
 static color
-subcolor(cm, c)
-struct colormap *cm;
-pchr c;
+subcolor(
+    struct colormap *cm,
+    pchr c)
 {
-	color co;			/* current color of c */
-	color sco;			/* new subcolor */
-
-	co = GETCOLOR(cm, c);
-	sco = newsub(cm, co);
-	if (CISERR())
-		return COLORLESS;
-	assert(sco != COLORLESS);
-
-	if (co == sco)		/* already in an open subcolor */
-		return co;	/* rest is redundant */
-	cm->cd[co].nchrs--;
-	cm->cd[sco].nchrs++;
-	setcolor(cm, c, sco);
-	return sco;
+    color co;			/* current color of c */
+    color sco;			/* new subcolor */
+
+    co = GETCOLOR(cm, c);
+    sco = newsub(cm, co);
+    if (CISERR()) {
+	return COLORLESS;
+    }
+    assert(sco != COLORLESS);
+
+    if (co == sco) {		/* already in an open subcolor */
+	return co;		/* rest is redundant */
+    }
+    cm->cd[co].nchrs--;
+    cm->cd[sco].nchrs++;
+    setcolor(cm, c, sco);
+    return sco;
 }
-
+
 /*
  - newsub - allocate a new subcolor (if necessary) for a color
  ^ static color newsub(struct colormap *, pcolor);
  */
 static color
-newsub(cm, co)
-struct colormap *cm;
-pcolor co;
+newsub(
+    struct colormap *cm,
+    pcolor co)
 {
-	color sco;			/* new subcolor */
-
-	sco = cm->cd[co].sub;
-	if (sco == NOSUB) {		/* color has no open subcolor */
-		if (cm->cd[co].nchrs == 1)	/* optimization */
-			return co;
-		sco = newcolor(cm);	/* must create subcolor */
-		if (sco == COLORLESS) {
-			assert(CISERR());
-			return COLORLESS;
-		}
-		cm->cd[co].sub = sco;
-		cm->cd[sco].sub = sco;	/* open subcolor points to self */
+    color sco;			/* new subcolor */
+
+    sco = cm->cd[co].sub;
+    if (sco == NOSUB) {		/* color has no open subcolor */
+	if (cm->cd[co].nchrs == 1) {	/* optimization */
+	    return co;
+	}
+	sco = newcolor(cm);	/* must create subcolor */
+	if (sco == COLORLESS) {
+	    assert(CISERR());
+	    return COLORLESS;
 	}
-	assert(sco != NOSUB);
+	cm->cd[co].sub = sco;
+	cm->cd[sco].sub = sco;	/* open subcolor points to self */
+    }
+    assert(sco != NOSUB);
 
-	return sco;
+    return sco;
 }
-
+
 /*
  - subrange - allocate new subcolors to this range of chrs, fill in arcs
  ^ static VOID subrange(struct vars *, pchr, pchr, struct state *,
  ^ 	struct state *);
  */
-static VOID
-subrange(v, from, to, lp, rp)
-struct vars *v;
-pchr from;
-pchr to;
-struct state *lp;
-struct state *rp;
+static void
+subrange(
+    struct vars *v,
+    pchr from,
+    pchr to,
+    struct state *lp,
+    struct state *rp)
 {
-	uchr uf;
-	int i;
-
-	assert(from <= to);
-
-	/* first, align "from" on a tree-block boundary */
-	uf = (uchr)from;
-	i = (int)( ((uf + BYTTAB-1) & (uchr)~BYTMASK) - uf );
-	for (; from <= to && i > 0; i--, from++)
-		newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
-	if (from > to)			/* didn't reach a boundary */
-		return;
-
-	/* deal with whole blocks */
-	for (; to - from >= BYTTAB; from += BYTTAB)
-		subblock(v, from, lp, rp);
-
-	/* clean up any remaining partial table */
-	for (; from <= to; from++)
-		newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+    uchr uf;
+    int i;
+
+    assert(from <= to);
+
+    /*
+     * First, align "from" on a tree-block boundary
+     */
+
+    uf = (uchr) from;
+    i = (int) (((uf + BYTTAB - 1) & (uchr) ~BYTMASK) - uf);
+    for (; from<=to && i>0; i--, from++) {
+	newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+    }
+    if (from > to) {		/* didn't reach a boundary */
+	return;
+    }
+
+    /*
+     * Deal with whole blocks.
+     */
+
+    for (; to-from>=BYTTAB ; from+=BYTTAB) {
+	subblock(v, from, lp, rp);
+    }
+
+    /*
+     * Clean up any remaining partial table.
+     */
+
+    for (; from<=to ; from++) {
+	newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+    }
 }
-
+
 /*
  - subblock - allocate new subcolors for one tree block of chrs, fill in arcs
  ^ static VOID subblock(struct vars *, pchr, struct state *, struct state *);
  */
-static VOID
-subblock(v, start, lp, rp)
-struct vars *v;
-pchr start;			/* first of BYTTAB chrs */
-struct state *lp;
-struct state *rp;
+static void
+subblock(
+    struct vars *v,
+    pchr start,			/* first of BYTTAB chrs */
+    struct state *lp,
+    struct state *rp)
 {
-	uchr uc = start;
-	struct colormap *cm = v->cm;
-	int shift;
-	int level;
-	int i;
-	int b;
-	union tree *t;
-	union tree *cb;
-	union tree *fillt;
-	union tree *lastt;
-	int previ;
-	int ndone;
-	color co;
-	color sco;
-
-	assert((uc % BYTTAB) == 0);
-
-	/* find its color block, making new pointer blocks as needed */
-	t = cm->tree;
-	fillt = NULL;
-	for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
-						level++, shift -= BYTBITS) {
-		b = (uc >> shift) & BYTMASK;
-		lastt = t;
-		t = lastt->tptr[b];
-		assert(t != NULL);
-		fillt = &cm->tree[level+1];
-		if (t == fillt && shift > BYTBITS) {	/* need new ptr block */
-			t = (union tree *)MALLOC(sizeof(struct ptrs));
-			if (t == NULL) {
-				CERR(REG_ESPACE);
-				return;
-			}
-			memcpy(VS(t->tptr), VS(fillt->tptr),
-						BYTTAB*sizeof(union tree *));
-			lastt->tptr[b] = t;
-		}
+    uchr uc = start;
+    struct colormap *cm = v->cm;
+    int shift;
+    int level;
+    int i;
+    int b;
+    union tree *t;
+    union tree *cb;
+    union tree *fillt;
+    union tree *lastt;
+    int previ;
+    int ndone;
+    color co;
+    color sco;
+
+    assert((uc % BYTTAB) == 0);
+
+    /*
+     * Find its color block, making new pointer blocks as needed.
+     */
+
+    t = cm->tree;
+    fillt = NULL;
+    for (level=0, shift=BYTBITS*(NBYTS-1); shift>0; level++, shift-=BYTBITS) {
+	b = (uc >> shift) & BYTMASK;
+	lastt = t;
+	t = lastt->tptr[b];
+	assert(t != NULL);
+	fillt = &cm->tree[level+1];
+	if (t == fillt && shift > BYTBITS) {	/* need new ptr block */
+	    t = (union tree *) MALLOC(sizeof(struct ptrs));
+	    if (t == NULL) {
+		CERR(REG_ESPACE);
+		return;
+	    }
+	    memcpy(t->tptr, fillt->tptr, BYTTAB*sizeof(union tree *));
+	    lastt->tptr[b] = t;
 	}
+    }
+
+    /*
+     * Special cases: fill block or solid block.
+     */
+    co = t->tcolor[0];
+    cb = cm->cd[co].block;
+    if (t == fillt || t == cb) {
+	/*
+	 * Either way, we want a subcolor solid block.
+	 */
 
-	/* special cases:  fill block or solid block */
-	co = t->tcolor[0];
-	cb = cm->cd[co].block;
-	if (t == fillt || t == cb) {
-		/* either way, we want a subcolor solid block */
-		sco = newsub(cm, co);
-		t = cm->cd[sco].block;
-		if (t == NULL) {	/* must set it up */
-			t = (union tree *)MALLOC(sizeof(struct colors));
-			if (t == NULL) {
-				CERR(REG_ESPACE);
-				return;
-			}
-			for (i = 0; i < BYTTAB; i++)
-				t->tcolor[i] = sco;
-			cm->cd[sco].block = t;
-		}
-		/* find loop must have run at least once */
-		lastt->tptr[b] = t;
-		newarc(v->nfa, PLAIN, sco, lp, rp);
-		cm->cd[co].nchrs -= BYTTAB;
-		cm->cd[sco].nchrs += BYTTAB;
+	sco = newsub(cm, co);
+	t = cm->cd[sco].block;
+	if (t == NULL) {	/* must set it up */
+	    t = (union tree *) MALLOC(sizeof(struct colors));
+	    if (t == NULL) {
+		CERR(REG_ESPACE);
 		return;
+	    }
+	    for (i=0 ; i<BYTTAB ; i++) {
+		t->tcolor[i] = sco;
+	    }
+	    cm->cd[sco].block = t;
 	}
 
-	/* general case, a mixed block to be altered */
-	i = 0;
-	while (i < BYTTAB) {
-		co = t->tcolor[i];
-		sco = newsub(cm, co);
-		newarc(v->nfa, PLAIN, sco, lp, rp);
-		previ = i;
-		do {
-			t->tcolor[i++] = sco;
-		} while (i < BYTTAB && t->tcolor[i] == co);
-		ndone = i - previ;
-		cm->cd[co].nchrs -= ndone;
-		cm->cd[sco].nchrs += ndone;
-	}
-}
+	/*
+	 * Find loop must have run at least once.
+	 */
+
+	lastt->tptr[b] = t;
+	newarc(v->nfa, PLAIN, sco, lp, rp);
+	cm->cd[co].nchrs -= BYTTAB;
+	cm->cd[sco].nchrs += BYTTAB;
+	return;
+    }
+
+    /*
+     * General case, a mixed block to be altered.
+     */
 
+    i = 0;
+    while (i < BYTTAB) {
+	co = t->tcolor[i];
+	sco = newsub(cm, co);
+	newarc(v->nfa, PLAIN, sco, lp, rp);
+	previ = i;
+	do {
+	    t->tcolor[i++] = sco;
+	} while (i < BYTTAB && t->tcolor[i] == co);
+	ndone = i - previ;
+	cm->cd[co].nchrs -= ndone;
+	cm->cd[sco].nchrs += ndone;
+    }
+}
+
 /*
  - okcolors - promote subcolors to full colors
  ^ static VOID okcolors(struct nfa *, struct colormap *);
  */
-static VOID
-okcolors(nfa, cm)
-struct nfa *nfa;
-struct colormap *cm;
+static void
+okcolors(
+    struct nfa *nfa,
+    struct colormap *cm)
 {
-	struct colordesc *cd;
-	struct colordesc *end = CDEND(cm);
-	struct colordesc *scd;
-	struct arc *a;
-	color co;
-	color sco;
-
-	for (cd = cm->cd, co = 0; cd < end; cd++, co++) {
-		sco = cd->sub;
-		if (UNUSEDCOLOR(cd) || sco == NOSUB) {
-			/* has no subcolor, no further action */
-		} else if (sco == co) {
-			/* is subcolor, let parent deal with it */
-		} else if (cd->nchrs == 0) {
-			/* parent empty, its arcs change color to subcolor */
-			cd->sub = NOSUB;
-			scd = &cm->cd[sco];
-			assert(scd->nchrs > 0);
-			assert(scd->sub == sco);
-			scd->sub = NOSUB;
-			while ((a = cd->arcs) != NULL) {
-				assert(a->co == co);
-				uncolorchain(cm, a);
-				a->co = sco;
-				colorchain(cm, a);
-			}
-			freecolor(cm, co);
-		} else {
-			/* parent's arcs must gain parallel subcolor arcs */
-			cd->sub = NOSUB;
-			scd = &cm->cd[sco];
-			assert(scd->nchrs > 0);
-			assert(scd->sub == sco);
-			scd->sub = NOSUB;
-			for (a = cd->arcs; a != NULL; a = a->colorchain) {
-				assert(a->co == co);
-				newarc(nfa, a->type, sco, a->from, a->to);
-			}
-		}
+    struct colordesc *cd;
+    struct colordesc *end = CDEND(cm);
+    struct colordesc *scd;
+    struct arc *a;
+    color co;
+    color sco;
+
+    for (cd=cm->cd, co=0 ; cd<end ; cd++, co++) {
+	sco = cd->sub;
+	if (UNUSEDCOLOR(cd) || sco == NOSUB) {
+	    /*
+	     * Has no subcolor, no further action.
+	     */
+	} else if (sco == co) {
+	    /*
+	     * Is subcolor, let parent deal with it.
+	     */
+	} else if (cd->nchrs == 0) {
+	    /*
+	     * Parent empty, its arcs change color to subcolor.
+	     */
+
+	    cd->sub = NOSUB;
+	    scd = &cm->cd[sco];
+	    assert(scd->nchrs > 0);
+	    assert(scd->sub == sco);
+	    scd->sub = NOSUB;
+	    while ((a = cd->arcs) != NULL) {
+		assert(a->co == co);
+		uncolorchain(cm, a);
+		a->co = sco;
+		colorchain(cm, a);
+	    }
+	    freecolor(cm, co);
+	} else {
+	    /*
+	     * Parent's arcs must gain parallel subcolor arcs.
+	     */
+
+	    cd->sub = NOSUB;
+	    scd = &cm->cd[sco];
+	    assert(scd->nchrs > 0);
+	    assert(scd->sub == sco);
+	    scd->sub = NOSUB;
+	    for (a=cd->arcs ; a!=NULL ; a=a->colorchain) {
+		assert(a->co == co);
+		newarc(nfa, a->type, sco, a->from, a->to);
+	    }
 	}
+    }
 }
-
+
 /*
  - colorchain - add this arc to the color chain of its color
  ^ static VOID colorchain(struct colormap *, struct arc *);
  */
-static VOID
-colorchain(cm, a)
-struct colormap *cm;
-struct arc *a;
+static void
+colorchain(
+    struct colormap *cm,
+    struct arc *a)
 {
-	struct colordesc *cd = &cm->cd[a->co];
-
-	if (cd->arcs)
-		cd->arcs->colorchain_rev = a;
-	a->colorchain = cd->arcs;
-	a->colorchain_rev = NULL;
-	cd->arcs = a;
+    struct colordesc *cd = &cm->cd[a->co];
+
+    if (cd->arcs != NULL) {
+	cd->arcs->colorchainRev = a;
+    }
+    a->colorchain = cd->arcs;
+    a->colorchainRev = NULL;
+    cd->arcs = a;
 }
-
+
 /*
  - uncolorchain - delete this arc from the color chain of its color
  ^ static VOID uncolorchain(struct colormap *, struct arc *);
  */
-static VOID
-uncolorchain(cm, a)
-struct colormap *cm;
-struct arc *a;
-{
-	struct colordesc *cd = &cm->cd[a->co];
-	struct arc *aa = a->colorchain_rev;
-
-	if (aa == NULL) {
-		assert(cd->arcs == a);
-		cd->arcs = a->colorchain;
-	} else {
-		assert(aa->colorchain == a);
-		aa->colorchain = a->colorchain;
-	}
-	if (a->colorchain)
-		a->colorchain->colorchain_rev = aa;
-	a->colorchain = NULL;		/* paranoia */
-	a->colorchain_rev = NULL;
-}
-
-/*
- - singleton - is this character in its own color?
- ^ static int singleton(struct colormap *, pchr c);
- */
-static int			/* predicate */
-singleton(cm, c)
-struct colormap *cm;
-pchr c;
+static void
+uncolorchain(
+    struct colormap *cm,
+    struct arc *a)
 {
-	color co;			/* color of c */
-
-	co = GETCOLOR(cm, c);
-	if (cm->cd[co].nchrs == 1 && cm->cd[co].sub == NOSUB)
-		return 1;
-	return 0;
+    struct colordesc *cd = &cm->cd[a->co];
+    struct arc *aa = a->colorchainRev;
+
+    if (aa == NULL) {
+	assert(cd->arcs == a);
+	cd->arcs = a->colorchain;
+    } else {
+	assert(aa->colorchain == a);
+	aa->colorchain = a->colorchain;
+    }
+    if (a->colorchain != NULL) {
+	a->colorchain->colorchainRev = aa;
+    }
+    a->colorchain = NULL;	/* paranoia */
+    a->colorchainRev = NULL;
 }
-
+
 /*
  - rainbow - add arcs of all full colors (but one) between specified states
  ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
  ^ 	struct state *, struct state *);
  */
-static VOID
-rainbow(nfa, cm, type, but, from, to)
-struct nfa *nfa;
-struct colormap *cm;
-int type;
-pcolor but;			/* COLORLESS if no exceptions */
-struct state *from;
-struct state *to;
+static void
+rainbow(
+    struct nfa *nfa,
+    struct colormap *cm,
+    int type,
+    pcolor but,			/* COLORLESS if no exceptions */
+    struct state *from,
+    struct state *to)
 {
-	struct colordesc *cd;
-	struct colordesc *end = CDEND(cm);
-	color co;
-
-	for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
-		if (!UNUSEDCOLOR(cd) && cd->sub != co && co != but &&
-							!(cd->flags&PSEUDO))
-			newarc(nfa, type, co, from, to);
+    struct colordesc *cd;
+    struct colordesc *end = CDEND(cm);
+    color co;
+
+    for (cd=cm->cd, co=0 ; cd<end && !CISERR(); cd++, co++) {
+	if (!UNUSEDCOLOR(cd) && (cd->sub != co) && (co != but)
+		&& !(cd->flags&PSEUDO)) {
+	    newarc(nfa, type, co, from, to);
+	}
+    }
 }
-
+
 /*
  - colorcomplement - add arcs of complementary colors
  * The calling sequence ought to be reconciled with cloneouts().
  ^ static VOID colorcomplement(struct nfa *, struct colormap *, int,
  ^ 	struct state *, struct state *, struct state *);
  */
-static VOID
-colorcomplement(nfa, cm, type, of, from, to)
-struct nfa *nfa;
-struct colormap *cm;
-int type;
-struct state *of;		/* complements of this guy's PLAIN outarcs */
-struct state *from;
-struct state *to;
+static void
+colorcomplement(
+    struct nfa *nfa,
+    struct colormap *cm,
+    int type,
+    struct state *of,		/* complements of this guy's PLAIN outarcs */
+    struct state *from,
+    struct state *to)
 {
-	struct colordesc *cd;
-	struct colordesc *end = CDEND(cm);
-	color co;
-
-	assert(of != from);
-	for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
-		if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO))
-			if (findarc(of, PLAIN, co) == NULL)
-				newarc(nfa, type, co, from, to);
+    struct colordesc *cd;
+    struct colordesc *end = CDEND(cm);
+    color co;
+
+    assert(of != from);
+    for (cd=cm->cd, co=0 ; cd<end && !CISERR() ; cd++, co++) {
+	if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO)) {
+	    if (findarc(of, PLAIN, co) == NULL) {
+		newarc(nfa, type, co, from, to);
+	    }
+	}
+    }
 }
-
-
-
+
 #ifdef REG_DEBUG
 /*
  ^ #ifdef REG_DEBUG
@@ -693,87 +743,106 @@ struct state *to;
  - dumpcolors - debugging output
  ^ static VOID dumpcolors(struct colormap *, FILE *);
  */
-static VOID
-dumpcolors(cm, f)
-struct colormap *cm;
-FILE *f;
+static void
+dumpcolors(
+    struct colormap *cm,
+    FILE *f)
 {
-	struct colordesc *cd;
-	struct colordesc *end;
-	color co;
-	chr c;
-	char *has;
-
-	fprintf(f, "max %ld\n", (long)cm->max);
-	if (NBYTS > 1)
-		fillcheck(cm, cm->tree, 0, f);
-	end = CDEND(cm);
-	for (cd = cm->cd + 1, co = 1; cd < end; cd++, co++)	/* skip 0 */
-		if (!UNUSEDCOLOR(cd)) {
-			assert(cd->nchrs > 0);
-			has = (cd->block != NULL) ? "#" : "";
-			if (cd->flags&PSEUDO)
-				fprintf(f, "#%2ld%s(ps): ", (long)co, has);
-			else
-				fprintf(f, "#%2ld%s(%2d): ", (long)co,
-							has, cd->nchrs);
-			/* it's hard to do this more efficiently */
-			for (c = CHR_MIN; c < CHR_MAX; c++)
-				if (GETCOLOR(cm, c) == co)
-					dumpchr(c, f);
-			assert(c == CHR_MAX);
-			if (GETCOLOR(cm, c) == co)
-				dumpchr(c, f);
-			fprintf(f, "\n");
+    struct colordesc *cd;
+    struct colordesc *end;
+    color co;
+    chr c;
+    char *has;
+
+    fprintf(f, "max %ld\n", (long) cm->max);
+    if (NBYTS > 1) {
+	fillcheck(cm, cm->tree, 0, f);
+    }
+    end = CDEND(cm);
+    for (cd=cm->cd+1, co=1 ; cd<end ; cd++, co++) {	/* skip 0 */
+	if (!UNUSEDCOLOR(cd)) {
+	    assert(cd->nchrs > 0);
+	    has = (cd->block != NULL) ? "#" : "";
+	    if (cd->flags&PSEUDO) {
+		fprintf(f, "#%2ld%s(ps): ", (long) co, has);
+	    } else {
+		fprintf(f, "#%2ld%s(%2d): ", (long) co, has, cd->nchrs);
+	    }
+
+	    /*
+	     * It's hard to do this more efficiently.
+	     */
+
+	    for (c=CHR_MIN ; c<CHR_MAX ; c++) {
+		if (GETCOLOR(cm, c) == co) {
+		    dumpchr(c, f);
 		}
+	    }
+	    assert(c == CHR_MAX);
+	    if (GETCOLOR(cm, c) == co) {
+		dumpchr(c, f);
+	    }
+	    fprintf(f, "\n");
+	}
+    }
 }
-
+
 /*
  - fillcheck - check proper filling of a tree
  ^ static VOID fillcheck(struct colormap *, union tree *, int, FILE *);
  */
-static VOID
-fillcheck(cm, tree, level, f)
-struct colormap *cm;
-union tree *tree;
-int level;			/* level number (top == 0) of this block */
-FILE *f;
+static void
+fillcheck(
+    struct colormap *cm,
+    union tree *tree,
+    int level,			/* level number (top == 0) of this block */
+    FILE *f)
 {
-	int i;
-	union tree *t;
-	union tree *fillt = &cm->tree[level+1];
-
-	assert(level < NBYTS-1);	/* this level has pointers */
-	for (i = BYTTAB-1; i >= 0; i--) {
-		t = tree->tptr[i];
-		if (t == NULL)
-			fprintf(f, "NULL found in filled tree!\n");
-		else if (t == fillt)
-			{}
-		else if (level < NBYTS-2)	/* more pointer blocks below */
-			fillcheck(cm, t, level+1, f);
+    int i;
+    union tree *t;
+    union tree *fillt = &cm->tree[level+1];
+
+    assert(level < NBYTS-1);	/* this level has pointers */
+    for (i=BYTTAB-1 ; i>=0 ; i--) {
+	t = tree->tptr[i];
+	if (t == NULL) {
+	    fprintf(f, "NULL found in filled tree!\n");
+	} else if (t == fillt) {
+	    /* empty body */
+	} else if (level < NBYTS-2) {	/* more pointer blocks below */
+	    fillcheck(cm, t, level+1, f);
 	}
+    }
 }
-
+
 /*
  - dumpchr - print a chr
  * Kind of char-centric but works well enough for debug use.
  ^ static VOID dumpchr(pchr, FILE *);
  */
-static VOID
-dumpchr(c, f)
-pchr c;
-FILE *f;
+static void
+dumpchr(
+    pchr c,
+    FILE *f)
 {
-	if (c == '\\')
-		fprintf(f, "\\\\");
-	else if (c > ' ' && c <= '~')
-		putc((char)c, f);
-	else
-		fprintf(f, "\\u%04lx", (long)c);
+    if (c == '\\') {
+	fprintf(f, "\\\\");
+    } else if (c > ' ' && c <= '~') {
+	putc((char) c, f);
+    } else {
+	fprintf(f, "\\u%04lx", (long) c);
+    }
 }
 
 /*
  ^ #endif
  */
 #endif				/* ifdef REG_DEBUG */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
index 0b976b8..64f34cd 100644
--- a/generic/regc_cvec.c
+++ b/generic/regc_cvec.c
@@ -6,7 +6,7 @@
  *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
+ * Corporation, none of whom are responsible for the results. The author
  * thanks all of them.
  *
  * Redistribution and use in source and binary forms -- with or without
@@ -14,8 +14,8 @@
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
  *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
  *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
@@ -27,149 +27,120 @@
  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
  */
 
 /*
+ * Notes:
+ * Only (selected) functions in _this_ file should treat chr* as non-constant.
+ */
+
+/*
  - newcvec - allocate a new cvec
- ^ static struct cvec *newcvec(int, int, int);
+ ^ static struct cvec *newcvec(int, int);
  */
 static struct cvec *
-newcvec(nchrs, nranges, nmcces)
-    int nchrs;				/* to hold this many chrs... */
-    int nranges;			/* ... and this many ranges... */
-    int nmcces;				/* ... and this many MCCEs */
+newcvec(
+    int nchrs,			/* to hold this many chrs... */
+    int nranges)		/* ... and this many ranges... */
 {
-    size_t n;
-    size_t nc;
-    struct cvec *cv;
+    size_t nc = (size_t)nchrs + (size_t)nranges*2;
+    size_t n = sizeof(struct cvec) + nc*sizeof(chr);
+    struct cvec *cv = (struct cvec *) MALLOC(n);
 
-    nc = (size_t)nchrs + (size_t)nmcces*(MAXMCCE+1) + (size_t)nranges*2;
-    n = sizeof(struct cvec) + (size_t)(nmcces-1)*sizeof(chr *)
-	    + nc*sizeof(chr);
-    cv = (struct cvec *)MALLOC(n);
     if (cv == NULL) {
 	return NULL;
     }
     cv->chrspace = nchrs;
-    cv->chrs = (chr *)&cv->mcces[nmcces];	/* chrs just after MCCE ptrs */
-    cv->mccespace = nmcces;
-    cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
+    cv->chrs = (chr *)(((char *)cv)+sizeof(struct cvec));
+    cv->ranges = cv->chrs + nchrs;
     cv->rangespace = nranges;
     return clearcvec(cv);
 }
-
+
 /*
  - clearcvec - clear a possibly-new cvec
  * Returns pointer as convenience.
  ^ static struct cvec *clearcvec(struct cvec *);
  */
 static struct cvec *
-clearcvec(cv)
-    struct cvec *cv;			/* character vector */
+clearcvec(
+    struct cvec *cv)		/* character vector */
 {
-    int i;
-
     assert(cv != NULL);
     cv->nchrs = 0;
-    assert(cv->chrs == (chr *)&cv->mcces[cv->mccespace]);
-    cv->nmcces = 0;
-    cv->nmccechrs = 0;
     cv->nranges = 0;
-    for (i = 0; i < cv->mccespace; i++) {
-	cv->mcces[i] = NULL;
-    }
-
     return cv;
 }
-
+
 /*
  - addchr - add a chr to a cvec
  ^ static VOID addchr(struct cvec *, pchr);
  */
-static VOID
-addchr(cv, c)
-    struct cvec *cv;			/* character vector */
-    pchr c;				/* character to add */
+static void
+addchr(
+    struct cvec *cv,		/* character vector */
+    pchr c)			/* character to add */
 {
-    assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
     cv->chrs[cv->nchrs++] = (chr)c;
 }
-
+
 /*
  - addrange - add a range to a cvec
  ^ static VOID addrange(struct cvec *, pchr, pchr);
  */
-static VOID
-addrange(cv, from, to)
-    struct cvec *cv;			/* character vector */
-    pchr from;				/* first character of range */
-    pchr to;				/* last character of range */
+static void
+addrange(
+    struct cvec *cv,		/* character vector */
+    pchr from,			/* first character of range */
+    pchr to)			/* last character of range */
 {
     assert(cv->nranges < cv->rangespace);
     cv->ranges[cv->nranges*2] = (chr)from;
     cv->ranges[cv->nranges*2 + 1] = (chr)to;
     cv->nranges++;
 }
-
-/*
- - haschr - does a cvec contain this chr?
- ^ static int haschr(struct cvec *, pchr);
- */
-static int				/* predicate */
-haschr(cv, c)
-    struct cvec *cv;			/* character vector */
-    pchr c;				/* character to test for */
-{
-    int i;
-    chr *p;
-
-    for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
-	if (*p == c) {
-	    return 1;
-	}
-    }
-    for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
-	if ((*p <= c) && (c <= *(p+1))) {
-	    return 1;
-	}
-    }
-    return 0;
-}
-
+
 /*
  - getcvec - get a cvec, remembering it as v->cv
  ^ static struct cvec *getcvec(struct vars *, int, int);
  */
 static struct cvec *
-getcvec(v, nchrs, nranges)
-    struct vars *v;			/* context */
-    int nchrs;				/* to hold this many chrs... */
-    int nranges;			/* ... and this many ranges... */
+getcvec(
+    struct vars *v,		/* context */
+    int nchrs,			/* to hold this many chrs... */
+    int nranges)		/* ... and this many ranges... */
 {
-    if (v->cv != NULL && nchrs <= v->cv->chrspace &&
-	    nranges <= v->cv->rangespace) {
+    if ((v->cv != NULL) && (nchrs <= v->cv->chrspace) &&
+	    (nranges <= v->cv->rangespace)) {
 	return clearcvec(v->cv);
     }
 
     if (v->cv != NULL) {
 	freecvec(v->cv);
     }
-    v->cv = newcvec(nchrs, nranges, 0);
+    v->cv = newcvec(nchrs, nranges);
     if (v->cv == NULL) {
 	ERR(REG_ESPACE);
     }
 
     return v->cv;
 }
-
+
 /*
  - freecvec - free a cvec
  ^ static VOID freecvec(struct cvec *);
  */
-static VOID
-freecvec(cv)
-    struct cvec *cv;			/* character vector */
+static void
+freecvec(
+    struct cvec *cv)		/* character vector */
 {
     FREE(cv);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 99497b9..8d07c59 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -3,20 +3,20 @@
  * This file is #included by regcomp.c.
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -27,7 +27,6 @@
  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
  */
 
 /* scanning macros (know about v) */
@@ -35,9 +34,10 @@
 #define	HAVE(n)		(v->stop - v->now >= (n))
 #define	NEXT1(c)	(!ATEOS() && *v->now == CHR(c))
 #define	NEXT2(a,b)	(HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))
-#define	NEXT3(a,b,c)	(HAVE(3) && *v->now == CHR(a) && \
-						*(v->now+1) == CHR(b) && \
-						*(v->now+2) == CHR(c))
+#define	NEXT3(a,b,c) \
+	(HAVE(3) && *v->now == CHR(a) && \
+		*(v->now+1) == CHR(b) && \
+		*(v->now+2) == CHR(c))
 #define	SET(c)		(v->nexttype = (c))
 #define	SETV(c, n)	(v->nexttype = (c), v->nextvalue = (n))
 #define	RET(c)		return (SET(c), 1)
@@ -60,804 +60,907 @@
 
 /* construct pointer past end of chr array */
 #define	ENDOF(array)	((array) + sizeof(array)/sizeof(chr))
-
+
 /*
  - lexstart - set up lexical stuff, scan leading options
  ^ static VOID lexstart(struct vars *);
  */
-static VOID
-lexstart(v)
-struct vars *v;
+static void
+lexstart(
+    struct vars *v)
 {
-	prefixes(v);			/* may turn on new type bits etc. */
-	NOERR();
+    prefixes(v);		/* may turn on new type bits etc. */
+    NOERR();
 
-	if (v->cflags&REG_QUOTE) {
-		assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
-		INTOCON(L_Q);
-	} else if (v->cflags&REG_EXTENDED) {
-		assert(!(v->cflags&REG_QUOTE));
-		INTOCON(L_ERE);
-	} else {
-		assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
-		INTOCON(L_BRE);
-	}
+    if (v->cflags&REG_QUOTE) {
+	assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
+	INTOCON(L_Q);
+    } else if (v->cflags&REG_EXTENDED) {
+	assert(!(v->cflags&REG_QUOTE));
+	INTOCON(L_ERE);
+    } else {
+	assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
+	INTOCON(L_BRE);
+    }
 
-	v->nexttype = EMPTY;		/* remember we were at the start */
-	next(v);			/* set up the first token */
+    v->nexttype = EMPTY;	/* remember we were at the start */
+    next(v);			/* set up the first token */
 }
-
+
 /*
  - prefixes - implement various special prefixes
  ^ static VOID prefixes(struct vars *);
  */
-static VOID
-prefixes(v)
-struct vars *v;
+static void
+prefixes(
+    struct vars *v)
 {
-	/* literal string doesn't get any of this stuff */
-	if (v->cflags&REG_QUOTE)
-		return;
+    /*
+     * Literal string doesn't get any of this stuff.
+     */
 
-	/* initial "***" gets special things */	
-	if (HAVE(4) && NEXT3('*', '*', '*'))
-		switch (*(v->now + 3)) {
-		case CHR('?'):		/* "***?" error, msg shows version */
-			ERR(REG_BADPAT);
-			return;		/* proceed no further */
-			break;
-		case CHR('='):		/* "***=" shifts to literal string */
-			NOTE(REG_UNONPOSIX);
-			v->cflags |= REG_QUOTE;
-			v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
-			v->now += 4;
-			return;		/* and there can be no more prefixes */
-			break;
-		case CHR(':'):		/* "***:" shifts to AREs */
-			NOTE(REG_UNONPOSIX);
-			v->cflags |= REG_ADVANCED;
-			v->now += 4;
-			break;
-		default:		/* otherwise *** is just an error */
-			ERR(REG_BADRPT);
-			return;
-			break;
-		}
+    if (v->cflags&REG_QUOTE) {
+	return;
+    }
 
-	/* BREs and EREs don't get embedded options */
-	if ((v->cflags&REG_ADVANCED) != REG_ADVANCED)
-		return;
+    /*
+     * Initial "***" gets special things.
+     */
 
-	/* embedded options (AREs only) */
-	if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
-		NOTE(REG_UNONPOSIX);
-		v->now += 2;
-		for (; !ATEOS() && iscalpha(*v->now); v->now++)
-			switch (*v->now) {
-			case CHR('b'):		/* BREs (but why???) */
-				v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
-				break;
-			case CHR('c'):		/* case sensitive */
-				v->cflags &= ~REG_ICASE;
-				break;
-			case CHR('e'):		/* plain EREs */
-				v->cflags |= REG_EXTENDED;
-				v->cflags &= ~(REG_ADVF|REG_QUOTE);
-				break;
-			case CHR('i'):		/* case insensitive */
-				v->cflags |= REG_ICASE;
-				break;
-			case CHR('m'):		/* Perloid synonym for n */
-			case CHR('n'):		/* \n affects ^ $ . [^ */
-				v->cflags |= REG_NEWLINE;
-				break;
-			case CHR('p'):		/* ~Perl, \n affects . [^ */
-				v->cflags |= REG_NLSTOP;
-				v->cflags &= ~REG_NLANCH;
-				break;
-			case CHR('q'):		/* literal string */
-				v->cflags |= REG_QUOTE;
-				v->cflags &= ~REG_ADVANCED;
-				break;
-			case CHR('s'):		/* single line, \n ordinary */
-				v->cflags &= ~REG_NEWLINE;
-				break;
-			case CHR('t'):		/* tight syntax */
-				v->cflags &= ~REG_EXPANDED;
-				break;
-			case CHR('w'):		/* weird, \n affects ^ $ only */
-				v->cflags &= ~REG_NLSTOP;
-				v->cflags |= REG_NLANCH;
-				break;
-			case CHR('x'):		/* expanded syntax */
-				v->cflags |= REG_EXPANDED;
-				break;
-			default:
-				ERR(REG_BADOPT);
-				return;
-			}
-		if (!NEXT1(')')) {
-			ERR(REG_BADOPT);
-			return;
-		}
-		v->now++;
-		if (v->cflags&REG_QUOTE)
-			v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+    if (HAVE(4) && NEXT3('*', '*', '*')) {
+	switch (*(v->now + 3)) {
+	case CHR('?'):		/* "***?" error, msg shows version */
+	    ERR(REG_BADPAT);
+	    return;		/* proceed no further */
+	    break;
+	case CHR('='):		/* "***=" shifts to literal string */
+	    NOTE(REG_UNONPOSIX);
+	    v->cflags |= REG_QUOTE;
+	    v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
+	    v->now += 4;
+	    return;		/* and there can be no more prefixes */
+	    break;
+	case CHR(':'):		/* "***:" shifts to AREs */
+	    NOTE(REG_UNONPOSIX);
+	    v->cflags |= REG_ADVANCED;
+	    v->now += 4;
+	    break;
+	default:		/* otherwise *** is just an error */
+	    ERR(REG_BADRPT);
+	    return;
+	    break;
 	}
-}
+    }
 
+    /*
+     * BREs and EREs don't get embedded options.
+     */
+
+    if ((v->cflags&REG_ADVANCED) != REG_ADVANCED) {
+	return;
+    }
+
+    /*
+     * Embedded options (AREs only).
+     */
+
+    if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
+	NOTE(REG_UNONPOSIX);
+	v->now += 2;
+	for (; !ATEOS() && iscalpha(*v->now); v->now++) {
+	    switch (*v->now) {
+	    case CHR('b'):	/* BREs (but why???) */
+		v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
+		break;
+	    case CHR('c'):	/* case sensitive */
+		v->cflags &= ~REG_ICASE;
+		break;
+	    case CHR('e'):	/* plain EREs */
+		v->cflags |= REG_EXTENDED;
+		v->cflags &= ~(REG_ADVF|REG_QUOTE);
+		break;
+	    case CHR('i'):	/* case insensitive */
+		v->cflags |= REG_ICASE;
+		break;
+	    case CHR('m'):	/* Perloid synonym for n */
+	    case CHR('n'):	/* \n affects ^ $ . [^ */
+		v->cflags |= REG_NEWLINE;
+		break;
+	    case CHR('p'):	/* ~Perl, \n affects . [^ */
+		v->cflags |= REG_NLSTOP;
+		v->cflags &= ~REG_NLANCH;
+		break;
+	    case CHR('q'):	/* literal string */
+		v->cflags |= REG_QUOTE;
+		v->cflags &= ~REG_ADVANCED;
+		break;
+	    case CHR('s'):	/* single line, \n ordinary */
+		v->cflags &= ~REG_NEWLINE;
+		break;
+	    case CHR('t'):	/* tight syntax */
+		v->cflags &= ~REG_EXPANDED;
+		break;
+	    case CHR('w'):	/* weird, \n affects ^ $ only */
+		v->cflags &= ~REG_NLSTOP;
+		v->cflags |= REG_NLANCH;
+		break;
+	    case CHR('x'):	/* expanded syntax */
+		v->cflags |= REG_EXPANDED;
+		break;
+	    default:
+		ERR(REG_BADOPT);
+		return;
+	    }
+	}
+	if (!NEXT1(')')) {
+	    ERR(REG_BADOPT);
+	    return;
+	}
+	v->now++;
+	if (v->cflags&REG_QUOTE) {
+	    v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+	}
+    }
+}
+
 /*
  - lexnest - "call a subroutine", interpolating string at the lexical level
  * Note, this is not a very general facility.  There are a number of
  * implicit assumptions about what sorts of strings can be subroutines.
- ^ static VOID lexnest(struct vars *, chr *, chr *);
+ ^ static VOID lexnest(struct vars *, const chr *, const chr *);
  */
-static VOID
-lexnest(v, beginp, endp)
-struct vars *v;
-CONST chr *beginp;		/* start of interpolation */
-CONST chr *endp;		/* one past end of interpolation */
+static void
+lexnest(
+    struct vars *v,
+    const chr *beginp,		/* start of interpolation */
+    const chr *endp)		/* one past end of interpolation */
 {
-	assert(v->savenow == NULL);	/* only one level of nesting */
-	v->savenow = v->now;
-	v->savestop = v->stop;
-	v->now = beginp;
-	v->stop = endp;
+    assert(v->savenow == NULL);	/* only one level of nesting */
+    v->savenow = v->now;
+    v->savestop = v->stop;
+    v->now = beginp;
+    v->stop = endp;
 }
-
+
 /*
  * string constants to interpolate as expansions of things like \d
  */
-static CONST chr backd[] = {		/* \d */
-	CHR('['), CHR('['), CHR(':'),
-	CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
-	CHR(':'), CHR(']'), CHR(']')
+
+static const chr backd[] = {	/* \d */
+    CHR('['), CHR('['), CHR(':'),
+    CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+    CHR(':'), CHR(']'), CHR(']')
 };
-static CONST chr backD[] = {		/* \D */
-	CHR('['), CHR('^'), CHR('['), CHR(':'),
-	CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
-	CHR(':'), CHR(']'), CHR(']')
+static const chr backD[] = {	/* \D */
+    CHR('['), CHR('^'), CHR('['), CHR(':'),
+    CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+    CHR(':'), CHR(']'), CHR(']')
 };
-static CONST chr brbackd[] = {	/* \d within brackets */
-	CHR('['), CHR(':'),
-	CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
-	CHR(':'), CHR(']')
+static const chr brbackd[] = {	/* \d within brackets */
+    CHR('['), CHR(':'),
+    CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+    CHR(':'), CHR(']')
 };
-static CONST chr backs[] = {		/* \s */
-	CHR('['), CHR('['), CHR(':'),
-	CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
-	CHR(':'), CHR(']'), CHR(']')
+static const chr backs[] = {	/* \s */
+    CHR('['), CHR('['), CHR(':'),
+    CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+    CHR(':'), CHR(']'), CHR(']')
 };
-static CONST chr backS[] = {		/* \S */
-	CHR('['), CHR('^'), CHR('['), CHR(':'),
-	CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
-	CHR(':'), CHR(']'), CHR(']')
+static const chr backS[] = {	/* \S */
+    CHR('['), CHR('^'), CHR('['), CHR(':'),
+    CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+    CHR(':'), CHR(']'), CHR(']')
 };
-static CONST chr brbacks[] = {	/* \s within brackets */
-	CHR('['), CHR(':'),
-	CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
-	CHR(':'), CHR(']')
+static const chr brbacks[] = {	/* \s within brackets */
+    CHR('['), CHR(':'),
+    CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+    CHR(':'), CHR(']')
 };
-static CONST chr backw[] = {		/* \w */
-	CHR('['), CHR('['), CHR(':'),
-	CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-	CHR(':'), CHR(']'), CHR('_'), CHR(']')
+static const chr backw[] = {	/* \w */
+    CHR('['), CHR('['), CHR(':'),
+    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+    CHR(':'), CHR(']'), CHR('_'), CHR(']')
 };
-static CONST chr backW[] = {		/* \W */
-	CHR('['), CHR('^'), CHR('['), CHR(':'),
-	CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-	CHR(':'), CHR(']'), CHR('_'), CHR(']')
+static const chr backW[] = {	/* \W */
+    CHR('['), CHR('^'), CHR('['), CHR(':'),
+    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+    CHR(':'), CHR(']'), CHR('_'), CHR(']')
 };
-static CONST chr brbackw[] = {	/* \w within brackets */
-	CHR('['), CHR(':'),
-	CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
-	CHR(':'), CHR(']'), CHR('_')
+static const chr brbackw[] = {	/* \w within brackets */
+    CHR('['), CHR(':'),
+    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+    CHR(':'), CHR(']'), CHR('_')
 };
-
+
 /*
  - lexword - interpolate a bracket expression for word characters
  * Possibly ought to inquire whether there is a "word" character class.
  ^ static VOID lexword(struct vars *);
  */
-static VOID
-lexword(v)
-struct vars *v;
+static void
+lexword(
+    struct vars *v)
 {
-	lexnest(v, backw, ENDOF(backw));
+    lexnest(v, backw, ENDOF(backw));
 }
-
+
 /*
  - next - get next token
  ^ static int next(struct vars *);
  */
 static int			/* 1 normal, 0 failure */
-next(v)
-struct vars *v;
+next(
+    struct vars *v)
 {
-	chr c;
+    chr c;
 
-	/* errors yield an infinite sequence of failures */
-	if (ISERR())
-		return 0;	/* the error has set nexttype to EOS */
+    /*
+     * Errors yield an infinite sequence of failures.
+     */
 
-	/* remember flavor of last token */
-	v->lasttype = v->nexttype;
+    if (ISERR()) {
+	return 0;		/* the error has set nexttype to EOS */
+    }
 
-	/* REG_BOSONLY */
-	if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
-		/* at start of a REG_BOSONLY RE */
-		RETV(SBEGIN, 0);		/* same as \A */
-	}
+    /*
+     * Remember flavor of last token.
+     */
 
-	/* if we're nested and we've hit end, return to outer level */
-	if (v->savenow != NULL && ATEOS()) {
-		v->now = v->savenow;
-		v->stop = v->savestop;
-		v->savenow = v->savestop = NULL;
-	}
+    v->lasttype = v->nexttype;
 
-	/* skip white space etc. if appropriate (not in literal or []) */
-	if (v->cflags&REG_EXPANDED)
-		switch (v->lexcon) {
-		case L_ERE:
-		case L_BRE:
-		case L_EBND:
-		case L_BBND:
-			skip(v);
-			break;
-		}
+    /*
+     * REG_BOSONLY
+     */
 
-	/* handle EOS, depending on context */
-	if (ATEOS()) {
-		switch (v->lexcon) {
-		case L_ERE:
-		case L_BRE:
-		case L_Q:
-			RET(EOS);
-			break;
-		case L_EBND:
-		case L_BBND:
-			FAILW(REG_EBRACE);
-			break;
-		case L_BRACK:
-		case L_CEL:
-		case L_ECL:
-		case L_CCL:
-			FAILW(REG_EBRACK);
-			break;
-		}
-		assert(NOTREACHED);
+    if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
+	/* at start of a REG_BOSONLY RE */
+	RETV(SBEGIN, 0);	/* same as \A */
+    }
+
+    /*
+     * If we're nested and we've hit end, return to outer level.
+     */
+
+    if (v->savenow != NULL && ATEOS()) {
+	v->now = v->savenow;
+	v->stop = v->savestop;
+	v->savenow = v->savestop = NULL;
+    }
+
+    /*
+     * Skip white space etc. if appropriate (not in literal or [])
+     */
+
+    if (v->cflags&REG_EXPANDED) {
+	switch (v->lexcon) {
+	case L_ERE:
+	case L_BRE:
+	case L_EBND:
+	case L_BBND:
+	    skip(v);
+	    break;
 	}
+    }
 
-	/* okay, time to actually get a character */
-	c = *v->now++;
+    /*
+     * Handle EOS, depending on context.
+     */
 
-	/* deal with the easy contexts, punt EREs to code below */
+    if (ATEOS()) {
 	switch (v->lexcon) {
-	case L_BRE:			/* punt BREs to separate function */
-		return brenext(v, c);
-		break;
-	case L_ERE:			/* see below */
-		break;
-	case L_Q:			/* literal strings are easy */
-		RETV(PLAIN, c);
-		break;
-	case L_BBND:			/* bounds are fairly simple */
+	case L_ERE:
+	case L_BRE:
+	case L_Q:
+	    RET(EOS);
+	    break;
 	case L_EBND:
-		switch (c) {
-		case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
-		case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
-		case CHR('8'): case CHR('9'):
-			RETV(DIGIT, (chr)DIGITVAL(c));
-			break;
-		case CHR(','):
-			RET(',');
-			break;
-		case CHR('}'):		/* ERE bound ends with } */
-			if (INCON(L_EBND)) {
-				INTOCON(L_ERE);
-				if ((v->cflags&REG_ADVF) && NEXT1('?')) {
-					v->now++;
-					NOTE(REG_UNONPOSIX);
-					RETV('}', 0);
-				}
-				RETV('}', 1);
-			} else
-				FAILW(REG_BADBR);
-			break;
-		case CHR('\\'):		/* BRE bound ends with \} */
-			if (INCON(L_BBND) && NEXT1('}')) {
-				v->now++;
-				INTOCON(L_BRE);
-				RET('}');
-			} else
-				FAILW(REG_BADBR);
-			break;
-		default:
-			FAILW(REG_BADBR);
-			break;
-		}
-		assert(NOTREACHED);
-		break;
-	case L_BRACK:			/* brackets are not too hard */
-		switch (c) {
-		case CHR(']'):
-			if (LASTTYPE('['))
-				RETV(PLAIN, c);
-			else {
-				INTOCON((v->cflags&REG_EXTENDED) ?
-							L_ERE : L_BRE);
-				RET(']');
-			}
-			break;
-		case CHR('\\'):
-			NOTE(REG_UBBS);
-			if (!(v->cflags&REG_ADVF))
-				RETV(PLAIN, c);
-			NOTE(REG_UNONPOSIX);
-			if (ATEOS())
-				FAILW(REG_EESCAPE);
-			(DISCARD)lexescape(v);
-			switch (v->nexttype) {	/* not all escapes okay here */
-			case PLAIN:
-				return 1;
-				break;
-			case CCLASS:
-				switch (v->nextvalue) {
-				case 'd':
-					lexnest(v, brbackd, ENDOF(brbackd));
-					break;
-				case 's':
-					lexnest(v, brbacks, ENDOF(brbacks));
-					break;
-				case 'w':
-					lexnest(v, brbackw, ENDOF(brbackw));
-					break;
-				default:
-					FAILW(REG_EESCAPE);
-					break;
-				}
-				/* lexnest done, back up and try again */
-				v->nexttype = v->lasttype;
-				return next(v);
-				break;
-			}
-			/* not one of the acceptable escapes */
-			FAILW(REG_EESCAPE);
-			break;
-		case CHR('-'):
-			if (LASTTYPE('[') || NEXT1(']'))
-				RETV(PLAIN, c);
-			else
-				RETV(RANGE, c);
-			break;
-		case CHR('['):
-			if (ATEOS())
-				FAILW(REG_EBRACK);
-			switch (*v->now++) {
-			case CHR('.'):
-				INTOCON(L_CEL);
-				/* might or might not be locale-specific */
-				RET(COLLEL);
-				break;
-			case CHR('='):
-				INTOCON(L_ECL);
-				NOTE(REG_ULOCALE);
-				RET(ECLASS);
-				break;
-			case CHR(':'):
-				INTOCON(L_CCL);
-				NOTE(REG_ULOCALE);
-				RET(CCLASS);
-				break;
-			default:			/* oops */
-				v->now--;
-				RETV(PLAIN, c);
-				break;
-			}
-			assert(NOTREACHED);
-			break;
-		default:
-			RETV(PLAIN, c);
-			break;
-		}
-		assert(NOTREACHED);
-		break;
-	case L_CEL:			/* collating elements are easy */
-		if (c == CHR('.') && NEXT1(']')) {
-			v->now++;
-			INTOCON(L_BRACK);
-			RETV(END, '.');
-		} else
-			RETV(PLAIN, c);
-		break;
-	case L_ECL:			/* ditto equivalence classes */
-		if (c == CHR('=') && NEXT1(']')) {
-			v->now++;
-			INTOCON(L_BRACK);
-			RETV(END, '=');
-		} else
-			RETV(PLAIN, c);
-		break;
-	case L_CCL:			/* ditto character classes */
-		if (c == CHR(':') && NEXT1(']')) {
-			v->now++;
-			INTOCON(L_BRACK);
-			RETV(END, ':');
-		} else
-			RETV(PLAIN, c);
-		break;
-	default:
-		assert(NOTREACHED);
-		break;
+	case L_BBND:
+	    FAILW(REG_EBRACE);
+	    break;
+	case L_BRACK:
+	case L_CEL:
+	case L_ECL:
+	case L_CCL:
+	    FAILW(REG_EBRACK);
+	    break;
 	}
+	assert(NOTREACHED);
+    }
+
+    /*
+     * Okay, time to actually get a character.
+     */
+
+    c = *v->now++;
 
-	/* that got rid of everything except EREs and AREs */
-	assert(INCON(L_ERE));
+    /*
+     * Deal with the easy contexts, punt EREs to code below.
+     */
 
-	/* deal with EREs and AREs, except for backslashes */
+    switch (v->lexcon) {
+    case L_BRE:			/* punt BREs to separate function */
+	return brenext(v, c);
+	break;
+    case L_ERE:			/* see below */
+	break;
+    case L_Q:			/* literal strings are easy */
+	RETV(PLAIN, c);
+	break;
+    case L_BBND:		/* bounds are fairly simple */
+    case L_EBND:
 	switch (c) {
-	case CHR('|'):
-		RET('|');
-		break;
-	case CHR('*'):
+	case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
+	case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+	case CHR('8'): case CHR('9'):
+	    RETV(DIGIT, (chr)DIGITVAL(c));
+	    break;
+	case CHR(','):
+	    RET(',');
+	    break;
+	case CHR('}'):		/* ERE bound ends with } */
+	    if (INCON(L_EBND)) {
+		INTOCON(L_ERE);
 		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
-			v->now++;
-			NOTE(REG_UNONPOSIX);
-			RETV('*', 0);
+		    v->now++;
+		    NOTE(REG_UNONPOSIX);
+		    RETV('}', 0);
 		}
-		RETV('*', 1);
+		RETV('}', 1);
+	    } else {
+		FAILW(REG_BADBR);
+	    }
+	    break;
+	case CHR('\\'):		/* BRE bound ends with \} */
+	    if (INCON(L_BBND) && NEXT1('}')) {
+		v->now++;
+		INTOCON(L_BRE);
+		RET('}');
+	    } else {
+		FAILW(REG_BADBR);
+	    }
+	    break;
+	default:
+	    FAILW(REG_BADBR);
+	    break;
+	}
+	assert(NOTREACHED);
+	break;
+    case L_BRACK:		/* brackets are not too hard */
+	switch (c) {
+	case CHR(']'):
+	    if (LASTTYPE('[')) {
+		RETV(PLAIN, c);
+	    } else {
+		INTOCON((v->cflags&REG_EXTENDED) ? L_ERE : L_BRE);
+		RET(']');
+	    }
+	    break;
+	case CHR('\\'):
+	    NOTE(REG_UBBS);
+	    if (!(v->cflags&REG_ADVF)) {
+		RETV(PLAIN, c);
+	    }
+	    NOTE(REG_UNONPOSIX);
+	    if (ATEOS()) {
+		FAILW(REG_EESCAPE);
+	    }
+	    (DISCARD)lexescape(v);
+	    switch (v->nexttype) {	/* not all escapes okay here */
+	    case PLAIN:
+		return 1;
 		break;
-	case CHR('+'):
-		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
-			v->now++;
-			NOTE(REG_UNONPOSIX);
-			RETV('+', 0);
+	    case CCLASS:
+		switch (v->nextvalue) {
+		case 'd':
+		    lexnest(v, brbackd, ENDOF(brbackd));
+		    break;
+		case 's':
+		    lexnest(v, brbacks, ENDOF(brbacks));
+		    break;
+		case 'w':
+		    lexnest(v, brbackw, ENDOF(brbackw));
+		    break;
+		default:
+		    FAILW(REG_EESCAPE);
+		    break;
 		}
-		RETV('+', 1);
+
+		/*
+		 * lexnest() done, back up and try again.
+		 */
+
+		v->nexttype = v->lasttype;
+		return next(v);
 		break;
-	case CHR('?'):
-		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
-			v->now++;
-			NOTE(REG_UNONPOSIX);
-			RETV('?', 0);
-		}
-		RETV('?', 1);
+	    }
+
+	    /*
+	     * Not one of the acceptable escapes.
+	     */
+
+	    FAILW(REG_EESCAPE);
+	    break;
+	case CHR('-'):
+	    if (LASTTYPE('[') || NEXT1(']')) {
+		RETV(PLAIN, c);
+	    } else {
+		RETV(RANGE, c);
+	    }
+	    break;
+	case CHR('['):
+	    if (ATEOS()) {
+		FAILW(REG_EBRACK);
+	    }
+	    switch (*v->now++) {
+	    case CHR('.'):
+		INTOCON(L_CEL);
+
+		/*
+		 * Might or might not be locale-specific.
+		 */
+
+		RET(COLLEL);
 		break;
-	case CHR('{'):		/* bounds start or plain character */
-		if (v->cflags&REG_EXPANDED)
-			skip(v);
-		if (ATEOS() || !iscdigit(*v->now)) {
-			NOTE(REG_UBRACES);
-			NOTE(REG_UUNSPEC);
-			RETV(PLAIN, c);
-		} else {
-			NOTE(REG_UBOUNDS);
-			INTOCON(L_EBND);
-			RET('{');
-		}
-		assert(NOTREACHED);
+	    case CHR('='):
+		INTOCON(L_ECL);
+		NOTE(REG_ULOCALE);
+		RET(ECLASS);
 		break;
-	case CHR('('):		/* parenthesis, or advanced extension */
-		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
-			NOTE(REG_UNONPOSIX);
-			v->now++;
-			switch (*v->now++) {
-			case CHR(':'):		/* non-capturing paren */
-				RETV('(', 0);
-				break;
-			case CHR('#'):		/* comment */
-				while (!ATEOS() && *v->now != CHR(')'))
-					v->now++;
-				if (!ATEOS())
-					v->now++;
-				assert(v->nexttype == v->lasttype);
-				return next(v);
-				break;
-			case CHR('='):		/* positive lookahead */
-				NOTE(REG_ULOOKAHEAD);
-				RETV(LACON, 1);
-				break;
-			case CHR('!'):		/* negative lookahead */
-				NOTE(REG_ULOOKAHEAD);
-				RETV(LACON, 0);
-				break;
-			default:
-				FAILW(REG_BADRPT);
-				break;
-			}
-			assert(NOTREACHED);
-		}
-		if (v->cflags&REG_NOSUB)
-			RETV('(', 0);		/* all parens non-capturing */
-		else
-			RETV('(', 1);
+	    case CHR(':'):
+		INTOCON(L_CCL);
+		NOTE(REG_ULOCALE);
+		RET(CCLASS);
 		break;
-	case CHR(')'):
-		if (LASTTYPE('(')) {
-			NOTE(REG_UUNSPEC);
-		}
-		RETV(')', c);
+	    default:		/* oops */
+		v->now--;
+		RETV(PLAIN, c);
 		break;
-	case CHR('['):		/* easy except for [[:<:]] and [[:>:]] */
-		if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
-				*(v->now+1) == CHR(':') &&
-				(*(v->now+2) == CHR('<') ||
-						*(v->now+2) == CHR('>')) &&
-				*(v->now+3) == CHR(':') &&
-				*(v->now+4) == CHR(']') &&
-				*(v->now+5) == CHR(']')) {
-			c = *(v->now+2);
-			v->now += 6;
-			NOTE(REG_UNONPOSIX);
-			RET((c == CHR('<')) ? '<' : '>');
+	    }
+	    assert(NOTREACHED);
+	    break;
+	default:
+	    RETV(PLAIN, c);
+	    break;
+	}
+	assert(NOTREACHED);
+	break;
+    case L_CEL:			/* collating elements are easy */
+	if (c == CHR('.') && NEXT1(']')) {
+	    v->now++;
+	    INTOCON(L_BRACK);
+	    RETV(END, '.');
+	} else {
+	    RETV(PLAIN, c);
+	}
+	break;
+    case L_ECL:			/* ditto equivalence classes */
+	if (c == CHR('=') && NEXT1(']')) {
+	    v->now++;
+	    INTOCON(L_BRACK);
+	    RETV(END, '=');
+	} else {
+	    RETV(PLAIN, c);
+	}
+	break;
+    case L_CCL:			/* ditto character classes */
+	if (c == CHR(':') && NEXT1(']')) {
+	    v->now++;
+	    INTOCON(L_BRACK);
+	    RETV(END, ':');
+	} else {
+	    RETV(PLAIN, c);
+	}
+	break;
+    default:
+	assert(NOTREACHED);
+	break;
+    }
+
+    /*
+     * That got rid of everything except EREs and AREs.
+     */
+
+    assert(INCON(L_ERE));
+
+    /*
+     * Deal with EREs and AREs, except for backslashes.
+     */
+
+    switch (c) {
+    case CHR('|'):
+	RET('|');
+	break;
+    case CHR('*'):
+	if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+	    v->now++;
+	    NOTE(REG_UNONPOSIX);
+	    RETV('*', 0);
+	}
+	RETV('*', 1);
+	break;
+    case CHR('+'):
+	if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+	    v->now++;
+	    NOTE(REG_UNONPOSIX);
+	    RETV('+', 0);
+	}
+	RETV('+', 1);
+	break;
+    case CHR('?'):
+	if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+	    v->now++;
+	    NOTE(REG_UNONPOSIX);
+	    RETV('?', 0);
+	}
+	RETV('?', 1);
+	break;
+    case CHR('{'):		/* bounds start or plain character */
+	if (v->cflags&REG_EXPANDED) {
+	    skip(v);
+	}
+	if (ATEOS() || !iscdigit(*v->now)) {
+	    NOTE(REG_UBRACES);
+	    NOTE(REG_UUNSPEC);
+	    RETV(PLAIN, c);
+	} else {
+	    NOTE(REG_UBOUNDS);
+	    INTOCON(L_EBND);
+	    RET('{');
+	}
+	assert(NOTREACHED);
+	break;
+    case CHR('('):		/* parenthesis, or advanced extension */
+	if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+	    NOTE(REG_UNONPOSIX);
+	    v->now++;
+	    switch (*v->now++) {
+	    case CHR(':'):	/* non-capturing paren */
+		RETV('(', 0);
+		break;
+	    case CHR('#'):	/* comment */
+		while (!ATEOS() && *v->now != CHR(')')) {
+		    v->now++;
 		}
-		INTOCON(L_BRACK);
-		if (NEXT1('^')) {
-			v->now++;
-			RETV('[', 0);
+		if (!ATEOS()) {
+		    v->now++;
 		}
-		RETV('[', 1);
-		break;
-	case CHR('.'):
-		RET('.');
+		assert(v->nexttype == v->lasttype);
+		return next(v);
 		break;
-	case CHR('^'):
-		RET('^');
+	    case CHR('='):	/* positive lookahead */
+		NOTE(REG_ULOOKAHEAD);
+		RETV(LACON, 1);
 		break;
-	case CHR('$'):
-		RET('$');
+	    case CHR('!'):	/* negative lookahead */
+		NOTE(REG_ULOOKAHEAD);
+		RETV(LACON, 0);
 		break;
-	case CHR('\\'):		/* mostly punt backslashes to code below */
-		if (ATEOS())
-			FAILW(REG_EESCAPE);
-		break;
-	default:		/* ordinary character */
-		RETV(PLAIN, c);
+	    default:
+		FAILW(REG_BADRPT);
 		break;
+	    }
+	    assert(NOTREACHED);
+	}
+	if (v->cflags&REG_NOSUB) {
+	    RETV('(', 0);	/* all parens non-capturing */
+	} else {
+	    RETV('(', 1);
+	}
+	break;
+    case CHR(')'):
+	if (LASTTYPE('(')) {
+	    NOTE(REG_UUNSPEC);
+	}
+	RETV(')', c);
+	break;
+    case CHR('['):		/* easy except for [[:<:]] and [[:>:]] */
+	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
+		*(v->now+1) == CHR(':') &&
+		(*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
+		*(v->now+3) == CHR(':') &&
+		*(v->now+4) == CHR(']') &&
+		*(v->now+5) == CHR(']')) {
+	    c = *(v->now+2);
+	    v->now += 6;
+	    NOTE(REG_UNONPOSIX);
+	    RET((c == CHR('<')) ? '<' : '>');
+	}
+	INTOCON(L_BRACK);
+	if (NEXT1('^')) {
+	    v->now++;
+	    RETV('[', 0);
+	}
+	RETV('[', 1);
+	break;
+    case CHR('.'):
+	RET('.');
+	break;
+    case CHR('^'):
+	RET('^');
+	break;
+    case CHR('$'):
+	RET('$');
+	break;
+    case CHR('\\'):		/* mostly punt backslashes to code below */
+	if (ATEOS()) {
+	    FAILW(REG_EESCAPE);
 	}
+	break;
+    default:		/* ordinary character */
+	RETV(PLAIN, c);
+	break;
+    }
 
-	/* ERE/ARE backslash handling; backslash already eaten */
-	assert(!ATEOS());
-	if (!(v->cflags&REG_ADVF)) {	/* only AREs have non-trivial escapes */
-		if (iscalnum(*v->now)) {
-			NOTE(REG_UBSALNUM);
-			NOTE(REG_UUNSPEC);
-		}
-		RETV(PLAIN, *v->now++);
+    /*
+     * ERE/ARE backslash handling; backslash already eaten.
+     */
+
+    assert(!ATEOS());
+    if (!(v->cflags&REG_ADVF)) {/* only AREs have non-trivial escapes */
+	if (iscalnum(*v->now)) {
+	    NOTE(REG_UBSALNUM);
+	    NOTE(REG_UUNSPEC);
 	}
-	(DISCARD)lexescape(v);
-	if (ISERR())
-		FAILW(REG_EESCAPE);
-	if (v->nexttype == CCLASS) {	/* fudge at lexical level */
-		switch (v->nextvalue) {
-		case 'd':	lexnest(v, backd, ENDOF(backd)); break;
-		case 'D':	lexnest(v, backD, ENDOF(backD)); break;
-		case 's':	lexnest(v, backs, ENDOF(backs)); break;
-		case 'S':	lexnest(v, backS, ENDOF(backS)); break;
-		case 'w':	lexnest(v, backw, ENDOF(backw)); break;
-		case 'W':	lexnest(v, backW, ENDOF(backW)); break;
-		default:
-			assert(NOTREACHED);
-			FAILW(REG_ASSERT);
-			break;
-		}
-		/* lexnest done, back up and try again */
-		v->nexttype = v->lasttype;
-		return next(v);
+	RETV(PLAIN, *v->now++);
+    }
+    (DISCARD)lexescape(v);
+    if (ISERR()) {
+	FAILW(REG_EESCAPE);
+    }
+    if (v->nexttype == CCLASS) {/* fudge at lexical level */
+	switch (v->nextvalue) {
+	case 'd':	lexnest(v, backd, ENDOF(backd)); break;
+	case 'D':	lexnest(v, backD, ENDOF(backD)); break;
+	case 's':	lexnest(v, backs, ENDOF(backs)); break;
+	case 'S':	lexnest(v, backS, ENDOF(backS)); break;
+	case 'w':	lexnest(v, backw, ENDOF(backw)); break;
+	case 'W':	lexnest(v, backW, ENDOF(backW)); break;
+	default:
+	    assert(NOTREACHED);
+	    FAILW(REG_ASSERT);
+	    break;
 	}
-	/* otherwise, lexescape has already done the work */
-	return !ISERR();
-}
+	/* lexnest done, back up and try again */
+	v->nexttype = v->lasttype;
+	return next(v);
+    }
+
+    /*
+     * Otherwise, lexescape has already done the work.
+     */
 
+    return !ISERR();
+}
+
 /*
  - lexescape - parse an ARE backslash escape (backslash already eaten)
  * Note slightly nonstandard use of the CCLASS type code.
  ^ static int lexescape(struct vars *);
  */
 static int			/* not actually used, but convenient for RETV */
-lexescape(v)
-struct vars *v;
+lexescape(
+    struct vars *v)
 {
-	chr c;
-	static CONST chr alert[] = {
-		CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
-	};
-	static CONST chr esc[] = {
-		CHR('E'), CHR('S'), CHR('C')
-	};
-	CONST chr *save;
-
-	assert(v->cflags&REG_ADVF);
-
-	assert(!ATEOS());
-	c = *v->now++;
-	if (!iscalnum(c))
-		RETV(PLAIN, c);
+    chr c;
+    static const chr alert[] = {
+	CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
+    };
+    static const chr esc[] = {
+	CHR('E'), CHR('S'), CHR('C')
+    };
+    const chr *save;
 
-	NOTE(REG_UNONPOSIX);
-	switch (c) {
-	case CHR('a'):
-		RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
-		break;
-	case CHR('A'):
-		RETV(SBEGIN, 0);
-		break;
-	case CHR('b'):
-		RETV(PLAIN, CHR('\b'));
-		break;
-	case CHR('B'):
-		RETV(PLAIN, CHR('\\'));
-		break;
-	case CHR('c'):
-		NOTE(REG_UUNPORT);
-		if (ATEOS())
-			FAILW(REG_EESCAPE);
-		RETV(PLAIN, (chr)(*v->now++ & 037));
-		break;
-	case CHR('d'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 'd');
-		break;
-	case CHR('D'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 'D');
-		break;
-	case CHR('e'):
-		NOTE(REG_UUNPORT);
-		RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
-		break;
-	case CHR('f'):
-		RETV(PLAIN, CHR('\f'));
-		break;
-	case CHR('m'):
-		RET('<');
-		break;
-	case CHR('M'):
-		RET('>');
-		break;
-	case CHR('n'):
-		RETV(PLAIN, CHR('\n'));
-		break;
-	case CHR('r'):
-		RETV(PLAIN, CHR('\r'));
-		break;
-	case CHR('s'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 's');
-		break;
-	case CHR('S'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 'S');
-		break;
-	case CHR('t'):
-		RETV(PLAIN, CHR('\t'));
-		break;
-	case CHR('u'):
-		c = lexdigits(v, 16, 4, 4);
-		if (ISERR())
-			FAILW(REG_EESCAPE);
-		RETV(PLAIN, c);
-		break;
-	case CHR('U'):
-		c = lexdigits(v, 16, 8, 8);
-		if (ISERR())
-			FAILW(REG_EESCAPE);
-		RETV(PLAIN, c);
-		break;
-	case CHR('v'):
-		RETV(PLAIN, CHR('\v'));
-		break;
-	case CHR('w'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 'w');
-		break;
-	case CHR('W'):
-		NOTE(REG_ULOCALE);
-		RETV(CCLASS, 'W');
-		break;
-	case CHR('x'):
-		NOTE(REG_UUNPORT);
-		c = lexdigits(v, 16, 1, 255);	/* REs >255 long outside spec */
-		if (ISERR())
-			FAILW(REG_EESCAPE);
-		RETV(PLAIN, c);
-		break;
-	case CHR('y'):
-		NOTE(REG_ULOCALE);
-		RETV(WBDRY, 0);
-		break;
-	case CHR('Y'):
-		NOTE(REG_ULOCALE);
-		RETV(NWBDRY, 0);
-		break;
-	case CHR('Z'):
-		RETV(SEND, 0);
-		break;
-	case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
-	case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
-	case CHR('9'):
-		save = v->now;
-		v->now--;	/* put first digit back */
-		c = lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
-		if (ISERR())
-			FAILW(REG_EESCAPE);
-		/* ugly heuristic (first test is "exactly 1 digit?") */
-		if (v->now-save == 0 || ((int)c > 0 && (int)c <= v->nsubexp)) {
-			NOTE(REG_UBACKREF);
-			RETV(BACKREF, (chr)c);
-		}
-		/* oops, doesn't look like it's a backref after all... */
-		v->now = save;
-		/* and fall through into octal number */
-	case CHR('0'):
-		NOTE(REG_UUNPORT);
-		v->now--;	/* put first digit back */
-		c = lexdigits(v, 8, 1, 3);
-		if (ISERR())
-			FAILW(REG_EESCAPE);
-		RETV(PLAIN, c);
-		break;
-	default:
-		assert(iscalpha(c));
-		FAILW(REG_EESCAPE);	/* unknown alphabetic escape */
-		break;
+    assert(v->cflags&REG_ADVF);
+
+    assert(!ATEOS());
+    c = *v->now++;
+    if (!iscalnum(c)) {
+	RETV(PLAIN, c);
+    }
+
+    NOTE(REG_UNONPOSIX);
+    switch (c) {
+    case CHR('a'):
+	RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
+	break;
+    case CHR('A'):
+	RETV(SBEGIN, 0);
+	break;
+    case CHR('b'):
+	RETV(PLAIN, CHR('\b'));
+	break;
+    case CHR('B'):
+	RETV(PLAIN, CHR('\\'));
+	break;
+    case CHR('c'):
+	NOTE(REG_UUNPORT);
+	if (ATEOS()) {
+	    FAILW(REG_EESCAPE);
 	}
-	assert(NOTREACHED);
-}
+	RETV(PLAIN, (chr)(*v->now++ & 037));
+	break;
+    case CHR('d'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 'd');
+	break;
+    case CHR('D'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 'D');
+	break;
+    case CHR('e'):
+	NOTE(REG_UUNPORT);
+	RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
+	break;
+    case CHR('f'):
+	RETV(PLAIN, CHR('\f'));
+	break;
+    case CHR('m'):
+	RET('<');
+	break;
+    case CHR('M'):
+	RET('>');
+	break;
+    case CHR('n'):
+	RETV(PLAIN, CHR('\n'));
+	break;
+    case CHR('r'):
+	RETV(PLAIN, CHR('\r'));
+	break;
+    case CHR('s'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 's');
+	break;
+    case CHR('S'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 'S');
+	break;
+    case CHR('t'):
+	RETV(PLAIN, CHR('\t'));
+	break;
+    case CHR('u'):
+	c = lexdigits(v, 16, 4, 4);
+	if (ISERR()) {
+	    FAILW(REG_EESCAPE);
+	}
+	RETV(PLAIN, c);
+	break;
+    case CHR('U'):
+	c = lexdigits(v, 16, 8, 8);
+	if (ISERR()) {
+	    FAILW(REG_EESCAPE);
+	}
+	RETV(PLAIN, c);
+	break;
+    case CHR('v'):
+	RETV(PLAIN, CHR('\v'));
+	break;
+    case CHR('w'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 'w');
+	break;
+    case CHR('W'):
+	NOTE(REG_ULOCALE);
+	RETV(CCLASS, 'W');
+	break;
+    case CHR('x'):
+	NOTE(REG_UUNPORT);
+	c = lexdigits(v, 16, 1, 255);	/* REs >255 long outside spec */
+	if (ISERR()) {
+	    FAILW(REG_EESCAPE);
+	}
+	RETV(PLAIN, c);
+	break;
+    case CHR('y'):
+	NOTE(REG_ULOCALE);
+	RETV(WBDRY, 0);
+	break;
+    case CHR('Y'):
+	NOTE(REG_ULOCALE);
+	RETV(NWBDRY, 0);
+	break;
+    case CHR('Z'):
+	RETV(SEND, 0);
+	break;
+    case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+    case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+    case CHR('9'):
+	save = v->now;
+	v->now--;		/* put first digit back */
+	c = lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
+	if (ISERR()) {
+	    FAILW(REG_EESCAPE);
+	}
+
+	/*
+	 * Ugly heuristic (first test is "exactly 1 digit?")
+	 */
+
+	if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) {
+	    NOTE(REG_UBACKREF);
+	    RETV(BACKREF, (chr)c);
+	}
+
+	/*
+	 * Oops, doesn't look like it's a backref after all...
+	 */
 
+	v->now = save;
+
+	/*
+	 * And fall through into octal number.
+	 */
+
+    case CHR('0'):
+	NOTE(REG_UUNPORT);
+	v->now--;		/* put first digit back */
+	c = lexdigits(v, 8, 1, 3);
+	if (ISERR()) {
+	    FAILW(REG_EESCAPE);
+	}
+	RETV(PLAIN, c);
+	break;
+    default:
+	assert(iscalpha(c));
+	FAILW(REG_EESCAPE);	/* unknown alphabetic escape */
+	break;
+    }
+    assert(NOTREACHED);
+}
+
 /*
  - lexdigits - slurp up digits and return chr value
  ^ static chr lexdigits(struct vars *, int, int, int);
  */
 static chr			/* chr value; errors signalled via ERR */
-lexdigits(v, base, minlen, maxlen)
-struct vars *v;
-int base;
-int minlen;
-int maxlen;
+lexdigits(
+    struct vars *v,
+    int base,
+    int minlen,
+    int maxlen)
 {
-	uchr n;			/* unsigned to avoid overflow misbehavior */
-	int len;
-	chr c;
-	int d;
-	CONST uchr ub = (uchr) base;
-
-	n = 0;
-	for (len = 0; len < maxlen && !ATEOS(); len++) {
-		c = *v->now++;
-		switch (c) {
-		case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
-		case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
-		case CHR('8'): case CHR('9'):
-			d = DIGITVAL(c);
-			break;
-		case CHR('a'): case CHR('A'): d = 10; break;
-		case CHR('b'): case CHR('B'): d = 11; break;
-		case CHR('c'): case CHR('C'): d = 12; break;
-		case CHR('d'): case CHR('D'): d = 13; break;
-		case CHR('e'): case CHR('E'): d = 14; break;
-		case CHR('f'): case CHR('F'): d = 15; break;
-		default:
-			v->now--;	/* oops, not a digit at all */
-			d = -1;
-			break;
-		}
+    uchr n;			/* unsigned to avoid overflow misbehavior */
+    int len;
+    chr c;
+    int d;
+    CONST uchr ub = (uchr) base;
 
-		if (d >= base) {	/* not a plausible digit */
-			v->now--;
-			d = -1;
-		}
-		if (d < 0)
-			break;		/* NOTE BREAK OUT */
-		n = n*ub + (uchr)d;
+    n = 0;
+    for (len = 0; len < maxlen && !ATEOS(); len++) {
+	c = *v->now++;
+	switch (c) {
+	case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
+	case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+	case CHR('8'): case CHR('9'):
+	    d = DIGITVAL(c);
+	    break;
+	case CHR('a'): case CHR('A'): d = 10; break;
+	case CHR('b'): case CHR('B'): d = 11; break;
+	case CHR('c'): case CHR('C'): d = 12; break;
+	case CHR('d'): case CHR('D'): d = 13; break;
+	case CHR('e'): case CHR('E'): d = 14; break;
+	case CHR('f'): case CHR('F'): d = 15; break;
+	default:
+	    v->now--;		/* oops, not a digit at all */
+	    d = -1;
+	    break;
 	}
-	if (len < minlen)
-		ERR(REG_EESCAPE);
 
-	return (chr)n;
-}
+	if (d >= base) {	/* not a plausible digit */
+	    v->now--;
+	    d = -1;
+	}
+	if (d < 0) {
+	    break;		/* NOTE BREAK OUT */
+	}
+	n = n*ub + (uchr)d;
+    }
+    if (len < minlen) {
+	ERR(REG_EESCAPE);
+    }
 
+    return (chr)n;
+}
+
 /*
  - brenext - get next BRE token
  * This is much like EREs except for all the stupid backslashes and the
@@ -865,197 +968,218 @@ int maxlen;
  ^ static int brenext(struct vars *, pchr);
  */
 static int			/* 1 normal, 0 failure */
-brenext(v, pc)
-struct vars *v;
-pchr pc;
+brenext(
+    struct vars *v,
+    pchr pc)
 {
-	chr c = (chr)pc;
+    chr c = (chr)pc;
 
-	switch (c) {
-	case CHR('*'):
-		if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^'))
-			RETV(PLAIN, c);
-		RET('*');
-		break;
-	case CHR('['):
-		if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
-				*(v->now+1) == CHR(':') &&
-				(*(v->now+2) == CHR('<') ||
-						*(v->now+2) == CHR('>')) &&
-				*(v->now+3) == CHR(':') &&
-				*(v->now+4) == CHR(']') &&
-				*(v->now+5) == CHR(']')) {
-			c = *(v->now+2);
-			v->now += 6;
-			NOTE(REG_UNONPOSIX);
-			RET((c == CHR('<')) ? '<' : '>');
-		}
-		INTOCON(L_BRACK);
-		if (NEXT1('^')) {
-			v->now++;
-			RETV('[', 0);
-		}
-		RETV('[', 1);
-		break;
-	case CHR('.'):
-		RET('.');
-		break;
-	case CHR('^'):
-		if (LASTTYPE(EMPTY))
-			RET('^');
-		if (LASTTYPE('(')) {
-			NOTE(REG_UUNSPEC);
-			RET('^');
-		}
-		RETV(PLAIN, c);
-		break;
-	case CHR('$'):
-		if (v->cflags&REG_EXPANDED)
-			skip(v);
-		if (ATEOS())
-			RET('$');
-		if (NEXT2('\\', ')')) {
-			NOTE(REG_UUNSPEC);
-			RET('$');
-		}
-		RETV(PLAIN, c);
-		break;
-	case CHR('\\'):
-		break;		/* see below */
-	default:
-		RETV(PLAIN, c);
-		break;
+    switch (c) {
+    case CHR('*'):
+	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
+	    RETV(PLAIN, c);
+	}
+	RET('*');
+	break;
+    case CHR('['):
+	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
+		*(v->now+1) == CHR(':') &&
+		(*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
+		*(v->now+3) == CHR(':') &&
+		*(v->now+4) == CHR(']') &&
+		*(v->now+5) == CHR(']')) {
+	    c = *(v->now+2);
+	    v->now += 6;
+	    NOTE(REG_UNONPOSIX);
+	    RET((c == CHR('<')) ? '<' : '>');
+	}
+	INTOCON(L_BRACK);
+	if (NEXT1('^')) {
+	    v->now++;
+	    RETV('[', 0);
+	}
+	RETV('[', 1);
+	break;
+    case CHR('.'):
+	RET('.');
+	break;
+    case CHR('^'):
+	if (LASTTYPE(EMPTY)) {
+	    RET('^');
+	}
+	if (LASTTYPE('(')) {
+	    NOTE(REG_UUNSPEC);
+	    RET('^');
 	}
+	RETV(PLAIN, c);
+	break;
+    case CHR('$'):
+	if (v->cflags&REG_EXPANDED) {
+	    skip(v);
+	}
+	if (ATEOS()) {
+	    RET('$');
+	}
+	if (NEXT2('\\', ')')) {
+	    NOTE(REG_UUNSPEC);
+	    RET('$');
+	}
+	RETV(PLAIN, c);
+	break;
+    case CHR('\\'):
+	break;			/* see below */
+    default:
+	RETV(PLAIN, c);
+	break;
+    }
 
-	assert(c == CHR('\\'));
+    assert(c == CHR('\\'));
 
-	if (ATEOS())
-		FAILW(REG_EESCAPE);
+    if (ATEOS()) {
+	FAILW(REG_EESCAPE);
+    }
 
-	c = *v->now++;
-	switch (c) {
-	case CHR('{'):
-		INTOCON(L_BBND);
-		NOTE(REG_UBOUNDS);
-		RET('{');
-		break;
-	case CHR('('):
-		RETV('(', 1);
-		break;
-	case CHR(')'):
-		RETV(')', c);
-		break;
-	case CHR('<'):
-		NOTE(REG_UNONPOSIX);
-		RET('<');
-		break;
-	case CHR('>'):
-		NOTE(REG_UNONPOSIX);
-		RET('>');
-		break;
-	case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
-	case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
-	case CHR('9'):
-		NOTE(REG_UBACKREF);
-		RETV(BACKREF, (chr)DIGITVAL(c));
-		break;
-	default:
-		if (iscalnum(c)) {
-			NOTE(REG_UBSALNUM);
-			NOTE(REG_UUNSPEC);
-		}
-		RETV(PLAIN, c);
-		break;
+    c = *v->now++;
+    switch (c) {
+    case CHR('{'):
+	INTOCON(L_BBND);
+	NOTE(REG_UBOUNDS);
+	RET('{');
+	break;
+    case CHR('('):
+	RETV('(', 1);
+	break;
+    case CHR(')'):
+	RETV(')', c);
+	break;
+    case CHR('<'):
+	NOTE(REG_UNONPOSIX);
+	RET('<');
+	break;
+    case CHR('>'):
+	NOTE(REG_UNONPOSIX);
+	RET('>');
+	break;
+    case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+    case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+    case CHR('9'):
+	NOTE(REG_UBACKREF);
+	RETV(BACKREF, (chr)DIGITVAL(c));
+	break;
+    default:
+	if (iscalnum(c)) {
+	    NOTE(REG_UBSALNUM);
+	    NOTE(REG_UUNSPEC);
 	}
+	RETV(PLAIN, c);
+	break;
+    }
 
-	assert(NOTREACHED);
+    assert(NOTREACHED);
 }
-
+
 /*
  - skip - skip white space and comments in expanded form
  ^ static VOID skip(struct vars *);
  */
-static VOID
-skip(v)
-struct vars *v;
+static void
+skip(
+    struct vars *v)
 {
-	CONST chr *start = v->now;
-
-	assert(v->cflags&REG_EXPANDED);
-
-	for (;;) {
-		while (!ATEOS() && iscspace(*v->now))
-			v->now++;
-		if (ATEOS() || *v->now != CHR('#'))
-			break;				/* NOTE BREAK OUT */
-		assert(NEXT1('#'));
-		while (!ATEOS() && *v->now != CHR('\n'))
-			v->now++;
-		/* leave the newline to be picked up by the iscspace loop */
+    const chr *start = v->now;
+
+    assert(v->cflags&REG_EXPANDED);
+
+    for (;;) {
+	while (!ATEOS() && iscspace(*v->now)) {
+	    v->now++;
+	}
+	if (ATEOS() || *v->now != CHR('#')) {
+	    break;		/* NOTE BREAK OUT */
+	}
+	assert(NEXT1('#'));
+	while (!ATEOS() && *v->now != CHR('\n')) {
+	    v->now++;
 	}
 
-	if (v->now != start)
-		NOTE(REG_UNONPOSIX);
-}
+	/*
+	 * Leave the newline to be picked up by the iscspace loop.
+	 */
+    }
 
+    if (v->now != start) {
+	NOTE(REG_UNONPOSIX);
+    }
+}
+
 /*
  - newline - return the chr for a newline
  * This helps confine use of CHR to this source file.
  ^ static chr newline(NOPARMS);
  */
 static chr
-newline()
+newline(void)
 {
-	return CHR('\n');
+    return CHR('\n');
 }
-
+
 /*
  - ch - return the chr sequence for regc_locale.c's fake collating element ch
  * This helps confine use of CHR to this source file.  Beware that the caller
  * knows how long the sequence is.
  ^ #ifdef REG_DEBUG
- ^ static chr *ch(NOPARMS);
+ ^ static const chr *ch(NOPARMS);
  ^ #endif
  */
 #ifdef REG_DEBUG
-static CONST chr *
-ch()
+static const chr *
+ch(void)
 {
-	static CONST chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
+    static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
 
-	return chstr;
+    return chstr;
 }
 #endif
-
+
 /*
  - chrnamed - return the chr known by a given (chr string) name
  * The code is a bit clumsy, but this routine gets only such specialized
  * use that it hardly matters.
- ^ static chr chrnamed(struct vars *, chr *, chr *, pchr);
+ ^ static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
  */
 static chr
-chrnamed(v, startp, endp, lastresort)
-struct vars *v;
-CONST chr *startp;			/* start of name */
-CONST chr *endp;			/* just past end of name */
-pchr lastresort;		/* what to return if name lookup fails */
+chrnamed(
+    struct vars *v,
+    const chr *startp,		/* start of name */
+    const chr *endp,		/* just past end of name */
+    pchr lastresort)		/* what to return if name lookup fails */
 {
-	celt c;
-	int errsave;
-	int e;
-	struct cvec *cv;
-
-	errsave = v->err;
-	v->err = 0;
-	c = element(v, startp, endp);
-	e = v->err;
-	v->err = errsave;
-
-	if (e != 0)
-		return (chr)lastresort;
-
-	cv = range(v, c, c, 0);
-	if (cv->nchrs == 0)
-		return (chr)lastresort;
-	return cv->chrs[0];
+    celt c;
+    int errsave;
+    int e;
+    struct cvec *cv;
+
+    errsave = v->err;
+    v->err = 0;
+    c = element(v, startp, endp);
+    e = v->err;
+    v->err = errsave;
+
+    if (e != 0) {
+	return (chr)lastresort;
+    }
+
+    cv = range(v, c, c, 0);
+    if (cv->nchrs == 0) {
+	return (chr)lastresort;
+    }
+    return cv->chrs[0];
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 6fd831d..40791f4 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -12,9 +12,9 @@
 
 /* ASCII character-name table */
 
-static CONST struct cname {
-    CONST char *name;
-    CONST char code;
+static const struct cname {
+    const char *name;
+    const char code;
 } cnames[] = {
     {"NUL",		'\0'},
     {"SOH",		'\001'},
@@ -133,7 +133,7 @@ typedef struct crange {
  * Unicode: alphabetic characters.
  */
 
-static CONST crange alphaRangeTable[] = {
+static const crange alphaRangeTable[] = {
     {0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
     {0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
     {0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
@@ -224,7 +224,7 @@ static CONST crange alphaRangeTable[] = {
 
 #define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
 
-static CONST chr alphaCharTable[] = {
+static const chr alphaCharTable[] = {
     0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x386, 0x38c,
     0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, 0x6ff,
     0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x8a0,
@@ -258,7 +258,7 @@ static CONST chr alphaCharTable[] = {
  * Unicode: control characters.
  */
 
-static CONST crange controlRangeTable[] = {
+static const crange controlRangeTable[] = {
     {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, {0x202a, 0x202e},
     {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb}
 #if TCL_UTF_MAX > 4
@@ -268,7 +268,7 @@ static CONST crange controlRangeTable[] = {
 
 #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
 
-static CONST chr controlCharTable[] = {
+static const chr controlCharTable[] = {
     0xad, 0x6dd, 0x70f, 0xfeff
 #if TCL_UTF_MAX > 4
     ,0x110bd, 0xe0001
@@ -281,7 +281,7 @@ static CONST chr controlCharTable[] = {
  * Unicode: decimal digit characters.
  */
 
-static CONST crange digitRangeTable[] = {
+static const crange digitRangeTable[] = {
     {0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9},
     {0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef},
     {0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef},
@@ -307,7 +307,7 @@ static CONST crange digitRangeTable[] = {
  * Unicode: punctuation characters.
  */
 
-static CONST crange punctRangeTable[] = {
+static const crange punctRangeTable[] = {
     {0x21, 0x23}, {0x25, 0x2a}, {0x2c, 0x2f}, {0x5b, 0x5d},
     {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9},
     {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4},
@@ -329,7 +329,7 @@ static CONST crange punctRangeTable[] = {
 
 #define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))
 
-static CONST chr punctCharTable[] = {
+static const chr punctCharTable[] = {
     0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
     0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
     0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
@@ -353,13 +353,13 @@ static CONST chr punctCharTable[] = {
  * Unicode: white space characters.
  */
 
-static CONST crange spaceRangeTable[] = {
+static const crange spaceRangeTable[] = {
     {0x9, 0xd}, {0x2000, 0x200a}
 };
 
 #define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
 
-static CONST chr spaceCharTable[] = {
+static const chr spaceCharTable[] = {
     0x20, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f, 0x3000
 };
 
@@ -369,7 +369,7 @@ static CONST chr spaceCharTable[] = {
  * Unicode: lowercase characters.
  */
 
-static CONST crange lowerRangeTable[] = {
+static const crange lowerRangeTable[] = {
     {0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
     {0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
     {0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
@@ -394,7 +394,7 @@ static CONST crange lowerRangeTable[] = {
 
 #define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))
 
-static CONST chr lowerCharTable[] = {
+static const chr lowerCharTable[] = {
     0xb5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10b, 0x10d, 0x10f,
     0x111, 0x113, 0x115, 0x117, 0x119, 0x11b, 0x11d, 0x11f, 0x121,
     0x123, 0x125, 0x127, 0x129, 0x12b, 0x12d, 0x12f, 0x131, 0x133,
@@ -468,7 +468,7 @@ static CONST chr lowerCharTable[] = {
  * Unicode: uppercase characters.
  */
 
-static CONST crange upperRangeTable[] = {
+static const crange upperRangeTable[] = {
     {0x41, 0x5a}, {0xc0, 0xd6}, {0xd8, 0xde}, {0x189, 0x18b},
     {0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
     {0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
@@ -491,7 +491,7 @@ static CONST crange upperRangeTable[] = {
 
 #define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
 
-static CONST chr upperCharTable[] = {
+static const chr upperCharTable[] = {
     0x100, 0x102, 0x104, 0x106, 0x108, 0x10a, 0x10c, 0x10e, 0x110,
     0x112, 0x114, 0x116, 0x118, 0x11a, 0x11c, 0x11e, 0x120, 0x122,
     0x124, 0x126, 0x128, 0x12a, 0x12c, 0x12e, 0x130, 0x132, 0x134,
@@ -566,7 +566,7 @@ static CONST chr upperCharTable[] = {
  * Unicode: unicode print characters excluding space.
  */
 
-static CONST crange graphRangeTable[] = {
+static const crange graphRangeTable[] = {
     {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37e},
     {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x527}, {0x531, 0x556},
     {0x559, 0x55f}, {0x561, 0x587}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
@@ -682,7 +682,7 @@ static CONST crange graphRangeTable[] = {
 
 #define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
 
-static CONST chr graphCharTable[] = {
+static const chr graphCharTable[] = {
     0x38c, 0x589, 0x58a, 0x58f, 0x85e, 0x8a0, 0x98f, 0x990, 0x9b2,
     0x9c7, 0x9c8, 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33,
     0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e,
@@ -715,18 +715,18 @@ static CONST chr graphCharTable[] = {
 
 /*
  - element - map collating-element name to celt
- ^ static celt element(struct vars *, CONST chr *, CONST chr *);
+ ^ static celt element(struct vars *, const chr *, const chr *);
  */
 static celt
-element(v, startp, endp)
-    struct vars *v;			/* context */
-    CONST chr *startp;			/* points to start of name */
-    CONST chr *endp;				/* points just past end of name */
+element(
+    struct vars *v,		/* context */
+    const chr *startp,		/* points to start of name */
+    const chr *endp)		/* points just past end of name */
 {
-    CONST struct cname *cn;
+    const struct cname *cn;
     size_t len;
     Tcl_DString ds;
-    CONST char *np;
+    const char *np;
 
     /*
      * Generic: one-chr names stand for themselves.
@@ -769,11 +769,11 @@ element(v, startp, endp)
  ^ static struct cvec *range(struct vars *, celt, celt, int);
  */
 static struct cvec *
-range(v, a, b, cases)
-    struct vars *v;			/* context */
-    celt a;				/* range start */
-    celt b;				/* range end, might equal a */
-    int cases;				/* case-independent? */
+range(
+    struct vars *v,		/* context */
+    celt a,			/* range start */
+    celt b,			/* range end, might equal a */
+    int cases)			/* case-independent? */
 {
     int nchrs;
     struct cvec *cv;
@@ -826,8 +826,8 @@ range(v, a, b, cases)
  ^ static int before(celt, celt);
  */
 static int			/* predicate */
-before(x, y)
-    celt x, y;				/* collating elements */
+before(
+    celt x, celt y)		/* collating elements */
 {
     if (x < y) {
 	return 1;
@@ -841,11 +841,11 @@ before(x, y)
  ^ static struct cvec *eclass(struct vars *, celt, int);
  */
 static struct cvec *
-eclass(v, c, cases)
-    struct vars *v;			/* context */
-    celt c;				/* Collating element representing
-					 * the equivalence class. */
-    int cases;				/* all cases? */
+eclass(
+    struct vars *v,		/* context */
+    celt c,			/* Collating element representing the
+				 * equivalence class. */
+    int cases)			/* all cases? */
 {
     struct cvec *cv;
 
@@ -880,27 +880,27 @@ eclass(v, c, cases)
 /*
  - cclass - supply cvec for a character class
  * Must include case counterparts on request.
- ^ static struct cvec *cclass(struct vars *, CONST chr *, CONST chr *, int);
+ ^ static struct cvec *cclass(struct vars *, const chr *, const chr *, int);
  */
 static struct cvec *
-cclass(v, startp, endp, cases)
-    struct vars *v;			/* context */
-    CONST chr *startp;		/* where the name starts */
-    CONST chr *endp;		/* just past the end of the name */
-    int cases;				/* case-independent? */
+cclass(
+    struct vars *v,		/* context */
+    const chr *startp,		/* where the name starts */
+    const chr *endp,		/* just past the end of the name */
+    int cases)			/* case-independent? */
 {
     size_t len;
     struct cvec *cv = NULL;
     Tcl_DString ds;
-    CONST char *np;
-    CONST char *CONST *namePtr;
+    const char *np;
+    const char *const *namePtr;
     int i, index;
 
     /*
      * The following arrays define the valid character class names.
      */
 
-    static CONST char *CONST classNames[] = {
+    static const char *const classNames[] = {
 	"alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",
 	"lower", "print", "punct", "space", "upper", "xdigit", NULL
     };
@@ -1119,9 +1119,9 @@ cclass(v, startp, endp, cases)
  ^ static struct cvec *allcases(struct vars *, pchr);
  */
 static struct cvec *
-allcases(v, pc)
-    struct vars *v;			/* context */
-    pchr pc;				/* character to get case equivs of */
+allcases(
+    struct vars *v,		/* context */
+    pchr pc)			/* character to get case equivs of */
 {
     struct cvec *cv;
     chr c = (chr)pc;
@@ -1150,12 +1150,12 @@ allcases(v, pc)
  * Note that it does not need to report anything except equal/unequal.
  * Note also that the length is exact, and the comparison should not
  * stop at embedded NULs!
- ^ static int cmp(CONST chr *, CONST chr *, size_t);
+ ^ static int cmp(const chr *, const chr *, size_t);
  */
-static int				/* 0 for equal, nonzero for unequal */
-cmp(x, y, len)
-    CONST chr *x, *y;			/* strings to compare */
-    size_t len;				/* exact length of comparison */
+static int			/* 0 for equal, nonzero for unequal */
+cmp(
+    const chr *x, const chr *y,	/* strings to compare */
+    size_t len)			/* exact length of comparison */
 {
     return memcmp(VS(x), VS(y), len*sizeof(chr));
 }
@@ -1166,12 +1166,12 @@ cmp(x, y, len)
  * Note that it does not need to report anything except equal/unequal.
  * Note also that the length is exact, and the comparison should not
  * stop at embedded NULs!
- ^ static int casecmp(CONST chr *, CONST chr *, size_t);
+ ^ static int casecmp(const chr *, const chr *, size_t);
  */
-static int				/* 0 for equal, nonzero for unequal */
-casecmp(x, y, len)
-    CONST chr *x, *y;			/* strings to compare */
-    size_t len;				/* exact length of comparison */
+static int			/* 0 for equal, nonzero for unequal */
+casecmp(
+    const chr *x, const chr *y,	/* strings to compare */
+    size_t len)			/* exact length of comparison */
 {
     for (; len > 0; len--, x++, y++) {
 	if ((*x!=*y) && (Tcl_UniCharToLower(*x) != Tcl_UniCharToLower(*y))) {
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 459968a..65ca7a7 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -2,24 +2,24 @@
  * NFA utilities.
  * This file is #included by regcomp.c.
  *
- * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
  * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
@@ -28,471 +28,510 @@
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
- *
- *
- * One or two things that technically ought to be in here
- * are actually in color.c, thanks to some incestuous relationships in
- * the color chains.
+ * One or two things that technically ought to be in here are actually in
+ * color.c, thanks to some incestuous relationships in the color chains.
  */
 
 #define	NISERR()	VISERR(nfa->v)
 #define	NERR(e)		VERR(nfa->v, (e))
-
-
+
 /*
  - newnfa - set up an NFA
  ^ static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *);
  */
 static struct nfa *		/* the NFA, or NULL */
-newnfa(v, cm, parent)
-struct vars *v;
-struct colormap *cm;
-struct nfa *parent;		/* NULL if primary NFA */
+newnfa(
+    struct vars *v,
+    struct colormap *cm,
+    struct nfa *parent)		/* NULL if primary NFA */
 {
-	struct nfa *nfa;
-
-	nfa = (struct nfa *)MALLOC(sizeof(struct nfa));
-	if (nfa == NULL)
-		return NULL;
-
-	nfa->states = NULL;
-	nfa->slast = NULL;
-	nfa->free = NULL;
-	nfa->nstates = 0;
-	nfa->cm = cm;
-	nfa->v = v;
-	nfa->size = 0;
-	nfa->bos[0] = nfa->bos[1] = COLORLESS;
-	nfa->eos[0] = nfa->eos[1] = COLORLESS;
-	nfa->parent = parent;
-	nfa->post = newfstate(nfa, '@');	/* number 0 */
-	nfa->pre = newfstate(nfa, '>');		/* number 1 */
-
-	nfa->init = newstate(nfa);		/* may become invalid later */
-	nfa->final = newstate(nfa);
-	if (ISERR()) {
-		freenfa(nfa);
-		return NULL;
-	}
-	rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
-	newarc(nfa, '^', 1, nfa->pre, nfa->init);
-	newarc(nfa, '^', 0, nfa->pre, nfa->init);
-	rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
-	newarc(nfa, '$', 1, nfa->final, nfa->post);
-	newarc(nfa, '$', 0, nfa->final, nfa->post);
-
-	if (ISERR()) {
-		freenfa(nfa);
-		return NULL;
-	}
-	return nfa;
-}
+    struct nfa *nfa;
 
+    nfa = (struct nfa *) MALLOC(sizeof(struct nfa));
+    if (nfa == NULL) {
+	return NULL;
+    }
+
+    nfa->states = NULL;
+    nfa->slast = NULL;
+    nfa->free = NULL;
+    nfa->nstates = 0;
+    nfa->cm = cm;
+    nfa->v = v;
+    nfa->size = 0;
+    nfa->bos[0] = nfa->bos[1] = COLORLESS;
+    nfa->eos[0] = nfa->eos[1] = COLORLESS;
+    nfa->parent = parent;	/* Precedes newfstate so parent is valid. */
+    nfa->post = newfstate(nfa, '@');	/* number 0 */
+    nfa->pre = newfstate(nfa, '>');	/* number 1 */
+
+    nfa->init = newstate(nfa);	/* May become invalid later. */
+    nfa->final = newstate(nfa);
+    if (ISERR()) {
+	freenfa(nfa);
+	return NULL;
+    }
+    rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
+    newarc(nfa, '^', 1, nfa->pre, nfa->init);
+    newarc(nfa, '^', 0, nfa->pre, nfa->init);
+    rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
+    newarc(nfa, '$', 1, nfa->final, nfa->post);
+    newarc(nfa, '$', 0, nfa->final, nfa->post);
+
+    if (ISERR()) {
+	freenfa(nfa);
+	return NULL;
+    }
+    return nfa;
+}
+
 /*
- - too_many_states - checks if the max states exceeds the compile-time value
- ^ static int too_many_states(struct nfa *);
+ - TooManyStates - checks if the max states exceeds the compile-time value
+ ^ static int TooManyStates(struct nfa *);
  */
 static int
-too_many_states(nfa)
-struct nfa *nfa;
+TooManyStates(
+    struct nfa *nfa)
 {
-	struct nfa *parent = nfa->parent;
-	size_t sz = nfa->size;
-	while (parent != NULL) {
-		sz = parent->size;
-		parent = parent->parent;
-	}
-	if (sz > REG_MAX_STATES)
-		return 1;
-	return 0;
+    struct nfa *parent = nfa->parent;
+    size_t sz = nfa->size;
+
+    while (parent != NULL) {
+	sz = parent->size;
+	parent = parent->parent;
+    }
+    if (sz > REG_MAX_STATES) {
+	return 1;
+    }
+    return 0;
 }
-
+
 /*
- - increment_size - increases the tracked size of the NFA and its parents.
- ^ static void increment_size(struct nfa *);
+ - IncrementSize - increases the tracked size of the NFA and its parents.
+ ^ static void IncrementSize(struct nfa *);
  */
 static void
-increment_size(nfa)
-struct nfa *nfa;
+IncrementSize(
+    struct nfa *nfa)
 {
-	struct nfa *parent = nfa->parent;
-	nfa->size++;
-	while (parent != NULL) {
-		parent->size++;
-		parent = parent->parent;
-	}
-}
+    struct nfa *parent = nfa->parent;
 
+    nfa->size++;
+    while (parent != NULL) {
+	parent->size++;
+	parent = parent->parent;
+    }
+}
+
 /*
- - decrement_size - increases the tracked size of the NFA and its parents.
- ^ static void decrement_size(struct nfa *);
+ - DecrementSize - increases the tracked size of the NFA and its parents.
+ ^ static void DecrementSize(struct nfa *);
  */
 static void
-decrement_size(nfa)
-struct nfa *nfa;
+DecrementSize(
+    struct nfa *nfa)
 {
-	struct nfa *parent = nfa->parent;
-	nfa->size--;
-	while (parent != NULL) {
-		parent->size--;
-		parent = parent->parent;
-	}
-}
+    struct nfa *parent = nfa->parent;
 
+    nfa->size--;
+    while (parent != NULL) {
+	parent->size--;
+	parent = parent->parent;
+    }
+}
+
 /*
  - freenfa - free an entire NFA
  ^ static VOID freenfa(struct nfa *);
  */
-static VOID
-freenfa(nfa)
-struct nfa *nfa;
+static void
+freenfa(
+    struct nfa *nfa)
 {
-	struct state *s;
-
-	while ((s = nfa->states) != NULL) {
-		s->nins = s->nouts = 0;		/* don't worry about arcs */
-		freestate(nfa, s);
-	}
-	while ((s = nfa->free) != NULL) {
-		nfa->free = s->next;
-		destroystate(nfa, s);
-	}
+    struct state *s;
 
-	nfa->slast = NULL;
-	nfa->nstates = -1;
-	nfa->pre = NULL;
-	nfa->post = NULL;
-	FREE(nfa);
+    while ((s = nfa->states) != NULL) {
+	s->nins = s->nouts = 0;	/* don't worry about arcs */
+	freestate(nfa, s);
+    }
+    while ((s = nfa->free) != NULL) {
+	nfa->free = s->next;
+	destroystate(nfa, s);
+    }
+
+    nfa->slast = NULL;
+    nfa->nstates = -1;
+    nfa->pre = NULL;
+    nfa->post = NULL;
+    FREE(nfa);
 }
-
+
 /*
  - newstate - allocate an NFA state, with zero flag value
  ^ static struct state *newstate(struct nfa *);
  */
 static struct state *		/* NULL on error */
-newstate(nfa)
-struct nfa *nfa;
+newstate(
+    struct nfa *nfa)
 {
-	struct state *s;
+    struct state *s;
 
-	if (too_many_states(nfa)) {
-		/* XXX: add specific error for this */
-		NERR(REG_ETOOBIG);
-		return NULL;
-	}
-	if (nfa->free != NULL) {
-		s = nfa->free;
-		nfa->free = s->next;
-	} else {
-		s = (struct state *)MALLOC(sizeof(struct state));
-		if (s == NULL) {
-			NERR(REG_ESPACE);
-			return NULL;
-		}
-		s->oas.next = NULL;
-		s->free = NULL;
-		s->noas = 0;
-	}
-
-	assert(nfa->nstates >= 0);
-	s->no = nfa->nstates++;
-	s->flag = 0;
-	if (nfa->states == NULL)
-		nfa->states = s;
-	s->nins = 0;
-	s->ins = NULL;
-	s->nouts = 0;
-	s->outs = NULL;
-	s->tmp = NULL;
-	s->next = NULL;
-	if (nfa->slast != NULL) {
-		assert(nfa->slast->next == NULL);
-		nfa->slast->next = s;
+    if (TooManyStates(nfa)) {
+	/* XXX: add specific error for this */
+	NERR(REG_ETOOBIG);
+	return NULL;
+    }
+    if (nfa->free != NULL) {
+	s = nfa->free;
+	nfa->free = s->next;
+    } else {
+	s = (struct state *) MALLOC(sizeof(struct state));
+	if (s == NULL) {
+	    NERR(REG_ESPACE);
+	    return NULL;
 	}
-	s->prev = nfa->slast;
-	nfa->slast = s;
-	/* Track the current size and the parent size */
-	increment_size(nfa);
-	return s;
+	s->oas.next = NULL;
+	s->free = NULL;
+	s->noas = 0;
+    }
+
+    assert(nfa->nstates >= 0);
+    s->no = nfa->nstates++;
+    s->flag = 0;
+    if (nfa->states == NULL) {
+	nfa->states = s;
+    }
+    s->nins = 0;
+    s->ins = NULL;
+    s->nouts = 0;
+    s->outs = NULL;
+    s->tmp = NULL;
+    s->next = NULL;
+    if (nfa->slast != NULL) {
+	assert(nfa->slast->next == NULL);
+	nfa->slast->next = s;
+    }
+    s->prev = nfa->slast;
+    nfa->slast = s;
+
+    /*
+     * Track the current size and the parent size.
+     */
+
+    IncrementSize(nfa);
+    return s;
 }
-
+
 /*
  - newfstate - allocate an NFA state with a specified flag value
  ^ static struct state *newfstate(struct nfa *, int flag);
  */
 static struct state *		/* NULL on error */
-newfstate(nfa, flag)
-struct nfa *nfa;
-int flag;
+newfstate(
+    struct nfa *nfa,
+    int flag)
 {
-	struct state *s;
+    struct state *s;
 
-	s = newstate(nfa);
-	if (s != NULL)
-		s->flag = (char)flag;
-	return s;
+    s = newstate(nfa);
+    if (s != NULL) {
+	s->flag = (char) flag;
+    }
+    return s;
 }
-
+
 /*
  - dropstate - delete a state's inarcs and outarcs and free it
  ^ static VOID dropstate(struct nfa *, struct state *);
  */
-static VOID
-dropstate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+dropstate(
+    struct nfa *nfa,
+    struct state *s)
 {
-	struct arc *a;
-
-	while ((a = s->ins) != NULL)
-		freearc(nfa, a);
-	while ((a = s->outs) != NULL)
-		freearc(nfa, a);
-	freestate(nfa, s);
+    struct arc *a;
+
+    while ((a = s->ins) != NULL) {
+	freearc(nfa, a);
+    }
+    while ((a = s->outs) != NULL) {
+	freearc(nfa, a);
+    }
+    freestate(nfa, s);
 }
-
+
 /*
  - freestate - free a state, which has no in-arcs or out-arcs
  ^ static VOID freestate(struct nfa *, struct state *);
  */
-static VOID
-freestate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+freestate(
+    struct nfa *nfa,
+    struct state *s)
 {
-	assert(s != NULL);
-	assert(s->nins == 0 && s->nouts == 0);
-
-	s->no = FREESTATE;
-	s->flag = 0;
-	if (s->next != NULL)
-		s->next->prev = s->prev;
-	else {
-		assert(s == nfa->slast);
-		nfa->slast = s->prev;
-	}
-	if (s->prev != NULL)
-		s->prev->next = s->next;
-	else {
-		assert(s == nfa->states);
-		nfa->states = s->next;
-	}
-	s->prev = NULL;
-	s->next = nfa->free;	/* don't delete it, put it on the free list */
-	nfa->free = s;
-	decrement_size(nfa);
+    assert(s != NULL);
+    assert(s->nins == 0 && s->nouts == 0);
+
+    s->no = FREESTATE;
+    s->flag = 0;
+    if (s->next != NULL) {
+	s->next->prev = s->prev;
+    } else {
+	assert(s == nfa->slast);
+	nfa->slast = s->prev;
+    }
+    if (s->prev != NULL) {
+	s->prev->next = s->next;
+    } else {
+	assert(s == nfa->states);
+	nfa->states = s->next;
+    }
+    s->prev = NULL;
+    s->next = nfa->free;	/* don't delete it, put it on the free list */
+    nfa->free = s;
+    DecrementSize(nfa);
 }
-
+
 /*
  - destroystate - really get rid of an already-freed state
  ^ static VOID destroystate(struct nfa *, struct state *);
  */
-static VOID
-destroystate(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+destroystate(
+    struct nfa *nfa,
+    struct state *s)
 {
-	struct arcbatch *ab;
-	struct arcbatch *abnext;
-
-	assert(s->no == FREESTATE);
-	for (ab = s->oas.next; ab != NULL; ab = abnext) {
-		abnext = ab->next;
-		FREE(ab);
-	}
-	s->ins = NULL;
-	s->outs = NULL;
-	s->next = NULL;
-	FREE(s);
+    struct arcbatch *ab;
+    struct arcbatch *abnext;
+
+    assert(s->no == FREESTATE);
+    for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
+	abnext = ab->next;
+	FREE(ab);
+    }
+    s->ins = NULL;
+    s->outs = NULL;
+    s->next = NULL;
+    FREE(s);
 }
-
+
 /*
  - newarc - set up a new arc within an NFA
- ^ static VOID newarc(struct nfa *, int, pcolor, struct state *, 
+ ^ static VOID newarc(struct nfa *, int, pcolor, struct state *,
  ^	struct state *);
  */
-static VOID
-newarc(nfa, t, co, from, to)
-struct nfa *nfa;
-int t;
-pcolor co;
-struct state *from;
-struct state *to;
+static void
+newarc(
+    struct nfa *nfa,
+    int t,
+    pcolor co,
+    struct state *from,
+    struct state *to)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(from != NULL && to != NULL);
+    assert(from != NULL && to != NULL);
 
-	/* check for duplicates */
-	for (a = from->outs; a != NULL; a = a->outchain)
-		if (a->to == to && a->co == co && a->type == t)
-			return;
+    /*
+     * Check for duplicates.
+     */
 
-	a = allocarc(nfa, from);
-	if (NISERR())
-		return;
-	assert(a != NULL);
-
-	a->type = t;
-	a->co = (color)co;
-	a->to = to;
-	a->from = from;
-
-	/*
-	 * Put the new arc on the beginning, not the end, of the chains.
-	 * Not only is this easier, it has the very useful side effect that 
-	 * deleting the most-recently-added arc is the cheapest case rather
-	 * than the most expensive one.
-	 */
-	a->inchain = to->ins;
-	to->ins = a;
-	a->outchain = from->outs;
-	from->outs = a;
-
-	from->nouts++;
-	to->nins++;
-
-	if (COLORED(a) && nfa->parent == NULL)
-		colorchain(nfa->cm, a);
+    for (a=from->outs ; a!=NULL ; a=a->outchain) {
+	if (a->to == to && a->co == co && a->type == t) {
+	    return;
+	}
+    }
 
+    a = allocarc(nfa, from);
+    if (NISERR()) {
 	return;
+    }
+    assert(a != NULL);
+
+    a->type = t;
+    a->co = (color) co;
+    a->to = to;
+    a->from = from;
+
+    /*
+     * Put the new arc on the beginning, not the end, of the chains. Not only
+     * is this easier, it has the very useful side effect that deleting the
+     * most-recently-added arc is the cheapest case rather than the most
+     * expensive one.
+     */
+
+    a->inchain = to->ins;
+    to->ins = a;
+    a->outchain = from->outs;
+    from->outs = a;
+
+    from->nouts++;
+    to->nins++;
+
+    if (COLORED(a) && nfa->parent == NULL) {
+	colorchain(nfa->cm, a);
+    }
 }
-
+
 /*
  - allocarc - allocate a new out-arc within a state
  ^ static struct arc *allocarc(struct nfa *, struct state *);
  */
 static struct arc *		/* NULL for failure */
-allocarc(nfa, s)
-struct nfa *nfa;
-struct state *s;
+allocarc(
+    struct nfa *nfa,
+    struct state *s)
 {
-	struct arc *a;
-	struct arcbatch *new;
-	int i;
+    struct arc *a;
 
-	/* shortcut */
-	if (s->free == NULL && s->noas < ABSIZE) {
-		a = &s->oas.a[s->noas];
-		s->noas++;
-		return a;
-	}
+    /*
+     * Shortcut
+     */
 
-	/* if none at hand, get more */
-	if (s->free == NULL) {
-		new = (struct arcbatch *)MALLOC(sizeof(struct arcbatch));
-		if (new == NULL) {
-			NERR(REG_ESPACE);
-			return NULL;
-		}
-		new->next = s->oas.next;
-		s->oas.next = new;
+    if (s->free == NULL && s->noas < ABSIZE) {
+	a = &s->oas.a[s->noas];
+	s->noas++;
+	return a;
+    }
 
-		for (i = 0; i < ABSIZE; i++) {
-			new->a[i].type = 0;
-			new->a[i].freechain = &new->a[i+1];
-		}
-		new->a[ABSIZE-1].freechain = NULL;
-		s->free = &new->a[0];
+    /*
+     * if none at hand, get more
+     */
+
+    if (s->free == NULL) {
+	struct arcbatch *newAb = (struct arcbatch *)
+		MALLOC(sizeof(struct arcbatch));
+	int i;
+
+	if (newAb == NULL) {
+	    NERR(REG_ESPACE);
+	    return NULL;
 	}
-	assert(s->free != NULL);
+	newAb->next = s->oas.next;
+	s->oas.next = newAb;
 
-	a = s->free;
-	s->free = a->freechain;
-	return a;
+	for (i=0 ; i<ABSIZE ; i++) {
+	    newAb->a[i].type = 0;
+	    newAb->a[i].freechain = &newAb->a[i+1];
+	}
+	newAb->a[ABSIZE-1].freechain = NULL;
+	s->free = &newAb->a[0];
+    }
+    assert(s->free != NULL);
+
+    a = s->free;
+    s->free = a->freechain;
+    return a;
 }
-
+
 /*
  - freearc - free an arc
  ^ static VOID freearc(struct nfa *, struct arc *);
  */
-static VOID
-freearc(nfa, victim)
-struct nfa *nfa;
-struct arc *victim;
+static void
+freearc(
+    struct nfa *nfa,
+    struct arc *victim)
 {
-	struct state *from = victim->from;
-	struct state *to = victim->to;
-	struct arc *a;
-
-	assert(victim->type != 0);
-
-	/* take it off color chain if necessary */
-	if (COLORED(victim) && nfa->parent == NULL)
-		uncolorchain(nfa->cm, victim);
-
-	/* take it off source's out-chain */
-	assert(from != NULL);
-	assert(from->outs != NULL);
-	a = from->outs;
-	if (a == victim)		/* simple case:  first in chain */
-		from->outs = victim->outchain;
-	else {
-		for (; a != NULL && a->outchain != victim; a = a->outchain)
-			continue;
-		assert(a != NULL);
-		a->outchain = victim->outchain;
+    struct state *from = victim->from;
+    struct state *to = victim->to;
+    struct arc *a;
+
+    assert(victim->type != 0);
+
+    /*
+     * Take it off color chain if necessary.
+     */
+
+    if (COLORED(victim) && nfa->parent == NULL) {
+	uncolorchain(nfa->cm, victim);
+    }
+
+    /*
+     * Take it off source's out-chain.
+     */
+
+    assert(from != NULL);
+    assert(from->outs != NULL);
+    a = from->outs;
+    if (a == victim) {		/* simple case: first in chain */
+	from->outs = victim->outchain;
+    } else {
+	for (; a!=NULL && a->outchain!=victim ; a=a->outchain) {
+	    continue;
 	}
-	from->nouts--;
-
-	/* take it off target's in-chain */
-	assert(to != NULL);
-	assert(to->ins != NULL);
-	a = to->ins;
-	if (a == victim)		/* simple case:  first in chain */
-		to->ins = victim->inchain;
-	else {
-		for (; a != NULL && a->inchain != victim; a = a->inchain)
-			continue;
-		assert(a != NULL);
-		a->inchain = victim->inchain;
+	assert(a != NULL);
+	a->outchain = victim->outchain;
+    }
+    from->nouts--;
+
+    /*
+     * Take it off target's in-chain.
+     */
+
+    assert(to != NULL);
+    assert(to->ins != NULL);
+    a = to->ins;
+    if (a == victim) {		/* simple case: first in chain */
+	to->ins = victim->inchain;
+    } else {
+	for (; a->inchain!=victim ; a=a->inchain) {
+	    assert(a->inchain != NULL);
+	    continue;
 	}
-	to->nins--;
-
-	/* clean up and place on free list */
-	victim->type = 0;
-	victim->from = NULL;		/* precautions... */
-	victim->to = NULL;
-	victim->inchain = NULL;
-	victim->outchain = NULL;
-	victim->freechain = from->free;
-	from->free = victim;
+	a->inchain = victim->inchain;
+    }
+    to->nins--;
+
+    /*
+     * Clean up and place on free list.
+     */
+
+    victim->type = 0;
+    victim->from = NULL;	/* precautions... */
+    victim->to = NULL;
+    victim->inchain = NULL;
+    victim->outchain = NULL;
+    victim->freechain = from->free;
+    from->free = victim;
 }
-
+
 /*
  - findarc - find arc, if any, from given source with given type and color
  * If there is more than one such arc, the result is random.
  ^ static struct arc *findarc(struct state *, int, pcolor);
  */
 static struct arc *
-findarc(s, type, co)
-struct state *s;
-int type;
-pcolor co;
+findarc(
+    struct state *s,
+    int type,
+    pcolor co)
 {
-	struct arc *a;
+    struct arc *a;
 
-	for (a = s->outs; a != NULL; a = a->outchain)
-		if (a->type == type && a->co == co)
-			return a;
-	return NULL;
+    for (a=s->outs ; a!=NULL ; a=a->outchain) {
+	if (a->type == type && a->co == co) {
+	    return a;
+	}
+    }
+    return NULL;
 }
-
+
 /*
  - cparc - allocate a new arc within an NFA, copying details from old one
- ^ static VOID cparc(struct nfa *, struct arc *, struct state *, 
+ ^ static VOID cparc(struct nfa *, struct arc *, struct state *,
  ^ 	struct state *);
  */
-static VOID
-cparc(nfa, oa, from, to)
-struct nfa *nfa;
-struct arc *oa;
-struct state *from;
-struct state *to;
+static void
+cparc(
+    struct nfa *nfa,
+    struct arc *oa,
+    struct state *from,
+    struct state *to)
 {
-	newarc(nfa, oa->type, oa->co, from, to);
+    newarc(nfa, oa->type, oa->co, from, to);
 }
-
+
 /*
  - moveins - move all in arcs of a state to another state
  * You might think this could be done better by just updating the
@@ -501,341 +540,365 @@ struct state *to;
  * ones to exploit the suppression built into newarc.
  ^ static VOID moveins(struct nfa *, struct state *, struct state *);
  */
-static VOID
-moveins(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+moveins(
+    struct nfa *nfa,
+    struct state *oldState,
+    struct state *newState)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(old != new);
+    assert(oldState != newState);
 
-	while ((a = old->ins) != NULL) {
-		cparc(nfa, a, a->from, new);
-		freearc(nfa, a);
-	}
-	assert(old->nins == 0);
-	assert(old->ins == NULL);
+    while ((a = oldState->ins) != NULL) {
+	cparc(nfa, a, a->from, newState);
+	freearc(nfa, a);
+    }
+    assert(oldState->nins == 0);
+    assert(oldState->ins == NULL);
 }
-
+
 /*
  - copyins - copy all in arcs of a state to another state
  ^ static VOID copyins(struct nfa *, struct state *, struct state *);
  */
-static VOID
-copyins(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+copyins(
+    struct nfa *nfa,
+    struct state *oldState,
+    struct state *newState)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(old != new);
+    assert(oldState != newState);
 
-	for (a = old->ins; a != NULL; a = a->inchain)
-		cparc(nfa, a, a->from, new);
+    for (a=oldState->ins ; a!=NULL ; a=a->inchain) {
+	cparc(nfa, a, a->from, newState);
+    }
 }
-
+
 /*
  - moveouts - move all out arcs of a state to another state
  ^ static VOID moveouts(struct nfa *, struct state *, struct state *);
  */
-static VOID
-moveouts(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+moveouts(
+    struct nfa *nfa,
+    struct state *oldState,
+    struct state *newState)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(old != new);
+    assert(oldState != newState);
 
-	while ((a = old->outs) != NULL) {
-		cparc(nfa, a, new, a->to);
-		freearc(nfa, a);
-	}
+    while ((a = oldState->outs) != NULL) {
+	cparc(nfa, a, newState, a->to);
+	freearc(nfa, a);
+    }
 }
-
+
 /*
  - copyouts - copy all out arcs of a state to another state
  ^ static VOID copyouts(struct nfa *, struct state *, struct state *);
  */
-static VOID
-copyouts(nfa, old, new)
-struct nfa *nfa;
-struct state *old;
-struct state *new;
+static void
+copyouts(
+    struct nfa *nfa,
+    struct state *oldState,
+    struct state *newState)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(old != new);
+    assert(oldState != newState);
 
-	for (a = old->outs; a != NULL; a = a->outchain)
-		cparc(nfa, a, new, a->to);
+    for (a=oldState->outs ; a!=NULL ; a=a->outchain) {
+	cparc(nfa, a, newState, a->to);
+    }
 }
-
+
 /*
  - cloneouts - copy out arcs of a state to another state pair, modifying type
  ^ static VOID cloneouts(struct nfa *, struct state *, struct state *,
  ^ 	struct state *, int);
  */
-static VOID
-cloneouts(nfa, old, from, to, type)
-struct nfa *nfa;
-struct state *old;
-struct state *from;
-struct state *to;
-int type;
+static void
+cloneouts(
+    struct nfa *nfa,
+    struct state *old,
+    struct state *from,
+    struct state *to,
+    int type)
 {
-	struct arc *a;
+    struct arc *a;
 
-	assert(old != from);
+    assert(old != from);
 
-	for (a = old->outs; a != NULL; a = a->outchain)
-		newarc(nfa, type, a->co, from, to);
+    for (a=old->outs ; a!=NULL ; a=a->outchain) {
+	newarc(nfa, type, a->co, from, to);
+    }
 }
-
+
 /*
  - delsub - delete a sub-NFA, updating subre pointers if necessary
  * This uses a recursive traversal of the sub-NFA, marking already-seen
  * states using their tmp pointer.
  ^ static VOID delsub(struct nfa *, struct state *, struct state *);
  */
-static VOID
-delsub(nfa, lp, rp)
-struct nfa *nfa;
-struct state *lp;	/* the sub-NFA goes from here... */
-struct state *rp;	/* ...to here, *not* inclusive */
+static void
+delsub(
+    struct nfa *nfa,
+    struct state *lp,		/* the sub-NFA goes from here... */
+    struct state *rp)		/* ...to here, *not* inclusive */
 {
-	assert(lp != rp);
+    assert(lp != rp);
 
-	rp->tmp = rp;			/* mark end */
+    rp->tmp = rp;		/* mark end */
 
-	deltraverse(nfa, lp, lp);
-	assert(lp->nouts == 0 && rp->nins == 0);	/* did the job */
-	assert(lp->no != FREESTATE && rp->no != FREESTATE);	/* no more */
+    deltraverse(nfa, lp, lp);
+    assert(lp->nouts == 0 && rp->nins == 0);	/* did the job */
+    assert(lp->no != FREESTATE && rp->no != FREESTATE);	/* no more */
 
-	rp->tmp = NULL;			/* unmark end */
-	lp->tmp = NULL;			/* and begin, marked by deltraverse */
+    rp->tmp = NULL;		/* unmark end */
+    lp->tmp = NULL;		/* and begin, marked by deltraverse */
 }
-
+
 /*
  - deltraverse - the recursive heart of delsub
  * This routine's basic job is to destroy all out-arcs of the state.
  ^ static VOID deltraverse(struct nfa *, struct state *, struct state *);
  */
-static VOID
-deltraverse(nfa, leftend, s)
-struct nfa *nfa;
-struct state *leftend;
-struct state *s;
+static void
+deltraverse(
+    struct nfa *nfa,
+    struct state *leftend,
+    struct state *s)
 {
-	struct arc *a;
-	struct state *to;
-
-	if (s->nouts == 0)
-		return;			/* nothing to do */
-	if (s->tmp != NULL)
-		return;			/* already in progress */
-
-	s->tmp = s;			/* mark as in progress */
-
-	while ((a = s->outs) != NULL) {
-		to = a->to;
-		deltraverse(nfa, leftend, to);
-		assert(to->nouts == 0 || to->tmp != NULL);
-		freearc(nfa, a);
-		if (to->nins == 0 && to->tmp == NULL) {
-			assert(to->nouts == 0);
-			freestate(nfa, to);
-		}
+    struct arc *a;
+    struct state *to;
+
+    if (s->nouts == 0) {
+	return;			/* nothing to do */
+    }
+    if (s->tmp != NULL) {
+	return;			/* already in progress */
+    }
+
+    s->tmp = s;			/* mark as in progress */
+
+    while ((a = s->outs) != NULL) {
+	to = a->to;
+	deltraverse(nfa, leftend, to);
+	assert(to->nouts == 0 || to->tmp != NULL);
+	freearc(nfa, a);
+	if (to->nins == 0 && to->tmp == NULL) {
+	    assert(to->nouts == 0);
+	    freestate(nfa, to);
 	}
+    }
 
-	assert(s->no != FREESTATE);	/* we're still here */
-	assert(s == leftend || s->nins != 0);	/* and still reachable */
-	assert(s->nouts == 0);		/* but have no outarcs */
+    assert(s->no != FREESTATE);	/* we're still here */
+    assert(s == leftend || s->nins != 0);	/* and still reachable */
+    assert(s->nouts == 0);	/* but have no outarcs */
 
-	s->tmp = NULL;			/* we're done here */
+    s->tmp = NULL;		/* we're done here */
 }
-
+
 /*
  - dupnfa - duplicate sub-NFA
- * Another recursive traversal, this time using tmp to point to duplicates
- * as well as mark already-seen states.  (You knew there was a reason why
- * it's a state pointer, didn't you? :-))
- ^ static VOID dupnfa(struct nfa *, struct state *, struct state *, 
+ * Another recursive traversal, this time using tmp to point to duplicates as
+ * well as mark already-seen states. (You knew there was a reason why it's a
+ * state pointer, didn't you? :-))
+ ^ static VOID dupnfa(struct nfa *, struct state *, struct state *,
  ^ 	struct state *, struct state *);
  */
-static VOID
-dupnfa(nfa, start, stop, from, to)
-struct nfa *nfa;
-struct state *start;		/* duplicate of subNFA starting here */
-struct state *stop;		/* and stopping here */
-struct state *from;		/* stringing duplicate from here */
-struct state *to;		/* to here */
+static void
+dupnfa(
+    struct nfa *nfa,
+    struct state *start,	/* duplicate of subNFA starting here */
+    struct state *stop,		/* and stopping here */
+    struct state *from,		/* stringing duplicate from here */
+    struct state *to)		/* to here */
 {
-	if (start == stop) {
-		newarc(nfa, EMPTY, 0, from, to);
-		return;
-	}
+    if (start == stop) {
+	newarc(nfa, EMPTY, 0, from, to);
+	return;
+    }
 
-	stop->tmp = to;
-	duptraverse(nfa, start, from);
-	/* done, except for clearing out the tmp pointers */
+    stop->tmp = to;
+    duptraverse(nfa, start, from);
+    /* done, except for clearing out the tmp pointers */
 
-	stop->tmp = NULL;
-	cleartraverse(nfa, start);
+    stop->tmp = NULL;
+    cleartraverse(nfa, start);
 }
-
+
 /*
  - duptraverse - recursive heart of dupnfa
  ^ static VOID duptraverse(struct nfa *, struct state *, struct state *);
  */
-static VOID
-duptraverse(nfa, s, stmp)
-struct nfa *nfa;
-struct state *s;
-struct state *stmp;		/* s's duplicate, or NULL */
+static void
+duptraverse(
+    struct nfa *nfa,
+    struct state *s,
+    struct state *stmp)		/* s's duplicate, or NULL */
 {
-	struct arc *a;
+    struct arc *a;
 
-	if (s->tmp != NULL)
-		return;		/* already done */
+    if (s->tmp != NULL) {
+	return;			/* already done */
+    }
 
-	s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
-	if (s->tmp == NULL) {
-		assert(NISERR());
-		return;
-	}
+    s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
+    if (s->tmp == NULL) {
+	assert(NISERR());
+	return;
+    }
 
-	for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
-		duptraverse(nfa, a->to, (struct state *)NULL);
-		if (NISERR())
-			break;
-		assert(a->to->tmp != NULL);
-		cparc(nfa, a, s->tmp, a->to->tmp);
+    for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {
+	duptraverse(nfa, a->to, NULL);
+	if (NISERR()) {
+	    break;
 	}
+	assert(a->to->tmp != NULL);
+	cparc(nfa, a, s->tmp, a->to->tmp);
+    }
 }
-
+
 /*
  - cleartraverse - recursive cleanup for algorithms that leave tmp ptrs set
  ^ static VOID cleartraverse(struct nfa *, struct state *);
  */
-static VOID
-cleartraverse(nfa, s)
-struct nfa *nfa;
-struct state *s;
+static void
+cleartraverse(
+    struct nfa *nfa,
+    struct state *s)
 {
-	struct arc *a;
+    struct arc *a;
 
-	if (s->tmp == NULL)
-		return;
-	s->tmp = NULL;
+    if (s->tmp == NULL) {
+	return;
+    }
+    s->tmp = NULL;
 
-	for (a = s->outs; a != NULL; a = a->outchain)
-		cleartraverse(nfa, a->to);
+    for (a=s->outs ; a!=NULL ; a=a->outchain) {
+	cleartraverse(nfa, a->to);
+    }
 }
-
+
 /*
  - specialcolors - fill in special colors for an NFA
  ^ static VOID specialcolors(struct nfa *);
  */
-static VOID
-specialcolors(nfa)
-struct nfa *nfa;
+static void
+specialcolors(
+    struct nfa *nfa)
 {
-	/* false colors for BOS, BOL, EOS, EOL */
-	if (nfa->parent == NULL) {
-		nfa->bos[0] = pseudocolor(nfa->cm);
-		nfa->bos[1] = pseudocolor(nfa->cm);
-		nfa->eos[0] = pseudocolor(nfa->cm);
-		nfa->eos[1] = pseudocolor(nfa->cm);
-	} else {
-		assert(nfa->parent->bos[0] != COLORLESS);
-		nfa->bos[0] = nfa->parent->bos[0];
-		assert(nfa->parent->bos[1] != COLORLESS);
-		nfa->bos[1] = nfa->parent->bos[1];
-		assert(nfa->parent->eos[0] != COLORLESS);
-		nfa->eos[0] = nfa->parent->eos[0];
-		assert(nfa->parent->eos[1] != COLORLESS);
-		nfa->eos[1] = nfa->parent->eos[1];
-	}
+    /*
+     * False colors for BOS, BOL, EOS, EOL
+     */
+
+    if (nfa->parent == NULL) {
+	nfa->bos[0] = pseudocolor(nfa->cm);
+	nfa->bos[1] = pseudocolor(nfa->cm);
+	nfa->eos[0] = pseudocolor(nfa->cm);
+	nfa->eos[1] = pseudocolor(nfa->cm);
+    } else {
+	assert(nfa->parent->bos[0] != COLORLESS);
+	nfa->bos[0] = nfa->parent->bos[0];
+	assert(nfa->parent->bos[1] != COLORLESS);
+	nfa->bos[1] = nfa->parent->bos[1];
+	assert(nfa->parent->eos[0] != COLORLESS);
+	nfa->eos[0] = nfa->parent->eos[0];
+	assert(nfa->parent->eos[1] != COLORLESS);
+	nfa->eos[1] = nfa->parent->eos[1];
+    }
 }
-
+
 /*
  - optimize - optimize an NFA
  ^ static long optimize(struct nfa *, FILE *);
  */
 static long			/* re_info bits */
-optimize(nfa, f)
-struct nfa *nfa;
-FILE *f;			/* for debug output; NULL none */
+optimize(
+    struct nfa *nfa,
+    FILE *f)			/* for debug output; NULL none */
 {
-	int verbose = (f != NULL) ? 1 : 0;
-
-	if (verbose)
-		fprintf(f, "\ninitial cleanup:\n");
-	cleanup(nfa);		/* may simplify situation */
-	if (verbose)
-		dumpnfa(nfa, f);
-	if (verbose)
-		fprintf(f, "\nempties:\n");
-	fixempties(nfa, f);	/* get rid of EMPTY arcs */
-	if (verbose)
-		fprintf(f, "\nconstraints:\n");
-	pullback(nfa, f);	/* pull back constraints backward */
-	pushfwd(nfa, f);	/* push fwd constraints forward */
-	if (verbose)
-		fprintf(f, "\nfinal cleanup:\n");
-	cleanup(nfa);		/* final tidying */
-	return analyze(nfa);	/* and analysis */
+    int verbose = (f != NULL) ? 1 : 0;
+
+    if (verbose) {
+	fprintf(f, "\ninitial cleanup:\n");
+    }
+    cleanup(nfa);		/* may simplify situation */
+    if (verbose) {
+	dumpnfa(nfa, f);
+    }
+    if (verbose) {
+	fprintf(f, "\nempties:\n");
+    }
+    fixempties(nfa, f);		/* get rid of EMPTY arcs */
+    if (verbose) {
+	fprintf(f, "\nconstraints:\n");
+    }
+    pullback(nfa, f);		/* pull back constraints backward */
+    pushfwd(nfa, f);		/* push fwd constraints forward */
+    if (verbose) {
+	fprintf(f, "\nfinal cleanup:\n");
+    }
+    cleanup(nfa);		/* final tidying */
+    return analyze(nfa);	/* and analysis */
 }
-
+
 /*
  - pullback - pull back constraints backward to (with luck) eliminate them
  ^ static VOID pullback(struct nfa *, FILE *);
  */
-static VOID
-pullback(nfa, f)
-struct nfa *nfa;
-FILE *f;			/* for debug output; NULL none */
+static void
+pullback(
+    struct nfa *nfa,
+    FILE *f)			/* for debug output; NULL none */
 {
-	struct state *s;
-	struct state *nexts;
-	struct arc *a;
-	struct arc *nexta;
-	int progress;
-
-	/* find and pull until there are no more */
-	do {
-		progress = 0;
-		for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
-			nexts = s->next;
-			for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
-				nexta = a->outchain;
-				if (a->type == '^' || a->type == BEHIND)
-					if (pull(nfa, a))
-						progress = 1;
-				assert(nexta == NULL || s->no != FREESTATE);
-			}
-		}
-		if (progress && f != NULL)
-			dumpnfa(nfa, f);
-	} while (progress && !NISERR());
-	if (NISERR())
-		return;
-
-	for (a = nfa->pre->outs; a != NULL; a = nexta) {
+    struct state *s;
+    struct state *nexts;
+    struct arc *a;
+    struct arc *nexta;
+    int progress;
+
+    /*
+     * Find and pull until there are no more.
+     */
+
+    do {
+	progress = 0;
+	for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
+	    nexts = s->next;
+	    for (a=s->outs ; a!=NULL && !NISERR() ; a=nexta) {
 		nexta = a->outchain;
-		if (a->type == '^') {
-			assert(a->co == 0 || a->co == 1);
-			newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
-			freearc(nfa, a);
+		if (a->type == '^' || a->type == BEHIND) {
+		    if (pull(nfa, a)) {
+			progress = 1;
+		    }
 		}
+		assert(nexta == NULL || s->no != FREESTATE);
+	    }
+	}
+	if (progress && f != NULL) {
+	    dumpnfa(nfa, f);
+	}
+    } while (progress && !NISERR());
+    if (NISERR()) {
+	return;
+    }
+
+    for (a=nfa->pre->outs ; a!=NULL ; a=nexta) {
+	nexta = a->outchain;
+	if (a->type == '^') {
+	    assert(a->co == 0 || a->co == 1);
+	    newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
+	    freearc(nfa, a);
 	}
+    }
 }
-
+
 /*
  - pull - pull a back constraint backward past its source state
  * A significant property of this function is that it deletes at most
@@ -844,136 +907,155 @@ FILE *f;			/* for debug output; NULL none */
  ^ static int pull(struct nfa *, struct arc *);
  */
 static int			/* 0 couldn't, 1 could */
-pull(nfa, con)
-struct nfa *nfa;
-struct arc *con;
+pull(
+    struct nfa *nfa,
+    struct arc *con)
 {
-	struct state *from = con->from;
-	struct state *to = con->to;
-	struct arc *a;
-	struct arc *nexta;
-	struct state *s;
-
-	if (from == to) {	/* circular constraint is pointless */
-		freearc(nfa, con);
-		return 1;
-	}
-	if (from->flag)		/* can't pull back beyond start */
-		return 0;
-	if (from->nins == 0) {	/* unreachable */
-		freearc(nfa, con);
-		return 1;
-	}
+    struct state *from = con->from;
+    struct state *to = con->to;
+    struct arc *a;
+    struct arc *nexta;
+    struct state *s;
+
+    if (from == to) {		/* circular constraint is pointless */
+	freearc(nfa, con);
+	return 1;
+    }
+    if (from->flag) {		/* can't pull back beyond start */
+	return 0;
+    }
+    if (from->nins == 0) {	/* unreachable */
+	freearc(nfa, con);
+	return 1;
+    }
 
-	/*
-	 * DGP 2007-11-15: Cloning a state with a circular constraint on its
-	 * list of outs can lead to trouble [Bug 1810038], so get rid of them
-	 * first.
-	 */
+    /*
+     * DGP 2007-11-15: Cloning a state with a circular constraint on its list
+     * of outs can lead to trouble [Bug 1810038], so get rid of them first.
+     */
 
-	for (a = from->outs; a != NULL; a = nexta) {
-		nexta = a->outchain;
-		switch (a->type) {
-		case '^':
-		case '$':
-		case BEHIND:
-		case AHEAD:
-			if (from == a->to) {
-				freearc(nfa, a);
-			}
-			break;
-		}
+    for (a = from->outs; a != NULL; a = nexta) {
+	nexta = a->outchain;
+	switch (a->type) {
+	case '^':
+	case '$':
+	case BEHIND:
+	case AHEAD:
+	    if (from == a->to) {
+		freearc(nfa, a);
+	    }
+	    break;
 	}
+    }
 
-	/* first, clone from state if necessary to avoid other outarcs */
-	if (from->nouts > 1) {
-		s = newstate(nfa);
-		if (NISERR())
-			return 0;
-		assert(to != from);		/* con is not an inarc */
-		copyins(nfa, from, s);		/* duplicate inarcs */
-		cparc(nfa, con, s, to);		/* move constraint arc */
-		freearc(nfa, con);
-		from = s;
-		con = from->outs;
-	}
-	assert(from->nouts == 1);
+    /*
+     * First, clone from state if necessary to avoid other outarcs.
+     */
 
-	/* propagate the constraint into the from state's inarcs */
-	for (a = from->ins; a != NULL; a = nexta) {
-		nexta = a->inchain;
-		switch (combine(con, a)) {
-		case INCOMPATIBLE:	/* destroy the arc */
-			freearc(nfa, a);
-			break;
-		case SATISFIED:		/* no action needed */
-			break;
-		case COMPATIBLE:	/* swap the two arcs, more or less */
-			s = newstate(nfa);
-			if (NISERR())
-				return 0;
-			cparc(nfa, a, s, to);		/* anticipate move */
-			cparc(nfa, con, a->from, s);
-			if (NISERR())
-				return 0;
-			freearc(nfa, a);
-			break;
-		default:
-			assert(NOTREACHED);
-			break;
-		}
+    if (from->nouts > 1) {
+	s = newstate(nfa);
+	if (NISERR()) {
+	    return 0;
+	}
+	assert(to != from);	/* con is not an inarc */
+	copyins(nfa, from, s);	/* duplicate inarcs */
+	cparc(nfa, con, s, to);	/* move constraint arc */
+	freearc(nfa, con);
+	from = s;
+	con = from->outs;
+    }
+    assert(from->nouts == 1);
+
+    /*
+     * Propagate the constraint into the from state's inarcs.
+     */
+
+    for (a=from->ins ; a!=NULL ; a=nexta) {
+	nexta = a->inchain;
+	switch (combine(con, a)) {
+	case INCOMPATIBLE:	/* destroy the arc */
+	    freearc(nfa, a);
+	    break;
+	case SATISFIED:		/* no action needed */
+	    break;
+	case COMPATIBLE:	/* swap the two arcs, more or less */
+	    s = newstate(nfa);
+	    if (NISERR()) {
+		return 0;
+	    }
+	    cparc(nfa, a, s, to);	/* anticipate move */
+	    cparc(nfa, con, a->from, s);
+	    if (NISERR()) {
+		return 0;
+	    }
+	    freearc(nfa, a);
+	    break;
+	default:
+	    assert(NOTREACHED);
+	    break;
 	}
+    }
 
-	/* remaining inarcs, if any, incorporate the constraint */
-	moveins(nfa, from, to);
-	dropstate(nfa, from);		/* will free the constraint */
-	return 1;
-}
+    /*
+     * Remaining inarcs, if any, incorporate the constraint.
+     */
 
+    moveins(nfa, from, to);
+    dropstate(nfa, from);	/* will free the constraint */
+    return 1;
+}
+
 /*
  - pushfwd - push forward constraints forward to (with luck) eliminate them
  ^ static VOID pushfwd(struct nfa *, FILE *);
  */
-static VOID
-pushfwd(nfa, f)
-struct nfa *nfa;
-FILE *f;			/* for debug output; NULL none */
+static void
+pushfwd(
+    struct nfa *nfa,
+    FILE *f)			/* for debug output; NULL none */
 {
-	struct state *s;
-	struct state *nexts;
-	struct arc *a;
-	struct arc *nexta;
-	int progress;
-
-	/* find and push until there are no more */
-	do {
-		progress = 0;
-		for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
-			nexts = s->next;
-			for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
-				nexta = a->inchain;
-				if (a->type == '$' || a->type == AHEAD)
-					if (push(nfa, a))
-						progress = 1;
-				assert(nexta == NULL || s->no != FREESTATE);
-			}
-		}
-		if (progress && f != NULL)
-			dumpnfa(nfa, f);
-	} while (progress && !NISERR());
-	if (NISERR())
-		return;
-
-	for (a = nfa->post->ins; a != NULL; a = nexta) {
+    struct state *s;
+    struct state *nexts;
+    struct arc *a;
+    struct arc *nexta;
+    int progress;
+
+    /*
+     * Find and push until there are no more.
+     */
+
+    do {
+	progress = 0;
+	for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
+	    nexts = s->next;
+	    for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
 		nexta = a->inchain;
-		if (a->type == '$') {
-			assert(a->co == 0 || a->co == 1);
-			newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
-			freearc(nfa, a);
+		if (a->type == '$' || a->type == AHEAD) {
+		    if (push(nfa, a)) {
+			progress = 1;
+		    }
 		}
+		assert(nexta == NULL || s->no != FREESTATE);
+	    }
 	}
+	if (progress && f != NULL) {
+	    dumpnfa(nfa, f);
+	}
+    } while (progress && !NISERR());
+    if (NISERR()) {
+	return;
+    }
+
+    for (a = nfa->post->ins; a != NULL; a = nexta) {
+	nexta = a->inchain;
+	if (a->type == '$') {
+	    assert(a->co == 0 || a->co == 1);
+	    newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
+	    freearc(nfa, a);
+	}
+    }
 }
-
+
 /*
  - push - push a forward constraint forward past its destination state
  * A significant property of this function is that it deletes at most
@@ -982,94 +1064,106 @@ FILE *f;			/* for debug output; NULL none */
  ^ static int push(struct nfa *, struct arc *);
  */
 static int			/* 0 couldn't, 1 could */
-push(nfa, con)
-struct nfa *nfa;
-struct arc *con;
+push(
+    struct nfa *nfa,
+    struct arc *con)
 {
-	struct state *from = con->from;
-	struct state *to = con->to;
-	struct arc *a;
-	struct arc *nexta;
-	struct state *s;
-
-	if (to == from) {	/* circular constraint is pointless */
-		freearc(nfa, con);
-		return 1;
-	}
-	if (to->flag)		/* can't push forward beyond end */
-		return 0;
-	if (to->nouts == 0) {	/* dead end */
-		freearc(nfa, con);
-		return 1;
+    struct state *from = con->from;
+    struct state *to = con->to;
+    struct arc *a;
+    struct arc *nexta;
+    struct state *s;
+
+    if (to == from) {		/* circular constraint is pointless */
+	freearc(nfa, con);
+	return 1;
+    }
+    if (to->flag) {		/* can't push forward beyond end */
+	return 0;
+    }
+    if (to->nouts == 0) {	/* dead end */
+	freearc(nfa, con);
+	return 1;
+    }
+
+    /*
+     * DGP 2007-11-15: Here we duplicate the same protections as appear
+     * in pull() above to avoid troubles with cloning a state with a
+     * circular constraint on its list of ins.  It is not clear whether
+     * this is necessary, or is protecting against a "can't happen".
+     * Any test case that actually leads to a freearc() call here would
+     * be a welcome addition to the test suite.
+     */
+
+    for (a = to->ins; a != NULL; a = nexta) {
+	nexta = a->inchain;
+	switch (a->type) {
+	case '^':
+	case '$':
+	case BEHIND:
+	case AHEAD:
+	    if (a->from == to) {
+		freearc(nfa, a);
+	    }
+	    break;
 	}
+    }
+    /*
+     * First, clone to state if necessary to avoid other inarcs.
+     */
 
-	/*
-	 * DGP 2007-11-15: Here we duplicate the same protections as appear
-	 * in pull() above to avoid troubles with cloning a state with a
-	 * circular constraint on its list of ins.  It is not clear whether
-	 * this is necessary, or is protecting against a "can't happen".
-	 * Any test case that actually leads to a freearc() call here would
-	 * be a welcome addition to the test suite.
-	 */
-
-	for (a = to->ins; a != NULL; a = nexta) {
-		nexta = a->inchain;
-		switch (a->type) {
-		case '^':
-		case '$':
-		case BEHIND:
-		case AHEAD:
-			if (a->from == to) {
-				freearc(nfa, a);
-			}
-			break;
-		}
+    if (to->nins > 1) {
+	s = newstate(nfa);
+	if (NISERR()) {
+	    return 0;
 	}
-
-	/* first, clone to state if necessary to avoid other inarcs */
-	if (to->nins > 1) {
-		s = newstate(nfa);
-		if (NISERR())
-			return 0;
-		copyouts(nfa, to, s);		/* duplicate outarcs */
-		cparc(nfa, con, from, s);	/* move constraint */
-		freearc(nfa, con);
-		to = s;
-		con = to->ins;
+	copyouts(nfa, to, s);	/* duplicate outarcs */
+	cparc(nfa, con, from, s);	/* move constraint */
+	freearc(nfa, con);
+	to = s;
+	con = to->ins;
+    }
+    assert(to->nins == 1);
+
+    /*
+     * Propagate the constraint into the to state's outarcs.
+     */
+
+    for (a = to->outs; a != NULL; a = nexta) {
+	nexta = a->outchain;
+	switch (combine(con, a)) {
+	case INCOMPATIBLE:	/* destroy the arc */
+	    freearc(nfa, a);
+	    break;
+	case SATISFIED:		/* no action needed */
+	    break;
+	case COMPATIBLE:	/* swap the two arcs, more or less */
+	    s = newstate(nfa);
+	    if (NISERR()) {
+		return 0;
+	    }
+	    cparc(nfa, con, s, a->to);	/* anticipate move */
+	    cparc(nfa, a, from, s);
+	    if (NISERR()) {
+		return 0;
+	    }
+	    freearc(nfa, a);
+	    break;
+	default:
+	    assert(NOTREACHED);
+	    break;
 	}
-	assert(to->nins == 1);
+    }
 
-	/* propagate the constraint into the to state's outarcs */
-	for (a = to->outs; a != NULL; a = nexta) {
-		nexta = a->outchain;
-		switch (combine(con, a)) {
-		case INCOMPATIBLE:	/* destroy the arc */
-			freearc(nfa, a);
-			break;
-		case SATISFIED:		/* no action needed */
-			break;
-		case COMPATIBLE:	/* swap the two arcs, more or less */
-			s = newstate(nfa);
-			if (NISERR())
-				return 0;
-			cparc(nfa, con, s, a->to);	/* anticipate move */
-			cparc(nfa, a, from, s);
-			if (NISERR())
-				return 0;
-			freearc(nfa, a);
-			break;
-		default:
-			assert(NOTREACHED);
-			break;
-		}
-	}
+    /*
+     * Remaining outarcs, if any, incorporate the constraint.
+     */
 
-	/* remaining outarcs, if any, incorporate the constraint */
-	moveouts(nfa, to, from);
-	dropstate(nfa, to);		/* will free the constraint */
-	return 1;
+    moveouts(nfa, to, from);
+    dropstate(nfa, to);		/* will free the constraint */
+    return 1;
 }
-
+
 /*
  - combine - constraint lands on an arc, what happens?
  ^ #def	INCOMPATIBLE	1	// destroys arc
@@ -1078,417 +1172,468 @@ struct arc *con;
  ^ static int combine(struct arc *, struct arc *);
  */
 static int
-combine(con, a)
-struct arc *con;
-struct arc *a;
+combine(
+    struct arc *con,
+    struct arc *a)
 {
-#	define	CA(ct,at)	(((ct)<<CHAR_BIT) | (at))
-
-	switch (CA(con->type, a->type)) {
-	case CA('^', PLAIN):		/* newlines are handled separately */
-	case CA('$', PLAIN):
-		return INCOMPATIBLE;
-		break;
-	case CA(AHEAD, PLAIN):		/* color constraints meet colors */
-	case CA(BEHIND, PLAIN):
-		if (con->co == a->co)
-			return SATISFIED;
-		return INCOMPATIBLE;
-		break;
-	case CA('^', '^'):		/* collision, similar constraints */
-	case CA('$', '$'):
-	case CA(AHEAD, AHEAD):
-	case CA(BEHIND, BEHIND):
-		if (con->co == a->co)		/* true duplication */
-			return SATISFIED;
-		return INCOMPATIBLE;
-		break;
-	case CA('^', BEHIND):		/* collision, dissimilar constraints */
-	case CA(BEHIND, '^'):
-	case CA('$', AHEAD):
-	case CA(AHEAD, '$'):
-		return INCOMPATIBLE;
-		break;
-	case CA('^', '$'):		/* constraints passing each other */
-	case CA('^', AHEAD):
-	case CA(BEHIND, '$'):
-	case CA(BEHIND, AHEAD):
-	case CA('$', '^'):
-	case CA('$', BEHIND):
-	case CA(AHEAD, '^'):
-	case CA(AHEAD, BEHIND):
-	case CA('^', LACON):
-	case CA(BEHIND, LACON):
-	case CA('$', LACON):
-	case CA(AHEAD, LACON):
-		return COMPATIBLE;
-		break;
+#define CA(ct,at)	(((ct)<<CHAR_BIT) | (at))
+
+    switch (CA(con->type, a->type)) {
+    case CA('^', PLAIN):	/* newlines are handled separately */
+    case CA('$', PLAIN):
+	return INCOMPATIBLE;
+	break;
+    case CA(AHEAD, PLAIN):	/* color constraints meet colors */
+    case CA(BEHIND, PLAIN):
+	if (con->co == a->co) {
+	    return SATISFIED;
+	}
+	return INCOMPATIBLE;
+	break;
+    case CA('^', '^'):		/* collision, similar constraints */
+    case CA('$', '$'):
+    case CA(AHEAD, AHEAD):
+    case CA(BEHIND, BEHIND):
+	if (con->co == a->co) {	/* true duplication */
+	    return SATISFIED;
 	}
-	assert(NOTREACHED);
-	return INCOMPATIBLE;		/* for benefit of blind compilers */
+	return INCOMPATIBLE;
+	break;
+    case CA('^', BEHIND):	/* collision, dissimilar constraints */
+    case CA(BEHIND, '^'):
+    case CA('$', AHEAD):
+    case CA(AHEAD, '$'):
+	return INCOMPATIBLE;
+	break;
+    case CA('^', '$'):		/* constraints passing each other */
+    case CA('^', AHEAD):
+    case CA(BEHIND, '$'):
+    case CA(BEHIND, AHEAD):
+    case CA('$', '^'):
+    case CA('$', BEHIND):
+    case CA(AHEAD, '^'):
+    case CA(AHEAD, BEHIND):
+    case CA('^', LACON):
+    case CA(BEHIND, LACON):
+    case CA('$', LACON):
+    case CA(AHEAD, LACON):
+	return COMPATIBLE;
+	break;
+    }
+    assert(NOTREACHED);
+    return INCOMPATIBLE;	/* for benefit of blind compilers */
 }
-
+
 /*
  - fixempties - get rid of EMPTY arcs
  ^ static VOID fixempties(struct nfa *, FILE *);
  */
-static VOID
-fixempties(nfa, f)
-struct nfa *nfa;
-FILE *f;			/* for debug output; NULL none */
+static void
+fixempties(
+    struct nfa *nfa,
+    FILE *f)			/* for debug output; NULL none */
 {
-	struct state *s;
-	struct state *nexts;
-	struct state *to;
-	struct arc *a;
-	struct arc *nexta;
-	int progress;
-
-	/* find and eliminate empties until there are no more */
-	do {
-		progress = 0;
-		for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
-			nexts = s->next;
-			for (a = s->outs; a != NULL && !NISERR();
-				a = a->outchain)
-				if (a->type == EMPTY)
-					/* Mark a for deletion; copy arcs
-					 * to preserve graph connectivity
-					 * after it is gone. */
-					unempty(nfa, a);
-
-			/* Now pass through and delete the marked arcs.
-			 * Doing all the deletion after all the marking
-			 * prevents arc copying from resurrecting deleted
-			 * arcs which can cause failure to converge.
-			 * [Tcl Bug 3604074] */
-			for (a = s->outs; a != NULL; a = nexta) {
-				nexta = a->outchain;
-				if (a->from == NULL) {
-					progress = 1;
-		    			to = a->to;
-					a->from = s;
-					freearc(nfa, a);
-					if (to->nins == 0) {
-						while ((a = to->outs))
-							freearc(nfa, a);
-						if (nexts == to)
-							nexts = to->next;
-						freestate(nfa, to);
-					}
-					if (s->nouts == 0) {
-						while ((a = s->ins))
-							freearc(nfa, a);
-						freestate(nfa, s);
-					}
-				}
+    struct state *s;
+    struct state *nexts;
+    struct state *to;
+    struct arc *a;
+    struct arc *nexta;
+    int progress;
+
+    /*
+     * Find and eliminate empties until there are no more.
+     */
+
+    do {
+	progress = 0;
+	for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+	    nexts = s->next;
+	    for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
+		if (a->type == EMPTY) {
+
+		    /*
+		     *  Mark a for deletion; copy arcs to preserve graph
+		     * connectivity after it is gone.
+		     */
+
+		    unempty(nfa, a);
+		}
+	    }
+
+	    /*
+	     * Now pass through and delete the marked arcs.  Doing all the
+	     * deletion after all the marking prevents arc copying from
+	     * resurrecting deleted arcs which can cause failure to converge.
+	     * [Tcl Bug 3604074]
+	     */
+
+	    for (a = s->outs; a != NULL; a = nexta) {
+		nexta = a->outchain;
+		if (a->from == NULL) {
+		    progress = 1;
+		    to = a->to;
+		    a->from = s;
+		    freearc(nfa, a);
+		    if (to->nins == 0) {
+			while ((a = to->outs)) {
+			    freearc(nfa, a);
 			}
+			if (nexts == to) {
+			    nexts = to->next;
+			}
+			freestate(nfa, to);
+		    }
+		    if (s->nouts == 0) {
+			while ((a = s->ins)) {
+			    freearc(nfa, a);
+			}
+			freestate(nfa, s);
+		    }
 		}
-		if (progress && f != NULL)
-			dumpnfa(nfa, f);
-	} while (progress && !NISERR());
+	    }
+	}
+	if (progress && f != NULL) {
+	    dumpnfa(nfa, f);
+	}
+    } while (progress && !NISERR());
 }
-
+
 /*
  - unempty - optimize out an EMPTY arc, if possible
- * Actually, as it stands this function always succeeds, but the return
- * value is kept with an eye on possible future changes.
+ * Actually, as it stands this function always succeeds, but the return value
+ * is kept with an eye on possible future changes.
  ^ static int unempty(struct nfa *, struct arc *);
  */
 static int			/* 0 couldn't, 1 could */
-unempty(nfa, a)
-struct nfa *nfa;
-struct arc *a;
+unempty(
+    struct nfa *nfa,
+    struct arc *a)
 {
-	struct state *from = a->from;
-	struct state *to = a->to;
-
-	assert(a->type == EMPTY);
-	assert(from != nfa->pre && to != nfa->post);
+    struct state *from = a->from;
+    struct state *to = a->to;
 
-	if (from == to) {		/* vacuous loop */
-		freearc(nfa, a);
-		return 1;
-	}
+    assert(a->type == EMPTY);
+    assert(from != nfa->pre && to != nfa->post);
 
-	/* Mark arc for deletion */
-	a->from = NULL;
+    if (from == to) {		/* vacuous loop */
+	freearc(nfa, a);
+	return 1;
+    }
 
-	if (from->nouts > to->nins) {
-		copyouts(nfa, to, from);
-		return 1;
-	}
-	if (from->nouts < to->nins) {
-		copyins(nfa, from, to);
-		return 1;
-	}
+    /*
+     *  Mark arc for deletion.
+     */
 
-	/* from->nouts == to->nins */
-	/* decide on secondary issue:  move/copy fewest arcs */
-	if (from->nins > to->nouts) {
-		copyouts(nfa, to, from);
-		return 1;
-	}
+    a->from = NULL;
 
+    if (from->nouts > to->nins) {
+	copyouts(nfa, to, from);
+	return 1;
+    }
+    if (from->nouts < to->nins) {
 	copyins(nfa, from, to);
 	return 1;
-}
+    }
+
+    /*
+     * from->nouts == to->nins . decide on secondary issue:  copy fewest arcs
+     */
+
+    if (from->nins > to->nouts) {
+	copyouts(nfa, to, from);
+	return 1;
+    }
 
+    copyins(nfa, from, to);
+    return 1;
+}
+
 /*
  - cleanup - clean up NFA after optimizations
  ^ static VOID cleanup(struct nfa *);
  */
-static VOID
-cleanup(nfa)
-struct nfa *nfa;
+static void
+cleanup(
+    struct nfa *nfa)
 {
-	struct state *s;
-	struct state *nexts;
-	int n;
-
-	/* clear out unreachable or dead-end states */
-	/* use pre to mark reachable, then post to mark can-reach-post */
-	markreachable(nfa, nfa->pre, (struct state *)NULL, nfa->pre);
-	markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
-	for (s = nfa->states; s != NULL; s = nexts) {
-		nexts = s->next;
-		if (s->tmp != nfa->post && !s->flag)
-			dropstate(nfa, s);
+    struct state *s;
+    struct state *nexts;
+    int n;
+
+    /*
+     * Clear out unreachable or dead-end states. Use pre to mark reachable,
+     * then post to mark can-reach-post.
+     */
+
+    markreachable(nfa, nfa->pre, NULL, nfa->pre);
+    markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
+    for (s = nfa->states; s != NULL; s = nexts) {
+	nexts = s->next;
+	if (s->tmp != nfa->post && !s->flag) {
+	    dropstate(nfa, s);
 	}
-	assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
-	cleartraverse(nfa, nfa->pre);
-	assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
-	/* the nins==0 (final unreachable) case will be caught later */
-
-	/* renumber surviving states */
-	n = 0;
-	for (s = nfa->states; s != NULL; s = s->next)
-		s->no = n++;
-	nfa->nstates = n;
+    }
+    assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
+    cleartraverse(nfa, nfa->pre);
+    assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
+    /* the nins==0 (final unreachable) case will be caught later */
+
+    /*
+     * Renumber surviving states.
+     */
+
+    n = 0;
+    for (s = nfa->states; s != NULL; s = s->next) {
+	s->no = n++;
+    }
+    nfa->nstates = n;
 }
-
+
 /*
  - markreachable - recursive marking of reachable states
  ^ static VOID markreachable(struct nfa *, struct state *, struct state *,
  ^ 	struct state *);
  */
-static VOID
-markreachable(nfa, s, okay, mark)
-struct nfa *nfa;
-struct state *s;
-struct state *okay;		/* consider only states with this mark */
-struct state *mark;		/* the value to mark with */
+static void
+markreachable(
+    struct nfa *nfa,
+    struct state *s,
+    struct state *okay,		/* consider only states with this mark */
+    struct state *mark)		/* the value to mark with */
 {
-	struct arc *a;
+    struct arc *a;
 
-	if (s->tmp != okay)
-		return;
-	s->tmp = mark;
+    if (s->tmp != okay) {
+	return;
+    }
+    s->tmp = mark;
 
-	for (a = s->outs; a != NULL; a = a->outchain)
-		markreachable(nfa, a->to, okay, mark);
+    for (a = s->outs; a != NULL; a = a->outchain) {
+	markreachable(nfa, a->to, okay, mark);
+    }
 }
-
+
 /*
  - markcanreach - recursive marking of states which can reach here
  ^ static VOID markcanreach(struct nfa *, struct state *, struct state *,
  ^ 	struct state *);
  */
-static VOID
-markcanreach(nfa, s, okay, mark)
-struct nfa *nfa;
-struct state *s;
-struct state *okay;		/* consider only states with this mark */
-struct state *mark;		/* the value to mark with */
+static void
+markcanreach(
+    struct nfa *nfa,
+    struct state *s,
+    struct state *okay,		/* consider only states with this mark */
+    struct state *mark)		/* the value to mark with */
 {
-	struct arc *a;
+    struct arc *a;
 
-	if (s->tmp != okay)
-		return;
-	s->tmp = mark;
+    if (s->tmp != okay) {
+	return;
+    }
+    s->tmp = mark;
 
-	for (a = s->ins; a != NULL; a = a->inchain)
-		markcanreach(nfa, a->from, okay, mark);
+    for (a = s->ins; a != NULL; a = a->inchain) {
+	markcanreach(nfa, a->from, okay, mark);
+    }
 }
-
+
 /*
  - analyze - ascertain potentially-useful facts about an optimized NFA
  ^ static long analyze(struct nfa *);
  */
 static long			/* re_info bits to be ORed in */
-analyze(nfa)
-struct nfa *nfa;
+analyze(
+    struct nfa *nfa)
 {
-	struct arc *a;
-	struct arc *aa;
-
-	if (nfa->pre->outs == NULL)
-		return REG_UIMPOSSIBLE;
-	for (a = nfa->pre->outs; a != NULL; a = a->outchain)
-		for (aa = a->to->outs; aa != NULL; aa = aa->outchain)
-			if (aa->to == nfa->post)
-				return REG_UEMPTYMATCH;
-	return 0;
+    struct arc *a;
+    struct arc *aa;
+
+    if (nfa->pre->outs == NULL) {
+	return REG_UIMPOSSIBLE;
+    }
+    for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
+	for (aa = a->to->outs; aa != NULL; aa = aa->outchain) {
+	    if (aa->to == nfa->post) {
+		return REG_UEMPTYMATCH;
+	    }
+	}
+    }
+    return 0;
 }
-
+
 /*
  - compact - compact an NFA
  ^ static VOID compact(struct nfa *, struct cnfa *);
  */
-static VOID
-compact(nfa, cnfa)
-struct nfa *nfa;
-struct cnfa *cnfa;
+static void
+compact(
+    struct nfa *nfa,
+    struct cnfa *cnfa)
 {
-	struct state *s;
-	struct arc *a;
-	size_t nstates;
-	size_t narcs;
-	struct carc *ca;
-	struct carc *first;
-
-	assert (!NISERR());
-
-	nstates = 0;
-	narcs = 0;
-	for (s = nfa->states; s != NULL; s = s->next) {
-		nstates++;
-		narcs += 1 + s->nouts + 1;
-		/* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+    struct state *s;
+    struct arc *a;
+    size_t nstates;
+    size_t narcs;
+    struct carc *ca;
+    struct carc *first;
+
+    assert(!NISERR());
+
+    nstates = 0;
+    narcs = 0;
+    for (s = nfa->states; s != NULL; s = s->next) {
+	nstates++;
+	narcs += 1 + s->nouts + 1;
+	/* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+    }
+
+    cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *));
+    cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc));
+    if (cnfa->states == NULL || cnfa->arcs == NULL) {
+	if (cnfa->states != NULL) {
+	    FREE(cnfa->states);
 	}
-
-	cnfa->states = (struct carc **)MALLOC(nstates * sizeof(struct carc *));
-	cnfa->arcs = (struct carc *)MALLOC(narcs * sizeof(struct carc));
-	if (cnfa->states == NULL || cnfa->arcs == NULL) {
-		if (cnfa->states != NULL)
-			FREE(cnfa->states);
-		if (cnfa->arcs != NULL)
-			FREE(cnfa->arcs);
-		NERR(REG_ESPACE);
-		return;
+	if (cnfa->arcs != NULL) {
+	    FREE(cnfa->arcs);
 	}
-	cnfa->nstates = nstates;
-	cnfa->pre = nfa->pre->no;
-	cnfa->post = nfa->post->no;
-	cnfa->bos[0] = nfa->bos[0];
-	cnfa->bos[1] = nfa->bos[1];
-	cnfa->eos[0] = nfa->eos[0];
-	cnfa->eos[1] = nfa->eos[1];
-	cnfa->ncolors = maxcolor(nfa->cm) + 1;
-	cnfa->flags = 0;
-
-	ca = cnfa->arcs;
-	for (s = nfa->states; s != NULL; s = s->next) {
-		assert((size_t)s->no < nstates);
-		cnfa->states[s->no] = ca;
-		ca->co = 0;		/* clear and skip flags "arc" */
+	NERR(REG_ESPACE);
+	return;
+    }
+    cnfa->nstates = nstates;
+    cnfa->pre = nfa->pre->no;
+    cnfa->post = nfa->post->no;
+    cnfa->bos[0] = nfa->bos[0];
+    cnfa->bos[1] = nfa->bos[1];
+    cnfa->eos[0] = nfa->eos[0];
+    cnfa->eos[1] = nfa->eos[1];
+    cnfa->ncolors = maxcolor(nfa->cm) + 1;
+    cnfa->flags = 0;
+
+    ca = cnfa->arcs;
+    for (s = nfa->states; s != NULL; s = s->next) {
+	assert((size_t) s->no < nstates);
+	cnfa->states[s->no] = ca;
+	ca->co = 0;		/* clear and skip flags "arc" */
+	ca++;
+	first = ca;
+	for (a = s->outs; a != NULL; a = a->outchain) {
+	    switch (a->type) {
+	    case PLAIN:
+		ca->co = a->co;
+		ca->to = a->to->no;
 		ca++;
-		first = ca;
-		for (a = s->outs; a != NULL; a = a->outchain)
-			switch (a->type) {
-			case PLAIN:
-				ca->co = a->co;
-				ca->to = a->to->no;
-				ca++;
-				break;
-			case LACON:
-				assert(s->no != cnfa->pre);
-				ca->co = (color)(cnfa->ncolors + a->co);
-				ca->to = a->to->no;
-				ca++;
-				cnfa->flags |= HASLACONS;
-				break;
-			default:
-				assert(NOTREACHED);
-				break;
-			}
-		carcsort(first, ca-1);
-		ca->co = COLORLESS;
-		ca->to = 0;
+		break;
+	    case LACON:
+		assert(s->no != cnfa->pre);
+		ca->co = (color) (cnfa->ncolors + a->co);
+		ca->to = a->to->no;
 		ca++;
+		cnfa->flags |= HASLACONS;
+		break;
+	    default:
+		assert(NOTREACHED);
+		break;
+	    }
 	}
-	assert(ca == &cnfa->arcs[narcs]);
-	assert(cnfa->nstates != 0);
-
-	/* mark no-progress states */
-	for (a = nfa->pre->outs; a != NULL; a = a->outchain)
-		cnfa->states[a->to->no]->co = 1;
-	cnfa->states[nfa->pre->no]->co = 1;
+	carcsort(first, ca-1);
+	ca->co = COLORLESS;
+	ca->to = 0;
+	ca++;
+    }
+    assert(ca == &cnfa->arcs[narcs]);
+    assert(cnfa->nstates != 0);
+
+    /*
+     * Mark no-progress states.
+     */
+
+    for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
+	cnfa->states[a->to->no]->co = 1;
+    }
+    cnfa->states[nfa->pre->no]->co = 1;
 }
-
+
 /*
  - carcsort - sort compacted-NFA arcs by color
  * Really dumb algorithm, but if the list is long enough for that to matter,
  * you're in real trouble anyway.
  ^ static VOID carcsort(struct carc *, struct carc *);
  */
-static VOID
-carcsort(first, last)
-struct carc *first;
-struct carc *last;
+static void
+carcsort(
+    struct carc *first,
+    struct carc *last)
 {
-	struct carc *p;
-	struct carc *q;
-	struct carc tmp;
-
-	if (last - first <= 1)
-		return;
-
-	for (p = first; p <= last; p++)
-		for (q = p; q <= last; q++)
-			if (p->co > q->co ||
-					(p->co == q->co && p->to > q->to)) {
-				assert(p != q);
-				tmp = *p;
-				*p = *q;
-				*q = tmp;
-			}
-}
+    struct carc *p;
+    struct carc *q;
+    struct carc tmp;
 
+    if (last - first <= 1) {
+	return;
+    }
+
+    for (p = first; p <= last; p++) {
+	for (q = p; q <= last; q++) {
+	    if (p->co > q->co || (p->co == q->co && p->to > q->to)) {
+		assert(p != q);
+		tmp = *p;
+		*p = *q;
+		*q = tmp;
+	    }
+	}
+    }
+}
+
 /*
  - freecnfa - free a compacted NFA
  ^ static VOID freecnfa(struct cnfa *);
  */
-static VOID
-freecnfa(cnfa)
-struct cnfa *cnfa;
+static void
+freecnfa(
+    struct cnfa *cnfa)
 {
-	assert(cnfa->nstates != 0);	/* not empty already */
-	cnfa->nstates = 0;
-	FREE(cnfa->states);
-	FREE(cnfa->arcs);
+    assert(cnfa->nstates != 0);	/* not empty already */
+    cnfa->nstates = 0;
+    FREE(cnfa->states);
+    FREE(cnfa->arcs);
 }
-
+
 /*
  - dumpnfa - dump an NFA in human-readable form
  ^ static VOID dumpnfa(struct nfa *, FILE *);
  */
-static VOID
-dumpnfa(nfa, f)
-struct nfa *nfa;
-FILE *f;
+static void
+dumpnfa(
+    struct nfa *nfa,
+    FILE *f)
 {
 #ifdef REG_DEBUG
-	struct state *s;
-
-	fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
-	if (nfa->bos[0] != COLORLESS)
-		fprintf(f, ", bos [%ld]", (long)nfa->bos[0]);
-	if (nfa->bos[1] != COLORLESS)
-		fprintf(f, ", bol [%ld]", (long)nfa->bos[1]);
-	if (nfa->eos[0] != COLORLESS)
-		fprintf(f, ", eos [%ld]", (long)nfa->eos[0]);
-	if (nfa->eos[1] != COLORLESS)
-		fprintf(f, ", eol [%ld]", (long)nfa->eos[1]);
-	fprintf(f, "\n");
-	for (s = nfa->states; s != NULL; s = s->next)
-		dumpstate(s, f);
-	if (nfa->parent == NULL)
-		dumpcolors(nfa->cm, f);
-	fflush(f);
+    struct state *s;
+
+    fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
+    if (nfa->bos[0] != COLORLESS) {
+	fprintf(f, ", bos [%ld]", (long) nfa->bos[0]);
+    }
+    if (nfa->bos[1] != COLORLESS) {
+	fprintf(f, ", bol [%ld]", (long) nfa->bos[1]);
+    }
+    if (nfa->eos[0] != COLORLESS) {
+	fprintf(f, ", eos [%ld]", (long) nfa->eos[0]);
+    }
+    if (nfa->eos[1] != COLORLESS) {
+	fprintf(f, ", eol [%ld]", (long) nfa->eos[1]);
+    }
+    fprintf(f, "\n");
+    for (s = nfa->states; s != NULL; s = s->next) {
+	dumpstate(s, f);
+    }
+    if (nfa->parent == NULL) {
+	dumpcolors(nfa->cm, f);
+    }
+    fflush(f);
 #endif
 }
-
+
 #ifdef REG_DEBUG		/* subordinates of dumpnfa */
 /*
  ^ #ifdef REG_DEBUG
@@ -1498,165 +1643,185 @@ FILE *f;
  - dumpstate - dump an NFA state in human-readable form
  ^ static VOID dumpstate(struct state *, FILE *);
  */
-static VOID
-dumpstate(s, f)
-struct state *s;
-FILE *f;
+static void
+dumpstate(
+    struct state *s,
+    FILE *f)
 {
-	struct arc *a;
-
-	fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "",
-					(s->flag) ? s->flag : '.');
-	if (s->prev != NULL && s->prev->next != s)
-		fprintf(f, "\tstate chain bad\n");
-	if (s->nouts == 0)
-		fprintf(f, "\tno out arcs\n");
-	else
-		dumparcs(s, f);
-	fflush(f);
-	for (a = s->ins; a != NULL; a = a->inchain) {
-		if (a->to != s)
-			fprintf(f, "\tlink from %d to %d on %d's in-chain\n",
-					a->from->no, a->to->no, s->no);
+    struct arc *a;
+
+    fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "",
+	    (s->flag) ? s->flag : '.');
+    if (s->prev != NULL && s->prev->next != s) {
+	fprintf(f, "\tstate chain bad\n");
+    }
+    if (s->nouts == 0) {
+	fprintf(f, "\tno out arcs\n");
+    } else {
+	dumparcs(s, f);
+    }
+    fflush(f);
+    for (a = s->ins; a != NULL; a = a->inchain) {
+	if (a->to != s) {
+	    fprintf(f, "\tlink from %d to %d on %d's in-chain\n",
+		    a->from->no, a->to->no, s->no);
 	}
+    }
 }
-
+
 /*
  - dumparcs - dump out-arcs in human-readable form
  ^ static VOID dumparcs(struct state *, FILE *);
  */
-static VOID
-dumparcs(s, f)
-struct state *s;
-FILE *f;
+static void
+dumparcs(
+    struct state *s,
+    FILE *f)
 {
-	int pos;
+    int pos;
 
-	assert(s->nouts > 0);
-	/* printing arcs in reverse order is usually clearer */
-	pos = dumprarcs(s->outs, s, f, 1);
-	if (pos != 1)
-		fprintf(f, "\n");
+    assert(s->nouts > 0);
+    /* printing arcs in reverse order is usually clearer */
+    pos = dumprarcs(s->outs, s, f, 1);
+    if (pos != 1) {
+	fprintf(f, "\n");
+    }
 }
-
+
 /*
  - dumprarcs - dump remaining outarcs, recursively, in reverse order
  ^ static int dumprarcs(struct arc *, struct state *, FILE *, int);
  */
 static int			/* resulting print position */
-dumprarcs(a, s, f, pos)
-struct arc *a;
-struct state *s;
-FILE *f;
-int pos;			/* initial print position */
+dumprarcs(
+    struct arc *a,
+    struct state *s,
+    FILE *f,
+    int pos)			/* initial print position */
 {
-	if (a->outchain != NULL)
-		pos = dumprarcs(a->outchain, s, f, pos);
-	dumparc(a, s, f);
-	if (pos == 5) {
-		fprintf(f, "\n");
-		pos = 1;
-	} else
-		pos++;
-	return pos;
+    if (a->outchain != NULL) {
+	pos = dumprarcs(a->outchain, s, f, pos);
+    }
+    dumparc(a, s, f);
+    if (pos == 5) {
+	fprintf(f, "\n");
+	pos = 1;
+    } else {
+	pos++;
+    }
+    return pos;
 }
-
+
 /*
  - dumparc - dump one outarc in readable form, including prefixing tab
  ^ static VOID dumparc(struct arc *, struct state *, FILE *);
  */
-static VOID
-dumparc(a, s, f)
-struct arc *a;
-struct state *s;
-FILE *f;
+static void
+dumparc(
+    struct arc *a,
+    struct state *s,
+    FILE *f)
 {
-	struct arc *aa;
-	struct arcbatch *ab;
-
-	fprintf(f, "\t");
-	switch (a->type) {
-	case PLAIN:
-		fprintf(f, "[%ld]", (long)a->co);
-		break;
-	case AHEAD:
-		fprintf(f, ">%ld>", (long)a->co);
-		break;
-	case BEHIND:
-		fprintf(f, "<%ld<", (long)a->co);
-		break;
-	case LACON:
-		fprintf(f, ":%ld:", (long)a->co);
-		break;
-	case '^':
-	case '$':
-		fprintf(f, "%c%d", a->type, (int)a->co);
-		break;
-	case EMPTY:
-		break;
-	default:
-		fprintf(f, "0x%x/0%lo", a->type, (long)a->co);
-		break;
+    struct arc *aa;
+    struct arcbatch *ab;
+
+    fprintf(f, "\t");
+    switch (a->type) {
+    case PLAIN:
+	fprintf(f, "[%ld]", (long) a->co);
+	break;
+    case AHEAD:
+	fprintf(f, ">%ld>", (long) a->co);
+	break;
+    case BEHIND:
+	fprintf(f, "<%ld<", (long) a->co);
+	break;
+    case LACON:
+	fprintf(f, ":%ld:", (long) a->co);
+	break;
+    case '^':
+    case '$':
+	fprintf(f, "%c%d", a->type, (int) a->co);
+	break;
+    case EMPTY:
+	break;
+    default:
+	fprintf(f, "0x%x/0%lo", a->type, (long) a->co);
+	break;
+    }
+    if (a->from != s) {
+	fprintf(f, "?%d?", a->from->no);
+    }
+    for (ab = &a->from->oas; ab != NULL; ab = ab->next) {
+	for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++) {
+	    if (aa == a) {
+		break;		/* NOTE BREAK OUT */
+	    }
 	}
-	if (a->from != s)
-		fprintf(f, "?%d?", a->from->no);
-	for (ab = &a->from->oas; ab != NULL; ab = ab->next) {
-		for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++)
-			if (aa == a)
-				break;		/* NOTE BREAK OUT */
-		if (aa < &ab->a[ABSIZE])	/* propagate break */
-				break;		/* NOTE BREAK OUT */
+	if (aa < &ab->a[ABSIZE]) {	/* propagate break */
+	    break;		/* NOTE BREAK OUT */
 	}
-	if (ab == NULL)
-		fprintf(f, "?!?");	/* not in allocated space */
-	fprintf(f, "->");
-	if (a->to == NULL) {
-		fprintf(f, "NULL");
-		return;
+    }
+    if (ab == NULL) {
+	fprintf(f, "?!?");	/* not in allocated space */
+    }
+    fprintf(f, "->");
+    if (a->to == NULL) {
+	fprintf(f, "NULL");
+	return;
+    }
+    fprintf(f, "%d", a->to->no);
+    for (aa = a->to->ins; aa != NULL; aa = aa->inchain) {
+	if (aa == a) {
+	    break;		/* NOTE BREAK OUT */
 	}
-	fprintf(f, "%d", a->to->no);
-	for (aa = a->to->ins; aa != NULL; aa = aa->inchain)
-		if (aa == a)
-			break;		/* NOTE BREAK OUT */
-	if (aa == NULL)
-		fprintf(f, "?!?");	/* missing from in-chain */
+    }
+    if (aa == NULL) {
+	fprintf(f, "?!?");	/* missing from in-chain */
+    }
 }
 
 /*
  ^ #endif
  */
 #endif				/* ifdef REG_DEBUG */
-
+
 /*
  - dumpcnfa - dump a compacted NFA in human-readable form
  ^ static VOID dumpcnfa(struct cnfa *, FILE *);
  */
-static VOID
-dumpcnfa(cnfa, f)
-struct cnfa *cnfa;
-FILE *f;
+static void
+dumpcnfa(
+    struct cnfa *cnfa,
+    FILE *f)
 {
 #ifdef REG_DEBUG
-	int st;
-
-	fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
-	if (cnfa->bos[0] != COLORLESS)
-		fprintf(f, ", bos [%ld]", (long)cnfa->bos[0]);
-	if (cnfa->bos[1] != COLORLESS)
-		fprintf(f, ", bol [%ld]", (long)cnfa->bos[1]);
-	if (cnfa->eos[0] != COLORLESS)
-		fprintf(f, ", eos [%ld]", (long)cnfa->eos[0]);
-	if (cnfa->eos[1] != COLORLESS)
-		fprintf(f, ", eol [%ld]", (long)cnfa->eos[1]);
-	if (cnfa->flags&HASLACONS)
-		fprintf(f, ", haslacons");
-	fprintf(f, "\n");
-	for (st = 0; st < cnfa->nstates; st++)
-		dumpcstate(st, cnfa->states[st], cnfa, f);
-	fflush(f);
+    int st;
+
+    fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
+    if (cnfa->bos[0] != COLORLESS) {
+	fprintf(f, ", bos [%ld]", (long) cnfa->bos[0]);
+    }
+    if (cnfa->bos[1] != COLORLESS) {
+	fprintf(f, ", bol [%ld]", (long) cnfa->bos[1]);
+    }
+    if (cnfa->eos[0] != COLORLESS) {
+	fprintf(f, ", eos [%ld]", (long) cnfa->eos[0]);
+    }
+    if (cnfa->eos[1] != COLORLESS) {
+	fprintf(f, ", eol [%ld]", (long) cnfa->eos[1]);
+    }
+    if (cnfa->flags&HASLACONS) {
+	fprintf(f, ", haslacons");
+    }
+    fprintf(f, "\n");
+    for (st = 0; st < cnfa->nstates; st++) {
+	dumpcstate(st, cnfa->states[st], cnfa, f);
+    }
+    fflush(f);
 #endif
 }
-
+
 #ifdef REG_DEBUG		/* subordinates of dumpcnfa */
 /*
  ^ #ifdef REG_DEBUG
@@ -1666,36 +1831,46 @@ FILE *f;
  - dumpcstate - dump a compacted-NFA state in human-readable form
  ^ static VOID dumpcstate(int, struct carc *, struct cnfa *, FILE *);
  */
-static VOID
-dumpcstate(st, ca, cnfa, f)
-int st;
-struct carc *ca;
-struct cnfa *cnfa;
-FILE *f;
+static void
+dumpcstate(
+    int st,
+    struct carc *ca,
+    struct cnfa *cnfa,
+    FILE *f)
 {
-	int i;
-	int pos;
-
-	fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
-	pos = 1;
-	for (i = 1; ca[i].co != COLORLESS; i++) {
-		if (ca[i].co < cnfa->ncolors)
-			fprintf(f, "\t[%ld]->%d", (long)ca[i].co, ca[i].to);
-		else
-			fprintf(f, "\t:%ld:->%d", (long)ca[i].co-cnfa->ncolors,
-								ca[i].to);
-		if (pos == 5) {
-			fprintf(f, "\n");
-			pos = 1;
-		} else
-			pos++;
+    int i;
+    int pos;
+
+    fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+    pos = 1;
+    for (i = 1; ca[i].co != COLORLESS; i++) {
+	if (ca[i].co < cnfa->ncolors) {
+	    fprintf(f, "\t[%ld]->%d", (long) ca[i].co, ca[i].to);
+	} else {
+	    fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
 	}
-	if (i == 1 || pos != 1)
-		fprintf(f, "\n");
-	fflush(f);
+	if (pos == 5) {
+	    fprintf(f, "\n");
+	    pos = 1;
+	} else {
+	    pos++;
+	}
+    }
+    if (i == 1 || pos != 1) {
+	fprintf(f, "\n");
+    }
+    fflush(f);
 }
 
 /*
  ^ #endif
  */
 #endif				/* ifdef REG_DEBUG */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regcomp.c b/generic/regcomp.c
index a1fe5bc..6dea04b 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -2,11 +2,11 @@
  * re_*comp and friends - compile REs
  * This file #includes several others (see the bottom).
  *
- * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
  *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
+ * Corporation, none of whom are responsible for the results. The author
  * thanks all of them.
  *
  * Redistribution and use in source and binary forms -- with or without
@@ -14,12 +14,12 @@
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
  *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
  *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
  * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
@@ -38,198 +38,189 @@
 /* =====^!^===== begin forwards =====^!^===== */
 /* automatically gathered by fwd; do not hand-edit */
 /* === regcomp.c === */
-int compile _ANSI_ARGS_((regex_t *, CONST chr *, size_t, int));
-static VOID moresubs _ANSI_ARGS_((struct vars *, int));
-static int freev _ANSI_ARGS_((struct vars *, int));
-static VOID makesearch _ANSI_ARGS_((struct vars *, struct nfa *));
-static struct subre *parse _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
-static struct subre *parsebranch _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, int));
-static VOID parseqatom _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, struct subre *));
-static VOID nonword _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
-static VOID word _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
-static int scannum _ANSI_ARGS_((struct vars *));
-static VOID repeat _ANSI_ARGS_((struct vars *, struct state *, struct state *, int, int));
-static VOID bracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static VOID cbracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static VOID brackpart _ANSI_ARGS_((struct vars *, struct state *, struct state *));
-static CONST chr *scanplain _ANSI_ARGS_((struct vars *));
-static VOID onechr _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
-static VOID dovec _ANSI_ARGS_((struct vars *, struct cvec *, struct state *, struct state *));
-static celt nextleader _ANSI_ARGS_((struct vars *, pchr, pchr));
-static VOID wordchrs _ANSI_ARGS_((struct vars *));
-static struct subre *subre _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
-static VOID freesubre _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID freesrnode _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID optst _ANSI_ARGS_((struct vars *, struct subre *));
-static int numst _ANSI_ARGS_((struct subre *, int));
-static VOID markst _ANSI_ARGS_((struct subre *));
-static VOID cleanst _ANSI_ARGS_((struct vars *));
-static long nfatree _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
-static long nfanode _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
-static int newlacon _ANSI_ARGS_((struct vars *, struct state *, struct state *, int));
-static VOID freelacons _ANSI_ARGS_((struct subre *, int));
-static VOID rfree _ANSI_ARGS_((regex_t *));
-static VOID dump _ANSI_ARGS_((regex_t *, FILE *));
-static VOID dumpst _ANSI_ARGS_((struct subre *, FILE *, int));
-static VOID stdump _ANSI_ARGS_((struct subre *, FILE *, int));
-static char *stid _ANSI_ARGS_((struct subre *, char *, size_t));
+int compile(regex_t *, const chr *, size_t, int);
+static void moresubs(struct vars *, int);
+static int freev(struct vars *, int);
+static void makesearch(struct vars *, struct nfa *);
+static struct subre *parse(struct vars *, int, int, struct state *, struct state *);
+static struct subre *parsebranch(struct vars *, int, int, struct state *, struct state *, int);
+static void parseqatom(struct vars *, int, int, struct state *, struct state *, struct subre *);
+static void nonword(struct vars *, int, struct state *, struct state *);
+static void word(struct vars *, int, struct state *, struct state *);
+static int scannum(struct vars *);
+static void repeat(struct vars *, struct state *, struct state *, int, int);
+static void bracket(struct vars *, struct state *, struct state *);
+static void cbracket(struct vars *, struct state *, struct state *);
+static void brackpart(struct vars *, struct state *, struct state *);
+static const chr *scanplain(struct vars *);
+static void onechr(struct vars *, pchr, struct state *, struct state *);
+static void dovec(struct vars *, struct cvec *, struct state *, struct state *);
+static void wordchrs(struct vars *);
+static struct subre *subre(struct vars *, int, int, struct state *, struct state *);
+static void freesubre(struct vars *, struct subre *);
+static void freesrnode(struct vars *, struct subre *);
+static void optst(struct vars *, struct subre *);
+static int numst(struct subre *, int);
+static void markst(struct subre *);
+static void cleanst(struct vars *);
+static long nfatree(struct vars *, struct subre *, FILE *);
+static long nfanode(struct vars *, struct subre *, FILE *);
+static int newlacon(struct vars *, struct state *, struct state *, int);
+static void freelacons(struct subre *, int);
+static void rfree(regex_t *);
+static void dump(regex_t *, FILE *);
+static void dumpst(struct subre *, FILE *, int);
+static void stdump(struct subre *, FILE *, int);
+static const char *stid(struct subre *, char *, size_t);
 /* === regc_lex.c === */
-static VOID lexstart _ANSI_ARGS_((struct vars *));
-static VOID prefixes _ANSI_ARGS_((struct vars *));
-static VOID lexnest _ANSI_ARGS_((struct vars *, CONST chr *, CONST chr *));
-static VOID lexword _ANSI_ARGS_((struct vars *));
-static int next _ANSI_ARGS_((struct vars *));
-static int lexescape _ANSI_ARGS_((struct vars *));
-static chr lexdigits _ANSI_ARGS_((struct vars *, int, int, int));
-static int brenext _ANSI_ARGS_((struct vars *, pchr));
-static VOID skip _ANSI_ARGS_((struct vars *));
-static chr newline _ANSI_ARGS_((NOPARMS));
+static void lexstart(struct vars *);
+static void prefixes(struct vars *);
+static void lexnest(struct vars *, const chr *, const chr *);
+static void lexword(struct vars *);
+static int next(struct vars *);
+static int lexescape(struct vars *);
+static chr lexdigits(struct vars *, int, int, int);
+static int brenext(struct vars *, pchr);
+static void skip(struct vars *);
+static chr newline(NOPARMS);
 #ifdef REG_DEBUG
-static CONST chr *ch _ANSI_ARGS_((NOPARMS));
+static const chr *ch(NOPARMS);
 #endif
-static chr chrnamed _ANSI_ARGS_((struct vars *, CONST chr *, CONST chr *, pchr));
+static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
 /* === regc_color.c === */
-static VOID initcm _ANSI_ARGS_((struct vars *, struct colormap *));
-static VOID freecm _ANSI_ARGS_((struct colormap *));
-static VOID cmtreefree _ANSI_ARGS_((struct colormap *, union tree *, int));
-static color setcolor _ANSI_ARGS_((struct colormap *, pchr, pcolor));
-static color maxcolor _ANSI_ARGS_((struct colormap *));
-static color newcolor _ANSI_ARGS_((struct colormap *));
-static VOID freecolor _ANSI_ARGS_((struct colormap *, pcolor));
-static color pseudocolor _ANSI_ARGS_((struct colormap *));
-static color subcolor _ANSI_ARGS_((struct colormap *, pchr c));
-static color newsub _ANSI_ARGS_((struct colormap *, pcolor));
-static VOID subrange _ANSI_ARGS_((struct vars *, pchr, pchr, struct state *, struct state *));
-static VOID subblock _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
-static VOID okcolors _ANSI_ARGS_((struct nfa *, struct colormap *));
-static VOID colorchain _ANSI_ARGS_((struct colormap *, struct arc *));
-static VOID uncolorchain _ANSI_ARGS_((struct colormap *, struct arc *));
-static int singleton _ANSI_ARGS_((struct colormap *, pchr c));
-static VOID rainbow _ANSI_ARGS_((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *));
-static VOID colorcomplement _ANSI_ARGS_((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *));
+static void initcm(struct vars *, struct colormap *);
+static void freecm(struct colormap *);
+static void cmtreefree(struct colormap *, union tree *, int);
+static color setcolor(struct colormap *, pchr, pcolor);
+static color maxcolor(struct colormap *);
+static color newcolor(struct colormap *);
+static void freecolor(struct colormap *, pcolor);
+static color pseudocolor(struct colormap *);
+static color subcolor(struct colormap *, pchr c);
+static color newsub(struct colormap *, pcolor);
+static void subrange(struct vars *, pchr, pchr, struct state *, struct state *);
+static void subblock(struct vars *, pchr, struct state *, struct state *);
+static void okcolors(struct nfa *, struct colormap *);
+static void colorchain(struct colormap *, struct arc *);
+static void uncolorchain(struct colormap *, struct arc *);
+static void rainbow(struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *);
+static void colorcomplement(struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *);
 #ifdef REG_DEBUG
-static VOID dumpcolors _ANSI_ARGS_((struct colormap *, FILE *));
-static VOID fillcheck _ANSI_ARGS_((struct colormap *, union tree *, int, FILE *));
-static VOID dumpchr _ANSI_ARGS_((pchr, FILE *));
+static void dumpcolors(struct colormap *, FILE *);
+static void fillcheck(struct colormap *, union tree *, int, FILE *);
+static void dumpchr(pchr, FILE *);
 #endif
 /* === regc_nfa.c === */
-static struct nfa *newnfa _ANSI_ARGS_((struct vars *, struct colormap *, struct nfa *));
-static VOID freenfa _ANSI_ARGS_((struct nfa *));
-static struct state *newstate _ANSI_ARGS_((struct nfa *));
-static struct state *newfstate _ANSI_ARGS_((struct nfa *, int flag));
-static VOID dropstate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID freestate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID destroystate _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID newarc _ANSI_ARGS_((struct nfa *, int, pcolor, struct state *, struct state *));
-static struct arc *allocarc _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID freearc _ANSI_ARGS_((struct nfa *, struct arc *));
-static struct arc *findarc _ANSI_ARGS_((struct state *, int, pcolor));
-static VOID cparc _ANSI_ARGS_((struct nfa *, struct arc *, struct state *, struct state *));
-static VOID moveins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID copyins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID moveouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID copyouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID cloneouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, int));
-static VOID delsub _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID deltraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID dupnfa _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, struct state *));
-static VOID duptraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
-static VOID cleartraverse _ANSI_ARGS_((struct nfa *, struct state *));
-static VOID specialcolors _ANSI_ARGS_((struct nfa *));
-static long optimize _ANSI_ARGS_((struct nfa *, FILE *));
-static VOID pullback _ANSI_ARGS_((struct nfa *, FILE *));
-static int pull _ANSI_ARGS_((struct nfa *, struct arc *));
-static VOID pushfwd _ANSI_ARGS_((struct nfa *, FILE *));
-static int push _ANSI_ARGS_((struct nfa *, struct arc *));
+static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *);
+static void freenfa(struct nfa *);
+static struct state *newstate(struct nfa *);
+static struct state *newfstate(struct nfa *, int flag);
+static void dropstate(struct nfa *, struct state *);
+static void freestate(struct nfa *, struct state *);
+static void destroystate(struct nfa *, struct state *);
+static void newarc(struct nfa *, int, pcolor, struct state *, struct state *);
+static struct arc *allocarc(struct nfa *, struct state *);
+static void freearc(struct nfa *, struct arc *);
+static struct arc *findarc(struct state *, int, pcolor);
+static void cparc(struct nfa *, struct arc *, struct state *, struct state *);
+static void moveins(struct nfa *, struct state *, struct state *);
+static void copyins(struct nfa *, struct state *, struct state *);
+static void moveouts(struct nfa *, struct state *, struct state *);
+static void copyouts(struct nfa *, struct state *, struct state *);
+static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int);
+static void delsub(struct nfa *, struct state *, struct state *);
+static void deltraverse(struct nfa *, struct state *, struct state *);
+static void dupnfa(struct nfa *, struct state *, struct state *, struct state *, struct state *);
+static void duptraverse(struct nfa *, struct state *, struct state *);
+static void cleartraverse(struct nfa *, struct state *);
+static void specialcolors(struct nfa *);
+static long optimize(struct nfa *, FILE *);
+static void pullback(struct nfa *, FILE *);
+static int pull(struct nfa *, struct arc *);
+static void pushfwd(struct nfa *, FILE *);
+static int push(struct nfa *, struct arc *);
 #define	INCOMPATIBLE	1	/* destroys arc */
 #define	SATISFIED	2	/* constraint satisfied */
 #define	COMPATIBLE	3	/* compatible but not satisfied yet */
-static int combine _ANSI_ARGS_((struct arc *, struct arc *));
-static VOID fixempties _ANSI_ARGS_((struct nfa *, FILE *));
-static int unempty _ANSI_ARGS_((struct nfa *, struct arc *));
-static VOID cleanup _ANSI_ARGS_((struct nfa *));
-static VOID markreachable _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
-static VOID markcanreach _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
-static long analyze _ANSI_ARGS_((struct nfa *));
-static VOID compact _ANSI_ARGS_((struct nfa *, struct cnfa *));
-static VOID carcsort _ANSI_ARGS_((struct carc *, struct carc *));
-static VOID freecnfa _ANSI_ARGS_((struct cnfa *));
-static VOID dumpnfa _ANSI_ARGS_((struct nfa *, FILE *));
+static int combine(struct arc *, struct arc *);
+static void fixempties(struct nfa *, FILE *);
+static int unempty(struct nfa *, struct arc *);
+static void cleanup(struct nfa *);
+static void markreachable(struct nfa *, struct state *, struct state *, struct state *);
+static void markcanreach(struct nfa *, struct state *, struct state *, struct state *);
+static long analyze(struct nfa *);
+static void compact(struct nfa *, struct cnfa *);
+static void carcsort(struct carc *, struct carc *);
+static void freecnfa(struct cnfa *);
+static void dumpnfa(struct nfa *, FILE *);
 #ifdef REG_DEBUG
-static VOID dumpstate _ANSI_ARGS_((struct state *, FILE *));
-static VOID dumparcs _ANSI_ARGS_((struct state *, FILE *));
-static int dumprarcs _ANSI_ARGS_((struct arc *, struct state *, FILE *, int));
-static VOID dumparc _ANSI_ARGS_((struct arc *, struct state *, FILE *));
+static void dumpstate(struct state *, FILE *);
+static void dumparcs(struct state *, FILE *);
+static int dumprarcs(struct arc *, struct state *, FILE *, int);
+static void dumparc(struct arc *, struct state *, FILE *);
 #endif
-static VOID dumpcnfa _ANSI_ARGS_((struct cnfa *, FILE *));
+static void dumpcnfa(struct cnfa *, FILE *);
 #ifdef REG_DEBUG
-static VOID dumpcstate _ANSI_ARGS_((int, struct carc *, struct cnfa *, FILE *));
+static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
 #endif
 /* === regc_cvec.c === */
-static struct cvec *newcvec _ANSI_ARGS_((int, int, int));
-static struct cvec *clearcvec _ANSI_ARGS_((struct cvec *));
-static VOID addchr _ANSI_ARGS_((struct cvec *, pchr));
-static VOID addrange _ANSI_ARGS_((struct cvec *, pchr, pchr));
-static int haschr _ANSI_ARGS_((struct cvec *, pchr));
-static struct cvec *getcvec _ANSI_ARGS_((struct vars *, int, int));
-static VOID freecvec _ANSI_ARGS_((struct cvec *));
+static struct cvec *clearcvec(struct cvec *);
+static void addchr(struct cvec *, pchr);
+static void addrange(struct cvec *, pchr, pchr);
+static struct cvec *newcvec(int, int);
+static struct cvec *getcvec(struct vars *, int, int);
+static void freecvec(struct cvec *);
 /* === regc_locale.c === */
-static celt element _ANSI_ARGS_((struct vars *, CONST chr *, CONST chr *));
-static struct cvec *range _ANSI_ARGS_((struct vars *, celt, celt, int));
-static int before _ANSI_ARGS_((celt, celt));
-static struct cvec *eclass _ANSI_ARGS_((struct vars *, celt, int));
-static struct cvec *cclass _ANSI_ARGS_((struct vars *, CONST chr *, CONST chr *, int));
-static struct cvec *allcases _ANSI_ARGS_((struct vars *, pchr));
-static int cmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
-static int casecmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
+static celt element(struct vars *, const chr *, const chr *);
+static struct cvec *range(struct vars *, celt, celt, int);
+static int before(celt, celt);
+static struct cvec *eclass(struct vars *, celt, int);
+static struct cvec *cclass(struct vars *, const chr *, const chr *, int);
+static struct cvec *allcases(struct vars *, pchr);
+static int cmp(const chr *, const chr *, size_t);
+static int casecmp(const chr *, const chr *, size_t);
 /* automatically gathered by fwd; do not hand-edit */
 /* =====^!^===== end forwards =====^!^===== */
-
-
-
+
 /* internal variables, bundled for easy passing around */
 struct vars {
-	regex_t *re;
-	CONST chr *now;	/* scan pointer into string */
-	CONST chr *stop;		/* end of string */
-	CONST chr *savenow;		/* saved now and stop for "subroutine call" */
-	CONST chr *savestop;
-	int err;		/* error code (0 if none) */
-	int cflags;		/* copy of compile flags */
-	int lasttype;		/* type of previous token */
-	int nexttype;		/* type of next token */
-	chr nextvalue;		/* value (if any) of next token */
-	int lexcon;		/* lexical context type (see lex.c) */
-	int nsubexp;		/* subexpression count */
-	struct subre **subs;	/* subRE pointer vector */
-	size_t nsubs;		/* length of vector */
-	struct subre *sub10[10];	/* initial vector, enough for most */
-	struct nfa *nfa;	/* the NFA */
-	struct colormap *cm;	/* character color map */
-	color nlcolor;		/* color of newline */
-	struct state *wordchrs;	/* state in nfa holding word-char outarcs */
-	struct subre *tree;	/* subexpression tree */
-	struct subre *treechain;	/* all tree nodes allocated */
-	struct subre *treefree;		/* any free tree nodes */
-	int ntree;		/* number of tree nodes */
-	struct cvec *cv;	/* interface cvec */
-	struct cvec *cv2;	/* utility cvec */
-	struct cvec *mcces;	/* collating-element information */
-#		define	ISCELEADER(v,c)	(v->mcces != NULL && haschr(v->mcces, (c)))
-	struct state *mccepbegin;	/* in nfa, start of MCCE prototypes */
-	struct state *mccepend;	/* in nfa, end of MCCE prototypes */
-	struct subre *lacons;	/* lookahead-constraint vector */
-	int nlacons;		/* size of lacons */
+    regex_t *re;
+    const chr *now;		/* scan pointer into string */
+    const chr *stop;		/* end of string */
+    const chr *savenow;		/* saved now and stop for "subroutine call" */
+    const chr *savestop;
+    int err;			/* error code (0 if none) */
+    int cflags;			/* copy of compile flags */
+    int lasttype;		/* type of previous token */
+    int nexttype;		/* type of next token */
+    chr nextvalue;		/* value (if any) of next token */
+    int lexcon;			/* lexical context type (see lex.c) */
+    int nsubexp;		/* subexpression count */
+    struct subre **subs;	/* subRE pointer vector */
+    size_t nsubs;		/* length of vector */
+    struct subre *sub10[10];	/* initial vector, enough for most */
+    struct nfa *nfa;		/* the NFA */
+    struct colormap *cm;	/* character color map */
+    color nlcolor;		/* color of newline */
+    struct state *wordchrs;	/* state in nfa holding word-char outarcs */
+    struct subre *tree;		/* subexpression tree */
+    struct subre *treechain;	/* all tree nodes allocated */
+    struct subre *treefree;	/* any free tree nodes */
+    int ntree;			/* number of tree nodes */
+    struct cvec *cv;		/* interface cvec */
+    struct cvec *cv2;		/* utility cvec */
+    struct subre *lacons;	/* lookahead-constraint vector */
+    int nlacons;		/* size of lacons */
 };
 
 /* parsing macros; most know that `v' is the struct vars pointer */
 #define	NEXT()	(next(v))		/* advance by one token */
 #define	SEE(t)	(v->nexttype == (t))	/* is next token this? */
 #define	EAT(t)	(SEE(t) && next(v))	/* if next is this, swallow it */
-#define	VISERR(vv)	((vv)->err != 0)	/* have we seen an error yet? */
+#define	VISERR(vv)	((vv)->err != 0)/* have we seen an error yet? */
 #define	ISERR()	VISERR(v)
-#define	VERR(vv,e)	((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err :\
-							((vv)->err = (e)))
+#define	VERR(vv,e) \
+	((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err : ((vv)->err = (e)))
 #define	ERR(e)	VERR(v, e)		/* record an error */
 #define	NOERR()	{if (ISERR()) return;}	/* if error seen, return */
 #define	NOERRN()	{if (ISERR()) return NULL;}	/* NOERR with retval */
@@ -259,387 +250,459 @@ struct vars {
 #define	PREFER	'P'		/* length preference */
 
 /* is an arc colored, and hence on a color chain? */
-#define	COLORED(a)	((a)->type == PLAIN || (a)->type == AHEAD || \
-							(a)->type == BEHIND)
-
-
+#define	COLORED(a) \
+	((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)
 
 /* static function list */
 static struct fns functions = {
-	rfree,			/* regfree insides */
+    rfree,			/* regfree insides */
 };
-
-
-
+
 /*
  - compile - compile regular expression
- ^ int compile(regex_t *, CONST chr *, size_t, int);
+ ^ int compile(regex_t *, const chr *, size_t, int);
  */
 int
-compile(re, string, len, flags)
-regex_t *re;
-CONST chr *string;
-size_t len;
-int flags;
+compile(
+    regex_t *re,
+    const chr *string,
+    size_t len,
+    int flags)
 {
-	struct vars var;
-	struct vars *v = &var;
-	struct guts *g;
-	int i;
-	size_t j;
-	FILE *debug = (flags&REG_PROGRESS) ? stdout : (FILE *)NULL;
-#	define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }
-
-	/* sanity checks */
-
-	if (re == NULL || string == NULL)
-		return REG_INVARG;
-	if ((flags&REG_QUOTE) &&
-			(flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)))
-		return REG_INVARG;
-	if (!(flags&REG_EXTENDED) && (flags&REG_ADVF))
-		return REG_INVARG;
-
-	/* initial setup (after which freev() is callable) */
-	v->re = re;
-	v->now = (chr *)string;
-	v->stop = v->now + len;
-	v->savenow = v->savestop = NULL;
-	v->err = 0;
-	v->cflags = flags;
-	v->nsubexp = 0;
-	v->subs = v->sub10;
-	v->nsubs = 10;
-	for (j = 0; j < v->nsubs; j++)
-		v->subs[j] = NULL;
-	v->nfa = NULL;
-	v->cm = NULL;
-	v->nlcolor = COLORLESS;
-	v->wordchrs = NULL;
-	v->tree = NULL;
-	v->treechain = NULL;
-	v->treefree = NULL;
-	v->cv = NULL;
-	v->cv2 = NULL;
-	v->mcces = NULL;
-	v->lacons = NULL;
-	v->nlacons = 0;
-	re->re_magic = REMAGIC;
-	re->re_info = 0;		/* bits get set during parse */
-	re->re_csize = sizeof(chr);
-	re->re_guts = NULL;
-	re->re_fns = VS(&functions);
-
-	/* more complex setup, malloced things */
-	re->re_guts = VS(MALLOC(sizeof(struct guts)));
-	if (re->re_guts == NULL)
-		return freev(v, REG_ESPACE);
-	g = (struct guts *)re->re_guts;
-	g->tree = NULL;
-	initcm(v, &g->cmap);
-	v->cm = &g->cmap;
-	g->lacons = NULL;
-	g->nlacons = 0;
-	ZAPCNFA(g->search);
-	v->nfa = newnfa(v, v->cm, (struct nfa *)NULL);
-	CNOERR();
-	v->cv = newcvec(100, 20, 10);
-	if (v->cv == NULL)
-		return freev(v, REG_ESPACE);
-	CNOERR();
-
-	/* parsing */
-	lexstart(v);			/* also handles prefixes */
-	if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
-		/* assign newline a unique color */
-		v->nlcolor = subcolor(v->cm, newline());
-		okcolors(v->nfa, v->cm);
-	}
-	CNOERR();
-	v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
-	assert(SEE(EOS));		/* even if error; ISERR() => SEE(EOS) */
-	CNOERR();
-	assert(v->tree != NULL);
-
-	/* finish setup of nfa and its subre tree */
-	specialcolors(v->nfa);
-	CNOERR();
-	if (debug != NULL) {
-		fprintf(debug, "\n\n\n========= RAW ==========\n");
-		dumpnfa(v->nfa, debug);
-		dumpst(v->tree, debug, 1);
-	}
-	optst(v, v->tree);
-	v->ntree = numst(v->tree, 1);
-	markst(v->tree);
-	cleanst(v);
+    AllocVars(v);
+    struct guts *g;
+    int i;
+    size_t j;
+    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
+#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }
+
+    /*
+     * Sanity checks.
+     */
+
+    if (re == NULL || string == NULL) {
+	FreeVars(v);
+	return REG_INVARG;
+    }
+    if ((flags&REG_QUOTE) && (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE))) {
+	FreeVars(v);
+	return REG_INVARG;
+    }
+    if (!(flags&REG_EXTENDED) && (flags&REG_ADVF)) {
+	FreeVars(v);
+	return REG_INVARG;
+    }
+
+    /*
+     * Initial setup (after which freev() is callable).
+     */
+
+    v->re = re;
+    v->now = string;
+    v->stop = v->now + len;
+    v->savenow = v->savestop = NULL;
+    v->err = 0;
+    v->cflags = flags;
+    v->nsubexp = 0;
+    v->subs = v->sub10;
+    v->nsubs = 10;
+    for (j = 0; j < v->nsubs; j++) {
+	v->subs[j] = NULL;
+    }
+    v->nfa = NULL;
+    v->cm = NULL;
+    v->nlcolor = COLORLESS;
+    v->wordchrs = NULL;
+    v->tree = NULL;
+    v->treechain = NULL;
+    v->treefree = NULL;
+    v->cv = NULL;
+    v->cv2 = NULL;
+    v->lacons = NULL;
+    v->nlacons = 0;
+    re->re_magic = REMAGIC;
+    re->re_info = 0;		/* bits get set during parse */
+    re->re_csize = sizeof(chr);
+    re->re_guts = NULL;
+    re->re_fns = VS(&functions);
+
+    /*
+     * More complex setup, malloced things.
+     */
+
+    re->re_guts = VS(MALLOC(sizeof(struct guts)));
+    if (re->re_guts == NULL) {
+	return freev(v, REG_ESPACE);
+    }
+    g = (struct guts *) re->re_guts;
+    g->tree = NULL;
+    initcm(v, &g->cmap);
+    v->cm = &g->cmap;
+    g->lacons = NULL;
+    g->nlacons = 0;
+    ZAPCNFA(g->search);
+    v->nfa = newnfa(v, v->cm, NULL);
+    CNOERR();
+    v->cv = newcvec(100, 20);
+    if (v->cv == NULL) {
+	return freev(v, REG_ESPACE);
+    }
+
+    /*
+     * Parsing.
+     */
+
+    lexstart(v);		/* also handles prefixes */
+    if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
+	/*
+	 * Assign newline a unique color.
+	 */
+
+	v->nlcolor = subcolor(v->cm, newline());
+	okcolors(v->nfa, v->cm);
+    }
+    CNOERR();
+    v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
+    assert(SEE(EOS));		/* even if error; ISERR() => SEE(EOS) */
+    CNOERR();
+    assert(v->tree != NULL);
+
+    /*
+     * Finish setup of nfa and its subre tree.
+     */
+
+    specialcolors(v->nfa);
+    CNOERR();
+    if (debug != NULL) {
+	fprintf(debug, "\n\n\n========= RAW ==========\n");
+	dumpnfa(v->nfa, debug);
+	dumpst(v->tree, debug, 1);
+    }
+    optst(v, v->tree);
+    v->ntree = numst(v->tree, 1);
+    markst(v->tree);
+    cleanst(v);
+    if (debug != NULL) {
+	fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
+	dumpst(v->tree, debug, 1);
+    }
+
+    /*
+     * Build compacted NFAs for tree and lacons.
+     */
+
+    re->re_info |= nfatree(v, v->tree, debug);
+    CNOERR();
+    assert(v->nlacons == 0 || v->lacons != NULL);
+    for (i = 1; i < v->nlacons; i++) {
 	if (debug != NULL) {
-		fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
-		dumpst(v->tree, debug, 1);
+	    fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
 	}
+	nfanode(v, &v->lacons[i], debug);
+    }
+    CNOERR();
+    if (v->tree->flags&SHORTER) {
+	NOTE(REG_USHORTEST);
+    }
 
-	/* build compacted NFAs for tree and lacons */
-	re->re_info |= nfatree(v, v->tree, debug);
-	CNOERR();
-	assert(v->nlacons == 0 || v->lacons != NULL);
-	for (i = 1; i < v->nlacons; i++) {
-		if (debug != NULL)
-			fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
-		nfanode(v, &v->lacons[i], debug);
-	}
-	CNOERR();
-	if (v->tree->flags&SHORTER)
-		NOTE(REG_USHORTEST);
-
-	/* build compacted NFAs for tree, lacons, fast search */
-	if (debug != NULL)
-		fprintf(debug, "\n\n\n========= SEARCH ==========\n");
-	/* can sacrifice main NFA now, so use it as work area */
-	(DISCARD)optimize(v->nfa, debug);
-	CNOERR();
-	makesearch(v, v->nfa);
-	CNOERR();
-	compact(v->nfa, &g->search);
-	CNOERR();
-
-	/* looks okay, package it up */
-	re->re_nsub = v->nsubexp;
-	v->re = NULL;			/* freev no longer frees re */
-	g->magic = GUTSMAGIC;
-	g->cflags = v->cflags;
-	g->info = re->re_info;
-	g->nsub = re->re_nsub;
-	g->tree = v->tree;
-	v->tree = NULL;
-	g->ntree = v->ntree;
-	g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
-	g->lacons = v->lacons;
-	v->lacons = NULL;
-	g->nlacons = v->nlacons;
-
-	if (flags&REG_DUMP)
-		dump(re, stdout);
-
-	assert(v->err == 0);
-	return freev(v, 0);
-}
+    /*
+     * Build compacted NFAs for tree, lacons, fast search.
+     */
 
+    if (debug != NULL) {
+	fprintf(debug, "\n\n\n========= SEARCH ==========\n");
+    }
+
+    /*
+     * Can sacrifice main NFA now, so use it as work area.
+     */
+
+    (DISCARD) optimize(v->nfa, debug);
+    CNOERR();
+    makesearch(v, v->nfa);
+    CNOERR();
+    compact(v->nfa, &g->search);
+    CNOERR();
+
+    /*
+     * Looks okay, package it up.
+     */
+
+    re->re_nsub = v->nsubexp;
+    v->re = NULL;		/* freev no longer frees re */
+    g->magic = GUTSMAGIC;
+    g->cflags = v->cflags;
+    g->info = re->re_info;
+    g->nsub = re->re_nsub;
+    g->tree = v->tree;
+    v->tree = NULL;
+    g->ntree = v->ntree;
+    g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
+    g->lacons = v->lacons;
+    v->lacons = NULL;
+    g->nlacons = v->nlacons;
+
+    if (flags&REG_DUMP) {
+	dump(re, stdout);
+    }
+
+    assert(v->err == 0);
+    return freev(v, 0);
+}
+
 /*
  - moresubs - enlarge subRE vector
- ^ static VOID moresubs(struct vars *, int);
+ ^ static void moresubs(struct vars *, int);
  */
-static VOID
-moresubs(v, wanted)
-struct vars *v;
-int wanted;			/* want enough room for this one */
+static void
+moresubs(
+    struct vars *v,
+    int wanted)			/* want enough room for this one */
 {
-	struct subre **p;
-	size_t n;
-
-	assert(wanted > 0 && (size_t)wanted >= v->nsubs);
-	n = (size_t)wanted * 3 / 2 + 1;
-	if (v->subs == v->sub10) {
-		p = (struct subre **)MALLOC(n * sizeof(struct subre *));
-		if (p != NULL)
-			memcpy(VS(p), VS(v->subs),
-					v->nsubs * sizeof(struct subre *));
-	} else
-		p = (struct subre **)REALLOC(v->subs, n*sizeof(struct subre *));
-	if (p == NULL) {
-		ERR(REG_ESPACE);
-		return;
+    struct subre **p;
+    size_t n;
+
+    assert(wanted > 0 && (size_t)wanted >= v->nsubs);
+    n = (size_t)wanted * 3 / 2 + 1;
+    if (v->subs == v->sub10) {
+	p = (struct subre **) MALLOC(n * sizeof(struct subre *));
+	if (p != NULL) {
+	    memcpy(p, v->subs, v->nsubs * sizeof(struct subre *));
 	}
-	v->subs = p;
-	for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++)
-		*p = NULL;
-	assert(v->nsubs == n);
-	assert((size_t)wanted < v->nsubs);
+    } else {
+	p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *));
+    }
+    if (p == NULL) {
+	ERR(REG_ESPACE);
+	return;
+    }
+
+    v->subs = p;
+    for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) {
+	*p = NULL;
+    }
+    assert(v->nsubs == n);
+    assert((size_t)wanted < v->nsubs);
 }
-
+
 /*
  - freev - free vars struct's substructures where necessary
- * Optionally does error-number setting, and always returns error code
- * (if any), to make error-handling code terser.
+ * Optionally does error-number setting, and always returns error code (if
+ * any), to make error-handling code terser.
  ^ static int freev(struct vars *, int);
  */
 static int
-freev(v, err)
-struct vars *v;
-int err;
+freev(
+    struct vars *v,
+    int err)
 {
-	if (v->re != NULL)
-		rfree(v->re);
-	if (v->subs != v->sub10)
-		FREE(v->subs);
-	if (v->nfa != NULL)
-		freenfa(v->nfa);
-	if (v->tree != NULL)
-		freesubre(v, v->tree);
-	if (v->treechain != NULL)
-		cleanst(v);
-	if (v->cv != NULL)
-		freecvec(v->cv);
-	if (v->cv2 != NULL)
-		freecvec(v->cv2);
-	if (v->mcces != NULL)
-		freecvec(v->mcces);
-	if (v->lacons != NULL)
-		freelacons(v->lacons, v->nlacons);
-	ERR(err);			/* nop if err==0 */
-
-	return v->err;
+    register int ret;
+
+    if (v->re != NULL) {
+	rfree(v->re);
+    }
+    if (v->subs != v->sub10) {
+	FREE(v->subs);
+    }
+    if (v->nfa != NULL) {
+	freenfa(v->nfa);
+    }
+    if (v->tree != NULL) {
+	freesubre(v, v->tree);
+    }
+    if (v->treechain != NULL) {
+	cleanst(v);
+    }
+    if (v->cv != NULL) {
+	freecvec(v->cv);
+    }
+    if (v->cv2 != NULL) {
+	freecvec(v->cv2);
+    }
+    if (v->lacons != NULL) {
+	freelacons(v->lacons, v->nlacons);
+    }
+    ERR(err);			/* nop if err==0 */
+
+    ret = v->err;
+    FreeVars(v);
+    return ret;
 }
-
+
 /*
  - makesearch - turn an NFA into a search NFA (implicit prepend of .*?)
  * NFA must have been optimize()d already.
- ^ static VOID makesearch(struct vars *, struct nfa *);
+ ^ static void makesearch(struct vars *, struct nfa *);
  */
-static VOID
-makesearch(v, nfa)
-struct vars *v;
-struct nfa *nfa;
+static void
+makesearch(
+    struct vars *v,
+    struct nfa *nfa)
 {
-	struct arc *a;
-	struct arc *b;
-	struct state *pre = nfa->pre;
-	struct state *s;
-	struct state *s2;
-	struct state *slist;
-
-	/* no loops are needed if it's anchored */
-	for (a = pre->outs; a != NULL; a = a->outchain) {
-		assert(a->type == PLAIN);
-		if (a->co != nfa->bos[0] && a->co != nfa->bos[1])
-			break;
-	}
-	if (a != NULL) {
-		/* add implicit .* in front */
-		rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
+    struct arc *a, *b;
+    struct state *pre = nfa->pre;
+    struct state *s, *s2, *slist;
 
-		/* and ^* and \A* too -- not always necessary, but harmless */
-		newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
-		newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
+    /*
+     * No loops are needed if it's anchored.
+     */
+
+    for (a = pre->outs; a != NULL; a = a->outchain) {
+	assert(a->type == PLAIN);
+	if (a->co != nfa->bos[0] && a->co != nfa->bos[1]) {
+	    break;
 	}
+    }
+    if (a != NULL) {
+	/*
+	 * Add implicit .* in front.
+	 */
+
+	rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
 
 	/*
-	 * Now here's the subtle part.  Because many REs have no lookback
-	 * constraints, often knowing when you were in the pre state tells
-	 * you little; it's the next state(s) that are informative.  But
-	 * some of them may have other inarcs, i.e. it may be possible to
-	 * make actual progress and then return to one of them.  We must
-	 * de-optimize such cases, splitting each such state into progress
-	 * and no-progress states.
+	 * And ^* and \A* too -- not always necessary, but harmless.
 	 */
 
-	/* first, make a list of the states */
-	slist = NULL;
-	for (a = pre->outs; a != NULL; a = a->outchain) {
-		s = a->to;
-		for (b = s->ins; b != NULL; b = b->inchain)
-			if (b->from != pre)
-				break;
-		if (b != NULL) {		/* must be split */
-			if (s->tmp == NULL) {  /* if not already in the list */
-			                       /* (fixes bugs 505048, 230589, */
-			                       /* 840258, 504785) */
-				s->tmp = slist;
-				slist = s;
-			}
-		}
+	newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
+	newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
+    }
+
+    /*
+     * Now here's the subtle part. Because many REs have no lookback
+     * constraints, often knowing when you were in the pre state tells you
+     * little; it's the next state(s) that are informative. But some of them
+     * may have other inarcs, i.e. it may be possible to make actual progress
+     * and then return to one of them. We must de-optimize such cases,
+     * splitting each such state into progress and no-progress states.
+     */
+
+    /*
+     * First, make a list of the states.
+     */
+
+    slist = NULL;
+    for (a=pre->outs ; a!=NULL ; a=a->outchain) {
+	s = a->to;
+	for (b=s->ins ; b!=NULL ; b=b->inchain) {
+	    if (b->from != pre) {
+		break;
+	    }
+	}
+	if (b != NULL && s->tmp == NULL) {
+	    /*
+	     * Must be split if not already in the list (fixes bugs 505048,
+	     * 230589, 840258, 504785).
+	     */
+
+	    s->tmp = slist;
+	    slist = s;
 	}
+    }
 
-	/* do the splits */
-	for (s = slist; s != NULL; s = s2) {
-		s2 = newstate(nfa);
-		copyouts(nfa, s, s2);
-		for (a = s->ins; a != NULL; a = b) {
-			b = a->inchain;
-			if (a->from != pre) {
-				cparc(nfa, a, a->from, s2);
-				freearc(nfa, a);
-			}
-		}
-		s2 = s->tmp;
-		s->tmp = NULL;		/* clean up while we're at it */
+    /*
+     * Do the splits.
+     */
+
+    for (s=slist ; s!=NULL ; s=s2) {
+	s2 = newstate(nfa);
+
+	copyouts(nfa, s, s2);
+	for (a=s->ins ; a!=NULL ; a=b) {
+	    b = a->inchain;
+
+	    if (a->from != pre) {
+		cparc(nfa, a, a->from, s2);
+		freearc(nfa, a);
+	    }
 	}
+	s2 = s->tmp;
+	s->tmp = NULL;		/* clean up while we're at it */
+    }
 }
-
+
 /*
  - parse - parse an RE
- * This is actually just the top level, which parses a bunch of branches
- * tied together with '|'.  They appear in the tree as the left children
- * of a chain of '|' subres.
+ * This is actually just the top level, which parses a bunch of branches tied
+ * together with '|'. They appear in the tree as the left children of a chain
+ * of '|' subres.
  ^ static struct subre *parse(struct vars *, int, int, struct state *,
  ^ 	struct state *);
  */
 static struct subre *
-parse(v, stopper, type, init, final)
-struct vars *v;
-int stopper;			/* EOS or ')' */
-int type;			/* LACON (lookahead subRE) or PLAIN */
-struct state *init;		/* initial state */
-struct state *final;		/* final state */
+parse(
+    struct vars *v,
+    int stopper,		/* EOS or ')' */
+    int type,			/* LACON (lookahead subRE) or PLAIN */
+    struct state *init,		/* initial state */
+    struct state *final)	/* final state */
 {
-	struct state *left;	/* scaffolding for branch */
-	struct state *right;
-	struct subre *branches;	/* top level */
-	struct subre *branch;	/* current branch */
-	struct subre *t;	/* temporary */
-	int firstbranch;	/* is this the first branch? */
-
-	assert(stopper == ')' || stopper == EOS);
-
-	branches = subre(v, '|', LONGER, init, final);
+    struct state *left, *right;	/* scaffolding for branch */
+    struct subre *branches;	/* top level */
+    struct subre *branch;	/* current branch */
+    struct subre *t;		/* temporary */
+    int firstbranch;		/* is this the first branch? */
+
+    assert(stopper == ')' || stopper == EOS);
+
+    branches = subre(v, '|', LONGER, init, final);
+    NOERRN();
+    branch = branches;
+    firstbranch = 1;
+    do {	/* a branch */
+	if (!firstbranch) {
+	    /*
+	     * Need a place to hang the branch.
+	     */
+
+	    branch->right = subre(v, '|', LONGER, init, final);
+	    NOERRN();
+	    branch = branch->right;
+	}
+	firstbranch = 0;
+	left = newstate(v->nfa);
+	right = newstate(v->nfa);
 	NOERRN();
-	branch = branches;
-	firstbranch = 1;
-	do {	/* a branch */
-		if (!firstbranch) {
-			/* need a place to hang it */
-			branch->right = subre(v, '|', LONGER, init, final);
-			NOERRN();
-			branch = branch->right;
-		}
-		firstbranch = 0;
-		left = newstate(v->nfa);
-		right = newstate(v->nfa);
-		NOERRN();
-		EMPTYARC(init, left);
-		EMPTYARC(right, final);
-		NOERRN();
-		branch->left = parsebranch(v, stopper, type, left, right, 0);
-		NOERRN();
-		branch->flags |= UP(branch->flags | branch->left->flags);
-		if ((branch->flags &~ branches->flags) != 0)	/* new flags */
-			for (t = branches; t != branch; t = t->right)
-				t->flags |= branch->flags;
-	} while (EAT('|'));
-	assert(SEE(stopper) || SEE(EOS));
-
-	if (!SEE(stopper)) {
-		assert(stopper == ')' && SEE(EOS));
-		ERR(REG_EPAREN);
+	EMPTYARC(init, left);
+	EMPTYARC(right, final);
+	NOERRN();
+	branch->left = parsebranch(v, stopper, type, left, right, 0);
+	NOERRN();
+	branch->flags |= UP(branch->flags | branch->left->flags);
+	if ((branch->flags &~ branches->flags) != 0) {	/* new flags */
+	    for (t = branches; t != branch; t = t->right) {
+		t->flags |= branch->flags;
+	    }
 	}
+    } while (EAT('|'));
+    assert(SEE(stopper) || SEE(EOS));
 
-	/* optimize out simple cases */
-	if (branch == branches) {	/* only one branch */
-		assert(branch->right == NULL);
-		t = branch->left;
-		branch->left = NULL;
-		freesubre(v, branches);
-		branches = t;
-	} else if (!MESSY(branches->flags)) {	/* no interesting innards */
-		freesubre(v, branches->left);
-		branches->left = NULL;
-		freesubre(v, branches->right);
-		branches->right = NULL;
-		branches->op = '=';
-	}
+    if (!SEE(stopper)) {
+	assert(stopper == ')' && SEE(EOS));
+	ERR(REG_EPAREN);
+    }
 
-	return branches;
-}
+    /*
+     * Optimize out simple cases.
+     */
 
+    if (branch == branches) {	/* only one branch */
+	assert(branch->right == NULL);
+	t = branch->left;
+	branch->left = NULL;
+	freesubre(v, branches);
+	branches = t;
+    } else if (!MESSY(branches->flags)) {	/* no interesting innards */
+	freesubre(v, branches->left);
+	branches->left = NULL;
+	freesubre(v, branches->right);
+	branches->right = NULL;
+	branches->op = '=';
+    }
+
+    return branches;
+}
+
 /*
  - parsebranch - parse one branch of an RE
  * This mostly manages concatenation, working closely with parseqatom().
@@ -649,1458 +712,1446 @@ struct state *final;		/* final state */
  ^ 	struct state *, int);
  */
 static struct subre *
-parsebranch(v, stopper, type, left, right, partial)
-struct vars *v;
-int stopper;			/* EOS or ')' */
-int type;			/* LACON (lookahead subRE) or PLAIN */
-struct state *left;		/* leftmost state */
-struct state *right;		/* rightmost state */
-int partial;			/* is this only part of a branch? */
+parsebranch(
+    struct vars *v,
+    int stopper,		/* EOS or ')' */
+    int type,			/* LACON (lookahead subRE) or PLAIN */
+    struct state *left,		/* leftmost state */
+    struct state *right,	/* rightmost state */
+    int partial)		/* is this only part of a branch? */
 {
-	struct state *lp;	/* left end of current construct */
-	int seencontent;	/* is there anything in this branch yet? */
-	struct subre *t;
-
-	lp = left;
-	seencontent = 0;
-	t = subre(v, '=', 0, left, right);	/* op '=' is tentative */
-	NOERRN();
-	while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
-		if (seencontent) {	/* implicit concat operator */
-			lp = newstate(v->nfa);
-			NOERRN();
-			moveins(v->nfa, right, lp);
-		}
-		seencontent = 1;
-
-		/* NB, recursion in parseqatom() may swallow rest of branch */
-		parseqatom(v, stopper, type, lp, right, t);
+    struct state *lp;		/* left end of current construct */
+    int seencontent;		/* is there anything in this branch yet? */
+    struct subre *t;
+
+    lp = left;
+    seencontent = 0;
+    t = subre(v, '=', 0, left, right);	/* op '=' is tentative */
+    NOERRN();
+    while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
+	if (seencontent) {	/* implicit concat operator */
+	    lp = newstate(v->nfa);
+	    NOERRN();
+	    moveins(v->nfa, right, lp);
 	}
+	seencontent = 1;
 
-	if (!seencontent) {		/* empty branch */
-		if (!partial)
-			NOTE(REG_UUNSPEC);
-		assert(lp == left);
-		EMPTYARC(left, right);
+	/* NB, recursion in parseqatom() may swallow rest of branch */
+	parseqatom(v, stopper, type, lp, right, t);
+    }
+
+    if (!seencontent) {		/* empty branch */
+	if (!partial) {
+	    NOTE(REG_UUNSPEC);
 	}
+	assert(lp == left);
+	EMPTYARC(left, right);
+    }
 
-	return t;
+    return t;
 }
-
+
 /*
  - parseqatom - parse one quantified atom or constraint of an RE
- * The bookkeeping near the end cooperates very closely with parsebranch();
- * in particular, it contains a recursion that can involve parsing the rest
- * of the branch, making this function's name somewhat inaccurate.
- ^ static VOID parseqatom(struct vars *, int, int, struct state *,
+ * The bookkeeping near the end cooperates very closely with parsebranch(); in
+ * particular, it contains a recursion that can involve parsing the rest of
+ * the branch, making this function's name somewhat inaccurate.
+ ^ static void parseqatom(struct vars *, int, int, struct state *,
  ^ 	struct state *, struct subre *);
  */
-static VOID
-parseqatom(v, stopper, type, lp, rp, top)
-struct vars *v;
-int stopper;			/* EOS or ')' */
-int type;			/* LACON (lookahead subRE) or PLAIN */
-struct state *lp;		/* left state to hang it on */
-struct state *rp;		/* right state to hang it on */
-struct subre *top;		/* subtree top */
+static void
+parseqatom(
+    struct vars *v,
+    int stopper,		/* EOS or ')' */
+    int type,			/* LACON (lookahead subRE) or PLAIN */
+    struct state *lp,		/* left state to hang it on */
+    struct state *rp,		/* right state to hang it on */
+    struct subre *top)		/* subtree top */
 {
-	struct state *s;	/* temporaries for new states */
-	struct state *s2;
-#	define	ARCV(t, val)	newarc(v->nfa, t, val, lp, rp)
-	int m, n;
-	struct subre *atom;	/* atom's subtree */
-	struct subre *t;
-	int cap;		/* capturing parens? */
-	int pos;		/* positive lookahead? */
-	int subno;		/* capturing-parens or backref number */
-	int atomtype;
-	int qprefer;		/* quantifier short/long preference */
-	int f;
-	struct subre **atomp;	/* where the pointer to atom is */
-
-	/* initial bookkeeping */
-	atom = NULL;
-	assert(lp->nouts == 0);	/* must string new code */
-	assert(rp->nins == 0);	/*  between lp and rp */
-	subno = 0;		/* just to shut lint up */
-
-	/* an atom or constraint... */
-	atomtype = v->nexttype;
-	switch (atomtype) {
+    struct state *s;		/* temporaries for new states */
+    struct state *s2;
+#define	ARCV(t, val)	newarc(v->nfa, t, val, lp, rp)
+    int m, n;
+    struct subre *atom;		/* atom's subtree */
+    struct subre *t;
+    int cap;			/* capturing parens? */
+    int pos;			/* positive lookahead? */
+    int subno;			/* capturing-parens or backref number */
+    int atomtype;
+    int qprefer;		/* quantifier short/long preference */
+    int f;
+    struct subre **atomp;	/* where the pointer to atom is */
+
+    /*
+     * Initial bookkeeping.
+     */
+
+    atom = NULL;
+    assert(lp->nouts == 0);	/* must string new code */
+    assert(rp->nins == 0);	/* between lp and rp */
+    subno = 0;			/* just to shut lint up */
+
+    /*
+     * An atom or constraint...
+     */
+
+    atomtype = v->nexttype;
+    switch (atomtype) {
 	/* first, constraints, which end by returning */
-	case '^':
-		ARCV('^', 1);
-		if (v->cflags&REG_NLANCH)
-			ARCV(BEHIND, v->nlcolor);
-		NEXT();
-		return;
-		break;
-	case '$':
-		ARCV('$', 1);
-		if (v->cflags&REG_NLANCH)
-			ARCV(AHEAD, v->nlcolor);
-		NEXT();
-		return;
-		break;
-	case SBEGIN:
-		ARCV('^', 1);	/* BOL */
-		ARCV('^', 0);	/* or BOS */
-		NEXT();
-		return;
-		break;
-	case SEND:
-		ARCV('$', 1);	/* EOL */
-		ARCV('$', 0);	/* or EOS */
-		NEXT();
-		return;
-		break;
-	case '<':
-		wordchrs(v);	/* does NEXT() */
-		s = newstate(v->nfa);
-		NOERR();
-		nonword(v, BEHIND, lp, s);
-		word(v, AHEAD, s, rp);
-		return;
-		break;
-	case '>':
-		wordchrs(v);	/* does NEXT() */
-		s = newstate(v->nfa);
-		NOERR();
-		word(v, BEHIND, lp, s);
-		nonword(v, AHEAD, s, rp);
-		return;
-		break;
-	case WBDRY:
-		wordchrs(v);	/* does NEXT() */
-		s = newstate(v->nfa);
-		NOERR();
-		nonword(v, BEHIND, lp, s);
-		word(v, AHEAD, s, rp);
-		s = newstate(v->nfa);
-		NOERR();
-		word(v, BEHIND, lp, s);
-		nonword(v, AHEAD, s, rp);
-		return;
-		break;
-	case NWBDRY:
-		wordchrs(v);	/* does NEXT() */
-		s = newstate(v->nfa);
-		NOERR();
-		word(v, BEHIND, lp, s);
-		word(v, AHEAD, s, rp);
-		s = newstate(v->nfa);
-		NOERR();
-		nonword(v, BEHIND, lp, s);
-		nonword(v, AHEAD, s, rp);
-		return;
-		break;
-	case LACON:	/* lookahead constraint */
-		pos = v->nextvalue;
-		NEXT();
-		s = newstate(v->nfa);
-		s2 = newstate(v->nfa);
-		NOERR();
-		t = parse(v, ')', LACON, s, s2);
-		freesubre(v, t);	/* internal structure irrelevant */
-		assert(SEE(')') || ISERR());
-		NEXT();
-		n = newlacon(v, s, s2, pos);
-		NOERR();
-		ARCV(LACON, n);
-		return;
-		break;
-	/* then errors, to get them out of the way */
-	case '*':
-	case '+':
-	case '?':
-	case '{':
-		ERR(REG_BADRPT);
-		return;
-		break;
-	default:
-		ERR(REG_ASSERT);
-		return;
-		break;
-	/* then plain characters, and minor variants on that theme */
-	case ')':		/* unbalanced paren */
-		if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
-			ERR(REG_EPAREN);
-			return;
-		}
-		/* legal in EREs due to specification botch */
-		NOTE(REG_UPBOTCH);
-		/* fallthrough into case PLAIN */
-	case PLAIN:
-		onechr(v, v->nextvalue, lp, rp);
-		okcolors(v->nfa, v->cm);
-		NOERR();
-		NEXT();
-		break;
-	case '[':
-		if (v->nextvalue == 1)
-			bracket(v, lp, rp);
-		else
-			cbracket(v, lp, rp);
-		assert(SEE(']') || ISERR());
-		NEXT();
-		break;
-	case '.':
-		rainbow(v->nfa, v->cm, PLAIN,
-				(v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS,
-				lp, rp);
-		NEXT();
-		break;
-	/* and finally the ugly stuff */
-	case '(':	/* value flags as capturing or non */
-		cap = (type == LACON) ? 0 : v->nextvalue;
-		if (cap) {
-			v->nsubexp++;
-			subno = v->nsubexp;
-			if ((size_t)subno >= v->nsubs)
-				moresubs(v, subno);
-			assert((size_t)subno < v->nsubs);
-		} else
-			atomtype = PLAIN;	/* something that's not '(' */
-		NEXT();
-		/* need new endpoints because tree will contain pointers */
-		s = newstate(v->nfa);
-		s2 = newstate(v->nfa);
-		NOERR();
-		EMPTYARC(lp, s);
-		EMPTYARC(s2, rp);
-		NOERR();
-		atom = parse(v, ')', PLAIN, s, s2);
-		assert(SEE(')') || ISERR());
-		NEXT();
-		NOERR();
-		if (cap) {
-			v->subs[subno] = atom;
-			t = subre(v, '(', atom->flags|CAP, lp, rp);
-			NOERR();
-			t->subno = subno;
-			t->left = atom;
-			atom = t;
-		}
-		/* postpone everything else pending possible {0} */
-		break;
-	case BACKREF:	/* the Feature From The Black Lagoon */
-		INSIST(type != LACON, REG_ESUBREG);
-		INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
-		INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
-		NOERR();
-		assert(v->nextvalue > 0);
-		atom = subre(v, 'b', BACKR, lp, rp);
-		subno = v->nextvalue;
-		atom->subno = subno;
-		EMPTYARC(lp, rp);	/* temporarily, so there's something */
-		NEXT();
-		break;
+    case '^':
+	ARCV('^', 1);
+	if (v->cflags&REG_NLANCH) {
+	    ARCV(BEHIND, v->nlcolor);
 	}
-
-	/* ...and an atom may be followed by a quantifier */
-	switch (v->nexttype) {
-	case '*':
-		m = 0;
-		n = INFINITY;
-		qprefer = (v->nextvalue) ? LONGER : SHORTER;
-		NEXT();
-		break;
-	case '+':
-		m = 1;
-		n = INFINITY;
-		qprefer = (v->nextvalue) ? LONGER : SHORTER;
-		NEXT();
-		break;
-	case '?':
-		m = 0;
-		n = 1;
-		qprefer = (v->nextvalue) ? LONGER : SHORTER;
-		NEXT();
-		break;
-	case '{':
-		NEXT();
-		m = scannum(v);
-		if (EAT(',')) {
-			if (SEE(DIGIT))
-				n = scannum(v);
-			else
-				n = INFINITY;
-			if (m > n) {
-				ERR(REG_BADBR);
-				return;
-			}
-			/* {m,n} exercises preference, even if it's {m,m} */
-			qprefer = (v->nextvalue) ? LONGER : SHORTER;
-		} else {
-			n = m;
-			/* {m} passes operand's preference through */
-			qprefer = 0;
-		}
-		if (!SEE('}')) {	/* catches errors too */
-			ERR(REG_BADBR);
-			return;
-		}
-		NEXT();
-		break;
-	default:		/* no quantifier */
-		m = n = 1;
-		qprefer = 0;
-		break;
+	NEXT();
+	return;
+    case '$':
+	ARCV('$', 1);
+	if (v->cflags&REG_NLANCH) {
+	    ARCV(AHEAD, v->nlcolor);
 	}
+	NEXT();
+	return;
+    case SBEGIN:
+	ARCV('^', 1);		/* BOL */
+	ARCV('^', 0);		/* or BOS */
+	NEXT();
+	return;
+    case SEND:
+	ARCV('$', 1);		/* EOL */
+	ARCV('$', 0);		/* or EOS */
+	NEXT();
+	return;
+    case '<':
+	wordchrs(v);		/* does NEXT() */
+	s = newstate(v->nfa);
+	NOERR();
+	nonword(v, BEHIND, lp, s);
+	word(v, AHEAD, s, rp);
+	return;
+    case '>':
+	wordchrs(v);		/* does NEXT() */
+	s = newstate(v->nfa);
+	NOERR();
+	word(v, BEHIND, lp, s);
+	nonword(v, AHEAD, s, rp);
+	return;
+    case WBDRY:
+	wordchrs(v);		/* does NEXT() */
+	s = newstate(v->nfa);
+	NOERR();
+	nonword(v, BEHIND, lp, s);
+	word(v, AHEAD, s, rp);
+	s = newstate(v->nfa);
+	NOERR();
+	word(v, BEHIND, lp, s);
+	nonword(v, AHEAD, s, rp);
+	return;
+    case NWBDRY:
+	wordchrs(v);		/* does NEXT() */
+	s = newstate(v->nfa);
+	NOERR();
+	word(v, BEHIND, lp, s);
+	word(v, AHEAD, s, rp);
+	s = newstate(v->nfa);
+	NOERR();
+	nonword(v, BEHIND, lp, s);
+	nonword(v, AHEAD, s, rp);
+	return;
+    case LACON:			/* lookahead constraint */
+	pos = v->nextvalue;
+	NEXT();
+	s = newstate(v->nfa);
+	s2 = newstate(v->nfa);
+	NOERR();
+	t = parse(v, ')', LACON, s, s2);
+	freesubre(v, t);	/* internal structure irrelevant */
+	assert(SEE(')') || ISERR());
+	NEXT();
+	n = newlacon(v, s, s2, pos);
+	NOERR();
+	ARCV(LACON, n);
+	return;
 
-	/* annoying special case:  {0} or {0,0} cancels everything */
-	if (m == 0 && n == 0) {
-		if (atom != NULL)
-			freesubre(v, atom);
-		if (atomtype == '(')
-			v->subs[subno] = NULL;
-		delsub(v->nfa, lp, rp);
-		EMPTYARC(lp, rp);
-		return;
+	/*
+	 * Then errors, to get them out of the way.
+	 */
+
+    case '*':
+    case '+':
+    case '?':
+    case '{':
+	ERR(REG_BADRPT);
+	return;
+    default:
+	ERR(REG_ASSERT);
+	return;
+
+	/*
+	 * Then plain characters, and minor variants on that theme.
+	 */
+
+    case ')':			/* unbalanced paren */
+	if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
+	    ERR(REG_EPAREN);
+	    return;
 	}
 
-	/* if not a messy case, avoid hard part */
-	assert(!MESSY(top->flags));
-	f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
-	if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
-		if (!(m == 1 && n == 1))
-			repeat(v, lp, rp, m, n);
-		if (atom != NULL)
-			freesubre(v, atom);
-		top->flags = f;
-		return;
+	/*
+	 * Legal in EREs due to specification botch.
+	 */
+
+	NOTE(REG_UPBOTCH);
+	/* fallthrough into case PLAIN */
+    case PLAIN:
+	onechr(v, v->nextvalue, lp, rp);
+	okcolors(v->nfa, v->cm);
+	NOERR();
+	NEXT();
+	break;
+    case '[':
+	if (v->nextvalue == 1) {
+	    bracket(v, lp, rp);
+	} else {
+	    cbracket(v, lp, rp);
 	}
+	assert(SEE(']') || ISERR());
+	NEXT();
+	break;
+    case '.':
+	rainbow(v->nfa, v->cm, PLAIN,
+		(v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS, lp, rp);
+	NEXT();
+	break;
 
 	/*
-	 * hard part:  something messy
-	 * That is, capturing parens, back reference, short/long clash, or
-	 * an atom with substructure containing one of those.
+	 * And finally the ugly stuff.
 	 */
 
-	/* now we'll need a subre for the contents even if they're boring */
-	if (atom == NULL) {
-		atom = subre(v, '=', 0, lp, rp);
-		NOERR();
+    case '(':			/* value flags as capturing or non */
+	cap = (type == LACON) ? 0 : v->nextvalue;
+	if (cap) {
+	    v->nsubexp++;
+	    subno = v->nsubexp;
+	    if ((size_t)subno >= v->nsubs) {
+		moresubs(v, subno);
+	    }
+	    assert((size_t)subno < v->nsubs);
+	} else {
+	    atomtype = PLAIN;	/* something that's not '(' */
 	}
+	NEXT();
 
 	/*
-	 * prepare a general-purpose state skeleton
-	 *
-	 *    ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
-	 *   /                                            /
-	 * [lp] ----> [s2] ----bypass---------------------
-	 *
-	 * where bypass is an empty, and prefix is some repetitions of atom
+	 * Need new endpoints because tree will contain pointers.
 	 */
-	s = newstate(v->nfa);		/* first, new endpoints for the atom */
+
+	s = newstate(v->nfa);
 	s2 = newstate(v->nfa);
 	NOERR();
-	moveouts(v->nfa, lp, s);
-	moveins(v->nfa, rp, s2);
+	EMPTYARC(lp, s);
+	EMPTYARC(s2, rp);
 	NOERR();
-	atom->begin = s;
-	atom->end = s2;
-	s = newstate(v->nfa);		/* and spots for prefix and bypass */
-	s2 = newstate(v->nfa);
+	atom = parse(v, ')', PLAIN, s, s2);
+	assert(SEE(')') || ISERR());
+	NEXT();
 	NOERR();
-	EMPTYARC(lp, s);
-	EMPTYARC(lp, s2);
+	if (cap) {
+	    v->subs[subno] = atom;
+	    t = subre(v, '(', atom->flags|CAP, lp, rp);
+	    NOERR();
+	    t->subno = subno;
+	    t->left = atom;
+	    atom = t;
+	}
+
+	/*
+	 * Postpone everything else pending possible {0}.
+	 */
+
+	break;
+    case BACKREF:		/* the Feature From The Black Lagoon */
+	INSIST(type != LACON, REG_ESUBREG);
+	INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
+	INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
 	NOERR();
+	assert(v->nextvalue > 0);
+	atom = subre(v, 'b', BACKR, lp, rp);
+	subno = v->nextvalue;
+	atom->subno = subno;
+	EMPTYARC(lp, rp);	/* temporarily, so there's something */
+	NEXT();
+	break;
+    }
 
-	/* break remaining subRE into x{...} and what follows */
-	t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
-	t->left = atom;
-	atomp = &t->left;
-	/* here we should recurse... but we must postpone that to the end */
-
-	/* split top into prefix and remaining */
-	assert(top->op == '=' && top->left == NULL && top->right == NULL);
-	top->left = subre(v, '=', top->flags, top->begin, lp);
-	top->op = '.';
-	top->right = t;
-
-	/* if it's a backref, now is the time to replicate the subNFA */
-	if (atomtype == BACKREF) {
-		assert(atom->begin->nouts == 1);	/* just the EMPTY */
-		delsub(v->nfa, atom->begin, atom->end);
-		assert(v->subs[subno] != NULL);
-		/* and here's why the recursion got postponed:  it must */
-		/* wait until the skeleton is filled in, because it may */
-		/* hit a backref that wants to copy the filled-in skeleton */
-		dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
-						atom->begin, atom->end);
-		NOERR();
-	}
+    /*
+     * ...and an atom may be followed by a quantifier.
+     */
 
-	/* it's quantifier time; first, turn x{0,...} into x{1,...}|empty */
-	if (m == 0) {
-		EMPTYARC(s2, atom->end);		/* the bypass */
-		assert(PREF(qprefer) != 0);
-		f = COMBINE(qprefer, atom->flags);
-		t = subre(v, '|', f, lp, atom->end);
-		NOERR();
-		t->left = atom;
-		t->right = subre(v, '|', PREF(f), s2, atom->end);
-		NOERR();
-		t->right->left = subre(v, '=', 0, s2, atom->end);
-		NOERR();
-		*atomp = t;
-		atomp = &t->left;
-		m = 1;
-	}
+    switch (v->nexttype) {
+    case '*':
+	m = 0;
+	n = INFINITY;
+	qprefer = (v->nextvalue) ? LONGER : SHORTER;
+	NEXT();
+	break;
+    case '+':
+	m = 1;
+	n = INFINITY;
+	qprefer = (v->nextvalue) ? LONGER : SHORTER;
+	NEXT();
+	break;
+    case '?':
+	m = 0;
+	n = 1;
+	qprefer = (v->nextvalue) ? LONGER : SHORTER;
+	NEXT();
+	break;
+    case '{':
+	NEXT();
+	m = scannum(v);
+	if (EAT(',')) {
+	    if (SEE(DIGIT)) {
+		n = scannum(v);
+	    } else {
+		n = INFINITY;
+	    }
+	    if (m > n) {
+		ERR(REG_BADBR);
+		return;
+	    }
 
-	/* deal with the rest of the quantifier */
-	if (atomtype == BACKREF) {
-		/* special case:  backrefs have internal quantifiers */
-		EMPTYARC(s, atom->begin);	/* empty prefix */
-		/* just stuff everything into atom */
-		repeat(v, atom->begin, atom->end, m, n);
-		atom->min = (short)m;
-		atom->max = (short)n;
-		atom->flags |= COMBINE(qprefer, atom->flags);
-	} else if (m == 1 && n == 1) {
-		/* no/vacuous quantifier:  done */
-		EMPTYARC(s, atom->begin);	/* empty prefix */
+	    /*
+	     * {m,n} exercises preference, even if it's {m,m}
+	     */
+
+	    qprefer = (v->nextvalue) ? LONGER : SHORTER;
 	} else {
-		/* turn x{m,n} into x{m-1,n-1}x, with capturing */
-		/*  parens in only second x */
-		dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
-		assert(m >= 1 && m != INFINITY && n >= 1);
-		repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
-		f = COMBINE(qprefer, atom->flags);
-		t = subre(v, '.', f, s, atom->end);	/* prefix and atom */
-		NOERR();
-		t->left = subre(v, '=', PREF(f), s, atom->begin);
-		NOERR();
-		t->right = atom;
-		*atomp = t;
+	    n = m;
+	    /*
+	     * {m} passes operand's preference through.
+	     */
+
+	    qprefer = 0;
+	}
+	if (!SEE('}')) {	/* catches errors too */
+	    ERR(REG_BADBR);
+	    return;
+	}
+	NEXT();
+	break;
+    default:			/* no quantifier */
+	m = n = 1;
+	qprefer = 0;
+	break;
+    }
+
+    /*
+     * Annoying special case: {0} or {0,0} cancels everything.
+     */
+
+    if (m == 0 && n == 0) {
+	if (atom != NULL) {
+	    freesubre(v, atom);
 	}
+	if (atomtype == '(') {
+	    v->subs[subno] = NULL;
+	}
+	delsub(v->nfa, lp, rp);
+	EMPTYARC(lp, rp);
+	return;
+    }
 
-	/* and finally, look after that postponed recursion */
-	t = top->right;
-	if (!(SEE('|') || SEE(stopper) || SEE(EOS)))
-		t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
-	else {
-		EMPTYARC(atom->end, rp);
-		t->right = subre(v, '=', 0, atom->end, rp);
+    /*
+     * If not a messy case, avoid hard part.
+     */
+
+    assert(!MESSY(top->flags));
+    f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
+    if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
+	if (!(m == 1 && n == 1)) {
+	    repeat(v, lp, rp, m, n);
 	}
-	assert(SEE('|') || SEE(stopper) || SEE(EOS));
-	t->flags |= COMBINE(t->flags, t->right->flags);
-	top->flags |= COMBINE(top->flags, t->flags);
-}
+	if (atom != NULL) {
+	    freesubre(v, atom);
+	}
+	top->flags = f;
+	return;
+    }
+
+    /*
+     * hard part: something messy
+     * That is, capturing parens, back reference, short/long clash, or an atom
+     * with substructure containing one of those.
+     */
+
+    /*
+     * Now we'll need a subre for the contents even if they're boring.
+     */
+
+    if (atom == NULL) {
+	atom = subre(v, '=', 0, lp, rp);
+	NOERR();
+    }
+
+    /*
+     * Prepare a general-purpose state skeleton.
+     *
+     *    ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
+     *   /                                            /
+     * [lp] ----> [s2] ----bypass---------------------
+     *
+     * where bypass is an empty, and prefix is some repetitions of atom
+     */
+
+    s = newstate(v->nfa);	/* first, new endpoints for the atom */
+    s2 = newstate(v->nfa);
+    NOERR();
+    moveouts(v->nfa, lp, s);
+    moveins(v->nfa, rp, s2);
+    NOERR();
+    atom->begin = s;
+    atom->end = s2;
+    s = newstate(v->nfa);	/* and spots for prefix and bypass */
+    s2 = newstate(v->nfa);
+    NOERR();
+    EMPTYARC(lp, s);
+    EMPTYARC(lp, s2);
+    NOERR();
+
+    /*
+     * Break remaining subRE into x{...} and what follows.
+     */
+
+    t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+    t->left = atom;
+    atomp = &t->left;
+
+    /*
+     * Here we should recurse... but we must postpone that to the end.
+     */
+
+    /*
+     * Split top into prefix and remaining.
+     */
+
+    assert(top->op == '=' && top->left == NULL && top->right == NULL);
+    top->left = subre(v, '=', top->flags, top->begin, lp);
+    top->op = '.';
+    top->right = t;
+
+    /*
+     * If it's a backref, now is the time to replicate the subNFA.
+     */
+
+    if (atomtype == BACKREF) {
+	assert(atom->begin->nouts == 1);	/* just the EMPTY */
+	delsub(v->nfa, atom->begin, atom->end);
+	assert(v->subs[subno] != NULL);
+
+	/*
+	 * And here's why the recursion got postponed: it must wait until the
+	 * skeleton is filled in, because it may hit a backref that wants to
+	 * copy the filled-in skeleton.
+	 */
+
+	dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
+		atom->begin, atom->end);
+	NOERR();
+    }
+
+    /*
+     * It's quantifier time; first, turn x{0,...} into x{1,...}|empty
+     */
+
+    if (m == 0) {
+	EMPTYARC(s2, atom->end);/* the bypass */
+	assert(PREF(qprefer) != 0);
+	f = COMBINE(qprefer, atom->flags);
+	t = subre(v, '|', f, lp, atom->end);
+	NOERR();
+	t->left = atom;
+	t->right = subre(v, '|', PREF(f), s2, atom->end);
+	NOERR();
+	t->right->left = subre(v, '=', 0, s2, atom->end);
+	NOERR();
+	*atomp = t;
+	atomp = &t->left;
+	m = 1;
+    }
+
+    /*
+     * Deal with the rest of the quantifier.
+     */
+
+    if (atomtype == BACKREF) {
+	/*
+	 * Special case: backrefs have internal quantifiers.
+	 */
+
+	EMPTYARC(s, atom->begin);	/* empty prefix */
+
+	/*
+	 * Just stuff everything into atom.
+	 */
+
+	repeat(v, atom->begin, atom->end, m, n);
+	atom->min = (short) m;
+	atom->max = (short) n;
+	atom->flags |= COMBINE(qprefer, atom->flags);
+    } else if (m == 1 && n == 1) {
+	/*
+	 * No/vacuous quantifier: done.
+	 */
+
+	EMPTYARC(s, atom->begin);	/* empty prefix */
+    } else {
+	/*
+	 * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
+	 * x
+	 */
 
+	dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
+	assert(m >= 1 && m != INFINITY && n >= 1);
+	repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
+	f = COMBINE(qprefer, atom->flags);
+	t = subre(v, '.', f, s, atom->end);	/* prefix and atom */
+	NOERR();
+	t->left = subre(v, '=', PREF(f), s, atom->begin);
+	NOERR();
+	t->right = atom;
+	*atomp = t;
+    }
+
+    /*
+     * And finally, look after that postponed recursion.
+     */
+
+    t = top->right;
+    if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
+	t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+    } else {
+	EMPTYARC(atom->end, rp);
+	t->right = subre(v, '=', 0, atom->end, rp);
+    }
+    assert(SEE('|') || SEE(stopper) || SEE(EOS));
+    t->flags |= COMBINE(t->flags, t->right->flags);
+    top->flags |= COMBINE(top->flags, t->flags);
+}
+
 /*
  - nonword - generate arcs for non-word-character ahead or behind
- ^ static VOID nonword(struct vars *, int, struct state *, struct state *);
+ ^ static void nonword(struct vars *, int, struct state *, struct state *);
  */
-static VOID
-nonword(v, dir, lp, rp)
-struct vars *v;
-int dir;			/* AHEAD or BEHIND */
-struct state *lp;
-struct state *rp;
+static void
+nonword(
+    struct vars *v,
+    int dir,			/* AHEAD or BEHIND */
+    struct state *lp,
+    struct state *rp)
 {
-	int anchor = (dir == AHEAD) ? '$' : '^';
+    int anchor = (dir == AHEAD) ? '$' : '^';
 
-	assert(dir == AHEAD || dir == BEHIND);
-	newarc(v->nfa, anchor, 1, lp, rp);
-	newarc(v->nfa, anchor, 0, lp, rp);
-	colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
-	/* (no need for special attention to \n) */
+    assert(dir == AHEAD || dir == BEHIND);
+    newarc(v->nfa, anchor, 1, lp, rp);
+    newarc(v->nfa, anchor, 0, lp, rp);
+    colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
+    /* (no need for special attention to \n) */
 }
-
+
 /*
  - word - generate arcs for word character ahead or behind
- ^ static VOID word(struct vars *, int, struct state *, struct state *);
+ ^ static void word(struct vars *, int, struct state *, struct state *);
  */
-static VOID
-word(v, dir, lp, rp)
-struct vars *v;
-int dir;			/* AHEAD or BEHIND */
-struct state *lp;
-struct state *rp;
+static void
+word(
+    struct vars *v,
+    int dir,			/* AHEAD or BEHIND */
+    struct state *lp,
+    struct state *rp)
 {
-	assert(dir == AHEAD || dir == BEHIND);
-	cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
-	/* (no need for special attention to \n) */
+    assert(dir == AHEAD || dir == BEHIND);
+    cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
+    /* (no need for special attention to \n) */
 }
-
+
 /*
  - scannum - scan a number
  ^ static int scannum(struct vars *);
  */
 static int			/* value, <= DUPMAX */
-scannum(v)
-struct vars *v;
+scannum(
+    struct vars *v)
 {
-	int n = 0;
+    int n = 0;
 
-	while (SEE(DIGIT) && n < DUPMAX) {
-		n = n*10 + v->nextvalue;
-		NEXT();
-	}
-	if (SEE(DIGIT) || n > DUPMAX) {
-		ERR(REG_BADBR);
-		return 0;
-	}
-	return n;
+    while (SEE(DIGIT) && n < DUPMAX) {
+	n = n*10 + v->nextvalue;
+	NEXT();
+    }
+    if (SEE(DIGIT) || n > DUPMAX) {
+	ERR(REG_BADBR);
+	return 0;
+    }
+    return n;
 }
-
+
 /*
  - repeat - replicate subNFA for quantifiers
  * The duplication sequences used here are chosen carefully so that any
  * pointers starting out pointing into the subexpression end up pointing into
- * the last occurrence.  (Note that it may not be strung between the same
- * left and right end states, however!)  This used to be important for the
- * subRE tree, although the important bits are now handled by the in-line
- * code in parse(), and when this is called, it doesn't matter any more.
- ^ static VOID repeat(struct vars *, struct state *, struct state *, int, int);
+ * the last occurrence. (Note that it may not be strung between the same left
+ * and right end states, however!) This used to be important for the subRE
+ * tree, although the important bits are now handled by the in-line code in
+ * parse(), and when this is called, it doesn't matter any more.
+ ^ static void repeat(struct vars *, struct state *, struct state *, int, int);
  */
-static VOID
-repeat(v, lp, rp, m, n)
-struct vars *v;
-struct state *lp;
-struct state *rp;
-int m;
-int n;
+static void
+repeat(
+    struct vars *v,
+    struct state *lp,
+    struct state *rp,
+    int m,
+    int n)
 {
-#	define	SOME	2
-#	define	INF	3
-#	define	PAIR(x, y)	((x)*4 + (y))
-#	define	REDUCE(x)	( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
-	CONST int rm = REDUCE(m);
-	CONST int rn = REDUCE(n);
-	struct state *s;
-	struct state *s2;
-
-	switch (PAIR(rm, rn)) {
-	case PAIR(0, 0):		/* empty string */
-		delsub(v->nfa, lp, rp);
-		EMPTYARC(lp, rp);
-		break;
-	case PAIR(0, 1):		/* do as x| */
-		EMPTYARC(lp, rp);
-		break;
-	case PAIR(0, SOME):		/* do as x{1,n}| */
-		repeat(v, lp, rp, 1, n);
-		NOERR();
-		EMPTYARC(lp, rp);
-		break;
-	case PAIR(0, INF):		/* loop x around */
-		s = newstate(v->nfa);
-		NOERR();
-		moveouts(v->nfa, lp, s);
-		moveins(v->nfa, rp, s);
-		EMPTYARC(lp, s);
-		EMPTYARC(s, rp);
-		break;
-	case PAIR(1, 1):		/* no action required */
-		break;
-	case PAIR(1, SOME):		/* do as x{0,n-1}x = (x{1,n-1}|)x */
-		s = newstate(v->nfa);
-		NOERR();
-		moveouts(v->nfa, lp, s);
-		dupnfa(v->nfa, s, rp, lp, s);
-		NOERR();
-		repeat(v, lp, s, 1, n-1);
-		NOERR();
-		EMPTYARC(lp, s);
-		break;
-	case PAIR(1, INF):		/* add loopback arc */
-		s = newstate(v->nfa);
-		s2 = newstate(v->nfa);
-		NOERR();
-		moveouts(v->nfa, lp, s);
-		moveins(v->nfa, rp, s2);
-		EMPTYARC(lp, s);
-		EMPTYARC(s2, rp);
-		EMPTYARC(s2, s);
-		break;
-	case PAIR(SOME, SOME):		/* do as x{m-1,n-1}x */
-		s = newstate(v->nfa);
-		NOERR();
-		moveouts(v->nfa, lp, s);
-		dupnfa(v->nfa, s, rp, lp, s);
-		NOERR();
-		repeat(v, lp, s, m-1, n-1);
-		break;
-	case PAIR(SOME, INF):		/* do as x{m-1,}x */
-		s = newstate(v->nfa);
-		NOERR();
-		moveouts(v->nfa, lp, s);
-		dupnfa(v->nfa, s, rp, lp, s);
-		NOERR();
-		repeat(v, lp, s, m-1, n);
-		break;
-	default:
-		ERR(REG_ASSERT);
-		break;
-	}
+#define	SOME		2
+#define	INF		3
+#define	PAIR(x, y)	((x)*4 + (y))
+#define	REDUCE(x)	( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
+    const int rm = REDUCE(m);
+    const int rn = REDUCE(n);
+    struct state *s, *s2;
+
+    switch (PAIR(rm, rn)) {
+    case PAIR(0, 0):		/* empty string */
+	delsub(v->nfa, lp, rp);
+	EMPTYARC(lp, rp);
+	break;
+    case PAIR(0, 1):		/* do as x| */
+	EMPTYARC(lp, rp);
+	break;
+    case PAIR(0, SOME):		/* do as x{1,n}| */
+	repeat(v, lp, rp, 1, n);
+	NOERR();
+	EMPTYARC(lp, rp);
+	break;
+    case PAIR(0, INF):		/* loop x around */
+	s = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, lp, s);
+	moveins(v->nfa, rp, s);
+	EMPTYARC(lp, s);
+	EMPTYARC(s, rp);
+	break;
+    case PAIR(1, 1):		/* no action required */
+	break;
+    case PAIR(1, SOME):		/* do as x{0,n-1}x = (x{1,n-1}|)x */
+	s = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, lp, s);
+	dupnfa(v->nfa, s, rp, lp, s);
+	NOERR();
+	repeat(v, lp, s, 1, n-1);
+	NOERR();
+	EMPTYARC(lp, s);
+	break;
+    case PAIR(1, INF):		/* add loopback arc */
+	s = newstate(v->nfa);
+	s2 = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, lp, s);
+	moveins(v->nfa, rp, s2);
+	EMPTYARC(lp, s);
+	EMPTYARC(s2, rp);
+	EMPTYARC(s2, s);
+	break;
+    case PAIR(SOME, SOME):		/* do as x{m-1,n-1}x */
+	s = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, lp, s);
+	dupnfa(v->nfa, s, rp, lp, s);
+	NOERR();
+	repeat(v, lp, s, m-1, n-1);
+	break;
+    case PAIR(SOME, INF):		/* do as x{m-1,}x */
+	s = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, lp, s);
+	dupnfa(v->nfa, s, rp, lp, s);
+	NOERR();
+	repeat(v, lp, s, m-1, n);
+	break;
+    default:
+	ERR(REG_ASSERT);
+	break;
+    }
 }
-
+
 /*
  - bracket - handle non-complemented bracket expression
  * Also called from cbracket for complemented bracket expressions.
- ^ static VOID bracket(struct vars *, struct state *, struct state *);
+ ^ static void bracket(struct vars *, struct state *, struct state *);
  */
-static VOID
-bracket(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+bracket(
+    struct vars *v,
+    struct state *lp,
+    struct state *rp)
 {
-	assert(SEE('['));
-	NEXT();
-	while (!SEE(']') && !SEE(EOS))
-		brackpart(v, lp, rp);
-	assert(SEE(']') || ISERR());
-	okcolors(v->nfa, v->cm);
+    assert(SEE('['));
+    NEXT();
+    while (!SEE(']') && !SEE(EOS)) {
+	brackpart(v, lp, rp);
+    }
+    assert(SEE(']') || ISERR());
+    okcolors(v->nfa, v->cm);
 }
-
+
 /*
  - cbracket - handle complemented bracket expression
  * We do it by calling bracket() with dummy endpoints, and then complementing
- * the result.  The alternative would be to invoke rainbow(), and then delete
+ * the result. The alternative would be to invoke rainbow(), and then delete
  * arcs as the b.e. is seen... but that gets messy.
- ^ static VOID cbracket(struct vars *, struct state *, struct state *);
+ ^ static void cbracket(struct vars *, struct state *, struct state *);
  */
-static VOID
-cbracket(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+cbracket(
+    struct vars *v,
+    struct state *lp,
+    struct state *rp)
 {
-	struct state *left = newstate(v->nfa);
-	struct state *right = newstate(v->nfa);
-	struct state *s;
-	struct arc *a;			/* arc from lp */
-	struct arc *ba;			/* arc from left, from bracket() */
-	struct arc *pa;			/* MCCE-prototype arc */
-	color co;
-	chr *p;
-	int i;
+    struct state *left = newstate(v->nfa);
+    struct state *right = newstate(v->nfa);
 
-	NOERR();
-	bracket(v, left, right);
-	if (v->cflags&REG_NLSTOP)
-		newarc(v->nfa, PLAIN, v->nlcolor, left, right);
-	NOERR();
+    NOERR();
+    bracket(v, left, right);
+    if (v->cflags&REG_NLSTOP) {
+	newarc(v->nfa, PLAIN, v->nlcolor, left, right);
+    }
+    NOERR();
 
-	assert(lp->nouts == 0);		/* all outarcs will be ours */
+    assert(lp->nouts == 0);	/* all outarcs will be ours */
 
-	/* easy part of complementing */
-	colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
-	NOERR();
-	if (v->mcces == NULL) {		/* no MCCEs -- we're done */
-		dropstate(v->nfa, left);
-		assert(right->nins == 0);
-		freestate(v->nfa, right);
-		return;
-	}
-
-	/* but complementing gets messy in the presence of MCCEs... */
-	NOTE(REG_ULOCALE);
-	for (p = v->mcces->chrs, i = v->mcces->nchrs; i > 0; p++, i--) {
-		co = GETCOLOR(v->cm, *p);
-		a = findarc(lp, PLAIN, co);
-		ba = findarc(left, PLAIN, co);
-		if (ba == NULL) {
-			assert(a != NULL);
-			freearc(v->nfa, a);
-		} else {
-			assert(a == NULL);
-		}
-		s = newstate(v->nfa);
-		NOERR();
-		newarc(v->nfa, PLAIN, co, lp, s);
-		NOERR();
-		pa = findarc(v->mccepbegin, PLAIN, co);
-		assert(pa != NULL);
-		if (ba == NULL) {	/* easy case, need all of them */
-			cloneouts(v->nfa, pa->to, s, rp, PLAIN);
-			newarc(v->nfa, '$', 1, s, rp);
-			newarc(v->nfa, '$', 0, s, rp);
-			colorcomplement(v->nfa, v->cm, AHEAD, pa->to, s, rp);
-		} else {		/* must be selective */
-			if (findarc(ba->to, '$', 1) == NULL) {
-				newarc(v->nfa, '$', 1, s, rp);
-				newarc(v->nfa, '$', 0, s, rp);
-				colorcomplement(v->nfa, v->cm, AHEAD, pa->to,
-									 s, rp);
-			}
-			for (pa = pa->to->outs; pa != NULL; pa = pa->outchain)
-				if (findarc(ba->to, PLAIN, pa->co) == NULL)
-					newarc(v->nfa, PLAIN, pa->co, s, rp);
-			if (s->nouts == 0)	/* limit of selectivity: none */
-				dropstate(v->nfa, s);	/* frees arc too */
-		}
-		NOERR();
-	}
+    /*
+     * Easy part of complementing, and all there is to do since the MCCE code
+     * was removed.
+     */
 
-	delsub(v->nfa, left, right);
-	assert(left->nouts == 0);
-	freestate(v->nfa, left);
-	assert(right->nins == 0);
-	freestate(v->nfa, right);
+    colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
+    NOERR();
+    dropstate(v->nfa, left);
+    assert(right->nins == 0);
+    freestate(v->nfa, right);
+    return;
 }
-
+
 /*
  - brackpart - handle one item (or range) within a bracket expression
- ^ static VOID brackpart(struct vars *, struct state *, struct state *);
+ ^ static void brackpart(struct vars *, struct state *, struct state *);
  */
-static VOID
-brackpart(v, lp, rp)
-struct vars *v;
-struct state *lp;
-struct state *rp;
+static void
+brackpart(
+    struct vars *v,
+    struct state *lp,
+    struct state *rp)
 {
-	celt startc;
-	celt endc;
-	struct cvec *cv;
-	CONST chr *startp;
-	CONST chr *endp;
-	chr c[1];
-
-	/* parse something, get rid of special cases, take shortcuts */
+    celt startc, endc;
+    struct cvec *cv;
+    const chr *startp, *endp;
+    chr c[1];
+
+    /*
+     * Parse something, get rid of special cases, take shortcuts.
+     */
+
+    switch (v->nexttype) {
+    case RANGE:			/* a-b-c or other botch */
+	ERR(REG_ERANGE);
+	return;
+	break;
+    case PLAIN:
+	c[0] = v->nextvalue;
+	NEXT();
+
+	/*
+	 * Shortcut for ordinary chr (not range).
+	 */
+
+	if (!SEE(RANGE)) {
+	    onechr(v, c[0], lp, rp);
+	    return;
+	}
+	startc = element(v, c, c+1);
+	NOERR();
+	break;
+    case COLLEL:
+	startp = v->now;
+	endp = scanplain(v);
+	INSIST(startp < endp, REG_ECOLLATE);
+	NOERR();
+	startc = element(v, startp, endp);
+	NOERR();
+	break;
+    case ECLASS:
+	startp = v->now;
+	endp = scanplain(v);
+	INSIST(startp < endp, REG_ECOLLATE);
+	NOERR();
+	startc = element(v, startp, endp);
+	NOERR();
+	cv = eclass(v, startc, (v->cflags&REG_ICASE));
+	NOERR();
+	dovec(v, cv, lp, rp);
+	return;
+	break;
+    case CCLASS:
+	startp = v->now;
+	endp = scanplain(v);
+	INSIST(startp < endp, REG_ECTYPE);
+	NOERR();
+	cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
+	NOERR();
+	dovec(v, cv, lp, rp);
+	return;
+	break;
+    default:
+	ERR(REG_ASSERT);
+	return;
+	break;
+    }
+
+    if (SEE(RANGE)) {
+	NEXT();
 	switch (v->nexttype) {
-	case RANGE:			/* a-b-c or other botch */
-		ERR(REG_ERANGE);
-		return;
-		break;
 	case PLAIN:
-		c[0] = v->nextvalue;
-		NEXT();
-		/* shortcut for ordinary chr (not range, not MCCE leader) */
-		if (!SEE(RANGE) && !ISCELEADER(v, c[0])) {
-			onechr(v, c[0], lp, rp);
-			return;
-		}
-		startc = element(v, c, c+1);
-		NOERR();
-		break;
+	case RANGE:
+	    c[0] = v->nextvalue;
+	    NEXT();
+	    endc = element(v, c, c+1);
+	    NOERR();
+	    break;
 	case COLLEL:
-		startp = v->now;
-		endp = scanplain(v);
-		INSIST(startp < endp, REG_ECOLLATE);
-		NOERR();
-		startc = element(v, startp, endp);
-		NOERR();
-		break;
-	case ECLASS:
-		startp = v->now;
-		endp = scanplain(v);
-		INSIST(startp < endp, REG_ECOLLATE);
-		NOERR();
-		startc = element(v, startp, endp);
-		NOERR();
-		cv = eclass(v, startc, (v->cflags&REG_ICASE));
-		NOERR();
-		dovec(v, cv, lp, rp);
-		return;
-		break;
-	case CCLASS:
-		startp = v->now;
-		endp = scanplain(v);
-		INSIST(startp < endp, REG_ECTYPE);
-		NOERR();
-		cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
-		NOERR();
-		dovec(v, cv, lp, rp);
-		return;
-		break;
+	    startp = v->now;
+	    endp = scanplain(v);
+	    INSIST(startp < endp, REG_ECOLLATE);
+	    NOERR();
+	    endc = element(v, startp, endp);
+	    NOERR();
+	    break;
 	default:
-		ERR(REG_ASSERT);
-		return;
-		break;
+	    ERR(REG_ERANGE);
+	    return;
+	    break;
 	}
+    } else {
+	endc = startc;
+    }
 
-	if (SEE(RANGE)) {
-		NEXT();
-		switch (v->nexttype) {
-		case PLAIN:
-		case RANGE:
-			c[0] = v->nextvalue;
-			NEXT();
-			endc = element(v, c, c+1);
-			NOERR();
-			break;
-		case COLLEL:
-			startp = v->now;
-			endp = scanplain(v);
-			INSIST(startp < endp, REG_ECOLLATE);
-			NOERR();
-			endc = element(v, startp, endp);
-			NOERR();
-			break;
-		default:
-			ERR(REG_ERANGE);
-			return;
-			break;
-		}
-	} else
-		endc = startc;
+    /*
+     * Ranges are unportable. Actually, standard C does guarantee that digits
+     * are contiguous, but making that an exception is just too complicated.
+     */
 
-	/*
-	 * Ranges are unportable.  Actually, standard C does
-	 * guarantee that digits are contiguous, but making
-	 * that an exception is just too complicated.
-	 */
-	if (startc != endc)
-		NOTE(REG_UUNPORT);
-	cv = range(v, startc, endc, (v->cflags&REG_ICASE));
-	NOERR();
-	dovec(v, cv, lp, rp);
+    if (startc != endc) {
+	NOTE(REG_UUNPORT);
+    }
+    cv = range(v, startc, endc, (v->cflags&REG_ICASE));
+    NOERR();
+    dovec(v, cv, lp, rp);
 }
-
+
 /*
  - scanplain - scan PLAIN contents of [. etc.
- * Certain bits of trickery in lex.c know that this code does not try
- * to look past the final bracket of the [. etc.
- ^ static chr *scanplain(struct vars *);
+ * Certain bits of trickery in lex.c know that this code does not try to look
+ * past the final bracket of the [. etc.
+ ^ static const chr *scanplain(struct vars *);
  */
-static CONST chr *			/* just after end of sequence */
-scanplain(v)
-struct vars *v;
+static const chr *		/* just after end of sequence */
+scanplain(
+    struct vars *v)
 {
-	CONST chr *endp;
+    const chr *endp;
 
-	assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
-	NEXT();
+    assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
+    NEXT();
 
+    endp = v->now;
+    while (SEE(PLAIN)) {
 	endp = v->now;
-	while (SEE(PLAIN)) {
-		endp = v->now;
-		NEXT();
-	}
-
-	assert(SEE(END) || ISERR());
 	NEXT();
+    }
 
-	return endp;
-}
+    assert(SEE(END) || ISERR());
+    NEXT();
 
+    return endp;
+}
+
 /*
  - onechr - fill in arcs for a plain character, and possible case complements
  * This is mostly a shortcut for efficient handling of the common case.
- ^ static VOID onechr(struct vars *, pchr, struct state *, struct state *);
+ ^ static void onechr(struct vars *, pchr, struct state *, struct state *);
  */
-static VOID
-onechr(v, c, lp, rp)
-struct vars *v;
-pchr c;
-struct state *lp;
-struct state *rp;
+static void
+onechr(
+    struct vars *v,
+    pchr c,
+    struct state *lp,
+    struct state *rp)
 {
-	if (!(v->cflags&REG_ICASE)) {
-		newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
-		return;
-	}
+    if (!(v->cflags&REG_ICASE)) {
+	newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
+	return;
+    }
 
-	/* rats, need general case anyway... */
-	dovec(v, allcases(v, c), lp, rp);
-}
+    /*
+     * Rats, need general case anyway...
+     */
 
+    dovec(v, allcases(v, c), lp, rp);
+}
+
 /*
  - dovec - fill in arcs for each element of a cvec
- * This one has to handle the messy cases, like MCCEs and MCCE leaders.
- ^ static VOID dovec(struct vars *, struct cvec *, struct state *,
+ ^ static void dovec(struct vars *, struct cvec *, struct state *,
  ^ 	struct state *);
  */
-static VOID
-dovec(v, cv, lp, rp)
-struct vars *v;
-struct cvec *cv;
-struct state *lp;
-struct state *rp;
+static void
+dovec(
+    struct vars *v,
+    struct cvec *cv,
+    struct state *lp,
+    struct state *rp)
 {
-	chr ch, from, to;
-	celt ce;
-	chr *p;
-	int i;
-	color co;
-	struct cvec *leads;
-	struct arc *a;
-	struct arc *pa;		/* arc in prototype */
-	struct state *s;
-	struct state *ps;	/* state in prototype */
-
-	leads = NULL;
-
-	/* first, get the ordinary characters out of the way */
-	for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
-		ch = *p;
-		if (!ISCELEADER(v, ch))
-			newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
-		else {
-			assert(singleton(v->cm, ch));
-			assert(leads != NULL);
-			if (!haschr(leads, ch))
-				addchr(leads, ch);
-		}
-	}
-
-	/* and the ranges */
-	for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
-		from = *p;
-		to = *(p+1);
-		while (from <= to && (ce = nextleader(v, from, to)) != NOCELT) {
-			if (from < ce)
-				subrange(v, from, ce - 1, lp, rp);
-			assert(singleton(v->cm, ce));
-			assert(leads != NULL);
-			if (!haschr(leads, ce))
-				addchr(leads, ce);
-			from = ce + 1;
-		}
-		if (from <= to)
-			subrange(v, from, to, lp, rp);
+    chr ch, from, to;
+    const chr *p;
+    int i;
+
+    for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
+	ch = *p;
+	newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
+    }
+
+    for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
+	from = *p;
+	to = *(p+1);
+	if (from <= to) {
+	    subrange(v, from, to, lp, rp);
 	}
+    }
 
-	if ((leads == NULL || leads->nchrs == 0) && cv->nmcces == 0)
-		return;
-
-	/* deal with the MCCE leaders */
-	NOTE(REG_ULOCALE);
-	for (p = leads->chrs, i = leads->nchrs; i > 0; p++, i--) {
-		co = GETCOLOR(v->cm, *p);
-		a = findarc(lp, PLAIN, co);
-		if (a != NULL)
-			s = a->to;
-		else {
-			s = newstate(v->nfa);
-			NOERR();
-			newarc(v->nfa, PLAIN, co, lp, s);
-			NOERR();
-		}
-		pa = findarc(v->mccepbegin, PLAIN, co);
-		assert(pa != NULL);
-		ps = pa->to;
-		newarc(v->nfa, '$', 1, s, rp);
-		newarc(v->nfa, '$', 0, s, rp);
-		colorcomplement(v->nfa, v->cm, AHEAD, ps, s, rp);
-		NOERR();
-	}
-
-	/* and the MCCEs */
-	for (i = 0; i < cv->nmcces; i++) {
-		p = cv->mcces[i];
-		assert(singleton(v->cm, *p));
-		if (!singleton(v->cm, *p)) {
-			ERR(REG_ASSERT);
-			return;
-		}
-		ch = *p++;
-		co = GETCOLOR(v->cm, ch);
-		a = findarc(lp, PLAIN, co);
-		if (a != NULL)
-			s = a->to;
-		else {
-			s = newstate(v->nfa);
-			NOERR();
-			newarc(v->nfa, PLAIN, co, lp, s);
-			NOERR();
-		}
-		assert(*p != 0);	/* at least two chars */
-		assert(singleton(v->cm, *p));
-		ch = *p++;
-		co = GETCOLOR(v->cm, ch);
-		assert(*p == 0);	/* and only two, for now */
-		newarc(v->nfa, PLAIN, co, s, rp);
-		NOERR();
-	}
-}
-
-/*
- - nextleader - find next MCCE leader within range
- ^ static celt nextleader(struct vars *, pchr, pchr);
- */
-static celt			/* NOCELT means none */
-nextleader(v, from, to)
-struct vars *v;
-pchr from;
-pchr to;
-{
-	int i;
-	chr *p;
-	chr ch;
-	celt it = NOCELT;
-
-	if (v->mcces == NULL)
-		return it;
-
-	for (i = v->mcces->nchrs, p = v->mcces->chrs; i > 0; i--, p++) {
-		ch = *p;
-		if (from <= ch && ch <= to)
-			if (it == NOCELT || ch < it)
-				it = ch;
-	}
-	return it;
 }
-
+
 /*
  - wordchrs - set up word-chr list for word-boundary stuff, if needed
- * The list is kept as a bunch of arcs between two dummy states; it's
- * disposed of by the unreachable-states sweep in NFA optimization.
- * Does NEXT().  Must not be called from any unusual lexical context.
- * This should be reconciled with the \w etc. handling in lex.c, and
- * should be cleaned up to reduce dependencies on input scanning.
- ^ static VOID wordchrs(struct vars *);
+ * The list is kept as a bunch of arcs between two dummy states; it's disposed
+ * of by the unreachable-states sweep in NFA optimization. Does NEXT(). Must
+ * not be called from any unusual lexical context. This should be reconciled
+ * with the \w etc. handling in lex.c, and should be cleaned up to reduce
+ * dependencies on input scanning.
+ ^ static void wordchrs(struct vars *);
  */
-static VOID
-wordchrs(v)
-struct vars *v;
+static void
+wordchrs(
+    struct vars *v)
 {
-	struct state *left;
-	struct state *right;
+    struct state *left, *right;
 
-	if (v->wordchrs != NULL) {
-		NEXT();		/* for consistency */
-		return;
-	}
+    if (v->wordchrs != NULL) {
+	NEXT();		/* for consistency */
+	return;
+    }
 
-	left = newstate(v->nfa);
-	right = newstate(v->nfa);
-	NOERR();
-	/* fine point:  implemented with [::], and lexer will set REG_ULOCALE */
-	lexword(v);
-	NEXT();
-	assert(v->savenow != NULL && SEE('['));
-	bracket(v, left, right);
-	assert((v->savenow != NULL && SEE(']')) || ISERR());
-	NEXT();
-	NOERR();
-	v->wordchrs = left;
-}
+    left = newstate(v->nfa);
+    right = newstate(v->nfa);
+    NOERR();
 
+    /*
+     * Fine point: implemented with [::], and lexer will set REG_ULOCALE.
+     */
+
+    lexword(v);
+    NEXT();
+    assert(v->savenow != NULL && SEE('['));
+    bracket(v, left, right);
+    assert((v->savenow != NULL && SEE(']')) || ISERR());
+    NEXT();
+    NOERR();
+    v->wordchrs = left;
+}
+
 /*
  - subre - allocate a subre
  ^ static struct subre *subre(struct vars *, int, int, struct state *,
  ^	struct state *);
  */
 static struct subre *
-subre(v, op, flags, begin, end)
-struct vars *v;
-int op;
-int flags;
-struct state *begin;
-struct state *end;
+subre(
+    struct vars *v,
+    int op,
+    int flags,
+    struct state *begin,
+    struct state *end)
 {
-	struct subre *ret;
-
-	ret = v->treefree;
-	if (ret != NULL)
-		v->treefree = ret->left;
-	else {
-		ret = (struct subre *)MALLOC(sizeof(struct subre));
-		if (ret == NULL) {
-			ERR(REG_ESPACE);
-			return NULL;
-		}
-		ret->chain = v->treechain;
-		v->treechain = ret;
+    struct subre *ret = v->treefree;
+
+    if (ret != NULL) {
+	v->treefree = ret->left;
+    } else {
+	ret = (struct subre *) MALLOC(sizeof(struct subre));
+	if (ret == NULL) {
+	    ERR(REG_ESPACE);
+	    return NULL;
 	}
-
-	assert(strchr("|.b(=", op) != NULL);
-
-	ret->op = op;
-	ret->flags = flags;
-	ret->retry = 0;
-	ret->subno = 0;
-	ret->min = ret->max = 1;
-	ret->left = NULL;
-	ret->right = NULL;
-	ret->begin = begin;
-	ret->end = end;
-	ZAPCNFA(ret->cnfa);
-
-	return ret;
+	ret->chain = v->treechain;
+	v->treechain = ret;
+    }
+
+    assert(strchr("|.b(=", op) != NULL);
+
+    ret->op = op;
+    ret->flags = flags;
+    ret->retry = 0;
+    ret->subno = 0;
+    ret->min = ret->max = 1;
+    ret->left = NULL;
+    ret->right = NULL;
+    ret->begin = begin;
+    ret->end = end;
+    ZAPCNFA(ret->cnfa);
+
+    return ret;
 }
-
+
 /*
  - freesubre - free a subRE subtree
- ^ static VOID freesubre(struct vars *, struct subre *);
+ ^ static void freesubre(struct vars *, struct subre *);
  */
-static VOID
-freesubre(v, sr)
-struct vars *v;			/* might be NULL */
-struct subre *sr;
+static void
+freesubre(
+    struct vars *v,		/* might be NULL */
+    struct subre *sr)
 {
-	if (sr == NULL)
-		return;
-
-	if (sr->left != NULL)
-		freesubre(v, sr->left);
-	if (sr->right != NULL)
-		freesubre(v, sr->right);
-
-	freesrnode(v, sr);
+    if (sr == NULL) {
+	return;
+    }
+
+    if (sr->left != NULL) {
+	freesubre(v, sr->left);
+    }
+    if (sr->right != NULL) {
+	freesubre(v, sr->right);
+    }
+
+    freesrnode(v, sr);
 }
-
+
 /*
  - freesrnode - free one node in a subRE subtree
- ^ static VOID freesrnode(struct vars *, struct subre *);
+ ^ static void freesrnode(struct vars *, struct subre *);
  */
-static VOID
-freesrnode(v, sr)
-struct vars *v;			/* might be NULL */
-struct subre *sr;
+static void
+freesrnode(
+    struct vars *v,		/* might be NULL */
+    struct subre *sr)
 {
-	if (sr == NULL)
-		return;
-
-	if (!NULLCNFA(sr->cnfa))
-		freecnfa(&sr->cnfa);
-	sr->flags = 0;
-
-	if (v != NULL) {
-		sr->left = v->treefree;
-		v->treefree = sr;
-	} else
-		FREE(sr);
+    if (sr == NULL) {
+	return;
+    }
+
+    if (!NULLCNFA(sr->cnfa)) {
+	freecnfa(&sr->cnfa);
+    }
+    sr->flags = 0;
+
+    if (v != NULL) {
+	sr->left = v->treefree;
+	v->treefree = sr;
+    } else {
+	FREE(sr);
+    }
 }
-
+
 /*
  - optst - optimize a subRE subtree
- ^ static VOID optst(struct vars *, struct subre *);
+ ^ static void optst(struct vars *, struct subre *);
  */
-static VOID
-optst(v, t)
-struct vars *v;
-struct subre *t;
+static void
+optst(
+    struct vars *v,
+    struct subre *t)
 {
     /*
      * DGP (2007-11-13): I assume it was the programmer's intent to eventually
      * come back and add code to optimize subRE trees, but the routine coded
-     * just spent effort traversing the tree and doing nothing. We can do
+     * just spends effort traversing the tree and doing nothing. We can do
      * nothing with less effort.
      */
 
     return;
 }
-
+
 /*
  - numst - number tree nodes (assigning retry indexes)
  ^ static int numst(struct subre *, int);
  */
 static int			/* next number */
-numst(t, start)
-struct subre *t;
-int start;			/* starting point for subtree numbers */
+numst(
+    struct subre *t,
+    int start)			/* starting point for subtree numbers */
 {
-	int i;
-
-	assert(t != NULL);
-
-	i = start;
-	t->retry = (short)i++;
-	if (t->left != NULL)
-		i = numst(t->left, i);
-	if (t->right != NULL)
-		i = numst(t->right, i);
-	return i;
+    int i;
+
+    assert(t != NULL);
+
+    i = start;
+    t->retry = (short) i++;
+    if (t->left != NULL) {
+	i = numst(t->left, i);
+    }
+    if (t->right != NULL) {
+	i = numst(t->right, i);
+    }
+    return i;
 }
-
+
 /*
  - markst - mark tree nodes as INUSE
- ^ static VOID markst(struct subre *);
+ ^ static void markst(struct subre *);
  */
-static VOID
-markst(t)
-struct subre *t;
+static void
+markst(
+    struct subre *t)
 {
-	assert(t != NULL);
-
-	t->flags |= INUSE;
-	if (t->left != NULL)
-		markst(t->left);
-	if (t->right != NULL)
-		markst(t->right);
+    assert(t != NULL);
+
+    t->flags |= INUSE;
+    if (t->left != NULL) {
+	markst(t->left);
+    }
+    if (t->right != NULL) {
+	markst(t->right);
+    }
 }
-
+
 /*
  - cleanst - free any tree nodes not marked INUSE
- ^ static VOID cleanst(struct vars *);
+ ^ static void cleanst(struct vars *);
  */
-static VOID
-cleanst(v)
-struct vars *v;
+static void
+cleanst(
+    struct vars *v)
 {
-	struct subre *t;
-	struct subre *next;
+    struct subre *t;
+    struct subre *next;
 
-	for (t = v->treechain; t != NULL; t = next) {
-		next = t->chain;
-		if (!(t->flags&INUSE))
-			FREE(t);
+    for (t = v->treechain; t != NULL; t = next) {
+	next = t->chain;
+	if (!(t->flags&INUSE)) {
+	    FREE(t);
 	}
-	v->treechain = NULL;
-	v->treefree = NULL;		/* just on general principles */
+    }
+    v->treechain = NULL;
+    v->treefree = NULL;		/* just on general principles */
 }
-
+
 /*
  - nfatree - turn a subRE subtree into a tree of compacted NFAs
  ^ static long nfatree(struct vars *, struct subre *, FILE *);
  */
 static long			/* optimize results from top node */
-nfatree(v, t, f)
-struct vars *v;
-struct subre *t;
-FILE *f;			/* for debug output */
+nfatree(
+    struct vars *v,
+    struct subre *t,
+    FILE *f)			/* for debug output */
 {
-	assert(t != NULL && t->begin != NULL);
+    assert(t != NULL && t->begin != NULL);
 
-	if (t->left != NULL)
-		(DISCARD)nfatree(v, t->left, f);
-	if (t->right != NULL)
-		(DISCARD)nfatree(v, t->right, f);
+    if (t->left != NULL) {
+	(DISCARD) nfatree(v, t->left, f);
+    }
+    if (t->right != NULL) {
+	(DISCARD) nfatree(v, t->right, f);
+    }
 
-	return nfanode(v, t, f);
+    return nfanode(v, t, f);
 }
-
+
 /*
  - nfanode - do one NFA for nfatree
  ^ static long nfanode(struct vars *, struct subre *, FILE *);
  */
 static long			/* optimize results */
-nfanode(v, t, f)
-struct vars *v;
-struct subre *t;
-FILE *f;			/* for debug output */
+nfanode(
+    struct vars *v,
+    struct subre *t,
+    FILE *f)			/* for debug output */
 {
-	struct nfa *nfa;
-	long ret = 0;
-	char idbuf[50];
-
-	assert(t->begin != NULL);
-
-	if (f != NULL)
-		fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
-						stid(t, idbuf, sizeof(idbuf)));
-	nfa = newnfa(v, v->cm, v->nfa);
-	NOERRZ();
-	dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
-	if (!ISERR()) {
-		specialcolors(nfa);
-		ret = optimize(nfa, f);
-	}
-	if (!ISERR())
-		compact(nfa, &t->cnfa);
-
-	freenfa(nfa);
-	return ret;
+    struct nfa *nfa;
+    long ret = 0;
+    char idbuf[50];
+
+    assert(t->begin != NULL);
+
+    if (f != NULL) {
+	fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
+		stid(t, idbuf, sizeof(idbuf)));
+    }
+    nfa = newnfa(v, v->cm, v->nfa);
+    NOERRZ();
+    dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
+    if (!ISERR()) {
+	specialcolors(nfa);
+	ret = optimize(nfa, f);
+    }
+    if (!ISERR()) {
+	compact(nfa, &t->cnfa);
+    }
+
+    freenfa(nfa);
+    return ret;
 }
-
+
 /*
  - newlacon - allocate a lookahead-constraint subRE
  ^ static int newlacon(struct vars *, struct state *, struct state *, int);
  */
 static int			/* lacon number */
-newlacon(v, begin, end, pos)
-struct vars *v;
-struct state *begin;
-struct state *end;
-int pos;
+newlacon(
+    struct vars *v,
+    struct state *begin,
+    struct state *end,
+    int pos)
 {
-	int n;
-	struct subre *sub;
-
-	if (v->nlacons == 0) {
-		v->lacons = (struct subre *)MALLOC(2 * sizeof(struct subre));
-		n = 1;		/* skip 0th */
-		v->nlacons = 2;
-	} else {
-		v->lacons = (struct subre *)REALLOC(v->lacons,
-					(v->nlacons+1)*sizeof(struct subre));
-		n = v->nlacons++;
-	}
-	if (v->lacons == NULL) {
-		ERR(REG_ESPACE);
-		return 0;
-	}
-	sub = &v->lacons[n];
-	sub->begin = begin;
-	sub->end = end;
-	sub->subno = pos;
-	ZAPCNFA(sub->cnfa);
-	return n;
+    struct subre *sub;
+    int n;
+
+    if (v->nlacons == 0) {
+	v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
+	n = 1;		/* skip 0th */
+	v->nlacons = 2;
+    } else {
+	v->lacons = (struct subre *) REALLOC(v->lacons,
+		(v->nlacons+1)*sizeof(struct subre));
+	n = v->nlacons++;
+    }
+
+    if (v->lacons == NULL) {
+	ERR(REG_ESPACE);
+	return 0;
+    }
+
+    sub = &v->lacons[n];
+    sub->begin = begin;
+    sub->end = end;
+    sub->subno = pos;
+    ZAPCNFA(sub->cnfa);
+    return n;
 }
-
+
 /*
  - freelacons - free lookahead-constraint subRE vector
- ^ static VOID freelacons(struct subre *, int);
+ ^ static void freelacons(struct subre *, int);
  */
-static VOID
-freelacons(subs, n)
-struct subre *subs;
-int n;
+static void
+freelacons(
+    struct subre *subs,
+    int n)
 {
-	struct subre *sub;
-	int i;
-
-	assert(n > 0);
-	for (sub = subs + 1, i = n - 1; i > 0; sub++, i--)	/* no 0th */
-		if (!NULLCNFA(sub->cnfa))
-			freecnfa(&sub->cnfa);
-	FREE(subs);
-}
+    struct subre *sub;
+    int i;
 
+    assert(n > 0);
+    for (sub=subs+1, i=n-1; i>0; sub++, i--) {	/* no 0th */
+	if (!NULLCNFA(sub->cnfa)) {
+	    freecnfa(&sub->cnfa);
+	}
+    }
+    FREE(subs);
+}
+
 /*
  - rfree - free a whole RE (insides of regfree)
- ^ static VOID rfree(regex_t *);
+ ^ static void rfree(regex_t *);
  */
-static VOID
-rfree(re)
-regex_t *re;
+static void
+rfree(
+    regex_t *re)
 {
-	struct guts *g;
-
-	if (re == NULL || re->re_magic != REMAGIC)
-		return;
-
-	re->re_magic = 0;	/* invalidate RE */
-	g = (struct guts *)re->re_guts;
-	re->re_guts = NULL;
-	re->re_fns = NULL;
-	g->magic = 0;
-	freecm(&g->cmap);
-	if (g->tree != NULL)
-		freesubre((struct vars *)NULL, g->tree);
-	if (g->lacons != NULL)
-		freelacons(g->lacons, g->nlacons);
-	if (!NULLCNFA(g->search))
-		freecnfa(&g->search);
-	FREE(g);
+    struct guts *g;
+
+    if (re == NULL || re->re_magic != REMAGIC) {
+	return;
+    }
+
+    re->re_magic = 0;	/* invalidate RE */
+    g = (struct guts *) re->re_guts;
+    re->re_guts = NULL;
+    re->re_fns = NULL;
+    g->magic = 0;
+    freecm(&g->cmap);
+    if (g->tree != NULL) {
+	freesubre(NULL, g->tree);
+    }
+    if (g->lacons != NULL) {
+	freelacons(g->lacons, g->nlacons);
+    }
+    if (!NULLCNFA(g->search)) {
+	freecnfa(&g->search);
+    }
+    FREE(g);
 }
-
+
 /*
  - dump - dump an RE in human-readable form
- ^ static VOID dump(regex_t *, FILE *);
+ ^ static void dump(regex_t *, FILE *);
  */
-static VOID
-dump(re, f)
-regex_t *re;
-FILE *f;
+static void
+dump(
+    regex_t *re,
+    FILE *f)
 {
 #ifdef REG_DEBUG
-	struct guts *g;
-	int i;
-
-	if (re->re_magic != REMAGIC)
-		fprintf(f, "bad magic number (0x%x not 0x%x)\n", re->re_magic,
-								REMAGIC);
-	if (re->re_guts == NULL) {
-		fprintf(f, "NULL guts!!!\n");
-		return;
-	}
-	g = (struct guts *)re->re_guts;
-	if (g->magic != GUTSMAGIC)
-		fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic,
-								GUTSMAGIC);
-
-	fprintf(f, "\n\n\n========= DUMP ==========\n");
-	fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
-		re->re_nsub, re->re_info, re->re_csize, g->ntree);
-
-	dumpcolors(&g->cmap, f);
-	if (!NULLCNFA(g->search)) {
-		printf("\nsearch:\n");
-		dumpcnfa(&g->search, f);
-	}
-	for (i = 1; i < g->nlacons; i++) {
-		fprintf(f, "\nla%d (%s):\n", i,
-				(g->lacons[i].subno) ? "positive" : "negative");
-		dumpcnfa(&g->lacons[i].cnfa, f);
-	}
-	fprintf(f, "\n");
-	dumpst(g->tree, f, 0);
+    struct guts *g;
+    int i;
+
+    if (re->re_magic != REMAGIC) {
+	fprintf(f, "bad magic number (0x%x not 0x%x)\n",
+		re->re_magic, REMAGIC);
+    }
+    if (re->re_guts == NULL) {
+	fprintf(f, "NULL guts!!!\n");
+	return;
+    }
+    g = (struct guts *) re->re_guts;
+    if (g->magic != GUTSMAGIC) {
+	fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
+		g->magic, GUTSMAGIC);
+    }
+
+    fprintf(f, "\n\n\n========= DUMP ==========\n");
+    fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
+	    re->re_nsub, re->re_info, re->re_csize, g->ntree);
+
+    dumpcolors(&g->cmap, f);
+    if (!NULLCNFA(g->search)) {
+	printf("\nsearch:\n");
+	dumpcnfa(&g->search, f);
+    }
+    for (i = 1; i < g->nlacons; i++) {
+	fprintf(f, "\nla%d (%s):\n", i,
+		(g->lacons[i].subno) ? "positive" : "negative");
+	dumpcnfa(&g->lacons[i].cnfa, f);
+    }
+    fprintf(f, "\n");
+    dumpst(g->tree, f, 0);
 #endif
 }
-
+
 /*
  - dumpst - dump a subRE tree
- ^ static VOID dumpst(struct subre *, FILE *, int);
+ ^ static void dumpst(struct subre *, FILE *, int);
  */
-static VOID
-dumpst(t, f, nfapresent)
-struct subre *t;
-FILE *f;
-int nfapresent;			/* is the original NFA still around? */
+static void
+dumpst(
+    struct subre *t,
+    FILE *f,
+    int nfapresent)		/* is the original NFA still around? */
 {
-	if (t == NULL)
-		fprintf(f, "null tree\n");
-	else
-		stdump(t, f, nfapresent);
-	fflush(f);
+    if (t == NULL) {
+	fprintf(f, "null tree\n");
+    } else {
+	stdump(t, f, nfapresent);
+    }
+    fflush(f);
 }
-
+
 /*
  - stdump - recursive guts of dumpst
- ^ static VOID stdump(struct subre *, FILE *, int);
+ ^ static void stdump(struct subre *, FILE *, int);
  */
-static VOID
-stdump(t, f, nfapresent)
-struct subre *t;
-FILE *f;
-int nfapresent;			/* is the original NFA still around? */
+static void
+stdump(
+    struct subre *t,
+    FILE *f,
+    int nfapresent)		/* is the original NFA still around? */
 {
-	char idbuf[50];
-
-	fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
-	if (t->flags&LONGER)
-		fprintf(f, " longest");
-	if (t->flags&SHORTER)
-		fprintf(f, " shortest");
-	if (t->flags&MIXED)
-		fprintf(f, " hasmixed");
-	if (t->flags&CAP)
-		fprintf(f, " hascapture");
-	if (t->flags&BACKR)
-		fprintf(f, " hasbackref");
-	if (!(t->flags&INUSE))
-		fprintf(f, " UNUSED");
-	if (t->subno != 0)
-		fprintf(f, " (#%d)", t->subno);
-	if (t->min != 1 || t->max != 1) {
-		fprintf(f, " {%d,", t->min);
-		if (t->max != INFINITY)
-			fprintf(f, "%d", t->max);
-		fprintf(f, "}");
-	}
-	if (nfapresent)
-		fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
-	if (t->left != NULL)
-		fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
-	if (t->right != NULL)
-		fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
-	if (!NULLCNFA(t->cnfa)) {
-		fprintf(f, "\n");
-		dumpcnfa(&t->cnfa, f);
+    char idbuf[50];
+
+    fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
+    if (t->flags&LONGER) {
+	fprintf(f, " longest");
+    }
+    if (t->flags&SHORTER) {
+	fprintf(f, " shortest");
+    }
+    if (t->flags&MIXED) {
+	fprintf(f, " hasmixed");
+    }
+    if (t->flags&CAP) {
+	fprintf(f, " hascapture");
+    }
+    if (t->flags&BACKR) {
+	fprintf(f, " hasbackref");
+    }
+    if (!(t->flags&INUSE)) {
+	fprintf(f, " UNUSED");
+    }
+    if (t->subno != 0) {
+	fprintf(f, " (#%d)", t->subno);
+    }
+    if (t->min != 1 || t->max != 1) {
+	fprintf(f, " {%d,", t->min);
+	if (t->max != INFINITY) {
+	    fprintf(f, "%d", t->max);
 	}
+	fprintf(f, "}");
+    }
+    if (nfapresent) {
+	fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
+    }
+    if (t->left != NULL) {
+	fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
+    }
+    if (t->right != NULL) {
+	fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
+    }
+    if (!NULLCNFA(t->cnfa)) {
 	fprintf(f, "\n");
-	if (t->left != NULL)
-		stdump(t->left, f, nfapresent);
-	if (t->right != NULL)
-		stdump(t->right, f, nfapresent);
+	dumpcnfa(&t->cnfa, f);
+    }
+    fprintf(f, "\n");
+    if (t->left != NULL) {
+	stdump(t->left, f, nfapresent);
+    }
+    if (t->right != NULL) {
+	stdump(t->right, f, nfapresent);
+    }
 }
-
+
 /*
  - stid - identify a subtree node for dumping
- ^ static char *stid(struct subre *, char *, size_t);
+ ^ static const char *stid(struct subre *, char *, size_t);
  */
-static char *			/* points to buf or constant string */
-stid(t, buf, bufsize)
-struct subre *t;
-char *buf;
-size_t bufsize;
+static const char *			/* points to buf or constant string */
+stid(
+    struct subre *t,
+    char *buf,
+    size_t bufsize)
 {
-	/* big enough for hex int or decimal t->retry? */
-	if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1)
-		return "unable";
-	if (t->retry != 0)
-		sprintf(buf, "%d", t->retry);
-	else
-		sprintf(buf, "%p", t);
-	return buf;
+    /*
+     * Big enough for hex int or decimal t->retry?
+     */
+
+    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
+	return "unable";
+    }
+    if (t->retry != 0) {
+	sprintf(buf, "%d", t->retry);
+    } else {
+	sprintf(buf, "%p", t);
+    }
+    return buf;
 }
 
 #include "regc_lex.c"
@@ -2108,3 +2159,11 @@ size_t bufsize;
 #include "regc_nfa.c"
 #include "regc_cvec.c"
 #include "regc_locale.c"
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 5b6815c..57a2d47 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -1,22 +1,22 @@
 /*
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
- * Redistribution and use in source and binary forms -- with or without
- * modification -- are permitted for any purpose, provided that
- * redistributions in source form retain this entire copyright notice and
- * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms - with or without
+ * modification - are permitted for any purpose, provided that redistributions
+ * in source form retain this entire copyright notice and indicate the origin
+ * and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
  * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
@@ -26,23 +26,28 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-/* headers if any */
+/*
+ * Headers if any.
+ */
+
 #include "tclInt.h"
 
-/* overrides for regguts.h definitions, if any */
-#define	FUNCPTR(name, args)	(*name) _ANSI_ARGS_(args)
+/*
+ * Overrides for regguts.h definitions, if any.
+ */
+
+#define	FUNCPTR(name, args)	(*name)args
 #define	MALLOC(n)		ckalloc(n)
 #define	FREE(p)			ckfree(VS(p))
 #define	REALLOC(p,n)		ckrealloc(VS(p),n)
 
-
-
 /*
- * Do not insert extras between the "begin" and "end" lines -- this
- * chunk is automatically extracted to be fitted into regex.h.
+ * Do not insert extras between the "begin" and "end" lines - this chunk is
+ * automatically extracted to be fitted into regex.h.
  */
+
 /* --- begin --- */
-/* ensure certain things don't sneak in from system headers */
+/* Ensure certain things don't sneak in from system headers. */
 #ifdef __REG_WIDE_T
 #undef __REG_WIDE_T
 #endif
@@ -67,54 +72,90 @@
 #ifdef __REG_NOCHAR
 #undef __REG_NOCHAR
 #endif
-/* interface types */
+/* Interface types */
 #define	__REG_WIDE_T	Tcl_UniChar
-#define	__REG_REGOFF_T	long	/* not really right, but good enough... */
-#define	__REG_VOID_T	VOID
-#define	__REG_CONST	CONST
-/* names and declarations */
+#define	__REG_REGOFF_T	long	/* Not really right, but good enough... */
+#define	__REG_VOID_T	void
+#define	__REG_CONST	const
+/* Names and declarations */
 #define	__REG_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
-#define	__REG_NOFRONT		/* don't want regcomp() and regexec() */
-#define	__REG_NOCHAR		/* or the char versions */
+#define	__REG_NOFRONT		/* Don't want regcomp() and regexec() */
+#define	__REG_NOCHAR		/* Or the char versions */
 #define	regfree		TclReFree
 #define	regerror	TclReError
 /* --- end --- */
 
+/*
+ * Internal character type and related.
+ */
 
-
-/* internal character type and related */
-typedef Tcl_UniChar chr;	/* the type itself */
-typedef int pchr;		/* what it promotes to */
-typedef unsigned uchr;		/* unsigned type that will hold a chr */
-typedef int celt;		/* type to hold chr, MCCE number, or NOCELT */
-#define	NOCELT	(-1)		/* celt value which is not valid chr or MCCE */
-#define	CHR(c)	(UCHAR(c))	/* turn char literal into chr literal */
-#define	DIGITVAL(c)	((c)-'0')	/* turn chr digit into its value */
+typedef Tcl_UniChar chr;	/* The type itself. */
+typedef int pchr;		/* What it promotes to. */
+typedef unsigned uchr;		/* Unsigned type that will hold a chr. */
+typedef int celt;		/* Type to hold chr, or NOCELT */
+#define	NOCELT (-1)		/* Celt value which is not valid chr */
+#define	CHR(c) (UCHAR(c))	/* Turn char literal into chr literal */
+#define	DIGITVAL(c) ((c)-'0')	/* Turn chr digit into its value */
 #if TCL_UTF_MAX > 4
-#define	CHRBITS	32		/* bits in a chr; must not use sizeof */
-#define	CHR_MIN	0x00000000	/* smallest and largest chr; the value */
-#define	CHR_MAX	0xffffffff	/*  CHR_MAX-CHR_MIN+1 should fit in uchr */
+#define	CHRBITS	32		/* Bits in a chr; must not use sizeof */
+#define	CHR_MIN	0x00000000	/* Smallest and largest chr; the value */
+#define	CHR_MAX	0xffffffff	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
 #else
-#define	CHRBITS	16		/* bits in a chr; must not use sizeof */
-#define	CHR_MIN	0x0000		/* smallest and largest chr; the value */
-#define	CHR_MAX	0xffff		/*  CHR_MAX-CHR_MIN+1 should fit in uchr */
+#define	CHRBITS	16		/* Bits in a chr; must not use sizeof */
+#define	CHR_MIN	0x0000		/* Smallest and largest chr; the value */
+#define	CHR_MAX	0xffff		/* CHR_MAX-CHR_MIN+1 should fit in uchr */
 #endif
 
-/* functions operating on chr */
+/*
+ * Functions operating on chr.
+ */
+
 #define	iscalnum(x)	Tcl_UniCharIsAlnum(x)
 #define	iscalpha(x)	Tcl_UniCharIsAlpha(x)
 #define	iscdigit(x)	Tcl_UniCharIsDigit(x)
 #define	iscspace(x)	Tcl_UniCharIsSpace(x)
 
-/* name the external functions */
+/*
+ * Name the external functions.
+ */
+
 #define	compile		TclReComp
 #define	exec		TclReExec
 
-/* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
-#if 0		/* no debug unless requested by makefile */
+/*
+& Enable/disable debugging code (by whether REG_DEBUG is defined or not).
+*/
+
+#if 0				/* No debug unless requested by makefile. */
 #define	REG_DEBUG	/* */
 #endif
 
-/* and pick up the standard header */
+/*
+ * Method of allocating a local workspace. We used a thread-specific data
+ * space to store this because the regular expression engine is never
+ * reentered from the same thread; it doesn't make any callbacks.
+ */
+
+#if 1
+#define AllocVars(vPtr) \
+    static Tcl_ThreadDataKey varsKey; \
+    register struct vars *vPtr = (struct vars *) \
+	    Tcl_GetThreadData(&varsKey, sizeof(struct vars))
+#else
+/*
+ * This strategy for allocating workspace is "more proper" in some sense, but
+ * quite a bit slower. Using TSD (as above) leads to code that is quite a bit
+ * faster in practice (measured!)
+ */
+#define AllocVars(vPtr) \
+    register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars))
+#define FreeVars(vPtr) \
+    FREE(vPtr)
+#endif
+
+/*
+ * And pick up the standard header.
+ */
+
 #include "regex.h"
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index bc391fd..e233680 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -3,20 +3,20 @@
  * This file is #included by regexec.c.
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
+ *
  * I'd appreciate being given credit for this package in the documentation
  * of software which uses it, but that is not a requirement.
- * 
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -29,521 +29,620 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
  */
-
+
 /*
  - longest - longest-preferred matching engine
  ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
  */
 static chr *			/* endpoint, or NULL */
-longest(v, d, start, stop, hitstopp)
-struct vars *v;			/* used only for debug and exec flags */
-struct dfa *d;
-chr *start;			/* where the match should start */
-chr *stop;			/* match must end at or before here */
-int *hitstopp;			/* record whether hit v->stop, if non-NULL */
+longest(
+    struct vars *v,		/* used only for debug and exec flags */
+    struct dfa *d,
+    chr *start,			/* where the match should start */
+    chr *stop,			/* match must end at or before here */
+    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
 {
-	chr *cp;
-	chr *realstop = (stop == v->stop) ? stop : stop + 1;
-	color co;
-	struct sset *css;
-	struct sset *ss;
-	chr *post;
-	int i;
-	struct colormap *cm = d->cm;
-
-	/* initialize */
-	css = initialize(v, d, start);
-	cp = start;
-	if (hitstopp != NULL)
-		*hitstopp = 0;
-
-	/* startup */
-	FDEBUG(("+++ startup +++\n"));
-	if (cp == v->start) {
-		co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
-		FDEBUG(("color %ld\n", (long)co));
-	} else {
-		co = GETCOLOR(cm, *(cp - 1));
-		FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
-	}
-	css = miss(v, d, css, co, cp, start);
-	if (css == NULL)
-		return NULL;
-	css->lastseen = cp;
-
-	/* main loop */
-	if (v->eflags&REG_FTRACE)
-		while (cp < realstop) {
-			FDEBUG(("+++ at c%d +++\n", css - d->ssets));
-			co = GETCOLOR(cm, *cp);
-			FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
-			ss = css->outs[co];
-			if (ss == NULL) {
-				ss = miss(v, d, css, co, cp+1, start);
-				if (ss == NULL)
-					break;	/* NOTE BREAK OUT */
-			}
-			cp++;
-			ss->lastseen = cp;
-			css = ss;
+    chr *cp;
+    chr *realstop = (stop == v->stop) ? stop : stop + 1;
+    color co;
+    struct sset *css;
+    struct sset *ss;
+    chr *post;
+    int i;
+    struct colormap *cm = d->cm;
+
+    /*
+     * Initialize.
+     */
+
+    css = initialize(v, d, start);
+    cp = start;
+    if (hitstopp != NULL) {
+	*hitstopp = 0;
+    }
+
+    /*
+     * Startup.
+     */
+
+    FDEBUG(("+++ startup +++\n"));
+    if (cp == v->start) {
+	co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+	FDEBUG(("color %ld\n", (long)co));
+    } else {
+	co = GETCOLOR(cm, *(cp - 1));
+	FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+    }
+    css = miss(v, d, css, co, cp, start);
+    if (css == NULL) {
+	return NULL;
+    }
+    css->lastseen = cp;
+
+    /*
+     * Main loop.
+     */
+
+    if (v->eflags&REG_FTRACE) {
+	while (cp < realstop) {
+	    FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+	    co = GETCOLOR(cm, *cp);
+	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+	    ss = css->outs[co];
+	    if (ss == NULL) {
+		ss = miss(v, d, css, co, cp+1, start);
+		if (ss == NULL) {
+		    break;	/* NOTE BREAK OUT */
 		}
-	else
-		while (cp < realstop) {
-			co = GETCOLOR(cm, *cp);
-			ss = css->outs[co];
-			if (ss == NULL) {
-				ss = miss(v, d, css, co, cp+1, start);
-				if (ss == NULL)
-					break;	/* NOTE BREAK OUT */
-			}
-			cp++;
-			ss->lastseen = cp;
-			css = ss;
+	    }
+	    cp++;
+	    ss->lastseen = cp;
+	    css = ss;
+	}
+    } else {
+	while (cp < realstop) {
+	    co = GETCOLOR(cm, *cp);
+	    ss = css->outs[co];
+	    if (ss == NULL) {
+		ss = miss(v, d, css, co, cp+1, start);
+		if (ss == NULL) {
+		    break;	/* NOTE BREAK OUT */
 		}
+	    }
+	    cp++;
+	    ss->lastseen = cp;
+	    css = ss;
+	}
+    }
 
-	/* shutdown */
-	FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
-	if (cp == v->stop && stop == v->stop) {
-		if (hitstopp != NULL)
-			*hitstopp = 1;
-		co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
-		FDEBUG(("color %ld\n", (long)co));
-		ss = miss(v, d, css, co, cp, start);
-		/* special case:  match ended at eol? */
-		if (ss != NULL && (ss->flags&POSTSTATE))
-			return cp;
-		else if (ss != NULL)
-			ss->lastseen = cp;	/* to be tidy */
+    /*
+     * Shutdown.
+     */
+
+    FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+    if (cp == v->stop && stop == v->stop) {
+	if (hitstopp != NULL) {
+	    *hitstopp = 1;
+	}
+	co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+	FDEBUG(("color %ld\n", (long)co));
+	ss = miss(v, d, css, co, cp, start);
+
+	/*
+	 * Special case: match ended at eol?
+	 */
+
+	if (ss != NULL && (ss->flags&POSTSTATE)) {
+	    return cp;
+	} else if (ss != NULL) {
+	    ss->lastseen = cp;	/* to be tidy */
 	}
+    }
 
-	/* find last match, if any */
-	post = d->lastpost;
-	for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
-		if ((ss->flags&POSTSTATE) && post != ss->lastseen &&
-					(post == NULL || post < ss->lastseen))
-			post = ss->lastseen;
-	if (post != NULL)		/* found one */
-		return post - 1;
+    /*
+     * Find last match, if any.
+     */
 
-	return NULL;
-}
+    post = d->lastpost;
+    for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) {
+	if ((ss->flags&POSTSTATE) && (post != ss->lastseen) &&
+		(post == NULL || post < ss->lastseen)) {
+	    post = ss->lastseen;
+	}
+    }
+    if (post != NULL) {		/* found one */
+	return post - 1;
+    }
 
+    return NULL;
+}
+
 /*
  - shortest - shortest-preferred matching engine
  ^ static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *,
  ^ 	chr **, int *);
  */
 static chr *			/* endpoint, or NULL */
-shortest(v, d, start, min, max, coldp, hitstopp)
-struct vars *v;
-struct dfa *d;
-chr *start;			/* where the match should start */
-chr *min;			/* match must end at or after here */
-chr *max;			/* match must end at or before here */
-chr **coldp;			/* store coldstart pointer here, if nonNULL */
-int *hitstopp;			/* record whether hit v->stop, if non-NULL */
+shortest(
+    struct vars *v,
+    struct dfa *d,
+    chr *start,			/* where the match should start */
+    chr *min,			/* match must end at or after here */
+    chr *max,			/* match must end at or before here */
+    chr **coldp,		/* store coldstart pointer here, if nonNULL */
+    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
 {
-	chr *cp;
-	chr *realmin = (min == v->stop) ? min : min + 1;
-	chr *realmax = (max == v->stop) ? max : max + 1;
-	color co;
-	struct sset *css;
-	struct sset *ss;
-	struct colormap *cm = d->cm;
-
-	/* initialize */
-	css = initialize(v, d, start);
-	cp = start;
-	if (hitstopp != NULL)
-		*hitstopp = 0;
-
-	/* startup */
-	FDEBUG(("--- startup ---\n"));
-	if (cp == v->start) {
-		co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
-		FDEBUG(("color %ld\n", (long)co));
-	} else {
-		co = GETCOLOR(cm, *(cp - 1));
-		FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
-	}
-	css = miss(v, d, css, co, cp, start);
-	if (css == NULL)
-		return NULL;
-	css->lastseen = cp;
-	ss = css;
-
-	/* main loop */
-	if (v->eflags&REG_FTRACE)
-		while (cp < realmax) {
-			FDEBUG(("--- at c%d ---\n", css - d->ssets));
-			co = GETCOLOR(cm, *cp);
-			FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
-			ss = css->outs[co];
-			if (ss == NULL) {
-				ss = miss(v, d, css, co, cp+1, start);
-				if (ss == NULL)
-					break;	/* NOTE BREAK OUT */
-			}
-			cp++;
-			ss->lastseen = cp;
-			css = ss;
-			if ((ss->flags&POSTSTATE) && cp >= realmin)
-				break;		/* NOTE BREAK OUT */
+    chr *cp;
+    chr *realmin = (min == v->stop) ? min : min + 1;
+    chr *realmax = (max == v->stop) ? max : max + 1;
+    color co;
+    struct sset *css;
+    struct sset *ss;
+    struct colormap *cm = d->cm;
+
+    /*
+     * Initialize.
+     */
+
+    css = initialize(v, d, start);
+    cp = start;
+    if (hitstopp != NULL) {
+	*hitstopp = 0;
+    }
+
+    /*
+     * Startup.
+     */
+
+    FDEBUG(("--- startup ---\n"));
+    if (cp == v->start) {
+	co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+	FDEBUG(("color %ld\n", (long)co));
+    } else {
+	co = GETCOLOR(cm, *(cp - 1));
+	FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+    }
+    css = miss(v, d, css, co, cp, start);
+    if (css == NULL) {
+	return NULL;
+    }
+    css->lastseen = cp;
+    ss = css;
+
+    /*
+     * Main loop.
+     */
+
+    if (v->eflags&REG_FTRACE) {
+	while (cp < realmax) {
+	    FDEBUG(("--- at c%d ---\n", css - d->ssets));
+	    co = GETCOLOR(cm, *cp);
+	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+	    ss = css->outs[co];
+	    if (ss == NULL) {
+		ss = miss(v, d, css, co, cp+1, start);
+		if (ss == NULL) {
+		    break;	/* NOTE BREAK OUT */
 		}
-	else
-		while (cp < realmax) {
-			co = GETCOLOR(cm, *cp);
-			ss = css->outs[co];
-			if (ss == NULL) {
-				ss = miss(v, d, css, co, cp+1, start);
-				if (ss == NULL)
-					break;	/* NOTE BREAK OUT */
-			}
-			cp++;
-			ss->lastseen = cp;
-			css = ss;
-			if ((ss->flags&POSTSTATE) && cp >= realmin)
-				break;		/* NOTE BREAK OUT */
+	    }
+	    cp++;
+	    ss->lastseen = cp;
+	    css = ss;
+	    if ((ss->flags&POSTSTATE) && cp >= realmin) {
+		break;		/* NOTE BREAK OUT */
+	    }
+	}
+    } else {
+	while (cp < realmax) {
+	    co = GETCOLOR(cm, *cp);
+	    ss = css->outs[co];
+	    if (ss == NULL) {
+		ss = miss(v, d, css, co, cp+1, start);
+		if (ss == NULL) {
+		    break;	/* NOTE BREAK OUT */
 		}
+	    }
+	    cp++;
+	    ss->lastseen = cp;
+	    css = ss;
+	    if ((ss->flags&POSTSTATE) && cp >= realmin) {
+		break;		/* NOTE BREAK OUT */
+	    }
+	}
+    }
 
-	if (ss == NULL)
-		return NULL;
-
-	if (coldp != NULL)	/* report last no-progress state set, if any */
-		*coldp = lastcold(v, d);
-
-	if ((ss->flags&POSTSTATE) && cp > min) {
-		assert(cp >= realmin);
-		cp--;
-	} else if (cp == v->stop && max == v->stop) {
-		co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
-		FDEBUG(("color %ld\n", (long)co));
-		ss = miss(v, d, css, co, cp, start);
-		/* match might have ended at eol */
-		if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL)
-			*hitstopp = 1;
+    if (ss == NULL) {
+	return NULL;
+    }
+
+    if (coldp != NULL) {	/* report last no-progress state set, if any */
+	*coldp = lastcold(v, d);
+    }
+
+    if ((ss->flags&POSTSTATE) && cp > min) {
+	assert(cp >= realmin);
+	cp--;
+    } else if (cp == v->stop && max == v->stop) {
+	co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+	FDEBUG(("color %ld\n", (long)co));
+	ss = miss(v, d, css, co, cp, start);
+
+	/*
+	 * Match might have ended at eol.
+	 */
+
+	if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL) {
+	    *hitstopp = 1;
 	}
+    }
 
-	if (ss == NULL || !(ss->flags&POSTSTATE))
-		return NULL;
+    if (ss == NULL || !(ss->flags&POSTSTATE)) {
+	return NULL;
+    }
 
-	return cp;
+    return cp;
 }
-
+
 /*
  - lastcold - determine last point at which no progress had been made
  ^ static chr *lastcold(struct vars *, struct dfa *);
  */
 static chr *			/* endpoint, or NULL */
-lastcold(v, d)
-struct vars *v;
-struct dfa *d;
+lastcold(
+    struct vars *v,
+    struct dfa *d)
 {
-	struct sset *ss;
-	chr *nopr;
-	int i;
-
-	nopr = d->lastnopr;
-	if (nopr == NULL)
-		nopr = v->start;
-	for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
-		if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen)
-			nopr = ss->lastseen;
-	return nopr;
+    struct sset *ss;
+    chr *nopr;
+    int i;
+
+    nopr = d->lastnopr;
+    if (nopr == NULL) {
+	nopr = v->start;
+    }
+    for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) {
+	if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen) {
+	    nopr = ss->lastseen;
+	}
+    }
+    return nopr;
 }
-
+
 /*
  - newdfa - set up a fresh DFA
  ^ static struct dfa *newdfa(struct vars *, struct cnfa *,
  ^ 	struct colormap *, struct smalldfa *);
  */
 static struct dfa *
-newdfa(v, cnfa, cm, small)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
-struct smalldfa *small;		/* preallocated space, may be NULL */
+newdfa(
+    struct vars *v,
+    struct cnfa *cnfa,
+    struct colormap *cm,
+    struct smalldfa *sml)	/* preallocated space, may be NULL */
 {
-	struct dfa *d;
-	size_t nss = cnfa->nstates * 2;
-	int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
-	struct smalldfa *smallwas = small;
-
-	assert(cnfa != NULL && cnfa->nstates != 0);
-
-	if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
-		assert(wordsper == 1);
-		if (small == NULL) {
-			small = (struct smalldfa *)MALLOC(
-						sizeof(struct smalldfa));
-			if (small == NULL) {
-				ERR(REG_ESPACE);
-				return NULL;
-			}
-		}
-		d = &small->dfa;
-		d->ssets = small->ssets;
-		d->statesarea = small->statesarea;
-		d->work = &d->statesarea[nss];
-		d->outsarea = small->outsarea;
-		d->incarea = small->incarea;
-		d->cptsmalloced = 0;
-		d->mallocarea = (smallwas == NULL) ? (char *)small : NULL;
-	} else {
-		d = (struct dfa *)MALLOC(sizeof(struct dfa));
-		if (d == NULL) {
-			ERR(REG_ESPACE);
-			return NULL;
-		}
-		d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
-		d->statesarea = (unsigned *)MALLOC((nss+WORK) * wordsper *
-							sizeof(unsigned));
-		d->work = &d->statesarea[nss * wordsper];
-		d->outsarea = (struct sset **)MALLOC(nss * cnfa->ncolors *
-							sizeof(struct sset *));
-		d->incarea = (struct arcp *)MALLOC(nss * cnfa->ncolors *
-							sizeof(struct arcp));
-		d->cptsmalloced = 1;
-		d->mallocarea = (char *)d;
-		if (d->ssets == NULL || d->statesarea == NULL ||
-				d->outsarea == NULL || d->incarea == NULL) {
-			freedfa(d);
-			ERR(REG_ESPACE);
-			return NULL;
-		}
+    struct dfa *d;
+    size_t nss = cnfa->nstates * 2;
+    int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
+    struct smalldfa *smallwas = sml;
+
+    assert(cnfa != NULL && cnfa->nstates != 0);
+
+    if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
+	assert(wordsper == 1);
+	if (sml == NULL) {
+	    sml = (struct smalldfa *) MALLOC(sizeof(struct smalldfa));
+	    if (sml == NULL) {
+		ERR(REG_ESPACE);
+		return NULL;
+	    }
 	}
-
-	d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
-	d->nssused = 0;
-	d->nstates = cnfa->nstates;
-	d->ncolors = cnfa->ncolors;
-	d->wordsper = wordsper;
-	d->cnfa = cnfa;
-	d->cm = cm;
-	d->lastpost = NULL;
-	d->lastnopr = NULL;
-	d->search = d->ssets;
-
-	/* initialization of sset fields is done as needed */
-
-	return d;
+	d = &sml->dfa;
+	d->ssets = sml->ssets;
+	d->statesarea = sml->statesarea;
+	d->work = &d->statesarea[nss];
+	d->outsarea = sml->outsarea;
+	d->incarea = sml->incarea;
+	d->cptsmalloced = 0;
+	d->mallocarea = (smallwas == NULL) ? (char *)sml : NULL;
+    } else {
+	d = (struct dfa *)MALLOC(sizeof(struct dfa));
+	if (d == NULL) {
+	    ERR(REG_ESPACE);
+	    return NULL;
+	}
+	d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
+	d->statesarea = (unsigned *)
+		MALLOC((nss+WORK) * wordsper * sizeof(unsigned));
+	d->work = &d->statesarea[nss * wordsper];
+	d->outsarea = (struct sset **)
+		MALLOC(nss * cnfa->ncolors * sizeof(struct sset *));
+	d->incarea = (struct arcp *)
+		MALLOC(nss * cnfa->ncolors * sizeof(struct arcp));
+	d->cptsmalloced = 1;
+	d->mallocarea = (char *)d;
+	if (d->ssets == NULL || d->statesarea == NULL ||
+		d->outsarea == NULL || d->incarea == NULL) {
+	    freedfa(d);
+	    ERR(REG_ESPACE);
+	    return NULL;
+	}
+    }
+
+    d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
+    d->nssused = 0;
+    d->nstates = cnfa->nstates;
+    d->ncolors = cnfa->ncolors;
+    d->wordsper = wordsper;
+    d->cnfa = cnfa;
+    d->cm = cm;
+    d->lastpost = NULL;
+    d->lastnopr = NULL;
+    d->search = d->ssets;
+
+    /*
+     * Initialization of sset fields is done as needed.
+     */
+
+    return d;
 }
-
+
 /*
  - freedfa - free a DFA
- ^ static VOID freedfa(struct dfa *);
+ ^ static void freedfa(struct dfa *);
  */
-static VOID
-freedfa(d)
-struct dfa *d;
+static void
+freedfa(
+    struct dfa *d)
 {
-	if (d->cptsmalloced) {
-		if (d->ssets != NULL)
-			FREE(d->ssets);
-		if (d->statesarea != NULL)
-			FREE(d->statesarea);
-		if (d->outsarea != NULL)
-			FREE(d->outsarea);
-		if (d->incarea != NULL)
-			FREE(d->incarea);
+    if (d->cptsmalloced) {
+	if (d->ssets != NULL) {
+	    FREE(d->ssets);
+	}
+	if (d->statesarea != NULL) {
+	    FREE(d->statesarea);
+	}
+	if (d->outsarea != NULL) {
+	    FREE(d->outsarea);
 	}
+	if (d->incarea != NULL) {
+	    FREE(d->incarea);
+	}
+    }
 
-	if (d->mallocarea != NULL)
-		FREE(d->mallocarea);
+    if (d->mallocarea != NULL) {
+	FREE(d->mallocarea);
+    }
 }
-
+
 /*
  - hash - construct a hash code for a bitvector
  * There are probably better ways, but they're more expensive.
  ^ static unsigned hash(unsigned *, int);
  */
 static unsigned
-hash(uv, n)
-unsigned *uv;
-int n;
+hash(
+    unsigned *uv,
+    int n)
 {
-	int i;
-	unsigned h;
-
-	h = 0;
-	for (i = 0; i < n; i++)
-		h ^= uv[i];
-	return h;
+    int i;
+    unsigned h;
+
+    h = 0;
+    for (i = 0; i < n; i++) {
+	h ^= uv[i];
+    }
+    return h;
 }
-
+
 /*
  - initialize - hand-craft a cache entry for startup, otherwise get ready
  ^ static struct sset *initialize(struct vars *, struct dfa *, chr *);
  */
 static struct sset *
-initialize(v, d, start)
-struct vars *v;			/* used only for debug flags */
-struct dfa *d;
-chr *start;
+initialize(
+    struct vars *v,		/* used only for debug flags */
+    struct dfa *d,
+    chr *start)
 {
-	struct sset *ss;
-	int i;
-
-	/* is previous one still there? */
-	if (d->nssused > 0 && (d->ssets[0].flags&STARTER))
-		ss = &d->ssets[0];
-	else {				/* no, must (re)build it */
-		ss = getvacant(v, d, start, start);
-		for (i = 0; i < d->wordsper; i++)
-			ss->states[i] = 0;
-		BSET(ss->states, d->cnfa->pre);
-		ss->hash = HASH(ss->states, d->wordsper);
-		assert(d->cnfa->pre != d->cnfa->post);
-		ss->flags = STARTER|LOCKED|NOPROGRESS;
-		/* lastseen dealt with below */
+    struct sset *ss;
+    int i;
+
+    /*
+     * Is previous one still there?
+     */
+
+    if (d->nssused > 0 && (d->ssets[0].flags&STARTER)) {
+	ss = &d->ssets[0];
+    } else {			/* no, must (re)build it */
+	ss = getvacant(v, d, start, start);
+	for (i = 0; i < d->wordsper; i++) {
+	    ss->states[i] = 0;
 	}
-
-	for (i = 0; i < d->nssused; i++)
-		d->ssets[i].lastseen = NULL;
-	ss->lastseen = start;		/* maybe untrue, but harmless */
-	d->lastpost = NULL;
-	d->lastnopr = NULL;
-	return ss;
+	BSET(ss->states, d->cnfa->pre);
+	ss->hash = HASH(ss->states, d->wordsper);
+	assert(d->cnfa->pre != d->cnfa->post);
+	ss->flags = STARTER|LOCKED|NOPROGRESS;
+
+	/*
+	 * lastseen dealt with below
+	 */
+    }
+
+    for (i = 0; i < d->nssused; i++) {
+	d->ssets[i].lastseen = NULL;
+    }
+    ss->lastseen = start;	/* maybe untrue, but harmless */
+    d->lastpost = NULL;
+    d->lastnopr = NULL;
+    return ss;
 }
-
+
 /*
  - miss - handle a cache miss
  ^ static struct sset *miss(struct vars *, struct dfa *, struct sset *,
  ^ 	pcolor, chr *, chr *);
  */
 static struct sset *		/* NULL if goes to empty set */
-miss(v, d, css, co, cp, start)
-struct vars *v;			/* used only for debug flags */
-struct dfa *d;
-struct sset *css;
-pcolor co;
-chr *cp;			/* next chr */
-chr *start;			/* where the attempt got started */
+miss(
+    struct vars *v,		/* used only for debug flags */
+    struct dfa *d,
+    struct sset *css,
+    pcolor co,
+    chr *cp,			/* next chr */
+    chr *start)			/* where the attempt got started */
 {
-	struct cnfa *cnfa = d->cnfa;
-	int i;
-	unsigned h;
-	struct carc *ca;
-	struct sset *p;
-	int ispost;
-	int noprogress;
-	int gotstate;
-	int dolacons;
-	int sawlacons;
-
-	/* for convenience, we can be called even if it might not be a miss */
-	if (css->outs[co] != NULL) {
-		FDEBUG(("hit\n"));
-		return css->outs[co];
-	}
-	FDEBUG(("miss\n"));
-
-	/* first, what set of states would we end up in? */
-	for (i = 0; i < d->wordsper; i++)
-		d->work[i] = 0;
-	ispost = 0;
-	noprogress = 1;
-	gotstate = 0;
-	for (i = 0; i < d->nstates; i++)
-		if (ISBSET(css->states, i))
-			for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++)
-				if (ca->co == co) {
-					BSET(d->work, ca->to);
-					gotstate = 1;
-					if (ca->to == cnfa->post)
-						ispost = 1;
-					if (!cnfa->states[ca->to]->co)
-						noprogress = 0;
-					FDEBUG(("%d -> %d\n", i, ca->to));
-				}
-	dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
-	sawlacons = 0;
-	while (dolacons) {		/* transitive closure */
-		dolacons = 0;
-		for (i = 0; i < d->nstates; i++)
-			if (ISBSET(d->work, i))
-				for (ca = cnfa->states[i]+1; ca->co != COLORLESS;
-									ca++) {
-					if (ca->co <= cnfa->ncolors)
-						continue; /* NOTE CONTINUE */
-					sawlacons = 1;
-					if (ISBSET(d->work, ca->to))
-						continue; /* NOTE CONTINUE */
-					if (!lacon(v, cnfa, cp, ca->co))
-						continue; /* NOTE CONTINUE */
-					BSET(d->work, ca->to);
-					dolacons = 1;
-					if (ca->to == cnfa->post)
-						ispost = 1;
-					if (!cnfa->states[ca->to]->co)
-						noprogress = 0;
-					FDEBUG(("%d :> %d\n", i, ca->to));
-				}
+    struct cnfa *cnfa = d->cnfa;
+    int i;
+    unsigned h;
+    struct carc *ca;
+    struct sset *p;
+    int ispost;
+    int noprogress;
+    int gotstate;
+    int dolacons;
+    int sawlacons;
+
+    /*
+     * For convenience, we can be called even if it might not be a miss.
+     */
+
+    if (css->outs[co] != NULL) {
+	FDEBUG(("hit\n"));
+	return css->outs[co];
+    }
+    FDEBUG(("miss\n"));
+
+    /*
+     * First, what set of states would we end up in?
+     */
+
+    for (i = 0; i < d->wordsper; i++) {
+	d->work[i] = 0;
+    }
+    ispost = 0;
+    noprogress = 1;
+    gotstate = 0;
+    for (i = 0; i < d->nstates; i++) {
+	if (ISBSET(css->states, i)) {
+	    for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+		if (ca->co == co) {
+		    BSET(d->work, ca->to);
+		    gotstate = 1;
+		    if (ca->to == cnfa->post) {
+			ispost = 1;
+		    }
+		    if (!cnfa->states[ca->to]->co) {
+			noprogress = 0;
+		    }
+		    FDEBUG(("%d -> %d\n", i, ca->to));
+		}
+	    }
 	}
-	if (!gotstate)
-		return NULL;
-	h = HASH(d->work, d->wordsper);
-
-	/* next, is that in the cache? */
-	for (p = d->ssets, i = d->nssused; i > 0; p++, i--)
-		if (HIT(h, d->work, p, d->wordsper)) {
-			FDEBUG(("cached c%d\n", p - d->ssets));
-			break;			/* NOTE BREAK OUT */
+    }
+    dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
+    sawlacons = 0;
+    while (dolacons) {		/* transitive closure */
+	dolacons = 0;
+	for (i = 0; i < d->nstates; i++) {
+	    if (ISBSET(d->work, i)) {
+		for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+		    if (ca->co <= cnfa->ncolors) {
+			continue; /* NOTE CONTINUE */
+		    }
+		    sawlacons = 1;
+		    if (ISBSET(d->work, ca->to)) {
+			continue; /* NOTE CONTINUE */
+		    }
+		    if (!lacon(v, cnfa, cp, ca->co)) {
+			continue; /* NOTE CONTINUE */
+		    }
+		    BSET(d->work, ca->to);
+		    dolacons = 1;
+		    if (ca->to == cnfa->post) {
+			ispost = 1;
+		    }
+		    if (!cnfa->states[ca->to]->co) {
+			noprogress = 0;
+		    }
+		    FDEBUG(("%d :> %d\n", i, ca->to));
 		}
-	if (i == 0) {		/* nope, need a new cache entry */
-		p = getvacant(v, d, cp, start);
-		assert(p != css);
-		for (i = 0; i < d->wordsper; i++)
-			p->states[i] = d->work[i];
-		p->hash = h;
-		p->flags = (ispost) ? POSTSTATE : 0;
-		if (noprogress)
-			p->flags |= NOPROGRESS;
-		/* lastseen to be dealt with by caller */
+	    }
 	}
-
-	if (!sawlacons) {		/* lookahead conds. always cache miss */
-		FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
-		css->outs[co] = p;
-		css->inchain[co] = p->ins;
-		p->ins.ss = css;
-		p->ins.co = (color)co;
+    }
+    if (!gotstate) {
+	return NULL;
+    }
+    h = HASH(d->work, d->wordsper);
+
+    /*
+     * Next, is that in the cache?
+     */
+
+    for (p = d->ssets, i = d->nssused; i > 0; p++, i--) {
+	 if (HIT(h, d->work, p, d->wordsper)) {
+	     FDEBUG(("cached c%d\n", p - d->ssets));
+	     break;			/* NOTE BREAK OUT */
+	 }
+    }
+    if (i == 0) {		/* nope, need a new cache entry */
+	p = getvacant(v, d, cp, start);
+	assert(p != css);
+	for (i = 0; i < d->wordsper; i++) {
+	    p->states[i] = d->work[i];
+	}
+	p->hash = h;
+	p->flags = (ispost) ? POSTSTATE : 0;
+	if (noprogress) {
+	    p->flags |= NOPROGRESS;
 	}
-	return p;
-}
 
+	/*
+	 * lastseen to be dealt with by caller
+	 */
+    }
+
+    if (!sawlacons) {		/* lookahead conds. always cache miss */
+	FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+	css->outs[co] = p;
+	css->inchain[co] = p->ins;
+	p->ins.ss = css;
+	p->ins.co = (color)co;
+    }
+    return p;
+}
+
 /*
  - lacon - lookahead-constraint checker for miss()
  ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
  */
 static int			/* predicate:  constraint satisfied? */
-lacon(v, pcnfa, cp, co)
-struct vars *v;
-struct cnfa *pcnfa;		/* parent cnfa */
-chr *cp;
-pcolor co;			/* "color" of the lookahead constraint */
+lacon(
+    struct vars *v,
+    struct cnfa *pcnfa,		/* parent cnfa */
+    chr *cp,
+    pcolor co)			/* "color" of the lookahead constraint */
 {
-	int n;
-	struct subre *sub;
-	struct dfa *d;
-	struct smalldfa sd;
-	chr *end;
-
-	n = co - pcnfa->ncolors;
-	assert(n < v->g->nlacons && v->g->lacons != NULL);
-	FDEBUG(("=== testing lacon %d\n", n));
-	sub = &v->g->lacons[n];
-	d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
-	if (d == NULL) {
-		ERR(REG_ESPACE);
-		return 0;
-	}
-	end = longest(v, d, cp, v->stop, (int *)NULL);
-	freedfa(d);
-	FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
-	return (sub->subno) ? (end != NULL) : (end == NULL);
+    int n;
+    struct subre *sub;
+    struct dfa *d;
+    struct smalldfa sd;
+    chr *end;
+
+    n = co - pcnfa->ncolors;
+    assert(n < v->g->nlacons && v->g->lacons != NULL);
+    FDEBUG(("=== testing lacon %d\n", n));
+    sub = &v->g->lacons[n];
+    d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
+    if (d == NULL) {
+	ERR(REG_ESPACE);
+	return 0;
+    }
+    end = longest(v, d, cp, v->stop, (int *)NULL);
+    freedfa(d);
+    FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
+    return (sub->subno) ? (end != NULL) : (end == NULL);
 }
-
+
 /*
  - getvacant - get a vacant state set
  * This routine clears out the inarcs and outarcs, but does not otherwise
@@ -551,127 +650,167 @@ pcolor co;			/* "color" of the lookahead constraint */
  ^ static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-getvacant(v, d, cp, start)
-struct vars *v;			/* used only for debug flags */
-struct dfa *d;
-chr *cp;
-chr *start;
+getvacant(
+    struct vars *v,		/* used only for debug flags */
+    struct dfa *d,
+    chr *cp,
+    chr *start)
 {
-	int i;
-	struct sset *ss;
-	struct sset *p;
-	struct arcp ap;
-	struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */
-	color co;
-
-	ss = pickss(v, d, cp, start);
-	assert(!(ss->flags&LOCKED));
-
-	/* clear out its inarcs, including self-referential ones */
-	ap = ss->ins;
-	while ((p = ap.ss) != NULL) {
-		co = ap.co;
-		FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
-		p->outs[co] = NULL;
-		ap = p->inchain[co];
-		p->inchain[co].ss = NULL;	/* paranoia */
+    int i;
+    struct sset *ss;
+    struct sset *p;
+    struct arcp ap;
+    struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */
+    color co;
+
+    ss = pickss(v, d, cp, start);
+    assert(!(ss->flags&LOCKED));
+
+    /*
+     * Clear out its inarcs, including self-referential ones.
+     */
+
+    ap = ss->ins;
+    while ((p = ap.ss) != NULL) {
+	co = ap.co;
+	FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+	p->outs[co] = NULL;
+	ap = p->inchain[co];
+	p->inchain[co].ss = NULL; /* paranoia */
+    }
+    ss->ins.ss = NULL;
+
+    /*
+     * Take it off the inarc chains of the ssets reached by its outarcs.
+     */
+
+    for (i = 0; i < d->ncolors; i++) {
+	p = ss->outs[i];
+	assert(p != ss);	/* not self-referential */
+	if (p == NULL) {
+	    continue;		/* NOTE CONTINUE */
 	}
-	ss->ins.ss = NULL;
-
-	/* take it off the inarc chains of the ssets reached by its outarcs */
-	for (i = 0; i < d->ncolors; i++) {
-		p = ss->outs[i];
-		assert(p != ss);		/* not self-referential */
-		if (p == NULL)
-			continue;		/* NOTE CONTINUE */
-		FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
-		if (p->ins.ss == ss && p->ins.co == i)
-			p->ins = ss->inchain[i];
-		else {
-			assert(p->ins.ss != NULL);
-			for (ap = p->ins; ap.ss != NULL &&
-						!(ap.ss == ss && ap.co == i);
-						ap = ap.ss->inchain[ap.co])
-				lastap = ap;
-			assert(ap.ss != NULL);
-			lastap.ss->inchain[lastap.co] = ss->inchain[i];
-		}
-		ss->outs[i] = NULL;
-		ss->inchain[i].ss = NULL;
+	FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+	if (p->ins.ss == ss && p->ins.co == i) {
+	    p->ins = ss->inchain[i];
+	} else {
+	    assert(p->ins.ss != NULL);
+	    for (ap = p->ins; ap.ss != NULL &&
+		    !(ap.ss == ss && ap.co == i);
+		    ap = ap.ss->inchain[ap.co]) {
+		lastap = ap;
+	    }
+	    assert(ap.ss != NULL);
+	    lastap.ss->inchain[lastap.co] = ss->inchain[i];
 	}
+	ss->outs[i] = NULL;
+	ss->inchain[i].ss = NULL;
+    }
 
-	/* if ss was a success state, may need to remember location */
-	if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
-			(d->lastpost == NULL || d->lastpost < ss->lastseen))
-		d->lastpost = ss->lastseen;
+    /*
+     * If ss was a success state, may need to remember location.
+     */
 
-	/* likewise for a no-progress state */
-	if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
-			(d->lastnopr == NULL || d->lastnopr < ss->lastseen))
-		d->lastnopr = ss->lastseen;
+    if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
+	    (d->lastpost == NULL || d->lastpost < ss->lastseen)) {
+	d->lastpost = ss->lastseen;
+    }
 
-	return ss;
-}
+    /*
+     * Likewise for a no-progress state.
+     */
 
+    if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
+	    (d->lastnopr == NULL || d->lastnopr < ss->lastseen)) {
+	d->lastnopr = ss->lastseen;
+    }
+
+    return ss;
+}
+
 /*
  - pickss - pick the next stateset to be used
  ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-pickss(v, d, cp, start)
-struct vars *v;			/* used only for debug flags */
-struct dfa *d;
-chr *cp;
-chr *start;
+pickss(
+    struct vars *v,		/* used only for debug flags */
+    struct dfa *d,
+    chr *cp,
+    chr *start)
 {
-	int i;
-	struct sset *ss;
-	struct sset *end;
-	chr *ancient;
-
-	/* shortcut for cases where cache isn't full */
-	if (d->nssused < d->nssets) {
-		i = d->nssused;
-		d->nssused++;
-		ss = &d->ssets[i];
-		FDEBUG(("new c%d\n", i));
-		/* set up innards */
-		ss->states = &d->statesarea[i * d->wordsper];
-		ss->flags = 0;
-		ss->ins.ss = NULL;
-		ss->ins.co = WHITE;		/* give it some value */
-		ss->outs = &d->outsarea[i * d->ncolors];
-		ss->inchain = &d->incarea[i * d->ncolors];
-		for (i = 0; i < d->ncolors; i++) {
-			ss->outs[i] = NULL;
-			ss->inchain[i].ss = NULL;
-		}
-		return ss;
+    int i;
+    struct sset *ss;
+    struct sset *end;
+    chr *ancient;
+
+    /*
+     * Shortcut for cases where cache isn't full.
+     */
+
+    if (d->nssused < d->nssets) {
+	i = d->nssused;
+	d->nssused++;
+	ss = &d->ssets[i];
+	FDEBUG(("new c%d\n", i));
+
+	/*
+	 * Set up innards.
+	 */
+
+	ss->states = &d->statesarea[i * d->wordsper];
+	ss->flags = 0;
+	ss->ins.ss = NULL;
+	ss->ins.co = WHITE;	/* give it some value */
+	ss->outs = &d->outsarea[i * d->ncolors];
+	ss->inchain = &d->incarea[i * d->ncolors];
+	for (i = 0; i < d->ncolors; i++) {
+	    ss->outs[i] = NULL;
+	    ss->inchain[i].ss = NULL;
+	}
+	return ss;
+    }
+
+    /*
+     * Look for oldest, or old enough anyway.
+     */
+
+    if (cp - start > d->nssets*2/3) {	/* oldest 33% are expendable */
+	ancient = cp - d->nssets*2/3;
+    } else {
+	ancient = start;
+    }
+    for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++) {
+	if ((ss->lastseen == NULL || ss->lastseen < ancient)
+		&& !(ss->flags&LOCKED)) {
+	    d->search = ss + 1;
+	    FDEBUG(("replacing c%d\n", ss - d->ssets));
+	    return ss;
 	}
+    }
+    for (ss = d->ssets, end = d->search; ss < end; ss++) {
+	if ((ss->lastseen == NULL || ss->lastseen < ancient)
+		&& !(ss->flags&LOCKED)) {
+	    d->search = ss + 1;
+	    FDEBUG(("replacing c%d\n", ss - d->ssets));
+	    return ss;
+	}
+    }
 
-	/* look for oldest, or old enough anyway */
-	if (cp - start > d->nssets*2/3)		/* oldest 33% are expendable */
-		ancient = cp - d->nssets*2/3;
-	else
-		ancient = start;
-	for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++)
-		if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
-							!(ss->flags&LOCKED)) {
-			d->search = ss + 1;
-			FDEBUG(("replacing c%d\n", ss - d->ssets));
-			return ss;
-		}
-	for (ss = d->ssets, end = d->search; ss < end; ss++)
-		if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
-							!(ss->flags&LOCKED)) {
-			d->search = ss + 1;
-			FDEBUG(("replacing c%d\n", ss - d->ssets));
-			return ss;
-		}
+    /*
+     * Nobody's old enough?!? -- something's really wrong.
+     */
 
-	/* nobody's old enough?!? -- something's really wrong */
-	FDEBUG(("can't find victim to replace!\n"));
-	assert(NOTREACHED);
-	ERR(REG_ASSERT);
-	return d->ssets;
+    FDEBUG(("can't find victim to replace!\n"));
+    assert(NOTREACHED);
+    ERR(REG_ASSERT);
+    return d->ssets;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regerror.c b/generic/regerror.c
index 6376e80..a1a0163 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -2,20 +2,20 @@
  * regerror - error-code expansion
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -31,79 +31,99 @@
 
 #include "regguts.h"
 
-/* unknown-error explanation */
-static CONST char unk[] = "*** unknown regex error code 0x%x ***";
+/*
+ * Unknown-error explanation.
+ */
+
+static const char unk[] = "*** unknown regex error code 0x%x ***";
+
+/*
+ * Struct to map among codes, code names, and explanations.
+ */
 
-/* struct to map among codes, code names, and explanations */
 static struct rerr {
-	int code;
-	char *name;
-	char *explain;
+    int code;
+    const char *name;
+    const char *explain;
 } rerrs[] = {
-	/* the actual table is built from regex.h */
-#	include "regerrs.h"
-	{ -1,	"",	"oops" },	/* explanation special-cased in code */
+    /* The actual table is built from regex.h */
+#include "regerrs.h"
+    { -1, "", "oops" },		/* explanation special-cased in code */
 };
-
+
 /*
  - regerror - the interface to error numbers
  */
 /* ARGSUSED */
-size_t				/* actual space needed (including NUL) */
-regerror(code, preg, errbuf, errbuf_size)
-int code;			/* error code, or REG_ATOI or REG_ITOA */
-CONST regex_t *preg;		/* associated regex_t (unused at present) */
-char *errbuf;			/* result buffer (unless errbuf_size==0) */
-size_t errbuf_size;		/* available space in errbuf, can be 0 */
+size_t				/* Actual space needed (including NUL) */
+regerror(
+    int code,			/* Error code, or REG_ATOI or REG_ITOA */
+    const regex_t *preg,	/* Associated regex_t (unused at present) */
+    char *errbuf,		/* Result buffer (unless errbuf_size==0) */
+    size_t errbuf_size)		/* Available space in errbuf, can be 0 */
 {
-	struct rerr *r;
-	char *msg;
-	char convbuf[sizeof(unk)+50];	/* 50 = plenty for int */
-	size_t len;
-	int icode;
+    struct rerr *r;
+    const char *msg;
+    char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
+    size_t len;
+    int icode;
 
-	switch (code) {
-	case REG_ATOI:		/* convert name to number */
-		for (r = rerrs; r->code >= 0; r++)
-			if (strcmp(r->name, errbuf) == 0)
-				break;
-		sprintf(convbuf, "%d", r->code);	/* -1 for unknown */
-		msg = convbuf;
+    switch (code) {
+    case REG_ATOI:		/* Convert name to number */
+	for (r = rerrs; r->code >= 0; r++) {
+	    if (strcmp(r->name, errbuf) == 0) {
 		break;
-	case REG_ITOA:		/* convert number to name */
-		icode = atoi(errbuf);	/* not our problem if this fails */
-		for (r = rerrs; r->code >= 0; r++)
-			if (r->code == icode)
-				break;
-		if (r->code >= 0)
-			msg = r->name;
-		else {			/* unknown; tell him the number */
-			sprintf(convbuf, "REG_%u", (unsigned)icode);
-			msg = convbuf;
-		}
+	    }
+	}
+	sprintf(convbuf, "%d", r->code); /* -1 for unknown */
+	msg = convbuf;
+	break;
+    case REG_ITOA:		/* Convert number to name */
+	icode = atoi(errbuf);	/* Not our problem if this fails */
+	for (r = rerrs; r->code >= 0; r++) {
+	    if (r->code == icode) {
 		break;
-	default:		/* a real, normal error code */
-		for (r = rerrs; r->code >= 0; r++)
-			if (r->code == code)
-				break;
-		if (r->code >= 0)
-			msg = r->explain;
-		else {			/* unknown; say so */
-			sprintf(convbuf, unk, code);
-			msg = convbuf;
-		}
+	    }
+	}
+	if (r->code >= 0) {
+	    msg = r->name;
+	} else {		/* Unknown; tell him the number */
+	    sprintf(convbuf, "REG_%u", (unsigned)icode);
+	    msg = convbuf;
+	}
+	break;
+    default:			/* A real, normal error code */
+	for (r = rerrs; r->code >= 0; r++) {
+	    if (r->code == code) {
 		break;
+	    }
+	}
+	if (r->code >= 0) {
+	    msg = r->explain;
+	} else {		/* Unknown; say so */
+	    sprintf(convbuf, unk, code);
+	    msg = convbuf;
 	}
+	break;
+    }
 
-	len = strlen(msg) + 1;		/* space needed, including NUL */
-	if (errbuf_size > 0) {
-		if (errbuf_size > len)
-			strcpy(errbuf, msg);
-		else {			/* truncate to fit */
-			strncpy(errbuf, msg, errbuf_size-1);
-			errbuf[errbuf_size-1] = '\0';
-		}
+    len = strlen(msg) + 1;	/* Space needed, including NUL */
+    if (errbuf_size > 0) {
+	if (errbuf_size > len) {
+	    strcpy(errbuf, msg);
+	} else {		/* Truncate to fit */
+	    strncpy(errbuf, msg, errbuf_size-1);
+	    errbuf[errbuf_size-1] = '\0';
 	}
+    }
 
-	return len;
+    return len;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regex.h b/generic/regex.h
index a35925a..fa86092 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -4,20 +4,20 @@
  * regular expressions
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
  *
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -30,38 +30,35 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
  *
- *
  * Prototypes etc. marked with "^" within comments get gathered up (and
- * possibly edited) by the regfwd program and inserted near the bottom of
- * this file.
+ * possibly edited) by the regfwd program and inserted near the bottom of this
+ * file.
  *
- * We offer the option of declaring one wide-character version of the
- * RE functions as well as the char versions.  To do that, define
- * __REG_WIDE_T to the type of wide characters (unfortunately, there
- * is no consensus that wchar_t is suitable) and __REG_WIDE_COMPILE and
- * __REG_WIDE_EXEC to the names to be used for the compile and execute
- * functions (suggestion:  re_Xcomp and re_Xexec, where X is a letter
- * suggestive of the wide type, e.g. re_ucomp and re_uexec for Unicode).
- * For cranky old compilers, it may be necessary to do something like:
+ * We offer the option of declaring one wide-character version of the RE
+ * functions as well as the char versions. To do that, define __REG_WIDE_T to
+ * the type of wide characters (unfortunately, there is no consensus that
+ * wchar_t is suitable) and __REG_WIDE_COMPILE and __REG_WIDE_EXEC to the
+ * names to be used for the compile and execute functions (suggestion:
+ * re_Xcomp and re_Xexec, where X is a letter suggestive of the wide type,
+ * e.g. re_ucomp and re_uexec for Unicode). For cranky old compilers, it may
+ * be necessary to do something like:
  * #define	__REG_WIDE_COMPILE(a,b,c,d)	re_Xcomp(a,b,c,d)
  * #define	__REG_WIDE_EXEC(a,b,c,d,e,f,g)	re_Xexec(a,b,c,d,e,f,g)
  * rather than just #defining the names as parameterless macros.
  *
  * For some specialized purposes, it may be desirable to suppress the
- * declarations of the "front end" functions, regcomp() and regexec(),
- * or of the char versions of the compile and execute functions.  To
- * suppress the front-end functions, define __REG_NOFRONT.  To suppress
- * the char versions, define __REG_NOCHAR.
+ * declarations of the "front end" functions, regcomp() and regexec(), or of
+ * the char versions of the compile and execute functions. To suppress the
+ * front-end functions, define __REG_NOFRONT. To suppress the char versions,
+ * define __REG_NOCHAR.
  *
  * The right place to do those defines (and some others you may want, see
- * below) would be <sys/types.h>.  If you don't have control of that file,
- * the right place to add your own defines to this file is marked below.
- * This is normally done automatically, by the makefile and regmkhdr, based
- * on the contents of regcustom.h.
+ * below) would be <sys/types.h>. If you don't have control of that file, the
+ * right place to add your own defines to this file is marked below. This is
+ * normally done automatically, by the makefile and regmkhdr, based on the
+ * contents of regcustom.h.
  */
 
-
-
 /*
  * voodoo for C++
  */
@@ -69,18 +66,15 @@
 extern "C" {
 #endif
 
-
-
 /*
  * Add your own defines, if needed, here.
  */
 
-
-
 /*
- * Location where a chunk of regcustom.h is automatically spliced into
- * this file (working from its prototype, regproto.h).
+ * Location where a chunk of regcustom.h is automatically spliced into this
+ * file (working from its prototype, regproto.h).
  */
+
 /* --- begin --- */
 /* ensure certain things don't sneak in from system headers */
 #ifdef __REG_WIDE_T
@@ -121,15 +115,14 @@ extern "C" {
 #define	regerror	TclReError
 /* --- end --- */
 
-
 /*
  * interface types etc.
  */
 
 /*
- * regoff_t has to be large enough to hold either off_t or ssize_t,
- * and must be signed; it's only a guess that long is suitable, so we
- * offer <sys/types.h> an override.
+ * regoff_t has to be large enough to hold either off_t or ssize_t, and must
+ * be signed; it's only a guess that long is suitable, so we offer
+ * <sys/types.h> an override.
  */
 #ifdef __REG_REGOFF_T
 typedef __REG_REGOFF_T regoff_t;
@@ -148,8 +141,8 @@ typedef void re_void;
 #endif
 
 /*
- * Also for benefit of old compilers, <sys/types.h> can supply a macro
- * which expands to a substitute for `const'.
+ * Also for benefit of old compilers, <sys/types.h> can supply a macro which
+ * expands to a substitute for `const'.
  */
 #ifndef __REG_CONST
 #define	__REG_CONST	const
@@ -163,43 +156,41 @@ typedef void re_void;
 
 /* the biggie, a compiled RE (or rather, a front end to same) */
 typedef struct {
-	int re_magic;		/* magic number */
-	size_t re_nsub;		/* number of subexpressions */
-	long re_info;		/* information about RE */
-#		define	REG_UBACKREF		000001
-#		define	REG_ULOOKAHEAD		000002
-#		define	REG_UBOUNDS		000004
-#		define	REG_UBRACES		000010
-#		define	REG_UBSALNUM		000020
-#		define	REG_UPBOTCH		000040
-#		define	REG_UBBS		000100
-#		define	REG_UNONPOSIX		000200
-#		define	REG_UUNSPEC		000400
-#		define	REG_UUNPORT		001000
-#		define	REG_ULOCALE		002000
-#		define	REG_UEMPTYMATCH		004000
-#		define	REG_UIMPOSSIBLE		010000
-#		define	REG_USHORTEST		020000
-	int re_csize;		/* sizeof(character) */
-	char *re_endp;		/* backward compatibility kludge */
-	/* the rest is opaque pointers to hidden innards */
-	char *re_guts;		/* `char *' is more portable than `void *' */
-	char *re_fns;
+    int re_magic;		/* magic number */
+    size_t re_nsub;		/* number of subexpressions */
+    long re_info;		/* information about RE */
+#define	REG_UBACKREF		000001
+#define	REG_ULOOKAHEAD		000002
+#define	REG_UBOUNDS		000004
+#define	REG_UBRACES		000010
+#define	REG_UBSALNUM		000020
+#define	REG_UPBOTCH		000040
+#define	REG_UBBS		000100
+#define	REG_UNONPOSIX		000200
+#define	REG_UUNSPEC		000400
+#define	REG_UUNPORT		001000
+#define	REG_ULOCALE		002000
+#define	REG_UEMPTYMATCH		004000
+#define	REG_UIMPOSSIBLE		010000
+#define	REG_USHORTEST		020000
+    int re_csize;		/* sizeof(character) */
+    char *re_endp;		/* backward compatibility kludge */
+    /* the rest is opaque pointers to hidden innards */
+    char *re_guts;		/* `char *' is more portable than `void *' */
+    char *re_fns;
 } regex_t;
 
 /* result reporting (may acquire more fields later) */
 typedef struct {
-	regoff_t rm_so;		/* start of substring */
-	regoff_t rm_eo;		/* end of substring */
+    regoff_t rm_so;		/* start of substring */
+    regoff_t rm_eo;		/* end of substring */
 } regmatch_t;
 
 /* supplementary control and reporting */
 typedef struct {
-	regmatch_t rm_extend;	/* see REG_EXPECT */
+    regmatch_t rm_extend;	/* see REG_EXPECT */
 } rm_detail_t;
 
-
-
 /*
  * compilation
  ^ #ifndef __REG_NOCHAR
@@ -231,8 +222,6 @@ typedef struct {
 #define	REG_FAKE	010000	/* none of your business :-) */
 #define	REG_PROGRESS	020000	/* none of your business :-) */
 
-
-
 /*
  * execution
  ^ #ifndef __REG_NOCHAR
@@ -254,23 +243,19 @@ typedef struct {
 #define	REG_MTRACE	0020	/* none of your business */
 #define	REG_SMALL	0040	/* none of your business */
 
-
-
 /*
  * misc generics (may be more functions here eventually)
  ^ re_void regfree(regex_t *);
  */
 
-
-
 /*
  * error reporting
  * Be careful if modifying the list of error codes -- the table used by
  * regerror() is generated automatically from this file!
  *
- * Note that there is no wide-char variant of regerror at this time; what
- * kind of character is used for error reports is independent of what kind
- * is used in matching.
+ * Note that there is no wide-char variant of regerror at this time; what kind
+ * of character is used for error reports is independent of what kind is used
+ * in matching.
  *
  ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
  */
@@ -297,8 +282,6 @@ typedef struct {
 #define	REG_ATOI	101	/* convert error-code name to number */
 #define	REG_ITOA	102	/* convert error-code number to name */
 
-
-
 /*
  * the prototypes, as possibly munched by regfwd
  */
@@ -306,30 +289,28 @@ typedef struct {
 /* automatically gathered by fwd; do not hand-edit */
 /* === regproto.h === */
 #ifndef __REG_NOCHAR
-int re_comp _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, int));
+int re_comp(regex_t *, __REG_CONST char *, size_t, int);
 #endif
 #ifndef __REG_NOFRONT
-int regcomp _ANSI_ARGS_((regex_t *, __REG_CONST char *, int));
+int regcomp(regex_t *, __REG_CONST char *, int);
 #endif
 #ifdef __REG_WIDE_T
-int __REG_WIDE_COMPILE _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int));
+MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
 #endif
 #ifndef __REG_NOCHAR
-int re_exec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
 #endif
 #ifndef __REG_NOFRONT
-int regexec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, regmatch_t [], int));
+int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
 #endif
 #ifdef __REG_WIDE_T
-int __REG_WIDE_EXEC _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
 #endif
-re_void regfree _ANSI_ARGS_((regex_t *));
-extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t));
+MODULE_SCOPE re_void regfree(regex_t *);
+MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
 /* automatically gathered by fwd; do not hand-edit */
 /* =====^!^===== end forwards =====^!^===== */
 
-
-
 /*
  * more C++ voodoo
  */
@@ -337,6 +318,4 @@ extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t))
 }
 #endif
 
-
-
 #endif
diff --git a/generic/regexec.c b/generic/regexec.c
index be459d3..c902209 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -2,20 +2,20 @@
  * re_*exec and friends - match REs
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -26,1015 +26,1181 @@
  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
  */
 
 #include "regguts.h"
 
+/*
+ * Lazy-DFA representation.
+ */
 
-
-/* lazy-DFA representation */
 struct arcp {			/* "pointer" to an outarc */
-	struct sset *ss;
-	color co;
+    struct sset *ss;
+    color co;
 };
 
 struct sset {			/* state set */
-	unsigned *states;	/* pointer to bitvector */
-	unsigned hash;		/* hash of bitvector */
-#		define	HASH(bv, nw)	(((nw) == 1) ? *(bv) : hash(bv, nw))
-#	define	HIT(h,bv,ss,nw)	((ss)->hash == (h) && ((nw) == 1 || \
-		memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
-	int flags;
-#		define	STARTER		01	/* the initial state set */
-#		define	POSTSTATE	02	/* includes the goal state */
-#		define	LOCKED		04	/* locked in cache */
-#		define	NOPROGRESS	010	/* zero-progress state set */
-	struct arcp ins;	/* chain of inarcs pointing here */
-	chr *lastseen;		/* last entered on arrival here */
-	struct sset **outs;	/* outarc vector indexed by color */
-	struct arcp *inchain;	/* chain-pointer vector for outarcs */
+    unsigned *states;		/* pointer to bitvector */
+    unsigned hash;		/* hash of bitvector */
+#define	HASH(bv, nw)	(((nw) == 1) ? *(bv) : hash(bv, nw))
+#define	HIT(h,bv,ss,nw)	((ss)->hash == (h) && ((nw) == 1 || \
+	memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
+    int flags;
+#define	STARTER		01	/* the initial state set */
+#define	POSTSTATE	02	/* includes the goal state */
+#define	LOCKED		04	/* locked in cache */
+#define	NOPROGRESS	010	/* zero-progress state set */
+    struct arcp ins;		/* chain of inarcs pointing here */
+    chr *lastseen;		/* last entered on arrival here */
+    struct sset **outs;		/* outarc vector indexed by color */
+    struct arcp *inchain;	/* chain-pointer vector for outarcs */
 };
 
 struct dfa {
-	int nssets;		/* size of cache */
-	int nssused;		/* how many entries occupied yet */
-	int nstates;		/* number of states */
-	int ncolors;		/* length of outarc and inchain vectors */
-	int wordsper;		/* length of state-set bitvectors */
-	struct sset *ssets;	/* state-set cache */
-	unsigned *statesarea;	/* bitvector storage */
-	unsigned *work;		/* pointer to work area within statesarea */
-	struct sset **outsarea;	/* outarc-vector storage */
-	struct arcp *incarea;	/* inchain storage */
-	struct cnfa *cnfa;
-	struct colormap *cm;
-	chr *lastpost;		/* location of last cache-flushed success */
-	chr *lastnopr;		/* location of last cache-flushed NOPROGRESS */
-	struct sset *search;	/* replacement-search-pointer memory */
-	int cptsmalloced;	/* were the areas individually malloced? */
-	char *mallocarea;	/* self, or master malloced area, or NULL */
+    int nssets;			/* size of cache */
+    int nssused;		/* how many entries occupied yet */
+    int nstates;		/* number of states */
+    int ncolors;		/* length of outarc and inchain vectors */
+    int wordsper;		/* length of state-set bitvectors */
+    struct sset *ssets;		/* state-set cache */
+    unsigned *statesarea;	/* bitvector storage */
+    unsigned *work;		/* pointer to work area within statesarea */
+    struct sset **outsarea;	/* outarc-vector storage */
+    struct arcp *incarea;	/* inchain storage */
+    struct cnfa *cnfa;
+    struct colormap *cm;
+    chr *lastpost;		/* location of last cache-flushed success */
+    chr *lastnopr;		/* location of last cache-flushed NOPROGRESS */
+    struct sset *search;	/* replacement-search-pointer memory */
+    int cptsmalloced;		/* were the areas individually malloced? */
+    char *mallocarea;		/* self, or master malloced area, or NULL */
 };
 
 #define	WORK	1		/* number of work bitvectors needed */
 
-/* setup for non-malloc allocation for small cases */
+/*
+ * Setup for non-malloc allocation for small cases.
+ */
+
 #define	FEWSTATES	20	/* must be less than UBITS */
 #define	FEWCOLORS	15
 struct smalldfa {
-	struct dfa dfa;
-	struct sset ssets[FEWSTATES*2];
-	unsigned statesarea[FEWSTATES*2 + WORK];
-	struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
-	struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
+    struct dfa dfa;
+    struct sset ssets[FEWSTATES*2];
+    unsigned statesarea[FEWSTATES*2 + WORK];
+    struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
+    struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
 };
 #define	DOMALLOC	((struct smalldfa *)NULL)	/* force malloc */
 
+/*
+ * Internal variables, bundled for easy passing around.
+ */
 
-
-/* internal variables, bundled for easy passing around */
 struct vars {
-	regex_t *re;
-	struct guts *g;
-	int eflags;		/* copies of arguments */
-	size_t nmatch;
-	regmatch_t *pmatch;
-	rm_detail_t *details;
-	chr *start;		/* start of string */
-	chr *stop;		/* just past end of string */
-	int err;		/* error code if any (0 none) */
-	regoff_t *mem;		/* memory vector for backtracking */
-	struct smalldfa dfa1;
-	struct smalldfa dfa2;
+    regex_t *re;
+    struct guts *g;
+    int eflags;			/* copies of arguments */
+    size_t nmatch;
+    regmatch_t *pmatch;
+    rm_detail_t *details;
+    chr *start;			/* start of string */
+    chr *stop;			/* just past end of string */
+    int err;			/* error code if any (0 none) */
+    regoff_t *mem;		/* memory vector for backtracking */
+    struct smalldfa dfa1;
+    struct smalldfa dfa2;
 };
-#define	VISERR(vv)	((vv)->err != 0)	/* have we seen an error yet? */
+#define	VISERR(vv) ((vv)->err != 0)	/* have we seen an error yet? */
 #define	ISERR()	VISERR(v)
-#define	VERR(vv,e)	(((vv)->err) ? (vv)->err : ((vv)->err = (e)))
-#define	ERR(e)	VERR(v, e)		/* record an error */
+#define	VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define	ERR(e)	VERR(v, e)	/* record an error */
 #define	NOERR()	{if (ISERR()) return v->err;}	/* if error seen, return it */
 #define	OFF(p)	((p) - v->start)
 #define	LOFF(p)	((long)OFF(p))
-
-
-
+
 /*
  * forward declarations
  */
 /* =====^!^===== begin forwards =====^!^===== */
 /* automatically gathered by fwd; do not hand-edit */
 /* === regexec.c === */
-int exec _ANSI_ARGS_((regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
-static int find _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
-static int cfind _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
-static int cfindloop _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **));
-static VOID zapsubs _ANSI_ARGS_((regmatch_t *, size_t));
-static VOID zapmem _ANSI_ARGS_((struct vars *, struct subre *));
-static VOID subset _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int dissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int condissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int altdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int cdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int ccondissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int crevdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int cbrdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
-static int caltdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+int exec(regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+static int find(struct vars *, struct cnfa *, struct colormap *);
+static int cfind(struct vars *, struct cnfa *, struct colormap *);
+static int cfindloop(struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **);
+static VOID zapsubs(regmatch_t *, size_t);
+static VOID zapmem(struct vars *, struct subre *);
+static VOID subset(struct vars *, struct subre *, chr *, chr *);
+static int dissect(struct vars *, struct subre *, chr *, chr *);
+static int condissect(struct vars *, struct subre *, chr *, chr *);
+static int altdissect(struct vars *, struct subre *, chr *, chr *);
+static int cdissect(struct vars *, struct subre *, chr *, chr *);
+static int ccondissect(struct vars *, struct subre *, chr *, chr *);
+static int crevdissect(struct vars *, struct subre *, chr *, chr *);
+static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
+static int caltdissect(struct vars *, struct subre *, chr *, chr *);
 /* === rege_dfa.c === */
-static chr *longest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, int *));
-static chr *shortest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *));
-static chr *lastcold _ANSI_ARGS_((struct vars *, struct dfa *));
-static struct dfa *newdfa _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct smalldfa *));
-static VOID freedfa _ANSI_ARGS_((struct dfa *));
-static unsigned hash _ANSI_ARGS_((unsigned *, int));
-static struct sset *initialize _ANSI_ARGS_((struct vars *, struct dfa *, chr *));
-static struct sset *miss _ANSI_ARGS_((struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *));
-static int lacon _ANSI_ARGS_((struct vars *, struct cnfa *, chr *, pcolor));
-static struct sset *getvacant _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
-static struct sset *pickss _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
+static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
+static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *);
+static chr *lastcold(struct vars *, struct dfa *);
+static struct dfa *newdfa(struct vars *, struct cnfa *, struct colormap *, struct smalldfa *);
+static VOID freedfa(struct dfa *);
+static unsigned hash(unsigned *, int);
+static struct sset *initialize(struct vars *, struct dfa *, chr *);
+static struct sset *miss(struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *);
+static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
+static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
+static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
 /* automatically gathered by fwd; do not hand-edit */
 /* =====^!^===== end forwards =====^!^===== */
-
-
-
+
 /*
  - exec - match regular expression
  ^ int exec(regex_t *, CONST chr *, size_t, rm_detail_t *,
  ^					size_t, regmatch_t [], int);
  */
 int
-exec(re, string, len, details, nmatch, pmatch, flags)
-regex_t *re;
-CONST chr *string;
-size_t len;
-rm_detail_t *details;
-size_t nmatch;
-regmatch_t pmatch[];
-int flags;
+exec(
+    regex_t *re,
+    CONST chr *string,
+    size_t len,
+    rm_detail_t *details,
+    size_t nmatch,
+    regmatch_t pmatch[],
+    int flags)
 {
-	struct vars var;
-	register struct vars *v = &var;
-	int st;
-	size_t n;
-	int backref;
-#	define	LOCALMAT	20
-	regmatch_t mat[LOCALMAT];
-#	define	LOCALMEM	40
-	regoff_t mem[LOCALMEM];
-
-	/* sanity checks */
-	if (re == NULL || string == NULL || re->re_magic != REMAGIC)
-		return REG_INVARG;
-	if (re->re_csize != sizeof(chr))
-		return REG_MIXED;
-
-	/* setup */
-	v->re = re;
-	v->g = (struct guts *)re->re_guts;
-	if ((v->g->cflags&REG_EXPECT) && details == NULL)
-		return REG_INVARG;
-	if (v->g->info&REG_UIMPOSSIBLE)
-		return REG_NOMATCH;
-	backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
-	v->eflags = flags;
-	if (v->g->cflags&REG_NOSUB)
-		nmatch = 0;		/* override client */
-	v->nmatch = nmatch;
-	if (backref) {
-		/* need work area */
-		if (v->g->nsub + 1 <= LOCALMAT)
-			v->pmatch = mat;
-		else
-			v->pmatch = (regmatch_t *)MALLOC((v->g->nsub + 1) *
-							sizeof(regmatch_t));
-		if (v->pmatch == NULL)
-			return REG_ESPACE;
-		v->nmatch = v->g->nsub + 1;
-	} else
-		v->pmatch = pmatch;
-	v->details = details;
-	v->start = (chr *)string;
-	v->stop = (chr *)string + len;
-	v->err = 0;
-	if (backref) {
-		/* need retry memory */
-		assert(v->g->ntree >= 0);
-		n = (size_t)v->g->ntree;
-		if (n <= LOCALMEM)
-			v->mem = mem;
-		else
-			v->mem = (regoff_t *)MALLOC(n*sizeof(regoff_t));
-		if (v->mem == NULL) {
-			if (v->pmatch != pmatch && v->pmatch != mat)
-				FREE(v->pmatch);
-			return REG_ESPACE;
-		}
-	} else
-		v->mem = NULL;
-
-	/* do it */
-	assert(v->g->tree != NULL);
-	if (backref)
-		st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
-	else
-		st = find(v, &v->g->tree->cnfa, &v->g->cmap);
-
-	/* copy (portion of) match vector over if necessary */
-	if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
-		zapsubs(pmatch, nmatch);
-		n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
-		memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+    AllocVars(v);
+    int st;
+    size_t n;
+    int backref;
+#define	LOCALMAT	20
+    regmatch_t mat[LOCALMAT];
+#define	LOCALMEM	40
+    regoff_t mem[LOCALMEM];
+
+    /*
+     * Sanity checks.
+     */
+
+    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
+	FreeVars(v);
+	return REG_INVARG;
+    }
+    if (re->re_csize != sizeof(chr)) {
+	FreeVars(v);
+	return REG_MIXED;
+    }
+
+    /*
+     * Setup.
+     */
+
+    v->re = re;
+    v->g = (struct guts *)re->re_guts;
+    if ((v->g->cflags&REG_EXPECT) && details == NULL) {
+	FreeVars(v);
+	return REG_INVARG;
+    }
+    if (v->g->info&REG_UIMPOSSIBLE) {
+	FreeVars(v);
+	return REG_NOMATCH;
+    }
+    backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
+    v->eflags = flags;
+    if (v->g->cflags&REG_NOSUB) {
+	nmatch = 0;		/* override client */
+    }
+    v->nmatch = nmatch;
+    if (backref) {
+	/*
+	 * Need work area.
+	 */
+
+	if (v->g->nsub + 1 <= LOCALMAT) {
+	    v->pmatch = mat;
+	} else {
+	    v->pmatch = (regmatch_t *)
+		    MALLOC((v->g->nsub + 1) * sizeof(regmatch_t));
 	}
-
-	/* clean up */
-	if (v->pmatch != pmatch && v->pmatch != mat)
+	if (v->pmatch == NULL) {
+	    FreeVars(v);
+	    return REG_ESPACE;
+	}
+	v->nmatch = v->g->nsub + 1;
+    } else {
+	v->pmatch = pmatch;
+    }
+    v->details = details;
+    v->start = (chr *)string;
+    v->stop = (chr *)string + len;
+    v->err = 0;
+    if (backref) {
+	/*
+	 * Need retry memory.
+	 */
+
+	assert(v->g->ntree >= 0);
+	n = (size_t)v->g->ntree;
+	if (n <= LOCALMEM) {
+	    v->mem = mem;
+	} else {
+	    v->mem = (regoff_t *) MALLOC(n*sizeof(regoff_t));
+	}
+	if (v->mem == NULL) {
+	    if (v->pmatch != pmatch && v->pmatch != mat) {
 		FREE(v->pmatch);
-	if (v->mem != NULL && v->mem != mem)
-		FREE(v->mem);
-	return st;
+	    }
+	    FreeVars(v);
+	    return REG_ESPACE;
+	}
+    } else {
+	v->mem = NULL;
+    }
+
+    /*
+     * Do it.
+     */
+
+    assert(v->g->tree != NULL);
+    if (backref) {
+	st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
+    } else {
+	st = find(v, &v->g->tree->cnfa, &v->g->cmap);
+    }
+
+    /*
+     * Copy (portion of) match vector over if necessary.
+     */
+
+    if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
+	zapsubs(pmatch, nmatch);
+	n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
+	memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+    }
+
+    /*
+     * Clean up.
+     */
+
+    if (v->pmatch != pmatch && v->pmatch != mat) {
+	FREE(v->pmatch);
+    }
+    if (v->mem != NULL && v->mem != mem) {
+	FREE(v->mem);
+    }
+    FreeVars(v);
+    return st;
 }
-
+
 /*
  - find - find a match for the main NFA (no-complications case)
  ^ static int find(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-find(v, cnfa, cm)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
+find(
+    struct vars *v,
+    struct cnfa *cnfa,
+    struct colormap *cm)
 {
-	struct dfa *s;
-	struct dfa *d;
-	chr *begin;
-	chr *end = NULL;
-	chr *cold;
-	chr *open;		/* open and close of range of possible starts */
-	chr *close;
-	int hitend;
-	int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
-
-	/* first, a shot with the search RE */
-	s = newdfa(v, &v->g->search, cm, &v->dfa1);
-	assert(!(ISERR() && s != NULL));
-	NOERR();
-	MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
-	cold = NULL;
-	close = shortest(v, s, v->start, v->start, v->stop, &cold, (int *)NULL);
-	freedfa(s);
-	NOERR();
-	if (v->g->cflags&REG_EXPECT) {
-		assert(v->details != NULL);
-		if (cold != NULL)
-			v->details->rm_extend.rm_so = OFF(cold);
-		else
-			v->details->rm_extend.rm_so = OFF(v->stop);
-		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+    struct dfa *s;
+    struct dfa *d;
+    chr *begin;
+    chr *end = NULL;
+    chr *cold;
+    chr *open;			/* Open and close of range of possible
+				 * starts */
+    chr *close;
+    int hitend;
+    int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
+
+    /*
+     * First, a shot with the search RE.
+     */
+
+    s = newdfa(v, &v->g->search, cm, &v->dfa1);
+    assert(!(ISERR() && s != NULL));
+    NOERR();
+    MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
+    cold = NULL;
+    close = shortest(v, s, v->start, v->start, v->stop, &cold, NULL);
+    freedfa(s);
+    NOERR();
+    if (v->g->cflags&REG_EXPECT) {
+	assert(v->details != NULL);
+	if (cold != NULL) {
+	    v->details->rm_extend.rm_so = OFF(cold);
+	} else {
+	    v->details->rm_extend.rm_so = OFF(v->stop);
+	}
+	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+    }
+    if (close == NULL) {	/* not found */
+	return REG_NOMATCH;
+    }
+    if (v->nmatch == 0) {	/* found, don't need exact location */
+	return REG_OKAY;
+    }
+
+    /*
+     * Find starting point and match.
+     */
+
+    assert(cold != NULL);
+    open = cold;
+    cold = NULL;
+    MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
+    d = newdfa(v, cnfa, cm, &v->dfa1);
+    assert(!(ISERR() && d != NULL));
+    NOERR();
+    for (begin = open; begin <= close; begin++) {
+	MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
+	if (shorter) {
+	    end = shortest(v, d, begin, begin, v->stop, NULL, &hitend);
+	} else {
+	    end = longest(v, d, begin, v->stop, &hitend);
 	}
-	if (close == NULL)		/* not found */
-		return REG_NOMATCH;
-	if (v->nmatch == 0)		/* found, don't need exact location */
-		return REG_OKAY;
-
-	/* find starting point and match */
-	assert(cold != NULL);
-	open = cold;
-	cold = NULL;
-	MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
-	d = newdfa(v, cnfa, cm, &v->dfa1);
-	assert(!(ISERR() && d != NULL));
 	NOERR();
-	for (begin = open; begin <= close; begin++) {
-		MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
-		if (shorter)
-			end = shortest(v, d, begin, begin, v->stop,
-							(chr **)NULL, &hitend);
-		else
-			end = longest(v, d, begin, v->stop, &hitend);
-		NOERR();
-		if (hitend && cold == NULL)
-			cold = begin;
-		if (end != NULL)
-			break;		/* NOTE BREAK OUT */
+	if (hitend && cold == NULL) {
+	    cold = begin;
 	}
-	assert(end != NULL);		/* search RE succeeded so loop should */
-	freedfa(d);
-
-	/* and pin down details */
-	assert(v->nmatch > 0);
-	v->pmatch[0].rm_so = OFF(begin);
-	v->pmatch[0].rm_eo = OFF(end);
-	if (v->g->cflags&REG_EXPECT) {
-		if (cold != NULL)
-			v->details->rm_extend.rm_so = OFF(cold);
-		else
-			v->details->rm_extend.rm_so = OFF(v->stop);
-		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+	if (end != NULL) {
+	    break;		/* NOTE BREAK OUT */
 	}
-	if (v->nmatch == 1)		/* no need for submatches */
-		return REG_OKAY;
-
-	/* submatches */
-	zapsubs(v->pmatch, v->nmatch);
-	return dissect(v, v->g->tree, begin, end);
+    }
+    assert(end != NULL);	/* search RE succeeded so loop should */
+    freedfa(d);
+
+    /*
+     * And pin down details.
+     */
+
+    assert(v->nmatch > 0);
+    v->pmatch[0].rm_so = OFF(begin);
+    v->pmatch[0].rm_eo = OFF(end);
+    if (v->g->cflags&REG_EXPECT) {
+	if (cold != NULL) {
+	    v->details->rm_extend.rm_so = OFF(cold);
+	} else {
+	    v->details->rm_extend.rm_so = OFF(v->stop);
+	}
+	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+    }
+    if (v->nmatch == 1) {	/* no need for submatches */
+	return REG_OKAY;
+    }
+
+    /*
+     * Submatches.
+     */
+
+    zapsubs(v->pmatch, v->nmatch);
+    return dissect(v, v->g->tree, begin, end);
 }
-
+
 /*
  - cfind - find a match for the main NFA (with complications)
  ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-cfind(v, cnfa, cm)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
+cfind(
+    struct vars *v,
+    struct cnfa *cnfa,
+    struct colormap *cm)
 {
-	struct dfa *s;
-	struct dfa *d;
-	chr *cold = NULL; /* silence gcc 4 warning */
-	int ret;
-
-	s = newdfa(v, &v->g->search, cm, &v->dfa1);
-	NOERR();
-	d = newdfa(v, cnfa, cm, &v->dfa2);
-	if (ISERR()) {
-		assert(d == NULL);
-		freedfa(s);
-		return v->err;
-	}
-
-	ret = cfindloop(v, cnfa, cm, d, s, &cold);
-
-	freedfa(d);
+    struct dfa *s;
+    struct dfa *d;
+    chr *cold = NULL; /* silence gcc 4 warning */
+    int ret;
+
+    s = newdfa(v, &v->g->search, cm, &v->dfa1);
+    NOERR();
+    d = newdfa(v, cnfa, cm, &v->dfa2);
+    if (ISERR()) {
+	assert(d == NULL);
 	freedfa(s);
-	NOERR();
-	if (v->g->cflags&REG_EXPECT) {
-		assert(v->details != NULL);
-		if (cold != NULL)
-			v->details->rm_extend.rm_so = OFF(cold);
-		else
-			v->details->rm_extend.rm_so = OFF(v->stop);
-		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+	return v->err;
+    }
+
+    ret = cfindloop(v, cnfa, cm, d, s, &cold);
+
+    freedfa(d);
+    freedfa(s);
+    NOERR();
+    if (v->g->cflags&REG_EXPECT) {
+	assert(v->details != NULL);
+	if (cold != NULL) {
+	    v->details->rm_extend.rm_so = OFF(cold);
+	} else {
+	    v->details->rm_extend.rm_so = OFF(v->stop);
 	}
-	return ret;
+	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+    }
+    return ret;
 }
-
+
 /*
  - cfindloop - the heart of cfind
  ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
  ^	struct dfa *, struct dfa *, chr **);
  */
 static int
-cfindloop(v, cnfa, cm, d, s, coldp)
-struct vars *v;
-struct cnfa *cnfa;
-struct colormap *cm;
-struct dfa *d;
-struct dfa *s;
-chr **coldp;			/* where to put coldstart pointer */
+cfindloop(
+    struct vars *v,
+    struct cnfa *cnfa,
+    struct colormap *cm,
+    struct dfa *d,
+    struct dfa *s,
+    chr **coldp)		/* where to put coldstart pointer */
 {
-	chr *begin;
-	chr *end;
-	chr *cold;
-	chr *open;		/* open and close of range of possible starts */
-	chr *close;
-	chr *estart;
-	chr *estop;
-	int er;
-	int shorter = v->g->tree->flags&SHORTER;
-	int hitend;
-
-	assert(d != NULL && s != NULL);
+    chr *begin;
+    chr *end;
+    chr *cold;
+    chr *open;			/* Open and close of range of possible
+				 * starts */
+    chr *close;
+    chr *estart;
+    chr *estop;
+    int er;
+    int shorter = v->g->tree->flags&SHORTER;
+    int hitend;
+
+    assert(d != NULL && s != NULL);
+    cold = NULL;
+    close = v->start;
+    do {
+	MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
+	close = shortest(v, s, close, close, v->stop, &cold, NULL);
+	if (close == NULL) {
+	    break;		/* NOTE BREAK */
+	}
+	assert(cold != NULL);
+	open = cold;
 	cold = NULL;
-	close = v->start;
-	do {
-		MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
-		close = shortest(v, s, close, close, v->stop, &cold, (int *)NULL);
-		if (close == NULL)
-			break;				/* NOTE BREAK */
-		assert(cold != NULL);
-		open = cold;
-		cold = NULL;
-		MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
-		for (begin = open; begin <= close; begin++) {
-			MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
-			estart = begin;
-			estop = v->stop;
-			for (;;) {
-				if (shorter)
-					end = shortest(v, d, begin, estart,
-						estop, (chr **)NULL, &hitend);
-				else
-					end = longest(v, d, begin, estop,
-								&hitend);
-				if (hitend && cold == NULL)
-					cold = begin;
-				if (end == NULL)
-					break;		/* NOTE BREAK OUT */
-				MDEBUG(("tentative end %ld\n", LOFF(end)));
-				zapsubs(v->pmatch, v->nmatch);
-				zapmem(v, v->g->tree);
-				er = cdissect(v, v->g->tree, begin, end);
-				if (er == REG_OKAY) {
-					if (v->nmatch > 0) {
-						v->pmatch[0].rm_so = OFF(begin);
-						v->pmatch[0].rm_eo = OFF(end);
-					}
-					*coldp = cold;
-					return REG_OKAY;
-				}
-				if (er != REG_NOMATCH) {
-					ERR(er);
-					return er;
-				}
-				if ((shorter) ? end == estop : end == begin) {
-					/* no point in trying again */
-					*coldp = cold;
-					return REG_NOMATCH;
-				}
-				/* go around and try again */
-				if (shorter)
-					estart = end + 1;
-				else
-					estop = end - 1;
-			}
+	MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
+	for (begin = open; begin <= close; begin++) {
+	    MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
+	    estart = begin;
+	    estop = v->stop;
+	    for (;;) {
+		if (shorter) {
+		    end = shortest(v, d, begin, estart, estop, NULL, &hitend);
+		} else {
+		    end = longest(v, d, begin, estop, &hitend);
+		}
+		if (hitend && cold == NULL) {
+		    cold = begin;
+		}
+		if (end == NULL) {
+		    break;	/* NOTE BREAK OUT */
 		}
-	} while (close < v->stop);
 
-	*coldp = cold;
-	return REG_NOMATCH;
-}
+		MDEBUG(("tentative end %ld\n", LOFF(end)));
+		zapsubs(v->pmatch, v->nmatch);
+		zapmem(v, v->g->tree);
+		er = cdissect(v, v->g->tree, begin, end);
+		if (er == REG_OKAY) {
+		    if (v->nmatch > 0) {
+			v->pmatch[0].rm_so = OFF(begin);
+			v->pmatch[0].rm_eo = OFF(end);
+		    }
+		    *coldp = cold;
+		    return REG_OKAY;
+		}
+		if (er != REG_NOMATCH) {
+		    ERR(er);
+		    return er;
+		}
+		if ((shorter) ? end == estop : end == begin) {
+		    /*
+		     * No point in trying again.
+		     */
+
+		    *coldp = cold;
+		    return REG_NOMATCH;
+		}
+
+		/*
+		 * Go around and try again
+		 */
+
+		if (shorter) {
+		    estart = end + 1;
+		} else {
+		    estop = end - 1;
+		}
+	    }
+	}
+    } while (close < v->stop);
 
+    *coldp = cold;
+    return REG_NOMATCH;
+}
+
 /*
  - zapsubs - initialize the subexpression matches to "no match"
  ^ static VOID zapsubs(regmatch_t *, size_t);
  */
-static VOID
-zapsubs(p, n)
-regmatch_t *p;
-size_t n;
+static void
+zapsubs(
+    regmatch_t *p,
+    size_t n)
 {
-	size_t i;
+    size_t i;
 
-	for (i = n-1; i > 0; i--) {
-		p[i].rm_so = -1;
-		p[i].rm_eo = -1;
-	}
+    for (i = n-1; i > 0; i--) {
+	p[i].rm_so = -1;
+	p[i].rm_eo = -1;
+    }
 }
-
+
 /*
  - zapmem - initialize the retry memory of a subtree to zeros
  ^ static VOID zapmem(struct vars *, struct subre *);
  */
-static VOID
-zapmem(v, t)
-struct vars *v;
-struct subre *t;
+static void
+zapmem(
+    struct vars *v,
+    struct subre *t)
 {
-	if (t == NULL)
-		return;
-
-	assert(v->mem != NULL);
-	v->mem[t->retry] = 0;
-	if (t->op == '(') {
-		assert(t->subno > 0);
-		v->pmatch[t->subno].rm_so = -1;
+    if (t == NULL) {
+	return;
+    }
+
+    assert(v->mem != NULL);
+    v->mem[t->retry] = 0;
+    if (t->op == '(') {
+	assert(t->subno > 0);
+	v->pmatch[t->subno].rm_so = -1;
 		v->pmatch[t->subno].rm_eo = -1;
-	}
-
-	if (t->left != NULL)
-		zapmem(v, t->left);
-	if (t->right != NULL)
-		zapmem(v, t->right);
+    }
+
+    if (t->left != NULL) {
+	zapmem(v, t->left);
+    }
+    if (t->right != NULL) {
+	zapmem(v, t->right);
+    }
 }
-
+
 /*
  - subset - set any subexpression relevant to a successful subre
  ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
  */
-static VOID
-subset(v, sub, begin, end)
-struct vars *v;
-struct subre *sub;
-chr *begin;
-chr *end;
+static void
+subset(
+    struct vars *v,
+    struct subre *sub,
+    chr *begin,
+    chr *end)
 {
-	int n = sub->subno;
+    int n = sub->subno;
 
-	assert(n > 0);
-	if ((size_t)n >= v->nmatch)
-		return;
+    assert(n > 0);
+    if ((size_t)n >= v->nmatch) {
+	return;
+    }
 
-	MDEBUG(("setting %d\n", n));
-	v->pmatch[n].rm_so = OFF(begin);
-	v->pmatch[n].rm_eo = OFF(end);
+    MDEBUG(("setting %d\n", n));
+    v->pmatch[n].rm_so = OFF(begin);
+    v->pmatch[n].rm_eo = OFF(end);
 }
-
+
 /*
  - dissect - determine subexpression matches (uncomplicated case)
  ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-dissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+dissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	assert(t != NULL);
-	MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
-
-	switch (t->op) {
-	case '=':		/* terminal node */
-		assert(t->left == NULL && t->right == NULL);
-		return REG_OKAY;	/* no action, parent did the work */
-		break;
-	case '|':		/* alternation */
-		assert(t->left != NULL);
-		return altdissect(v, t, begin, end);
-		break;
-	case 'b':		/* back ref -- shouldn't be calling us! */
-		return REG_ASSERT;
-		break;
-	case '.':		/* concatenation */
-		assert(t->left != NULL && t->right != NULL);
-		return condissect(v, t, begin, end);
-		break;
-	case '(':		/* capturing */
-		assert(t->left != NULL && t->right == NULL);
-		assert(t->subno > 0);
-		subset(v, t, begin, end);
-		return dissect(v, t->left, begin, end);
-		break;
-	default:
-		return REG_ASSERT;
-		break;
-	}
+    assert(t != NULL);
+    MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
+
+    switch (t->op) {
+    case '=':			/* terminal node */
+	assert(t->left == NULL && t->right == NULL);
+	return REG_OKAY;	/* no action, parent did the work */
+    case '|':			/* alternation */
+	assert(t->left != NULL);
+	return altdissect(v, t, begin, end);
+    case 'b':			/* back ref -- shouldn't be calling us! */
+	return REG_ASSERT;
+    case '.':			/* concatenation */
+	assert(t->left != NULL && t->right != NULL);
+	return condissect(v, t, begin, end);
+    case '(':			/* capturing */
+	assert(t->left != NULL && t->right == NULL);
+	assert(t->subno > 0);
+	subset(v, t, begin, end);
+	return dissect(v, t->left, begin, end);
+    default:
+	return REG_ASSERT;
+    }
 }
-
+
 /*
  - condissect - determine concatenation subexpression matches (uncomplicated)
  ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-condissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+condissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	struct dfa *d;
-	struct dfa *d2;
-	chr *mid;
-	int i;
-	int shorter = (t->left->flags&SHORTER) ? 1 : 0;
-	chr *stop = (shorter) ? end : begin;
-
-	assert(t->op == '.');
-	assert(t->left != NULL && t->left->cnfa.nstates > 0);
-	assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
-	NOERR();
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
-	if (ISERR()) {
-		assert(d2 == NULL);
-		freedfa(d);
-		return v->err;
+    struct dfa *d;
+    struct dfa *d2;
+    chr *mid;
+    int i;
+    int shorter = (t->left->flags&SHORTER) ? 1 : 0;
+    chr *stop = (shorter) ? end : begin;
+
+    assert(t->op == '.');
+    assert(t->left != NULL && t->left->cnfa.nstates > 0);
+    assert(t->right != NULL && t->right->cnfa.nstates > 0);
+
+    d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+    NOERR();
+    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
+    if (ISERR()) {
+	assert(d2 == NULL);
+	freedfa(d);
+	return v->err;
+    }
+
+    /*
+     * Pick a tentative midpoint.
+     */
+
+    if (shorter) {
+	mid = shortest(v, d, begin, begin, end, NULL, NULL);
+    } else {
+	mid = longest(v, d, begin, end, NULL);
+    }
+    if (mid == NULL) {
+	freedfa(d);
+	freedfa(d2);
+	return REG_ASSERT;
+    }
+    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+
+    /*
+     * Iterate until satisfaction or failure.
+     */
+
+    while (longest(v, d2, mid, end, NULL) != end) {
+	/*
+	 * That midpoint didn't work, find a new one.
+	 */
+
+	if (mid == stop) {
+	    /*
+	     * All possibilities exhausted!
+	     */
+
+	    MDEBUG(("no midpoint!\n"));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_ASSERT;
 	}
-
-	/* pick a tentative midpoint */
-	if (shorter)
-		mid = shortest(v, d, begin, begin, end, (chr **)NULL,
-								(int *)NULL);
-	else
-		mid = longest(v, d, begin, end, (int *)NULL);
-	if (mid == NULL) {
-		freedfa(d);
-		freedfa(d2);
-		return REG_ASSERT;
+	if (shorter) {
+	    mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
+	} else {
+	    mid = longest(v, d, begin, mid-1, NULL);
 	}
-	MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-
-	/* iterate until satisfaction or failure */
-	while (longest(v, d2, mid, end, (int *)NULL) != end) {
-		/* that midpoint didn't work, find a new one */
-		if (mid == stop) {
-			/* all possibilities exhausted! */
-			MDEBUG(("no midpoint!\n"));
-			freedfa(d);
-			freedfa(d2);
-			return REG_ASSERT;
-		}
-		if (shorter)
-			mid = shortest(v, d, begin, mid+1, end, (chr **)NULL,
-								(int *)NULL);
-		else
-			mid = longest(v, d, begin, mid-1, (int *)NULL);
-		if (mid == NULL) {
-			/* failed to find a new one! */
-			MDEBUG(("failed midpoint!\n"));
-			freedfa(d);
-			freedfa(d2);
-			return REG_ASSERT;
-		}
-		MDEBUG(("new midpoint %ld\n", LOFF(mid)));
+	if (mid == NULL) {
+	    /*
+	     * Failed to find a new one!
+	     */
+
+	    MDEBUG(("failed midpoint!\n"));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_ASSERT;
 	}
-
-	/* satisfaction */
-	MDEBUG(("successful\n"));
-	freedfa(d);
-	freedfa(d2);
-	i = dissect(v, t->left, begin, mid);
-	if (i != REG_OKAY)
-		return i;
-	return dissect(v, t->right, mid, end);
+	MDEBUG(("new midpoint %ld\n", LOFF(mid)));
+    }
+
+    /*
+     * Satisfaction.
+     */
+
+    MDEBUG(("successful\n"));
+    freedfa(d);
+    freedfa(d2);
+    i = dissect(v, t->left, begin, mid);
+    if (i != REG_OKAY) {
+	return i;
+    }
+    return dissect(v, t->right, mid, end);
 }
-
+
 /*
  - altdissect - determine alternative subexpression matches (uncomplicated)
  ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-altdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+altdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	struct dfa *d;
-	int i;
-
-	assert(t != NULL);
-	assert(t->op == '|');
-
-	for (i = 0; t != NULL; t = t->right, i++) {
-		MDEBUG(("trying %dth\n", i));
-		assert(t->left != NULL && t->left->cnfa.nstates > 0);
-		d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
-		if (ISERR())
-			return v->err;
-		if (longest(v, d, begin, end, (int *)NULL) == end) {
-			MDEBUG(("success\n"));
-			freedfa(d);
-			return dissect(v, t->left, begin, end);
-		}
-		freedfa(d);
+    struct dfa *d;
+    int i;
+
+    assert(t != NULL);
+    assert(t->op == '|');
+
+    for (i = 0; t != NULL; t = t->right, i++) {
+	MDEBUG(("trying %dth\n", i));
+	assert(t->left != NULL && t->left->cnfa.nstates > 0);
+	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+	if (ISERR()) {
+	    return v->err;
+	}
+	if (longest(v, d, begin, end, NULL) == end) {
+	    MDEBUG(("success\n"));
+	    freedfa(d);
+	    return dissect(v, t->left, begin, end);
 	}
-	return REG_ASSERT;	/* none of them matched?!? */
+	freedfa(d);
+    }
+    return REG_ASSERT;		/* none of them matched?!? */
 }
-
+
 /*
  - cdissect - determine subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, 
- * plus 1 so that 0 uniquely means "clean slate".
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
  ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-cdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+cdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	int er;
-
-	assert(t != NULL);
-	MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
-
-	switch (t->op) {
-	case '=':		/* terminal node */
-		assert(t->left == NULL && t->right == NULL);
-		return REG_OKAY;	/* no action, parent did the work */
-		break;
-	case '|':		/* alternation */
-		assert(t->left != NULL);
-		return caltdissect(v, t, begin, end);
-		break;
-	case 'b':		/* back ref -- shouldn't be calling us! */
-		assert(t->left == NULL && t->right == NULL);
-		return cbrdissect(v, t, begin, end);
-		break;
-	case '.':		/* concatenation */
-		assert(t->left != NULL && t->right != NULL);
-		return ccondissect(v, t, begin, end);
-		break;
-	case '(':		/* capturing */
-		assert(t->left != NULL && t->right == NULL);
-		assert(t->subno > 0);
-		er = cdissect(v, t->left, begin, end);
-		if (er == REG_OKAY)
-			subset(v, t, begin, end);
-		return er;
-		break;
-	default:
-		return REG_ASSERT;
-		break;
+    int er;
+
+    assert(t != NULL);
+    MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
+
+    switch (t->op) {
+    case '=':			/* terminal node */
+	assert(t->left == NULL && t->right == NULL);
+	return REG_OKAY;	/* no action, parent did the work */
+    case '|':			/* alternation */
+	assert(t->left != NULL);
+	return caltdissect(v, t, begin, end);
+    case 'b':			/* back ref -- shouldn't be calling us! */
+	assert(t->left == NULL && t->right == NULL);
+	return cbrdissect(v, t, begin, end);
+    case '.':			/* concatenation */
+	assert(t->left != NULL && t->right != NULL);
+	return ccondissect(v, t, begin, end);
+    case '(':			/* capturing */
+	assert(t->left != NULL && t->right == NULL);
+	assert(t->subno > 0);
+	er = cdissect(v, t->left, begin, end);
+	if (er == REG_OKAY) {
+	    subset(v, t, begin, end);
 	}
+	return er;
+    default:
+	return REG_ASSERT;
+    }
 }
-
+
 /*
  - ccondissect - concatenation subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, 
- * plus 1 so that 0 uniquely means "clean slate".
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
  ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-ccondissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+ccondissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	struct dfa *d;
-	struct dfa *d2;
-	chr *mid;
-	int er;
-
-	assert(t->op == '.');
-	assert(t->left != NULL && t->left->cnfa.nstates > 0);
-	assert(t->right != NULL && t->right->cnfa.nstates > 0);
+    struct dfa *d, *d2;
+    chr *mid;
+    int er;
+
+    assert(t->op == '.');
+    assert(t->left != NULL && t->left->cnfa.nstates > 0);
+    assert(t->right != NULL && t->right->cnfa.nstates > 0);
+
+    if (t->left->flags&SHORTER) { /* reverse scan */
+	return crevdissect(v, t, begin, end);
+    }
+
+    d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+    if (ISERR()) {
+	return v->err;
+    }
+    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
+    if (ISERR()) {
+	freedfa(d);
+	return v->err;
+    }
+    MDEBUG(("cconcat %d\n", t->retry));
 
-	if (t->left->flags&SHORTER)		/* reverse scan */
-		return crevdissect(v, t, begin, end);
+    /*
+     * Pick a tentative midpoint.
+     */
 
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
-	if (ISERR())
-		return v->err;
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
-	if (ISERR()) {
-		freedfa(d);
-		return v->err;
+    if (v->mem[t->retry] == 0) {
+	mid = longest(v, d, begin, end, NULL);
+	if (mid == NULL) {
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
 	}
-	MDEBUG(("cconcat %d\n", t->retry));
-
-	/* pick a tentative midpoint */
-	if (v->mem[t->retry] == 0) {
-		mid = longest(v, d, begin, end, (int *)NULL);
-		if (mid == NULL) {
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
+	MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+	v->mem[t->retry] = (mid - begin) + 1;
+    } else {
+	mid = begin + (v->mem[t->retry] - 1);
+	MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+    }
+
+    /*
+     * Iterate until satisfaction or failure.
+     */
+
+    for (;;) {
+	/*
+	 * Try this midpoint on for size.
+	 */
+
+	if (longest(v, d2, mid, end, NULL) == end) {
+	    er = cdissect(v, t->left, begin, mid);
+	    if (er == REG_OKAY) {
+		er = cdissect(v, t->right, mid, end);
+		if (er == REG_OKAY) {
+		    /*
+		     * Satisfaction.
+		     */
+		    
+		    MDEBUG(("successful\n"));
+		    freedfa(d);
+		    freedfa(d2);
+		    return REG_OKAY;
 		}
-		MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-		v->mem[t->retry] = (mid - begin) + 1;
-	} else {
-		mid = begin + (v->mem[t->retry] - 1);
-		MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+	    }
+	    if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
+		freedfa(d);
+		freedfa(d2);
+		return er;
+	    }
 	}
 
-	/* iterate until satisfaction or failure */
-	for (;;) {
-		/* try this midpoint on for size */
-		if (longest(v, d2, mid, end, NULL) == end) {
-			er = cdissect(v, t->left, begin, mid);
-			if (er == REG_OKAY) {
-				er = cdissect(v, t->right, mid, end);
-				if (er == REG_OKAY) {
-					/* satisfaction */
-					MDEBUG(("successful\n"));
-					freedfa(d);
-					freedfa(d2);
-					return REG_OKAY;
-				}
-			}
-			if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
-				freedfa(d);
-				freedfa(d2);
-				return er;
-			}
-		}
+	/*
+	 * That midpoint didn't work, find a new one.
+	 */
 
-		/* that midpoint didn't work, find a new one */
-		if (mid == begin) {
-			/* all possibilities exhausted */
-			MDEBUG(("%d no midpoint\n", t->retry));
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
-		}
-		mid = longest(v, d, begin, mid-1, (int *)NULL);
-		if (mid == NULL) {
-			/* failed to find a new one */
-			MDEBUG(("%d failed midpoint\n", t->retry));
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
-		}
-		MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
-		v->mem[t->retry] = (mid - begin) + 1;
-		zapmem(v, t->left);
-		zapmem(v, t->right);
+	if (mid == begin) {
+	    /*
+	     * All possibilities exhausted.
+	     */
+
+	    MDEBUG(("%d no midpoint\n", t->retry));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
 	}
+	mid = longest(v, d, begin, mid-1, NULL);
+	if (mid == NULL) {
+	    /*
+	     * Failed to find a new one.
+	     */
+
+	    MDEBUG(("%d failed midpoint\n", t->retry));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
+	}
+	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+	v->mem[t->retry] = (mid - begin) + 1;
+	zapmem(v, t->left);
+	zapmem(v, t->right);
+    }
 }
-
+
 /*
  - crevdissect - determine backref shortest-first subexpression matches
- * The retry memory stores the offset of the trial midpoint from begin, 
- * plus 1 so that 0 uniquely means "clean slate".
+ * The retry memory stores the offset of the trial midpoint from begin, plus 1
+ * so that 0 uniquely means "clean slate".
  ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-crevdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+crevdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	struct dfa *d;
-	struct dfa *d2;
-	chr *mid;
-	int er;
+    struct dfa *d;
+    struct dfa *d2;
+    chr *mid;
+    int er;
+
+    assert(t->op == '.');
+    assert(t->left != NULL && t->left->cnfa.nstates > 0);
+    assert(t->right != NULL && t->right->cnfa.nstates > 0);
+    assert(t->left->flags&SHORTER);
+
+    /*
+     * Concatenation -- need to split the substring between parts.
+     */
+
+    d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+    if (ISERR()) {
+	return v->err;
+    }
+    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
+    if (ISERR()) {
+	freedfa(d);
+	return v->err;
+    }
+    MDEBUG(("crev %d\n", t->retry));
 
-	assert(t->op == '.');
-	assert(t->left != NULL && t->left->cnfa.nstates > 0);
-	assert(t->right != NULL && t->right->cnfa.nstates > 0);
-	assert(t->left->flags&SHORTER);
+    /*
+     * Pick a tentative midpoint.
+     */
 
-	/* concatenation -- need to split the substring between parts */
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
-	if (ISERR())
-		return v->err;
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
-	if (ISERR()) {
-		freedfa(d);
-		return v->err;
+    if (v->mem[t->retry] == 0) {
+	mid = shortest(v, d, begin, begin, end, NULL, NULL);
+	if (mid == NULL) {
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
 	}
-	MDEBUG(("crev %d\n", t->retry));
-
-	/* pick a tentative midpoint */
-	if (v->mem[t->retry] == 0) {
-		mid = shortest(v, d, begin, begin, end, (chr **)NULL, (int *)NULL);
-		if (mid == NULL) {
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
+	MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
+	v->mem[t->retry] = (mid - begin) + 1;
+    } else {
+	mid = begin + (v->mem[t->retry] - 1);
+	MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+    }
+
+    /*
+     * Iterate until satisfaction or failure.
+     */
+
+    for (;;) {
+	/*
+	 * Try this midpoint on for size.
+	 */
+
+	if (longest(v, d2, mid, end, NULL) == end) {
+	    er = cdissect(v, t->left, begin, mid);
+	    if (er == REG_OKAY) {
+		er = cdissect(v, t->right, mid, end);
+		if (er == REG_OKAY) {
+		    /*
+		     * Satisfaction.
+		     */
+
+		    MDEBUG(("successful\n"));
+		    freedfa(d);
+		    freedfa(d2);
+		    return REG_OKAY;
 		}
-		MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-		v->mem[t->retry] = (mid - begin) + 1;
-	} else {
-		mid = begin + (v->mem[t->retry] - 1);
-		MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+	    }
+	    if (er != REG_OKAY && er != REG_NOMATCH) {
+		freedfa(d);
+		freedfa(d2);
+		return er;
+	    }
 	}
 
-	/* iterate until satisfaction or failure */
-	for (;;) {
-		/* try this midpoint on for size */
-		if (longest(v, d2, mid, end, NULL) == end) {
-			er = cdissect(v, t->left, begin, mid);
-			if (er == REG_OKAY) {
-				er = cdissect(v, t->right, mid, end);
-				if (er == REG_OKAY) {
-					/* satisfaction */
-					MDEBUG(("successful\n"));
-					freedfa(d);
-					freedfa(d2);
-					return REG_OKAY;
-				}
-			}
-			if (er != REG_OKAY && er != REG_NOMATCH) {
-				freedfa(d);
-				freedfa(d2);
-				return er;
-			}
-		}
+	/*
+	 * That midpoint didn't work, find a new one.
+	 */
 
-		/* that midpoint didn't work, find a new one */
-		if (mid == end) {
-			/* all possibilities exhausted */
-			MDEBUG(("%d no midpoint\n", t->retry));
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
-		}
-		mid = shortest(v, d, begin, mid+1, end, (chr **)NULL, (int *)NULL);
-		if (mid == NULL) {
-			/* failed to find a new one */
-			MDEBUG(("%d failed midpoint\n", t->retry));
-			freedfa(d);
-			freedfa(d2);
-			return REG_NOMATCH;
-		}
-		MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
-		v->mem[t->retry] = (mid - begin) + 1;
-		zapmem(v, t->left);
-		zapmem(v, t->right);
+	if (mid == end) {
+	    /*
+	     * All possibilities exhausted.
+	     */
+
+	    MDEBUG(("%d no midpoint\n", t->retry));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
 	}
+	mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
+	if (mid == NULL) {
+	    /*
+	     * Failed to find a new one.
+	     */
+
+	    MDEBUG(("%d failed midpoint\n", t->retry));
+	    freedfa(d);
+	    freedfa(d2);
+	    return REG_NOMATCH;
+	}
+	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+	v->mem[t->retry] = (mid - begin) + 1;
+	zapmem(v, t->left);
+	zapmem(v, t->right);
+    }
 }
-
+
 /*
  - cbrdissect - determine backref subexpression matches
  ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-cbrdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+cbrdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	int i;
-	int n = t->subno;
-	size_t len;
-	chr *paren;
-	chr *p;
-	chr *stop;
-	int min = t->min;
-	int max = t->max;
-
-	assert(t != NULL);
-	assert(t->op == 'b');
-	assert(n >= 0);
-	assert((size_t)n < v->nmatch);
-
-	MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
-
-	if (v->pmatch[n].rm_so == -1)
-		return REG_NOMATCH;
-	paren = v->start + v->pmatch[n].rm_so;
-	len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
-
-	/* no room to maneuver -- retries are pointless */
-	if (v->mem[t->retry])
-		return REG_NOMATCH;
-	v->mem[t->retry] = 1;
-
-	/* special-case zero-length string */
-	if (len == 0) {
-		if (begin == end)
-			return REG_OKAY;
-		return REG_NOMATCH;
+    int i;
+    int n = t->subno;
+    size_t len;
+    chr *paren;
+    chr *p;
+    chr *stop;
+    int min = t->min;
+    int max = t->max;
+
+    assert(t != NULL);
+    assert(t->op == 'b');
+    assert(n >= 0);
+    assert((size_t)n < v->nmatch);
+
+    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
+
+    if (v->pmatch[n].rm_so == -1) {
+	return REG_NOMATCH;
+    }
+    paren = v->start + v->pmatch[n].rm_so;
+    len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
+
+    /*
+     * No room to maneuver -- retries are pointless.
+     */
+
+    if (v->mem[t->retry]) {
+	return REG_NOMATCH;
+    }
+    v->mem[t->retry] = 1;
+
+    /*
+     * Special-case zero-length string.
+     */
+
+    if (len == 0) {
+	if (begin == end) {
+	    return REG_OKAY;
 	}
+	return REG_NOMATCH;
+    }
+
+    /*
+     * And too-short string.
+     */
+
+    assert(end >= begin);
+    if ((size_t)(end - begin) < len) {
+	return REG_NOMATCH;
+    }
+    stop = end - len;
+
+    /*
+     * Count occurrences.
+     */
 
-	/* and too-short string */
-	assert(end >= begin);
-	if ((size_t)(end - begin) < len)
-		return REG_NOMATCH;
-	stop = end - len;
-
-	/* count occurrences */
-	i = 0;
-	for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
-		if ((*v->g->compare)(paren, p, len) != 0)
-				break;
-		i++;
+    i = 0;
+    for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
+	if ((*v->g->compare)(paren, p, len) != 0) {
+	    break;
 	}
-	MDEBUG(("cbackref found %d\n", i));
-
-	/* and sort it out */
-	if (p != end)			/* didn't consume all of it */
-		return REG_NOMATCH;
-	if (min <= i && (i <= max || max == INFINITY))
-		return REG_OKAY;
-	return REG_NOMATCH;		/* out of range */
-}
+	i++;
+    }
+    MDEBUG(("cbackref found %d\n", i));
 
+    /*
+     * And sort it out.
+     */
+
+    if (p != end) {		/* didn't consume all of it */
+	return REG_NOMATCH;
+    }
+    if (min <= i && (i <= max || max == INFINITY)) {
+	return REG_OKAY;
+    }
+    return REG_NOMATCH;		/* out of range */
+}
+
 /*
  - caltdissect - determine alternative subexpression matches (w. complications)
  ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-caltdissect(v, t, begin, end)
-struct vars *v;
-struct subre *t;
-chr *begin;			/* beginning of relevant substring */
-chr *end;			/* end of same */
+caltdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,			/* beginning of relevant substring */
+    chr *end)			/* end of same */
 {
-	struct dfa *d;
-	int er;
-#	define	UNTRIED	0	/* not yet tried at all */
-#	define	TRYING	1	/* top matched, trying submatches */
-#	define	TRIED	2	/* top didn't match or submatches exhausted */
-
-	if (t == NULL)
-		return REG_NOMATCH;
-	assert(t->op == '|');
-	if (v->mem[t->retry] == TRIED)
-		return caltdissect(v, t->right, begin, end);
-
-	MDEBUG(("calt n%d\n", t->retry));
-	assert(t->left != NULL);
+    struct dfa *d;
+    int er;
+#define	UNTRIED	0		/* not yet tried at all */
+#define	TRYING	1		/* top matched, trying submatches */
+#define	TRIED	2		/* top didn't match or submatches exhausted */
 
-	if (v->mem[t->retry] == UNTRIED) {
-		d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
-		if (ISERR())
-			return v->err;
-		if (longest(v, d, begin, end, (int *)NULL) != end) {
-			freedfa(d);
-			v->mem[t->retry] = TRIED;
-			return caltdissect(v, t->right, begin, end);
-		}
-		freedfa(d);
-		MDEBUG(("calt matched\n"));
-		v->mem[t->retry] = TRYING;
-	}
+    if (t == NULL) {
+	return REG_NOMATCH;
+    }
+    assert(t->op == '|');
+    if (v->mem[t->retry] == TRIED) {
+	return caltdissect(v, t->right, begin, end);
+    }
 
-	er = cdissect(v, t->left, begin, end);
-	if (er != REG_NOMATCH)
-		return er;
+    MDEBUG(("calt n%d\n", t->retry));
+    assert(t->left != NULL);
 
-	v->mem[t->retry] = TRIED;
-	return caltdissect(v, t->right, begin, end);
-}
+    if (v->mem[t->retry] == UNTRIED) {
+	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+	if (ISERR()) {
+	    return v->err;
+	}
+	if (longest(v, d, begin, end, NULL) != end) {
+	    freedfa(d);
+	    v->mem[t->retry] = TRIED;
+	    return caltdissect(v, t->right, begin, end);
+	}
+	freedfa(d);
+	MDEBUG(("calt matched\n"));
+	v->mem[t->retry] = TRYING;
+    }
 
+    er = cdissect(v, t->left, begin, end);
+    if (er != REG_NOMATCH) {
+	return er;
+    }
 
+    v->mem[t->retry] = TRIED;
+    return caltdissect(v, t->right, begin, end);
+}
 
 #include "rege_dfa.c"
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regfree.c b/generic/regfree.c
index 17a7389..b0aaa70 100644
--- a/generic/regfree.c
+++ b/generic/regfree.c
@@ -2,20 +2,20 @@
  * regfree - free an RE
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -27,13 +27,11 @@
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
- *
- *
- * You might think that this could be incorporated into regcomp.c, and
- * that would be a reasonable idea... except that this is a generic
- * function (with a generic name), applicable to all compiled REs
- * regardless of the size of their characters, whereas the stuff in
- * regcomp.c gets compiled once per character size.
+ * You might think that this could be incorporated into regcomp.c, and that
+ * would be a reasonable idea... except that this is a generic function (with
+ * a generic name), applicable to all compiled REs regardless of the size of
+ * their characters, whereas the stuff in regcomp.c gets compiled once per
+ * character size.
  */
 
 #include "regguts.h"
@@ -43,11 +41,20 @@
  *
  * Ignoring invocation with NULL is a convenience.
  */
-VOID
-regfree(re)
-regex_t *re;
+void
+regfree(
+    regex_t *re)
 {
-	if (re == NULL)
-		return;
-	(*((struct fns *)re->re_fns)->free)(re);
+    if (re == NULL) {
+	return;
+    }
+    (*((struct fns *)re->re_fns)->free)(re);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regfronts.c b/generic/regfronts.c
index 82f48e2..5003297 100644
--- a/generic/regfronts.c
+++ b/generic/regfronts.c
@@ -1,24 +1,24 @@
 /*
  * regcomp and regexec - front ends to re_ routines
  *
- * Mostly for implementation of backward-compatibility kludges.  Note
- * that these routines exist ONLY in char versions.
+ * Mostly for implementation of backward-compatibility kludges. Note that
+ * these routines exist ONLY in char versions.
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -29,55 +29,63 @@
  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
  */
 
 #include "regguts.h"
-
+
 /*
  - regcomp - compile regular expression
  */
 int
-regcomp(re, str, flags)
-regex_t *re;
-CONST char *str;
-int flags;
+regcomp(
+    regex_t *re,
+    CONST char *str,
+    int flags)
 {
-	size_t len;
-	int f = flags;
+    size_t len;
+    int f = flags;
 
-	if (f&REG_PEND) {
-		len = re->re_endp - str;
-		f &= ~REG_PEND;
-	} else
-		len = strlen(str);
+    if (f&REG_PEND) {
+	len = re->re_endp - str;
+	f &= ~REG_PEND;
+    } else {
+	len = strlen(str);
+    }
 
-	return re_comp(re, str, len, f);
+    return re_comp(re, str, len, f);
 }
-
+
 /*
  - regexec - execute regular expression
  */
 int
-regexec(re, str, nmatch, pmatch, flags)
-regex_t *re;
-CONST char *str;
-size_t nmatch;
-regmatch_t pmatch[];
-int flags;
+regexec(
+    regex_t *re,
+    CONST char *str,
+    size_t nmatch,
+    regmatch_t pmatch[],
+    int flags)
 {
-	CONST char *start;
-	size_t len;
-	int f = flags;
+    CONST char *start;
+    size_t len;
+    int f = flags;
 
-	if (f&REG_STARTEND) {
-		start = str + pmatch[0].rm_so;
-		len = pmatch[0].rm_eo - pmatch[0].rm_so;
-		f &= ~REG_STARTEND;
-	} else {
-		start = str;
-		len = strlen(str);
-	}
+    if (f & REG_STARTEND) {
+	start = str + pmatch[0].rm_so;
+	len = pmatch[0].rm_eo - pmatch[0].rm_so;
+	f &= ~REG_STARTEND;
+    } else {
+	start = str;
+	len = strlen(str);
+    }
 
-	return re_exec(re, start, len, nmatch, pmatch, f);
+    return re_exec(re, start, len, nmatch, pmatch, f);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/regguts.h b/generic/regguts.h
index c77a8fc..67e3d03 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -2,20 +2,20 @@
  * Internal interface definitions, etc., for the reg package
  *
  * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
  * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
@@ -28,17 +28,13 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-
-
 /*
- * Environmental customization.  It should not (I hope) be necessary to
- * alter the file you are now reading -- regcustom.h should handle it all,
- * given care here and elsewhere.
+ * Environmental customization. It should not (I hope) be necessary to alter
+ * the file you are now reading -- regcustom.h should handle it all, given
+ * care here and elsewhere.
  */
 #include "regcustom.h"
 
-
-
 /*
  * Things that regcustom.h might override.
  */
@@ -54,34 +50,34 @@
 
 /* assertions */
 #ifndef assert
-#	ifndef REG_DEBUG
-#	ifndef NDEBUG
-#	define	NDEBUG		/* no assertions */
-#	endif
-#	endif
+#ifndef REG_DEBUG
+#ifndef NDEBUG
+#define	NDEBUG		/* no assertions */
+#endif
+#endif /* !REG_DEBUG */
 #include <assert.h>
 #endif
 
 /* voids */
 #ifndef VOID
-#define	VOID	void			/* for function return values */
+#define	VOID	void		/* for function return values */
 #endif
 #ifndef DISCARD
-#define	DISCARD	VOID			/* for throwing values away */
+#define	DISCARD	void		/* for throwing values away */
 #endif
 #ifndef PVOID
-#define	PVOID	VOID *			/* generic pointer */
+#define	PVOID	void *		/* generic pointer */
 #endif
 #ifndef VS
-#define	VS(x)	((PVOID)(x))		/* cast something to generic ptr */
+#define	VS(x)	((void*)(x))	/* cast something to generic ptr */
 #endif
 #ifndef NOPARMS
-#define	NOPARMS	VOID			/* for empty parm lists */
+#define	NOPARMS	void		/* for empty parm lists */
 #endif
 
 /* const */
 #ifndef CONST
-#define	CONST	const			/* for old compilers, might be empty */
+#define	CONST	const		/* for old compilers, might be empty */
 #endif
 
 /* function-pointer declarator */
@@ -109,11 +105,9 @@
 #include <limits.h>
 #endif
 #ifndef _POSIX2_RE_DUP_MAX
-#define	_POSIX2_RE_DUP_MAX	255	/* normally from <limits.h> */
+#define	_POSIX2_RE_DUP_MAX 255	/* normally from <limits.h> */
 #endif
 
-
-
 /*
  * misc
  */
@@ -126,8 +120,6 @@
 
 #define	REMAGIC	0xfed7		/* magic number for main struct */
 
-
-
 /*
  * debugging facilities
  */
@@ -141,8 +133,6 @@
 #define	MDEBUG(arglist)	{}
 #endif
 
-
-
 /*
  * bitmap manipulation
  */
@@ -150,14 +140,13 @@
 #define	BSET(uv, sn)	((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS))
 #define	ISBSET(uv, sn)	((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS)))
 
-
-
 /*
- * We dissect a chr into byts for colormap table indexing.  Here we define
- * a byt, which will be the same as a byte on most machines...  The exact
- * size of a byt is not critical, but about 8 bits is good, and extraction
- * of 8-bit chunks is sometimes especially fast.
+ * We dissect a chr into byts for colormap table indexing. Here we define a
+ * byt, which will be the same as a byte on most machines... The exact size of
+ * a byt is not critical, but about 8 bits is good, and extraction of 8-bit
+ * chunks is sometimes especially fast.
  */
+
 #ifndef BYTBITS
 #define	BYTBITS	8		/* bits in a byt */
 #endif
@@ -166,69 +155,66 @@
 #define	NBYTS	((CHRBITS+BYTBITS-1)/BYTBITS)
 /* the definition of GETCOLOR(), below, assumes NBYTS <= 4 */
 
-
-
 /*
  * As soon as possible, we map chrs into equivalence classes -- "colors" --
  * which are of much more manageable number.
  */
+
 typedef short color;		/* colors of characters */
 typedef int pcolor;		/* what color promotes to */
 #define	COLORLESS	(-1)	/* impossible color */
 #define	WHITE		0	/* default color, parent of all others */
 
-
-
 /*
- * A colormap is a tree -- more precisely, a DAG -- indexed at each level
- * by a byt of the chr, to map the chr to a color efficiently.  Because
- * lower sections of the tree can be shared, it can exploit the usual
- * sparseness of such a mapping table.  The tree is always NBYTS levels
- * deep (in the past it was shallower during construction but was "filled"
- * to full depth at the end of that); areas that are unaltered as yet point
- * to "fill blocks" which are entirely WHITE in color.
+ * A colormap is a tree -- more precisely, a DAG -- indexed at each level by a
+ * byt of the chr, to map the chr to a color efficiently. Because lower
+ * sections of the tree can be shared, it can exploit the usual sparseness of
+ * such a mapping table. The tree is always NBYTS levels deep (in the past it
+ * was shallower during construction but was "filled" to full depth at the end
+ * of that); areas that are unaltered as yet point to "fill blocks" which are
+ * entirely WHITE in color.
  */
 
 /* the tree itself */
 struct colors {
-	color ccolor[BYTTAB];
+    color ccolor[BYTTAB];
 };
 struct ptrs {
-	union tree *pptr[BYTTAB];
+    union tree *pptr[BYTTAB];
 };
 union tree {
-	struct colors colors;
-	struct ptrs ptrs;
+    struct colors colors;
+    struct ptrs ptrs;
 };
 #define	tcolor	colors.ccolor
 #define	tptr	ptrs.pptr
 
-/* internal per-color structure for the color machinery */
+/* Internal per-color descriptor structure for the color machinery */
 struct colordesc {
-	uchr nchrs;		/* number of chars of this color */
-	color sub;		/* open subcolor (if any); free chain ptr */
-#		define	NOSUB	COLORLESS
-	struct arc *arcs;	/* color chain */
-	int flags;
-#		define	FREECOL	01	/* currently free */
-#		define	PSEUDO	02	/* pseudocolor, no real chars */
-#	define	UNUSEDCOLOR(cd)	((cd)->flags&FREECOL)
-	union tree *block;	/* block of solid color, if any */
+    uchr nchrs;			/* number of chars of this color */
+    color sub;			/* open subcolor (if any); free chain ptr */
+#define	NOSUB	COLORLESS
+    struct arc *arcs;		/* color chain */
+    int flags;
+#define	FREECOL	01		/* currently free */
+#define	PSEUDO	02		/* pseudocolor, no real chars */
+#define	UNUSEDCOLOR(cd)	((cd)->flags&FREECOL)
+    union tree *block;		/* block of solid color, if any */
 };
 
 /* the color map itself */
 struct colormap {
-	int magic;
-#		define	CMMAGIC	0x876
-	struct vars *v;			/* for compile error reporting */
-	size_t ncds;			/* number of colordescs */
-	size_t max;			/* highest in use */
-	color free;			/* beginning of free chain (if non-0) */
-	struct colordesc *cd;
-#	define	CDEND(cm)	(&(cm)->cd[(cm)->max + 1])
-#		define	NINLINECDS	((size_t)10)
-	struct colordesc cdspace[NINLINECDS];
-	union tree tree[NBYTS];		/* tree top, plus fill blocks */
+    int magic;
+#define	CMMAGIC	0x876
+    struct vars *v;		/* for compile error reporting */
+    size_t ncds;		/* number of colordescs */
+    size_t max;			/* highest in use */
+    color free;			/* beginning of free chain (if non-0) */
+    struct colordesc *cd;
+#define	CDEND(cm)	(&(cm)->cd[(cm)->max + 1])
+#define	NINLINECDS	((size_t)10)
+    struct colordesc cdspace[NINLINECDS];
+    union tree tree[NBYTS];	/* tree top, plus fill blocks */
 };
 
 /* optimization magic to do fast chr->color mapping */
@@ -247,182 +233,196 @@ struct colormap {
 #define	GETCOLOR(cm, c)	((cm)->tree->tptr[B3(c)]->tptr[B2(c)]->tptr[B1(c)]->tcolor[B0(c)])
 #endif
 
-
-
 /*
  * Interface definitions for locale-interface functions in locale.c.
- * Multi-character collating elements (MCCEs) cause most of the trouble.
  */
+
+/* Representation of a set of characters. */
 struct cvec {
-	int nchrs;		/* number of chrs */
-	int chrspace;		/* number of chrs possible */
-	chr *chrs;		/* pointer to vector of chrs */
-	int nranges;		/* number of ranges (chr pairs) */
-	int rangespace;		/* number of chrs possible */
-	chr *ranges;		/* pointer to vector of chr pairs */
-	int nmcces;		/* number of MCCEs */
-	int mccespace;		/* number of MCCEs possible */
-	int nmccechrs;		/* number of chrs used for MCCEs */
-	chr *mcces[1];		/* pointers to 0-terminated MCCEs */
-				/* and both batches of chrs are on the end */
+    int nchrs;			/* number of chrs */
+    int chrspace;		/* number of chrs possible */
+    chr *chrs;			/* pointer to vector of chrs */
+    int nranges;		/* number of ranges (chr pairs) */
+    int rangespace;		/* number of chrs possible */
+    chr *ranges;		/* pointer to vector of chr pairs */
 };
 
-/* caution:  this value cannot be changed easily */
-#define	MAXMCCE	2		/* length of longest MCCE */
-
-
-
 /*
- * definitions for NFA internal representation
+ * definitions for non-deterministic finite autmaton (NFA) internal
+ * representation
  *
- * Having a "from" pointer within each arc may seem redundant, but it
- * saves a lot of hassle.
+ * Having a "from" pointer within each arc may seem redundant, but it saves a
+ * lot of hassle.
  */
+
 struct state;
 
 struct arc {
-	int type;
-#		define	ARCFREE	'\0'
-	color co;
-	struct state *from;	/* where it's from (and contained within) */
-	struct state *to;	/* where it's to */
-	struct arc *outchain;	/* *from's outs chain or free chain */
-#	define	freechain	outchain
-	struct arc *inchain;	/* *to's ins chain */
-	struct arc *colorchain;	/* color's arc chain */
-	struct arc *colorchain_rev;	/* back-link in color's arc chain */
+    int type;
+#define	ARCFREE	'\0'
+    color co;
+    struct state *from;		/* where it's from (and contained within) */
+    struct state *to;		/* where it's to */
+    struct arc *outchain;	/* *from's outs chain or free chain */
+#define	freechain	outchain
+    struct arc *inchain;	/* *to's ins chain */
+    struct arc *colorchain;	/* color's arc chain */
+    struct arc *colorchainRev;	/* back-link in color's arc chain */
 };
 
 struct arcbatch {		/* for bulk allocation of arcs */
-	struct arcbatch *next;
-#	define	ABSIZE	10
-	struct arc a[ABSIZE];
+    struct arcbatch *next;
+#define	ABSIZE	10
+    struct arc a[ABSIZE];
 };
 
 struct state {
-	int no;
-#		define	FREESTATE	(-1)
-	char flag;		/* marks special states */
-	int nins;		/* number of inarcs */
-	struct arc *ins;	/* chain of inarcs */
-	int nouts;		/* number of outarcs */
-	struct arc *outs;	/* chain of outarcs */
-	struct arc *free;	/* chain of free arcs */
-	struct state *tmp;	/* temporary for traversal algorithms */
-	struct state *next;	/* chain for traversing all */
-	struct state *prev;	/* back chain */
-	struct arcbatch oas;	/* first arcbatch, avoid malloc in easy case */
-	int noas;		/* number of arcs used in first arcbatch */
+    int no;
+#define	FREESTATE	(-1)
+    char flag;			/* marks special states */
+    int nins;			/* number of inarcs */
+    struct arc *ins;		/* chain of inarcs */
+    int nouts;			/* number of outarcs */
+    struct arc *outs;		/* chain of outarcs */
+    struct arc *free;		/* chain of free arcs */
+    struct state *tmp;		/* temporary for traversal algorithms */
+    struct state *next;		/* chain for traversing all */
+    struct state *prev;		/* back chain */
+    struct arcbatch oas;	/* first arcbatch, avoid malloc in easy case */
+    int noas;			/* number of arcs used in first arcbatch */
 };
 
 struct nfa {
-	struct state *pre;	/* pre-initial state */
-	struct state *init;	/* initial state */
-	struct state *final;	/* final state */
-	struct state *post;	/* post-final state */
-	int nstates;		/* for numbering states */
-	struct state *states;	/* state-chain header */
-	struct state *slast;	/* tail of the chain */
-	struct state *free;	/* free list */
-	struct colormap *cm;	/* the color map */
-	color bos[2];		/* colors, if any, assigned to BOS and BOL */
-	color eos[2];		/* colors, if any, assigned to EOS and EOL */
-	size_t size;		/* current NFA size; differs from nstates as
-				 * it will be incremented by its children */
-	struct vars *v;		/* simplifies compile error reporting */
-	struct nfa *parent;	/* parent NFA, if any */
+    struct state *pre;		/* pre-initial state */
+    struct state *init;		/* initial state */
+    struct state *final;	/* final state */
+    struct state *post;		/* post-final state */
+    int nstates;		/* for numbering states */
+    struct state *states;	/* state-chain header */
+    struct state *slast;	/* tail of the chain */
+    struct state *free;		/* free list */
+    struct colormap *cm;	/* the color map */
+    color bos[2];		/* colors, if any, assigned to BOS and BOL */
+    color eos[2];		/* colors, if any, assigned to EOS and EOL */
+    size_t size;		/* Current NFA size; differs from nstates as
+				 * it also counts the number of states created
+				 * by children of this state. */
+    struct vars *v;		/* simplifies compile error reporting */
+    struct nfa *parent;		/* parent NFA, if any */
 };
 
-
-
 /*
  * definitions for compacted NFA
  */
+
 struct carc {
-	color co;		/* COLORLESS is list terminator */
-	int to;			/* state number */
+    color co;			/* COLORLESS is list terminator */
+    int to;			/* state number */
 };
 
 struct cnfa {
-	int nstates;		/* number of states */
-	int ncolors;		/* number of colors */
-	int flags;
-#		define	HASLACONS	01	/* uses lookahead constraints */
-	int pre;		/* setup state number */
-	int post;		/* teardown state number */
-	color bos[2];		/* colors, if any, assigned to BOS and BOL */
-	color eos[2];		/* colors, if any, assigned to EOS and EOL */
-	struct carc **states;	/* vector of pointers to outarc lists */
-	struct carc *arcs;	/* the area for the lists */
+    int nstates;		/* number of states */
+    int ncolors;		/* number of colors */
+    int flags;
+#define	HASLACONS	01	/* uses lookahead constraints */
+    int pre;			/* setup state number */
+    int post;			/* teardown state number */
+    color bos[2];		/* colors, if any, assigned to BOS and BOL */
+    color eos[2];		/* colors, if any, assigned to EOS and EOL */
+    struct carc **states;	/* vector of pointers to outarc lists */
+    struct carc *arcs;		/* the area for the lists */
 };
 #define	ZAPCNFA(cnfa)	((cnfa).nstates = 0)
 #define	NULLCNFA(cnfa)	((cnfa).nstates == 0)
 
+/*
+ * Used to limit the maximum NFA size to something sane. [Bug 1810264]
+ */
 
-/* Used to limit the maximum NFA size */
 #ifndef REG_MAX_STATES
-#define REG_MAX_STATES 100000
+#   define REG_MAX_STATES	100000
 #endif
 
-
 /*
  * subexpression tree
  */
+
 struct subre {
-	char op;		/* '|', '.' (concat), 'b' (backref), '(', '=' */
-	char flags;
-#		define	LONGER	01	/* prefers longer match */
-#		define	SHORTER	02	/* prefers shorter match */
-#		define	MIXED	04	/* mixed preference below */
-#		define	CAP	010	/* capturing parens below */
-#		define	BACKR	020	/* back reference below */
-#		define	INUSE	0100	/* in use in final tree */
-#		define	LOCAL	03	/* bits which may not propagate up */
-#		define	LMIX(f)	((f)<<2)	/* LONGER -> MIXED */
-#		define	SMIX(f)	((f)<<1)	/* SHORTER -> MIXED */
-#		define	UP(f)	(((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
-#		define	MESSY(f)	((f)&(MIXED|CAP|BACKR))
-#		define	PREF(f)	((f)&LOCAL)
-#		define	PREF2(f1, f2)	((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
-#		define	COMBINE(f1, f2)	(UP((f1)|(f2)) | PREF2(f1, f2))
-	short retry;		/* index into retry memory */
-	int subno;		/* subexpression number (for 'b' and '(') */
-	short min;		/* min repetitions, for backref only */
-	short max;		/* max repetitions, for backref only */
-	struct subre *left;	/* left child, if any (also freelist chain) */
-	struct subre *right;	/* right child, if any */
-	struct state *begin;	/* outarcs from here... */
-	struct state *end;	/* ...ending in inarcs here */
-	struct cnfa cnfa;	/* compacted NFA, if any */
-	struct subre *chain;	/* for bookkeeping and error cleanup */
+    char op;			/* '|', '.' (concat), 'b' (backref), '(',
+				 * '=' */
+    char flags;
+#define	LONGER	01		/* prefers longer match */
+#define	SHORTER	02		/* prefers shorter match */
+#define	MIXED	04		/* mixed preference below */
+#define	CAP	010		/* capturing parens below */
+#define	BACKR	020		/* back reference below */
+#define	INUSE	0100		/* in use in final tree */
+#define	LOCAL	03		/* bits which may not propagate up */
+#define	LMIX(f)	((f)<<2)	/* LONGER -> MIXED */
+#define	SMIX(f)	((f)<<1)	/* SHORTER -> MIXED */
+#define	UP(f)	(((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
+#define	MESSY(f)	((f)&(MIXED|CAP|BACKR))
+#define	PREF(f)	((f)&LOCAL)
+#define	PREF2(f1, f2)	((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
+#define	COMBINE(f1, f2)	(UP((f1)|(f2)) | PREF2(f1, f2))
+    short retry;		/* index into retry memory */
+    int subno;			/* subexpression number (for 'b' and '(') */
+    short min;			/* min repetitions, for backref only */
+    short max;			/* max repetitions, for backref only */
+    struct subre *left;		/* left child, if any (also freelist chain) */
+    struct subre *right;	/* right child, if any */
+    struct state *begin;	/* outarcs from here... */
+    struct state *end;		/* ...ending in inarcs here */
+    struct cnfa cnfa;		/* compacted NFA, if any */
+    struct subre *chain;	/* for bookkeeping and error cleanup */
 };
 
-
-
 /*
- * table of function pointers for generic manipulation functions
- * A regex_t's re_fns points to one of these.
+ * table of function pointers for generic manipulation functions. A regex_t's
+ * re_fns points to one of these.
  */
+
 struct fns {
-	VOID FUNCPTR(free, (regex_t *));
+    VOID FUNCPTR(free, (regex_t *));
 };
 
-
-
 /*
  * the insides of a regex_t, hidden behind a void *
  */
+
 struct guts {
-	int magic;
-#		define	GUTSMAGIC	0xfed9
-	int cflags;		/* copy of compile flags */
-	long info;		/* copy of re_info */
-	size_t nsub;		/* copy of re_nsub */
-	struct subre *tree;
-	struct cnfa search;	/* for fast preliminary search */
-	int ntree;
-	struct colormap cmap;
-	int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
-	struct subre *lacons;	/* lookahead-constraint vector */
-	int nlacons;		/* size of lacons */
+    int magic;
+#define	GUTSMAGIC	0xfed9
+    int cflags;			/* copy of compile flags */
+    long info;			/* copy of re_info */
+    size_t nsub;		/* copy of re_nsub */
+    struct subre *tree;
+    struct cnfa search;		/* for fast preliminary search */
+    int ntree;
+    struct colormap cmap;
+    int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
+    struct subre *lacons;	/* lookahead-constraint vector */
+    int nlacons;		/* size of lacons */
 };
+
+/*
+ * Magic for allocating a variable workspace. This default version is
+ * stack-hungry.
+ */
+
+#ifndef AllocVars
+#define AllocVars(vPtr) \
+    struct vars var; \
+    register struct vars *vPtr = &var
+#endif
+#ifndef FreeVars
+#define FreeVars(vPtr) ((void) 0)
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index b8d8d7d..7f49002 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -7,6 +7,8 @@
 #
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
@@ -1033,7 +1035,7 @@ declare 286 {
     void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
 }
 declare 287 {
-    Tcl_Encoding Tcl_CreateEncoding(Tcl_EncodingType *typePtr)
+    Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
 }
 declare 288 {
     void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
@@ -1405,59 +1407,59 @@ declare 397 {
     int Tcl_ChannelBuffered(Tcl_Channel chan)
 }
 declare 398 {
-    CONST84_RETURN char *Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+    CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
 }
 declare 399 {
     Tcl_ChannelTypeVersion Tcl_ChannelVersion(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 400 {
     Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 401 {
     Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 402 {
     Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 403 {
     Tcl_DriverInputProc *Tcl_ChannelInputProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 404 {
     Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 405 {
     Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 406 {
     Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 407 {
     Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 408 {
     Tcl_DriverWatchProc *Tcl_ChannelWatchProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 409 {
     Tcl_DriverGetHandleProc *Tcl_ChannelGetHandleProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 410 {
     Tcl_DriverFlushProc *Tcl_ChannelFlushProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 declare 411 {
     Tcl_DriverHandlerProc *Tcl_ChannelHandlerProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 
 # Introduced in 8.4a2
@@ -1760,34 +1762,323 @@ declare 492 {
 # TIP#91 (back-compat enhancements for channels) dkf
 declare 493 {
     Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
+}
+
+# ----- BASELINE -- FOR -- 8.4.0 ----- #
+
+# TIP#111 (dictionaries) dkf
+declare 494 {
+    int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+	    Tcl_Obj *keyPtr, Tcl_Obj *valuePtr)
+}
+declare 495 {
+    int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr,
+	    Tcl_Obj **valuePtrPtr)
+}
+declare 496 {
+    int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+	    Tcl_Obj *keyPtr)
+}
+declare 497 {
+    int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr)
+}
+declare 498 {
+    int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+	    Tcl_DictSearch *searchPtr,
+	    Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
+}
+declare 499 {
+    void Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
+	    Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
+}
+declare 500 {
+    void Tcl_DictObjDone(Tcl_DictSearch *searchPtr)
+}
+declare 501 {
+    int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+	    int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr)
+}
+declare 502 {
+    int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+	    int keyc, Tcl_Obj *const *keyv)
+}
+declare 503 {
+    Tcl_Obj *Tcl_NewDictObj(void)
+}
+declare 504 {
+    Tcl_Obj *Tcl_DbNewDictObj(const char *file, int line)
+}
+
+# TIP#59 (configuration reporting) akupries
+declare 505 {
+    void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName,
+	    Tcl_Config *configuration, const char *valEncoding)
+}
+
+# TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
+# dkf, API by Brent Welch?
+declare 506 {
+    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
+	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
+}
+declare 507 {
+    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
+}
+declare 508 {
+    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+	    Tcl_Obj *objPtr)
+}
+declare 509 {
+    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+	    const char *pattern, int resetListFirst)
+}
+declare 510 {
+    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+	    const char *pattern, int allowOverwrite)
+}
+declare 511 {
+    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+	    const char *pattern)
+}
+declare 512 {
+    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
+}
+declare 513 {
+    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
+}
+declare 514 {
+    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
+	    Tcl_Namespace *contextNsPtr, int flags)
+}
+declare 515 {
+    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+	    Tcl_Namespace *contextNsPtr, int flags)
+}
+declare 516 {
+    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 517 {
+    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
+	    Tcl_Obj *objPtr)
+}
+
+# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
+declare 518 {
+    int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
+	    const char *encodingName)
 }
 
-# Slots 494 to 553 are taken already by 8.5
-# #111 - Dicts            (494 ... 504)
-#  #59 - Config           (505)
-# #139 - Namespace API    (506 ... 517)
-# #137 - source -encoding (518)
-# #121 - ExitProc         (519)
-# #121 - Resource Limits  (520 ... 534)
-# #226 - S/R Interp State (535 ... 537)
-# #227 - S/G Return Opts  (538 ... 539)
-# #235 - Ensemble C API   (540 ... 551)
-# #233 - Virtualized Time (552 ... 553)
+# TIP#121 (exit handler) dkf for Joe Mistachkin
+declare 519 {
+    Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+}
+
+# TIP#143 (resource limits) dkf
+declare 520 {
+    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
+	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData,
+	    Tcl_LimitHandlerDeleteProc *deleteProc)
+}
+declare 521 {
+    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
+	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData)
+}
+declare 522 {
+    int Tcl_LimitReady(Tcl_Interp *interp)
+}
+declare 523 {
+    int Tcl_LimitCheck(Tcl_Interp *interp)
+}
+declare 524 {
+    int Tcl_LimitExceeded(Tcl_Interp *interp)
+}
+declare 525 {
+    void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit)
+}
+declare 526 {
+    void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
+}
+declare 527 {
+    void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity)
+}
+declare 528 {
+    int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type)
+}
+declare 529 {
+    int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type)
+}
+declare 530 {
+    void Tcl_LimitTypeSet(Tcl_Interp *interp, int type)
+}
+declare 531 {
+    void Tcl_LimitTypeReset(Tcl_Interp *interp, int type)
+}
+declare 532 {
+    int Tcl_LimitGetCommands(Tcl_Interp *interp)
+}
+declare 533 {
+    void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
+}
+declare 534 {
+    int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type)
+}
+
+# TIP#226 (interpreter result state management) dgp
+declare 535 {
+    Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status)
+}
+declare 536 {
+    int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state)
+}
+declare 537 {
+    void Tcl_DiscardInterpState(Tcl_InterpState state)
+}
+
+# TIP#227 (return options interface) dgp
+declare 538 {
+    int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options)
+}
+declare 539 {
+    Tcl_Obj *Tcl_GetReturnOptions(Tcl_Interp *interp, int result)
+}
+
+# TIP#235 (ensembles) dkf
+declare 540 {
+    int Tcl_IsEnsemble(Tcl_Command token)
+}
+declare 541 {
+    Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name,
+	    Tcl_Namespace *namespacePtr, int flags)
+}
+declare 542 {
+    Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj,
+	    int flags)
+}
+declare 543 {
+    int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj *subcmdList)
+}
+declare 544 {
+    int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj *mapDict)
+}
+declare 545 {
+    int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj *unknownList)
+}
+declare 546 {
+    int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags)
+}
+declare 547 {
+    int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj **subcmdListPtr)
+}
+declare 548 {
+    int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj **mapDictPtr)
+}
+declare 549 {
+    int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Obj **unknownListPtr)
+}
+declare 550 {
+    int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token,
+	    int *flagsPtr)
+}
+declare 551 {
+    int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token,
+	    Tcl_Namespace **namespacePtrPtr)
+}
+
+# TIP#233 (virtualized time) akupries
+declare 552 {
+    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
+	    Tcl_ScaleTimeProc *scaleProc,
+	    ClientData clientData)
+}
+declare 553 {
+    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
+	    Tcl_ScaleTimeProc **scaleProc,
+	    ClientData *clientData)
+}
 
 # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
 declare 554 {
     Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
-	    Tcl_ChannelType *chanTypePtr)
+	    const Tcl_ChannelType *chanTypePtr)
 }
 
-# Slots 555 to 572 are taken already by 8.5
-# TIP #237: Arbitrary-prec Integers (555 ... 559)
-# TIP #208: 'chan' Command          (560 ... 561)
-# TIP #219: Channel Reflection      (562 ... 565)
-# TIP #237: Add. bignum support     (566)
-# TIP #181: 'namespace unknown' Cmd (567 ... 568)
-# TIP #258: Enhanced Encodings API  (569 ... 572)
+# TIP#237 (arbitrary-precision integers) kbk
+declare 555 {
+    Tcl_Obj *Tcl_NewBignumObj(mp_int *value)
+}
+declare 556 {
+    Tcl_Obj *Tcl_DbNewBignumObj(mp_int *value, const char *file, int line)
+}
+declare 557 {
+    void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value)
+}
+declare 558 {
+    int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
+}
+declare 559 {
+    int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
+}
+
+# TIP #208 ('chan' command) jeffh
+declare 560 {
+    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
+}
+declare 561 {
+    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
+	    const Tcl_ChannelType *chanTypePtr)
+}
+
+# TIP#219 (channel reflection api) akupries
+declare 562 {
+    void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg)
+}
+declare 563 {
+    void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg)
+}
+declare 564 {
+    void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg)
+}
+declare 565 {
+    void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg)
+}
+
+# TIP #237 (additional conversion functions for bignum support) kbk/dgp
+declare 566 {
+    int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval,
+	    mp_int *toInit)
+}
+
+# TIP#181 (namespace unknown command) dgp for Neil Madden
+declare 567 {
+    Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
+	    Tcl_Namespace *nsPtr)
+}
+declare 568 {
+    int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
+	    Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr)
+}
+
+# TIP#258 (enhanced interface for encodings) dgp
+declare 569 {
+    int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    Tcl_Encoding *encodingPtr)
+}
+declare 570 {
+    Tcl_Obj *Tcl_GetEncodingSearchPath(void)
+}
+declare 571 {
+    int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath)
+}
+declare 572 {
+    const char *Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
+}
 
 # TIP#268 (extended version numbers and requirements) akupries
 declare 573 {
@@ -1795,6 +2086,28 @@ declare 573 {
 	    int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr)
 }
 
+# TIP#270 (utility C routines for string formatting) dgp
+declare 574 {
+    void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 575 {
+    void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length,
+	    int limit, const char *ellipsis)
+}
+declare 576 {
+    Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
+	    Tcl_Obj *const objv[])
+}
+declare 577 {
+    int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    const char *format, int objc, Tcl_Obj *const objv[])
+}
+declare 578 {
+    Tcl_Obj *Tcl_ObjPrintf(const char *format, ...)
+}
+declare 579 {
+    void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
+}
 declare 630 {
     void TclUnusedStubEntry(void)
 }
@@ -1836,6 +2149,54 @@ declare 1 macosx {
 	    int hasResourceFile, int maxPathLen, char *libraryPath)
 }
 
+##############################################################################
+
+# Public functions that are not accessible via the stubs table.
+
+export {
+    void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
+}
+export {
+    const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
+	int exact)
+}
+export {
+    const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
+	const char* version, int epoch, int revision)
+}
+export {
+    const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
+	int exact)
+}
+export {
+    void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
+}
+export {
+    const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
+	int exact)
+}
+export {
+    const char *TclTomMathInitializeStubs(Tcl_Interp *interp,
+	const char *version, int epoch, int revision)
+}
+
+# Global variables that need to be exported from the tcl shared library.
+
+export {
+    TclStubs *tclStubsPtr                       (fool checkstubs)
+}
+export {
+    TclPlatStubs *tclPlatStubsPtr               (fool checkstubs)
+}
+export {
+    TclIntStubs *tclIntStubsPtr                 (fool checkstubs)
+}
+export {
+    TclIntPlatStubs *tclIntPlatStubsPtr         (fool checkstubs)
+}
+export {
+    TclTomMathStubs *tclTomMathStubsPtr         (fool checkstubs)
+}
 # Local Variables:
 # mode: tcl
 # End:
diff --git a/generic/tcl.h b/generic/tcl.h
index 5f47734..5fde9dc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1,8 +1,8 @@
 /*
  * tcl.h --
  *
- *	This header file describes the externally-visible facilities
- *	of the Tcl interpreter.
+ *	This header file describes the externally-visible facilities of the
+ *	Tcl interpreter.
  *
  * Copyright (c) 1987-1994 The Regents of the University of California.
  * Copyright (c) 1993-1996 Lucent Technologies.
@@ -10,8 +10,8 @@
  * Copyright (c) 1998-2000 by Scriptics Corporation.
  * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #ifndef _TCL
@@ -34,37 +34,38 @@ extern "C" {
 #define TCL_FINAL_RELEASE	2
 
 /*
- * When version numbers change here, must also go into the following files
- * and update the version numbers:
+ * When version numbers change here, must also go into the following files and
+ * update the version numbers:
  *
- * library/init.tcl	(only if Major.minor changes, not patchlevel) 1 LOC
+ * library/init.tcl	(1 LOC patch)
  * unix/configure.in	(2 LOC Major, 2 LOC minor, 1 LOC patch)
  * win/configure.in	(as above)
  * win/tcl.m4		(not patchlevel)
- * win/makefile.vc	(not patchlevel) 2 LOC
- * README		(sections 0 and 2)
- * mac/README		(2 LOC, not patchlevel)
+ * win/makefile.bc	(not patchlevel) 2 LOC
+ * README		(sections 0 and 2, with and without separator)
  * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
  * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
- * win/README.binary	(sections 0-4)
+ * macosx/Tcl.xcode/project.pbxproj (not patchlevel) 2 LOC
+ * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC
+ * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
  * win/README		(not patchlevel) (sections 0 and 2)
- * unix/tcl.spec	(2 LOC Major/Minor, 1 LOC patch)
- * tests/basic.test	(1 LOC M/M, not patchlevel)
+ * unix/tcl.spec	(1 LOC patch)
  * tools/tcl.hpj.in	(not patchlevel, for windows installer)
  * tools/tcl.wse.in	(for windows installer)
  * tools/tclSplash.bmp	(not patchlevel)
  */
+
 #define TCL_MAJOR_VERSION   8
-#define TCL_MINOR_VERSION   4
+#define TCL_MINOR_VERSION   5
 #define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL  19
+#define TCL_RELEASE_SERIAL  13
 
-#define TCL_VERSION	    "8.4"
-#define TCL_PATCH_LEVEL	    "8.4.19"
+#define TCL_VERSION	    "8.5"
+#define TCL_PATCH_LEVEL	    "8.5.13"
 
 /*
- * The following definitions set up the proper options for Windows
- * compilers.  We use this method because there is no autoconf equivalent.
+ * The following definitions set up the proper options for Windows compilers.
+ * We use this method because there is no autoconf equivalent.
  */
 
 #ifndef __WIN32__
@@ -93,6 +94,7 @@ extern "C" {
  * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
  * quotation marks), JOIN joins two arguments.
  */
+
 #ifndef STRINGIFY
 #  define STRINGIFY(x) STRINGIFY1(x)
 #  define STRINGIFY1(x) #x
@@ -102,20 +104,20 @@ extern "C" {
 #  define JOIN1(a,b) a##b
 #endif
 
-/* 
- * A special definition used to allow this header file to be included
- * from windows resource files so that they can obtain version
- * information.  RC_INVOKED is defined by default by the windows RC tool.
+/*
+ * A special definition used to allow this header file to be included from
+ * windows resource files so that they can obtain version information.
+ * RC_INVOKED is defined by default by the windows RC tool.
  *
- * Resource compilers don't like all the C stuff, like typedefs and
- * procedure declarations, that occur below, so block them out.
+ * Resource compilers don't like all the C stuff, like typedefs and function
+ * declarations, that occur below, so block them out.
  */
 
 #ifndef RC_INVOKED
 
 /*
- * Special macro to define mutexes, that doesn't do anything
- * if we are not using threads.
+ * Special macro to define mutexes, that doesn't do anything if we are not
+ * using threads.
  */
 
 #ifdef TCL_THREADS
@@ -125,62 +127,61 @@ extern "C" {
 #endif
 
 /*
- * Macros that eliminate the overhead of the thread synchronization
- * functions when compiling without thread support.
+ * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
+ * SEEK_END, all #define'd by stdio.h .
+ *
+ * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
+ * providing it for them rather than #include-ing it themselves as they
+ * should, so also for their sake, we keep the #include to be consistent with
+ * prior Tcl releases.
  */
 
-#ifndef TCL_THREADS
-#define Tcl_MutexLock(mutexPtr)
-#define Tcl_MutexUnlock(mutexPtr)
-#define Tcl_MutexFinalize(mutexPtr)
-#define Tcl_ConditionNotify(condPtr)
-#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
-#define Tcl_ConditionFinalize(condPtr)
-#endif /* TCL_THREADS */
-
-
-#ifndef BUFSIZ
-#   include <stdio.h>
-#endif
-
+#include <stdio.h>
 
 /*
- * Definitions that allow Tcl functions with variable numbers of
- * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
- * is used in procedure prototypes.  TCL_VARARGS_DEF is used to declare
- * the arguments in a function definiton: it takes the type and name of
- * the first argument and supplies the appropriate argument declaration
- * string for use in the function definition.  TCL_VARARGS_START
- * initializes the va_list data structure and returns the first argument.
+ * Support for functions with a variable number of arguments.
+ *
+ * The following TCL_VARARGS* macros are to support old extensions
+ * written for older versions of Tcl where the macros permitted
+ * support for the varargs.h system as well as stdarg.h .
+ *
+ * New code should just directly be written to use stdarg.h conventions.
  */
-#if !defined(NO_STDARG)
-#   include <stdarg.h>
-#   define TCL_VARARGS(type, name) (type name, ...)
-#   define TCL_VARARGS_DEF(type, name) (type name, ...)
-#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
-#else
-#   include <varargs.h>
-#      define TCL_VARARGS(type, name) ()
-#      define TCL_VARARGS_DEF(type, name) (va_alist)
-#   define TCL_VARARGS_START(type, name, list) \
-	(va_start(list), va_arg(list, type))
+
+#include <stdarg.h>
+#ifndef TCL_NO_DEPRECATED
+#    define TCL_VARARGS(type, name) (type name, ...)
+#    define TCL_VARARGS_DEF(type, name) (type name, ...)
+#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
 #endif
 
 /*
- * Macros used to declare a function to be exported by a DLL.
- * Used by Windows, maps to no-op declarations on non-Windows systems.
- * The default build on windows is for a DLL, which causes the DLLIMPORT
- * and DLLEXPORT macros to be nonempty. To build a static library, the
- * macro STATIC_BUILD should be defined.
+ * Macros used to declare a function to be exported by a DLL. Used by Windows,
+ * maps to no-op declarations on non-Windows systems. The default build on
+ * windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be
+ * nonempty. To build a static library, the macro STATIC_BUILD should be
+ * defined.
+ *
+ * Note: when building static but linking dynamically to MSVCRT we must still
+ *       correctly decorate the C library imported function.  Use CRTIMPORT
+ *       for this purpose.  _DLL is defined by the compiler when linking to
+ *       MSVCRT.
  */
 
 #if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#   define HAVE_DECLSPEC 1
 #   ifdef STATIC_BUILD
 #       define DLLIMPORT
 #       define DLLEXPORT
+#       ifdef _DLL
+#           define CRTIMPORT __declspec(dllimport)
+#       else
+#           define CRTIMPORT
+#       endif
 #   else
 #       define DLLIMPORT __declspec(dllimport)
 #       define DLLEXPORT __declspec(dllexport)
+#       define CRTIMPORT __declspec(dllimport)
 #   endif
 #else
 #   define DLLIMPORT
@@ -189,23 +190,25 @@ extern "C" {
 #   else
 #       define DLLEXPORT
 #   endif
+#   define CRTIMPORT
 #endif
 
 /*
  * These macros are used to control whether functions are being declared for
- * import or export.  If a function is being declared while it is being built
+ * import or export. If a function is being declared while it is being built
  * to be included in a shared library, then it should have the DLLEXPORT
- * storage class.  If is being declared for use by a module that is going to
+ * storage class. If is being declared for use by a module that is going to
  * link against the shared library, then it should have the DLLIMPORT storage
- * class.  If the symbol is beind declared for a static build or for use from a
+ * class. If the symbol is beind declared for a static build or for use from a
  * stub library, then the storage class should be empty.
  *
- * The convention is that a macro called BUILD_xxxx, where xxxx is the
- * name of a library we are building, is set on the compile line for sources
- * that are to be placed in the library.  When this macro is set, the
- * storage class will be set to DLLEXPORT.  At the end of the header file, the
- * storage class will be reset to DLLIMPORT.
+ * The convention is that a macro called BUILD_xxxx, where xxxx is the name of
+ * a library we are building, is set on the compile line for sources that are
+ * to be placed in the library. When this macro is set, the storage class will
+ * be set to DLLEXPORT. At the end of the header file, the storage class will
+ * be reset to DLLIMPORT.
  */
+
 #undef TCL_STORAGE_CLASS
 #ifdef BUILD_tcl
 #   define TCL_STORAGE_CLASS DLLEXPORT
@@ -218,8 +221,8 @@ extern "C" {
 #endif
 
 /*
- * Definitions that allow this header file to be used either with or
- * without ANSI C features like function prototypes.
+ * Definitions that allow this header file to be used either with or without
+ * ANSI C features like function prototypes.
  */
 
 #undef _ANSI_ARGS_
@@ -257,7 +260,7 @@ extern "C" {
 #endif
 
 /*
- * Make sure EXTERN isn't defined elsewhere
+ * Make sure EXTERN isn't defined elsewhere.
  */
 
 #ifdef EXTERN
@@ -271,12 +274,9 @@ extern "C" {
 #endif
 
 /*
- * The following code is copied from winnt.h.
- * If we don't replicate it here, then <windows.h> can't be included
- * after tcl.h, since tcl.h also defines VOID.
- * This block is skipped under Cygwin and Mingw.
- * 
- * 
+ * The following code is copied from winnt.h. If we don't replicate it here,
+ * then <windows.h> can't be included after tcl.h, since tcl.h also defines
+ * VOID. This block is skipped under Cygwin and Mingw.
  */
 
 #if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
@@ -289,15 +289,14 @@ typedef long LONG;
 #endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
 
 /*
- * Macro to use instead of "void" for arguments that must have
- * type "void *" in ANSI C;  maps them to type "char *" in
- * non-ANSI systems.
+ * Macro to use instead of "void" for arguments that must have type "void *"
+ * in ANSI C; maps them to type "char *" in non-ANSI systems.
  */
 
 #ifndef NO_VOID
-#         define VOID void
+#define VOID	void
 #else
-#         define VOID char
+#define VOID	char
 #endif
 
 /*
@@ -322,22 +321,23 @@ typedef long LONG;
 #   ifdef __LP64__
 #	undef TCL_WIDE_INT_TYPE
 #	define TCL_WIDE_INT_IS_LONG 1
+#	define TCL_CFG_DO64BIT 1
 #    else /* !__LP64__ */
 #	define TCL_WIDE_INT_TYPE long long
 #	undef TCL_WIDE_INT_IS_LONG
+#	undef TCL_CFG_DO64BIT
 #    endif /* __LP64__ */
 #    undef HAVE_STRUCT_STAT64
-#    include <mach/mach.h>
 #endif /* __APPLE__ */
 
 /*
- * Define Tcl_WideInt to be a type that is (at least) 64-bits wide,
- * and define Tcl_WideUInt to be the unsigned variant of that type
- * (assuming that where we have one, we can have the other.)
+ * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
+ * Tcl_WideUInt to be the unsigned variant of that type (assuming that where
+ * we have one, we can have the other.)
  *
  * Also defines the following macros:
- * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on
- *	a real 64-bit system.)
+ * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a real
+ *	64-bit system.)
  * Tcl_WideAsLong - forgetful converter from wideInt to long.
  * Tcl_LongAsWide - sign-extending converter from long to wideInt.
  * Tcl_WideAsDouble - converter from wideInt to double.
@@ -346,12 +346,9 @@ typedef long LONG;
  * The following invariant should hold for any long value 'longVal':
  *	longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
  *
- * Note on converting between Tcl_WideInt and strings.  This
- * implementation (in tclObj.c) depends on the functions strtoull()
- * and sprintf(...,"%" TCL_LL_MODIFIER "d",...).  TCL_LL_MODIFIER_SIZE
- * is the length of the modifier string, which is "ll" on most 32-bit
- * Unix systems.  It has to be split up like this to allow for the more
- * complex formats sometimes needed (e.g. in the format(n) command.)
+ * Note on converting between Tcl_WideInt and strings. This implementation (in
+ * tclObj.c) depends on the function
+ * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
  */
 
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
@@ -359,19 +356,16 @@ typedef long LONG;
 #      define TCL_WIDE_INT_TYPE __int64
 #      ifdef __BORLANDC__
 #         define TCL_LL_MODIFIER	"L"
-#         define TCL_LL_MODIFIER_SIZE	1
 #      else /* __BORLANDC__ */
 #         define TCL_LL_MODIFIER	"I64"
-#         define TCL_LL_MODIFIER_SIZE	3
 #      endif /* __BORLANDC__ */
 #   elif defined(__GNUC__)
 #      define TCL_WIDE_INT_TYPE long long
 #      define TCL_LL_MODIFIER	"ll"
-#      define TCL_LL_MODIFIER_SIZE	2
 #   else /* ! __WIN32__ && ! __GNUC__ */
 /*
- * Don't know what platform it is and configure hasn't discovered what
- * is going on for us.  Try to guess...
+ * Don't know what platform it is and configure hasn't discovered what is
+ * going on for us. Try to guess...
  */
 #      ifdef NO_LIMITS_H
 #	  error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
@@ -400,16 +394,14 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #   define Tcl_DoubleAsWide(val)	((long)((double)(val)))
 #   ifndef TCL_LL_MODIFIER
 #      define TCL_LL_MODIFIER		"l"
-#      define TCL_LL_MODIFIER_SIZE	1
 #   endif /* !TCL_LL_MODIFIER */
 #else /* TCL_WIDE_INT_IS_LONG */
 /*
- * The next short section of defines are only done when not running on
- * Windows or some other strange platform.
+ * The next short section of defines are only done when not running on Windows
+ * or some other strange platform.
  */
 #   ifndef TCL_LL_MODIFIER
 #      define TCL_LL_MODIFIER		"ll"
-#      define TCL_LL_MODIFIER_SIZE	2
 #   endif /* !TCL_LL_MODIFIER */
 #   define Tcl_WideAsLong(val)		((long)((Tcl_WideInt)(val)))
 #   define Tcl_LongAsWide(val)		((Tcl_WideInt)((long)(val)))
@@ -444,38 +436,27 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 	struct {long tv_sec;} st_ctim;
 	/* Here is a 4-byte gap */
     } Tcl_StatBuf;
-#elif defined(HAVE_STRUCT_STAT64)
+#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
     typedef struct stat64 Tcl_StatBuf;
 #else
     typedef struct stat Tcl_StatBuf;
 #endif
 
-
 /*
- * This flag controls whether binary compatability is maintained with
- * extensions built against a previous version of Tcl. This is true
- * by default.
- */
-#ifndef TCL_PRESERVE_BINARY_COMPATABILITY
-#   define TCL_PRESERVE_BINARY_COMPATABILITY 1
-#endif
-
-
-/*
- * Data structures defined opaquely in this module. The definitions below
- * just provide dummy types. A few fields are made visible in Tcl_Interp
- * structures, namely those used for returning a string result from
- * commands. Direct access to the result field is discouraged in Tcl 8.0.
- * The interpreter result is either an object or a string, and the two
- * values are kept consistent unless some C code sets interp->result
- * directly. Programmers should use either the procedure Tcl_GetObjResult()
- * or Tcl_GetStringResult() to read the interpreter's result. See the
- * SetResult man page for details.
- * 
- * Note: any change to the Tcl_Interp definition below must be mirrored
- * in the "real" definition in tclInt.h.
+ * Data structures defined opaquely in this module. The definitions below just
+ * provide dummy types. A few fields are made visible in Tcl_Interp
+ * structures, namely those used for returning a string result from commands.
+ * Direct access to the result field is discouraged in Tcl 8.0. The
+ * interpreter result is either an object or a string, and the two values are
+ * kept consistent unless some C code sets interp->result directly.
+ * Programmers should use either the function Tcl_GetObjResult() or
+ * Tcl_GetStringResult() to read the interpreter's result. See the SetResult
+ * man page for details.
+ *
+ * Note: any change to the Tcl_Interp definition below must be mirrored in the
+ * "real" definition in tclInt.h.
  *
- * Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc.
+ * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
  * Instead, they set a Tcl_Obj member in the "real" structure that can be
  * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
  */
@@ -484,25 +465,29 @@ typedef struct Tcl_Interp {
     char *result;		/* If the last command returned a string
 				 * result, this points to it. */
     void (*freeProc) _ANSI_ARGS_((char *blockPtr));
-				/* Zero means the string result is
-				 * statically allocated. TCL_DYNAMIC means
-				 * it was allocated with ckalloc and should
-				 * be freed with ckfree. Other values give
-				 * the address of procedure to invoke to
-				 * free the result. Tcl_Eval must free it
-				 * before executing next command. */
-    int errorLine;              /* When TCL_ERROR is returned, this gives
-                                 * the line number within the command where
-                                 * the error occurred (1 if first line). */
+				/* Zero means the string result is statically
+				 * allocated. TCL_DYNAMIC means it was
+				 * allocated with ckalloc and should be freed
+				 * with ckfree. Other values give the address
+				 * of function to invoke to free the result.
+				 * Tcl_Eval must free it before executing next
+				 * command. */
+    int errorLine;		/* When TCL_ERROR is returned, this gives the
+				 * line number within the command where the
+				 * error occurred (1 if first line). */
 } Tcl_Interp;
 
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
 typedef struct Tcl_Channel_ *Tcl_Channel;
+typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
 typedef struct Tcl_Command_ *Tcl_Command;
 typedef struct Tcl_Condition_ *Tcl_Condition;
+typedef struct Tcl_Dict_ *Tcl_Dict;
 typedef struct Tcl_EncodingState_ *Tcl_EncodingState;
 typedef struct Tcl_Encoding_ *Tcl_Encoding;
 typedef struct Tcl_Event Tcl_Event;
+typedef struct Tcl_InterpState_ *Tcl_InterpState;
+typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
 typedef struct Tcl_Mutex_ *Tcl_Mutex;
 typedef struct Tcl_Pid_ *Tcl_Pid;
 typedef struct Tcl_RegExp_ *Tcl_RegExp;
@@ -511,15 +496,13 @@ typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
 typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
 typedef struct Tcl_Trace_ *Tcl_Trace;
 typedef struct Tcl_Var_ *Tcl_Var;
-typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
-typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
 
 /*
- * Definition of the interface to procedures implementing threads.
- * A procedure following this definition is given to each call of
- * 'Tcl_CreateThread' and will be called as the main fuction of
- * the new thread created by that call.
+ * Definition of the interface to functions implementing threads. A function
+ * following this definition is given to each call of 'Tcl_CreateThread' and
+ * will be called as the main fuction of the new thread created by that call.
  */
+
 #if defined __WIN32__
 typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
 #else
@@ -528,10 +511,11 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
 
 /*
  * Threading function return types used for abstracting away platform
- * differences when writing a Tcl_ThreadCreateProc.  See the NewThread
- * function in generic/tclThreadTest.c for it's usage.
+ * differences when writing a Tcl_ThreadCreateProc. See the NewThread function
+ * in generic/tclThreadTest.c for it's usage.
  */
-#ifdef __WIN32__
+
+#if defined __WIN32__
 #   define Tcl_ThreadCreateType		unsigned __stdcall
 #   define TCL_THREAD_CREATE_RETURN	return 0
 #else
@@ -544,68 +528,68 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
  * given to Tcl_CreateThread.
  */
 
-#define TCL_THREAD_STACK_DEFAULT (0)    /* Use default size for stack */
-#define TCL_THREAD_NOFLAGS       (0000) /* Standard flags, default behaviour */
-#define TCL_THREAD_JOINABLE      (0001) /* Mark the thread as joinable */
+#define TCL_THREAD_STACK_DEFAULT (0)    /* Use default size for stack. */
+#define TCL_THREAD_NOFLAGS	 (0000) /* Standard flags, default
+					 * behaviour. */
+#define TCL_THREAD_JOINABLE	 (0001) /* Mark the thread as joinable. */
 
 /*
- * Flag values passed to Tcl_GetRegExpFromObj.
+ * Flag values passed to Tcl_StringCaseMatch.
  */
-#define	TCL_REG_BASIC		000000	/* BREs (convenience) */
-#define	TCL_REG_EXTENDED	000001	/* EREs */
-#define	TCL_REG_ADVF		000002	/* advanced features in EREs */
-#define	TCL_REG_ADVANCED	000003	/* AREs (which are also EREs) */
-#define	TCL_REG_QUOTE		000004	/* no special characters, none */
-#define	TCL_REG_NOCASE		000010	/* ignore case */
-#define	TCL_REG_NOSUB		000020	/* don't care about subexpressions */
-#define	TCL_REG_EXPANDED	000040	/* expanded format, white space &
-					 * comments */
-#define	TCL_REG_NLSTOP		000100  /* \n doesn't match . or [^ ] */
-#define	TCL_REG_NLANCH		000200  /* ^ matches after \n, $ before */
-#define	TCL_REG_NEWLINE		000300  /* newlines are line terminators */
-#define	TCL_REG_CANMATCH	001000  /* report details on partial/limited
-					 * matches */
+
+#define TCL_MATCH_NOCASE	(1<<0)
 
 /*
- * The following flag is experimental and only intended for use by Expect.  It
- * will probably go away in a later release.
+ * Flag values passed to Tcl_GetRegExpFromObj.
  */
 
-#define TCL_REG_BOSONLY		002000	/* prepend \A to pattern so it only
-					 * matches at the beginning of the
-					 * string. */
+#define	TCL_REG_BASIC		000000	/* BREs (convenience). */
+#define	TCL_REG_EXTENDED	000001	/* EREs. */
+#define	TCL_REG_ADVF		000002	/* Advanced features in EREs. */
+#define	TCL_REG_ADVANCED	000003	/* AREs (which are also EREs). */
+#define	TCL_REG_QUOTE		000004	/* No special characters, none. */
+#define	TCL_REG_NOCASE		000010	/* Ignore case. */
+#define	TCL_REG_NOSUB		000020	/* Don't care about subexpressions. */
+#define	TCL_REG_EXPANDED	000040	/* Expanded format, white space &
+					 * comments. */
+#define	TCL_REG_NLSTOP		000100  /* \n doesn't match . or [^ ] */
+#define	TCL_REG_NLANCH		000200  /* ^ matches after \n, $ before. */
+#define	TCL_REG_NEWLINE		000300  /* Newlines are line terminators. */
+#define	TCL_REG_CANMATCH	001000  /* Report details on partial/limited
+					 * matches. */
 
 /*
  * Flags values passed to Tcl_RegExpExecObj.
  */
+
 #define	TCL_REG_NOTBOL	0001	/* Beginning of string does not match ^.  */
 #define	TCL_REG_NOTEOL	0002	/* End of string does not match $. */
 
 /*
- * Structures filled in by Tcl_RegExpInfo.  Note that all offset values are
- * relative to the start of the match string, not the beginning of the
- * entire string.
+ * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
+ * relative to the start of the match string, not the beginning of the entire
+ * string.
  */
 
 typedef struct Tcl_RegExpIndices {
-    long start;		/* character offset of first character in match */
-    long end;		/* character offset of first character after the
-			 * match. */
+    long start;			/* Character offset of first character in
+				 * match. */
+    long end;			/* Character offset of first character after
+				 * the match. */
 } Tcl_RegExpIndices;
 
 typedef struct Tcl_RegExpInfo {
-    int nsubs;			/* number of subexpressions in the
-				 * compiled expression */
-    Tcl_RegExpIndices *matches;	/* array of nsubs match offset
-				 * pairs */
-    long extendStart;		/* The offset at which a subsequent
-				 * match might begin. */
+    int nsubs;			/* Number of subexpressions in the compiled
+				 * expression. */
+    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
+    long extendStart;		/* The offset at which a subsequent match
+				 * might begin. */
     long reserved;		/* Reserved for later use. */
 } Tcl_RegExpInfo;
 
 /*
- * Picky compilers complain if this typdef doesn't appear before the
- * struct's reference in tclDecls.h.
+ * Picky compilers complain if this typdef doesn't appear before the struct's
+ * reference in tclDecls.h.
  */
 
 typedef Tcl_StatBuf *Tcl_Stat_;
@@ -613,32 +597,31 @@ typedef struct stat *Tcl_OldStat_;
 
 /*
  * When a TCL command returns, the interpreter contains a result from the
- * command. Programmers are strongly encouraged to use one of the
- * procedures Tcl_GetObjResult() or Tcl_GetStringResult() to read the
- * interpreter's result. See the SetResult man page for details. Besides
- * this result, the command procedure returns an integer code, which is 
- * one of the following:
+ * command. Programmers are strongly encouraged to use one of the functions
+ * Tcl_GetObjResult() or Tcl_GetStringResult() to read the interpreter's
+ * result. See the SetResult man page for details. Besides this result, the
+ * command function returns an integer code, which is one of the following:
  *
- * TCL_OK		Command completed normally; the interpreter's
- *			result contains	the command's result.
- * TCL_ERROR		The command couldn't be completed successfully;
- *			the interpreter's result describes what went wrong.
- * TCL_RETURN		The command requests that the current procedure
- *			return; the interpreter's result contains the
- *			procedure's return value.
- * TCL_BREAK		The command requests that the innermost loop
- *			be exited; the interpreter's result is meaningless.
- * TCL_CONTINUE		Go on to the next iteration of the current loop;
- *			the interpreter's result is meaningless.
+ * TCL_OK		Command completed normally; the interpreter's result
+ *			contains the command's result.
+ * TCL_ERROR		The command couldn't be completed successfully; the
+ *			interpreter's result describes what went wrong.
+ * TCL_RETURN		The command requests that the current function return;
+ *			the interpreter's result contains the function's
+ *			return value.
+ * TCL_BREAK		The command requests that the innermost loop be
+ *			exited; the interpreter's result is meaningless.
+ * TCL_CONTINUE		Go on to the next iteration of the current loop; the
+ *			interpreter's result is meaningless.
  */
 
-#define TCL_OK		0
-#define TCL_ERROR	1
-#define TCL_RETURN	2
-#define TCL_BREAK	3
-#define TCL_CONTINUE	4
+#define TCL_OK			0
+#define TCL_ERROR		1
+#define TCL_RETURN		2
+#define TCL_BREAK		3
+#define TCL_CONTINUE		4
 
-#define TCL_RESULT_SIZE 200
+#define TCL_RESULT_SIZE		200
 
 /*
  * Flags to control what substitutions are performed by Tcl_SubstObj():
@@ -649,16 +632,17 @@ typedef struct stat *Tcl_OldStat_;
 #define TCL_SUBST_BACKSLASHES	004
 #define TCL_SUBST_ALL		007
 
-
 /*
  * Argument descriptors for math function callbacks in expressions:
  */
+
 typedef enum {
     TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
 } Tcl_ValueType;
+
 typedef struct Tcl_Value {
-    Tcl_ValueType type;		/* Indicates intValue or doubleValue is
-				 * valid, or both. */
+    Tcl_ValueType type;		/* Indicates intValue or doubleValue is valid,
+				 * or both. */
     long intValue;		/* Integer value. */
     double doubleValue;		/* Double-precision floating value. */
     Tcl_WideInt wideValue;	/* Wide (min. 64-bit) integer value. */
@@ -666,13 +650,13 @@ typedef struct Tcl_Value {
 
 /*
  * Forward declaration of Tcl_Obj to prevent an error when the forward
- * reference to Tcl_Obj is encountered in the procedure types declared 
- * below.
+ * reference to Tcl_Obj is encountered in the function types declared below.
  */
+
 struct Tcl_Obj;
 
 /*
- * Procedure types defined by Tcl:
+ * Function types defined by Tcl:
  */
 
 typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
@@ -718,7 +702,9 @@ typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
 typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
 typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
+typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	int flags));
+typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...));
 typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
 	Tcl_Channel chan, char *address, int port));
 typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
@@ -739,37 +725,35 @@ typedef void (Tcl_ServiceModeHookProc) _ANSI_ARGS_((int mode));
 typedef ClientData (Tcl_InitNotifierProc) _ANSI_ARGS_((VOID));
 typedef void (Tcl_FinalizeNotifierProc) _ANSI_ARGS_((ClientData clientData));
 typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void));
-
+
 /*
- * The following structure represents a type of object, which is a
- * particular internal representation for an object plus a set of
- * procedures that provide standard operations on objects of that type.
+ * The following structure represents a type of object, which is a particular
+ * internal representation for an object plus a set of functions that provide
+ * standard operations on objects of that type.
  */
 
 typedef struct Tcl_ObjType {
     char *name;			/* Name of the type, e.g. "int". */
     Tcl_FreeInternalRepProc *freeIntRepProc;
 				/* Called to free any storage for the type's
-				 * internal rep. NULL if the internal rep
-				 * does not need freeing. */
+				 * internal rep. NULL if the internal rep does
+				 * not need freeing. */
     Tcl_DupInternalRepProc *dupIntRepProc;
-    				/* Called to create a new object as a copy
-				 * of an existing object. */
+				/* Called to create a new object as a copy of
+				 * an existing object. */
     Tcl_UpdateStringProc *updateStringProc;
-    				/* Called to update the string rep from the
+				/* Called to update the string rep from the
 				 * type's internal representation. */
     Tcl_SetFromAnyProc *setFromAnyProc;
-    				/* Called to convert the object's internal
-				 * rep to this type. Frees the internal rep
-				 * of the old type. Returns TCL_ERROR on
-				 * failure. */
+				/* Called to convert the object's internal rep
+				 * to this type. Frees the internal rep of the
+				 * old type. Returns TCL_ERROR on failure. */
 } Tcl_ObjType;
 
-
 /*
- * One of the following structures exists for each object in the Tcl
- * system. An object stores a value as either a string, some internal
- * representation, or both.
+ * One of the following structures exists for each object in the Tcl system.
+ * An object stores a value as either a string, some internal representation,
+ * or both.
  */
 
 typedef struct Tcl_Obj {
@@ -779,101 +763,54 @@ typedef struct Tcl_Obj {
 				 * must be followed by a null byte (i.e., at
 				 * offset length) but may also contain
 				 * embedded null characters. The array's
-				 * storage is allocated by ckalloc. NULL
-				 * means the string rep is invalid and must
-				 * be regenerated from the internal rep.
-				 * Clients should use Tcl_GetStringFromObj
-				 * or Tcl_GetString to get a pointer to the
-				 * byte array as a readonly value. */
+				 * storage is allocated by ckalloc. NULL means
+				 * the string rep is invalid and must be
+				 * regenerated from the internal rep.  Clients
+				 * should use Tcl_GetStringFromObj or
+				 * Tcl_GetString to get a pointer to the byte
+				 * array as a readonly value. */
     int length;			/* The number of bytes at *bytes, not
 				 * including the terminating null. */
     Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
 				 * corresponds to the type of the object's
-				 * internal rep. NULL indicates the object
-				 * has no internal rep (has no type). */
+				 * internal rep. NULL indicates the object has
+				 * no internal rep (has no type). */
     union {			/* The internal representation: */
-	long longValue;		/*   - an long integer value */
-	double doubleValue;	/*   - a double-precision floating value */
-	VOID *otherValuePtr;	/*   - another, type-specific value */
-	Tcl_WideInt wideValue;	/*   - a long long value */
-	struct {		/*   - internal rep as two pointers */
+	long longValue;		/*   - an long integer value. */
+	double doubleValue;	/*   - a double-precision floating value. */
+	VOID *otherValuePtr;	/*   - another, type-specific value. */
+	Tcl_WideInt wideValue;	/*   - a long long value. */
+	struct {		/*   - internal rep as two pointers. */
 	    VOID *ptr1;
 	    VOID *ptr2;
 	} twoPtrValue;
+	struct {		/*   - internal rep as a wide int, tightly
+				 *     packed fields. */
+	    VOID *ptr;		/* Pointer to digits. */
+	    unsigned long value;/* Alloc, used, and signum packed into a
+				 * single word. */
+	} ptrAndLongRep;
     } internalRep;
 } Tcl_Obj;
 
-
 /*
- * Macros to increment and decrement a Tcl_Obj's reference count, and to
- * test whether an object is shared (i.e. has reference count > 1).
- * Note: clients should use Tcl_DecrRefCount() when they are finished using
- * an object, and should never call TclFreeObj() directly. TclFreeObj() is
- * only defined and made public in tcl.h to support Tcl_DecrRefCount's macro
- * definition.
+ * Macros to increment and decrement a Tcl_Obj's reference count, and to test
+ * whether an object is shared (i.e. has reference count > 1). Note: clients
+ * should use Tcl_DecrRefCount() when they are finished using an object, and
+ * should never call TclFreeObj() directly. TclFreeObj() is only defined and
+ * made public in tcl.h to support Tcl_DecrRefCount's macro definition.
  */
+
 void		Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
 void		Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
 int		Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
-
-#ifdef TCL_MEM_DEBUG
-#   define Tcl_IncrRefCount(objPtr) \
-	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
-#   define Tcl_DecrRefCount(objPtr) \
-	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
-#   define Tcl_IsShared(objPtr) \
-	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
-#else
-#   define Tcl_IncrRefCount(objPtr) \
-	++(objPtr)->refCount
-    /*
-     * Use do/while0 idiom for optimum correctness without compiler warnings
-     * http://c2.com/cgi/wiki?TrivialDoWhileLoop
-     */
-#   define Tcl_DecrRefCount(objPtr) \
-	do { \
-	    Tcl_Obj *_objPtr = (objPtr); \
-	    if (--(_objPtr)->refCount <= 0) { \
-		TclFreeObj(_objPtr); \
-	    } \
-	} while(0)
-#   define Tcl_IsShared(objPtr) \
-	((objPtr)->refCount > 1)
-#endif
 
 /*
- * Macros and definitions that help to debug the use of Tcl objects.
- * When TCL_MEM_DEBUG is defined, the Tcl_New declarations are 
- * overridden to call debugging versions of the object creation procedures.
+ * The following structure contains the state needed by Tcl_SaveResult. No-one
+ * outside of Tcl should access any of these fields. This structure is
+ * typically allocated on the stack.
  */
 
-#ifdef TCL_MEM_DEBUG
-#  define Tcl_NewBooleanObj(val) \
-     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
-#  define Tcl_NewByteArrayObj(bytes, len) \
-     Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
-#  define Tcl_NewDoubleObj(val) \
-     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
-#  define Tcl_NewIntObj(val) \
-     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-#  define Tcl_NewListObj(objc, objv) \
-     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
-#  define Tcl_NewLongObj(val) \
-     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-#  define Tcl_NewObj() \
-     Tcl_DbNewObj(__FILE__, __LINE__)
-#  define Tcl_NewStringObj(bytes, len) \
-     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
-#  define Tcl_NewWideIntObj(val) \
-     Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
-#endif /* TCL_MEM_DEBUG */
-
-
-/*
- * The following structure contains the state needed by
- * Tcl_SaveResult.  No-one outside of Tcl should access any of these
- * fields.  This structure is typically allocated on the stack.
- */
 typedef struct Tcl_SavedResult {
     char *result;
     Tcl_FreeProc *freeProc;
@@ -885,46 +822,46 @@ typedef struct Tcl_SavedResult {
 } Tcl_SavedResult;
 
 /*
- * The following definitions support Tcl's namespace facility.
- * Note: the first five fields must match exactly the fields in a
- * Namespace structure (see tclInt.h). 
+ * The following definitions support Tcl's namespace facility. Note: the first
+ * five fields must match exactly the fields in a Namespace structure (see
+ * tclInt.h).
  */
 
 typedef struct Tcl_Namespace {
-    char *name;                 /* The namespace's name within its parent
-				 * namespace. This contains no ::'s. The
-				 * name of the global namespace is ""
-				 * although "::" is an synonym. */
-    char *fullName;             /* The namespace's fully qualified name.
-				 * This starts with ::. */
-    ClientData clientData;      /* Arbitrary value associated with this
+    char *name;			/* The namespace's name within its parent
+				 * namespace. This contains no ::'s. The name
+				 * of the global namespace is "" although "::"
+				 * is an synonym. */
+    char *fullName;		/* The namespace's fully qualified name. This
+				 * starts with ::. */
+    ClientData clientData;	/* Arbitrary value associated with this
 				 * namespace. */
-    Tcl_NamespaceDeleteProc* deleteProc;
-                                /* Procedure invoked when deleting the
+    Tcl_NamespaceDeleteProc *deleteProc;
+				/* Function invoked when deleting the
 				 * namespace to, e.g., free clientData. */
-    struct Tcl_Namespace* parentPtr;
-                                /* Points to the namespace that contains
-				 * this one. NULL if this is the global
+    struct Tcl_Namespace *parentPtr;
+				/* Points to the namespace that contains this
+				 * one. NULL if this is the global
 				 * namespace. */
 } Tcl_Namespace;
 
 /*
- * The following structure represents a call frame, or activation record.
- * A call frame defines a naming context for a procedure call: its local
- * scope (for local variables) and its namespace scope (used for non-local
- * variables; often the global :: namespace). A call frame can also define
- * the naming context for a namespace eval or namespace inscope command:
- * the namespace in which the command's code should execute. The
- * Tcl_CallFrame structures exist only while procedures or namespace
- * eval/inscope's are being executed, and provide a Tcl call stack.
- * 
- * A call frame is initialized and pushed using Tcl_PushCallFrame and
- * popped using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be
- * provided by the Tcl_PushCallFrame caller, and callers typically allocate
- * them on the C call stack for efficiency. For this reason, Tcl_CallFrame
- * is defined as a structure and not as an opaque token. However, most
- * Tcl_CallFrame fields are hidden since applications should not access
- * them directly; others are declared as "dummyX".
+ * The following structure represents a call frame, or activation record. A
+ * call frame defines a naming context for a procedure call: its local scope
+ * (for local variables) and its namespace scope (used for non-local
+ * variables; often the global :: namespace). A call frame can also define the
+ * naming context for a namespace eval or namespace inscope command: the
+ * namespace in which the command's code should execute. The Tcl_CallFrame
+ * structures exist only while procedures or namespace eval/inscope's are
+ * being executed, and provide a Tcl call stack.
+ *
+ * A call frame is initialized and pushed using Tcl_PushCallFrame and popped
+ * using Tcl_PopCallFrame. Storage for a Tcl_CallFrame must be provided by the
+ * Tcl_PushCallFrame caller, and callers typically allocate them on the C call
+ * stack for efficiency. For this reason, Tcl_CallFrame is defined as a
+ * structure and not as an opaque token. However, most Tcl_CallFrame fields
+ * are hidden since applications should not access them directly; others are
+ * declared as "dummyX".
  *
  * WARNING!! The structure definition must be kept consistent with the
  * CallFrame structure in tclInt.h. If you change one, change the other.
@@ -949,57 +886,56 @@ typedef struct Tcl_CallFrame {
 
 /*
  * Information about commands that is returned by Tcl_GetCommandInfo and
- * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based
- * command procedure while proc is a traditional Tcl argc/argv
- * string-based procedure. Tcl_CreateObjCommand and Tcl_CreateCommand
- * ensure that both objProc and proc are non-NULL and can be called to
- * execute the command. However, it may be faster to call one instead of
- * the other. The member isNativeObjectProc is set to 1 if an
- * object-based procedure was registered by Tcl_CreateObjCommand, and to
- * 0 if a string-based procedure was registered by Tcl_CreateCommand.
- * The other procedure is typically set to a compatibility wrapper that
- * does string-to-object or object-to-string argument conversions then
- * calls the other procedure.
+ * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command
+ * function while proc is a traditional Tcl argc/argv string-based function.
+ * Tcl_CreateObjCommand and Tcl_CreateCommand ensure that both objProc and
+ * proc are non-NULL and can be called to execute the command. However, it may
+ * be faster to call one instead of the other. The member isNativeObjectProc
+ * is set to 1 if an object-based function was registered by
+ * Tcl_CreateObjCommand, and to 0 if a string-based function was registered by
+ * Tcl_CreateCommand. The other function is typically set to a compatibility
+ * wrapper that does string-to-object or object-to-string argument conversions
+ * then calls the other function.
  */
 
 typedef struct Tcl_CmdInfo {
-    int isNativeObjectProc;	 /* 1 if objProc was registered by a call to
-				  * Tcl_CreateObjCommand; 0 otherwise.
-				  * Tcl_SetCmdInfo does not modify this
-				  * field. */
-    Tcl_ObjCmdProc *objProc;	 /* Command's object-based procedure. */
-    ClientData objClientData;	 /* ClientData for object proc. */
-    Tcl_CmdProc *proc;		 /* Command's string-based procedure. */
-    ClientData clientData;	 /* ClientData for string proc. */
+    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
+				 * Tcl_CreateObjCommand; 0 otherwise.
+				 * Tcl_SetCmdInfo does not modify this
+				 * field. */
+    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
+    ClientData objClientData;	/* ClientData for object proc. */
+    Tcl_CmdProc *proc;		/* Command's string-based function. */
+    ClientData clientData;	/* ClientData for string proc. */
     Tcl_CmdDeleteProc *deleteProc;
-                                 /* Procedure to call when command is
-                                  * deleted. */
-    ClientData deleteData;	 /* Value to pass to deleteProc (usually
-				  * the same as clientData). */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace that contains
-				  * this command. Note that Tcl_SetCmdInfo
-				  * will not change a command's namespace;
-				  * use Tcl_RenameCommand to do that. */
-
+				/* Function to call when command is
+				 * deleted. */
+    ClientData deleteData;	/* Value to pass to deleteProc (usually the
+				 * same as clientData). */
+    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
+				 * command. Note that Tcl_SetCmdInfo will not
+				 * change a command's namespace; use
+				 * TclRenameCommand or Tcl_Eval (of 'rename')
+				 * to do that. */
 } Tcl_CmdInfo;
 
 /*
- * The structure defined below is used to hold dynamic strings.  The only
- * field that clients should use is the string field, accessible via the
- * macro Tcl_DStringValue.  
+ * The structure defined below is used to hold dynamic strings. The only
+ * fields that clients should use are string and length, accessible via the
+ * macros Tcl_DStringValue and Tcl_DStringLength.
  */
 
 #define TCL_DSTRING_STATIC_SIZE 200
 typedef struct Tcl_DString {
-    char *string;		/* Points to beginning of string:  either
+    char *string;		/* Points to beginning of string: either
 				 * staticSpace below or a malloced array. */
     int length;			/* Number of non-NULL characters in the
 				 * string. */
     int spaceAvl;		/* Total number of bytes available for the
 				 * string and its terminating NULL char. */
     char staticSpace[TCL_DSTRING_STATIC_SIZE];
-				/* Space to use in common case where string
-				 * is small. */
+				/* Space to use in common case where string is
+				 * small. */
 } Tcl_DString;
 
 #define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
@@ -1007,29 +943,34 @@ typedef struct Tcl_DString {
 #define Tcl_DStringTrunc Tcl_DStringSetLength
 
 /*
- * Definitions for the maximum number of digits of precision that may
- * be specified in the "tcl_precision" variable, and the number of
- * bytes of buffer space required by Tcl_PrintDouble.
+ * Definitions for the maximum number of digits of precision that may be
+ * specified in the "tcl_precision" variable, and the number of bytes of
+ * buffer space required by Tcl_PrintDouble.
  */
 
-#define TCL_MAX_PREC 17
-#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
+#define TCL_MAX_PREC		17
+#define TCL_DOUBLE_SPACE	(TCL_MAX_PREC+10)
 
 /*
  * Definition for a number of bytes of buffer space sufficient to hold the
- * string representation of an integer in base 10 (assuming the existence
- * of 64-bit integers).
+ * string representation of an integer in base 10 (assuming the existence of
+ * 64-bit integers).
  */
 
 #define TCL_INTEGER_SPACE	24
 
 /*
- * Flag that may be passed to Tcl_ConvertElement to force it not to
- * output braces (careful!  if you change this flag be sure to change
- * the definitions at the front of tclUtil.c).
+ * Flag values passed to Tcl_ConvertElement.
+ * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
+ *	use backslash quoting instead.
+ * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
+ *	is safe to leave the hash unquoted when the element is not the first
+ *	element of a list, and this flag can be used by the caller to indicate
+ *	that condition.
  */
 
 #define TCL_DONT_USE_BRACES	1
+#define TCL_DONT_QUOTE_HASH	8
 
 /*
  * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
@@ -1039,26 +980,36 @@ typedef struct Tcl_DString {
 #define TCL_EXACT	1
 
 /*
- * Flag values passed to Tcl_RecordAndEval and/or Tcl_EvalObj.
- * WARNING: these bit choices must not conflict with the bit choices
- * for evalFlag bits in tclInt.h!!
+ * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
+ * WARNING: these bit choices must not conflict with the bit choices for
+ * evalFlag bits in tclInt.h!
+ *
+ * Meanings:
+ *	TCL_NO_EVAL:		Just record this command
+ *	TCL_EVAL_GLOBAL:	Execute script in global namespace
+ *	TCL_EVAL_DIRECT:	Do not compile this script
+ *	TCL_EVAL_INVOKE:	Magical Tcl_EvalObjv mode for aliases/ensembles
+ *				o Run in iPtr->lookupNsPtr or global namespace
+ *				o Cut out of error traces
+ *				o Don't reset the flags controlling ensemble
+ *				  error message rewriting.
  */
 #define TCL_NO_EVAL		0x10000
 #define TCL_EVAL_GLOBAL		0x20000
 #define TCL_EVAL_DIRECT		0x40000
-#define TCL_EVAL_INVOKE	        0x80000
+#define TCL_EVAL_INVOKE		0x80000
 
 /*
- * Special freeProc values that may be passed to Tcl_SetResult (see
- * the man page for details):
+ * Special freeProc values that may be passed to Tcl_SetResult (see the man
+ * page for details):
  */
 
-#define TCL_VOLATILE	((Tcl_FreeProc *) 1)
-#define TCL_STATIC	((Tcl_FreeProc *) 0)
-#define TCL_DYNAMIC	((Tcl_FreeProc *) 3)
+#define TCL_VOLATILE		((Tcl_FreeProc *) 1)
+#define TCL_STATIC		((Tcl_FreeProc *) 0)
+#define TCL_DYNAMIC		((Tcl_FreeProc *) 3)
 
 /*
- * Flag values passed to variable-related procedures.
+ * Flag values passed to variable-related functions.
  */
 
 #define TCL_GLOBAL_ONLY		 1
@@ -1081,7 +1032,15 @@ typedef struct Tcl_DString {
 #define TCL_TRACE_RESULT_OBJECT  0x10000
 
 /*
- * Flag values passed to command-related procedures.
+ * Flag values for ensemble commands.
+ */
+
+#define TCL_ENSEMBLE_PREFIX 0x02/* Flag value to say whether to allow
+				 * unambiguous prefixes of commands or to
+				 * require exact matches for command names. */
+
+/*
+ * Flag values passed to command-related functions.
  */
 
 #define TCL_TRACE_RENAME 0x2000
@@ -1090,32 +1049,34 @@ typedef struct Tcl_DString {
 #define TCL_ALLOW_INLINE_COMPILATION 0x20000
 
 /*
- * Flag values passed to Tcl_CreateObjTrace, and used internally
- * by command execution traces.  Slots 4,8,16 and 32 are
- * used internally by execution traces (see tclCmdMZ.c)
+ * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
+ * always parsed whenever the part2 is NULL. (This is to avoid a common error
+ * when converting code to use the new object based APIs and forgetting to
+ * give the flag)
  */
-#define TCL_TRACE_ENTER_EXEC		1
-#define TCL_TRACE_LEAVE_EXEC		2
 
-/*
- * The TCL_PARSE_PART1 flag is deprecated and has no effect. 
- * The part1 is now always parsed whenever the part2 is NULL.
- * (This is to avoid a common error when converting code to
- *  use the new object based APIs and forgetting to give the
- *  flag)
- */
 #ifndef TCL_NO_DEPRECATED
-#   define TCL_PARSE_PART1      0x400
+#   define TCL_PARSE_PART1	0x400
 #endif
 
 /*
  * Types for linked variables:
  */
+
 #define TCL_LINK_INT		1
 #define TCL_LINK_DOUBLE		2
 #define TCL_LINK_BOOLEAN	3
 #define TCL_LINK_STRING		4
 #define TCL_LINK_WIDE_INT	5
+#define TCL_LINK_CHAR		6
+#define TCL_LINK_UCHAR		7
+#define TCL_LINK_SHORT		8
+#define TCL_LINK_USHORT		9
+#define TCL_LINK_UINT		10
+#define TCL_LINK_LONG		11
+#define TCL_LINK_ULONG		12
+#define TCL_LINK_FLOAT		13
+#define TCL_LINK_WIDE_UINT	14
 #define TCL_LINK_READ_ONLY	0x80
 
 /*
@@ -1136,10 +1097,10 @@ typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr));
 
 /*
  * This flag controls whether the hash table stores the hash of a key, or
- * recalculates it. There should be no reason for turning this flag off
- * as it is completely binary and source compatible unless you directly
- * access the bucketPtr member of the Tcl_HashTableEntry structure. This
- * member has been removed and the space used to store the hash value.
+ * recalculates it. There should be no reason for turning this flag off as it
+ * is completely binary and source compatible unless you directly access the
+ * bucketPtr member of the Tcl_HashTableEntry structure. This member has been
+ * removed and the space used to store the hash value.
  */
 
 #ifndef TCL_HASH_KEY_STORE_HASH
@@ -1147,160 +1108,152 @@ typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr));
 #endif
 
 /*
- * Structure definition for an entry in a hash table.  No-one outside
- * Tcl should access any of these fields directly;  use the macros
- * defined below.
+ * Structure definition for an entry in a hash table. No-one outside Tcl
+ * should access any of these fields directly; use the macros defined below.
  */
 
 struct Tcl_HashEntry {
-    Tcl_HashEntry *nextPtr;		/* Pointer to next entry in this
-					 * hash bucket, or NULL for end of
-					 * chain. */
-    Tcl_HashTable *tablePtr;		/* Pointer to table containing entry. */
+    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
+				 * or NULL for end of chain. */
+    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
 #if TCL_HASH_KEY_STORE_HASH
-#   if TCL_PRESERVE_BINARY_COMPATABILITY
-    VOID *hash;				/* Hash value, stored as pointer to
-					 * ensure that the offsets of the
-					 * fields in this structure are not
-					 * changed. */
-#   else
-    unsigned int hash;			/* Hash value. */
-#   endif
+    VOID *hash;			/* Hash value, stored as pointer to ensure
+				 * that the offsets of the fields in this
+				 * structure are not changed. */
 #else
-    Tcl_HashEntry **bucketPtr;		/* Pointer to bucket that points to
-					 * first entry in this entry's chain:
-					 * used for deleting the entry. */
+    Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to first
+				 * entry in this entry's chain: used for
+				 * deleting the entry. */
 #endif
-    ClientData clientData;		/* Application stores something here
-					 * with Tcl_SetHashValue. */
-    union {				/* Key has one of these forms: */
-	char *oneWordValue;		/* One-word value for key. */
-        Tcl_Obj *objPtr;		/* Tcl_Obj * key value. */
-	int words[1];			/* Multiple integer words for key.
-					 * The actual size will be as large
-					 * as necessary for this table's
-					 * keys. */
-	char string[4];			/* String for key.  The actual size
-					 * will be as large as needed to hold
-					 * the key. */
-    } key;				/* MUST BE LAST FIELD IN RECORD!! */
+    ClientData clientData;	/* Application stores something here with
+				 * Tcl_SetHashValue. */
+    union {			/* Key has one of these forms: */
+	char *oneWordValue;	/* One-word value for key. */
+	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
+	int words[1];		/* Multiple integer words for key. The actual
+				 * size will be as large as necessary for this
+				 * table's keys. */
+	char string[4];		/* String for key. The actual size will be as
+				 * large as needed to hold the key. */
+    } key;			/* MUST BE LAST FIELD IN RECORD!! */
 };
 
 /*
  * Flags used in Tcl_HashKeyType.
  *
- * TCL_HASH_KEY_RANDOMIZE_HASH:
+ * TCL_HASH_KEY_RANDOMIZE_HASH -
  *				There are some things, pointers for example
  *				which don't hash well because they do not use
  *				the lower bits. If this flag is set then the
  *				hash table will attempt to rectify this by
  *				randomising the bits and then using the upper
  *				N bits as the index into the table.
+ * TCL_HASH_KEY_SYSTEM_HASH -	If this flag is set then all memory internally
+ *                              allocated for the hash table that is not for an
+ *                              entry will use the system heap.
  */
+
 #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
+#define TCL_HASH_KEY_SYSTEM_HASH    0x2
 
 /*
- * Structure definition for the methods associated with a hash table
- * key type.
+ * Structure definition for the methods associated with a hash table key type.
  */
+
 #define TCL_HASH_KEY_TYPE_VERSION 1
 struct Tcl_HashKeyType {
     int version;		/* Version of the table. If this structure is
 				 * extended in future then the version can be
 				 * used to distinguish between different
-				 * structures. 
-				 */
-
+				 * structures. */
     int flags;			/* Flags, see above for details. */
-
-    /* Calculates a hash value for the key. If this is NULL then the pointer
-     * itself is used as a hash value.
-     */
     Tcl_HashKeyProc *hashKeyProc;
-
-    /* Compares two keys and returns zero if they do not match, and non-zero
-     * if they do. If this is NULL then the pointers are compared.
-     */
+				/* Calculates a hash value for the key. If
+				 * this is NULL then the pointer itself is
+				 * used as a hash value. */
     Tcl_CompareHashKeysProc *compareKeysProc;
-
-    /* Called to allocate memory for a new entry, i.e. if the key is a
-     * string then this could allocate a single block which contains enough
-     * space for both the entry and the string. Only the key field of the
-     * allocated Tcl_HashEntry structure needs to be filled in. If something
-     * else needs to be done to the key, i.e. incrementing a reference count
-     * then that should be done by this function. If this is NULL then Tcl_Alloc
-     * is used to allocate enough space for a Tcl_HashEntry and the key pointer
-     * is assigned to key.oneWordValue.
-     */
+				/* Compares two keys and returns zero if they
+				 * do not match, and non-zero if they do. If
+				 * this is NULL then the pointers are
+				 * compared. */
     Tcl_AllocHashEntryProc *allocEntryProc;
-
-    /* Called to free memory associated with an entry. If something else needs
-     * to be done to the key, i.e. decrementing a reference count then that
-     * should be done by this function. If this is NULL then Tcl_Free is used
-     * to free the Tcl_HashEntry.
-     */
+				/* Called to allocate memory for a new entry,
+				 * i.e. if the key is a string then this could
+				 * allocate a single block which contains
+				 * enough space for both the entry and the
+				 * string. Only the key field of the allocated
+				 * Tcl_HashEntry structure needs to be filled
+				 * in. If something else needs to be done to
+				 * the key, i.e. incrementing a reference
+				 * count then that should be done by this
+				 * function. If this is NULL then Tcl_Alloc is
+				 * used to allocate enough space for a
+				 * Tcl_HashEntry and the key pointer is
+				 * assigned to key.oneWordValue. */
     Tcl_FreeHashEntryProc *freeEntryProc;
+				/* Called to free memory associated with an
+				 * entry. If something else needs to be done
+				 * to the key, i.e. decrementing a reference
+				 * count then that should be done by this
+				 * function. If this is NULL then Tcl_Free is
+				 * used to free the Tcl_HashEntry. */
 };
 
 /*
- * Structure definition for a hash table.  Must be in tcl.h so clients
- * can allocate space for these structures, but clients should never
- * access any fields in this structure.
+ * Structure definition for a hash table.  Must be in tcl.h so clients can
+ * allocate space for these structures, but clients should never access any
+ * fields in this structure.
  */
 
 #define TCL_SMALL_HASH_TABLE 4
 struct Tcl_HashTable {
-    Tcl_HashEntry **buckets;		/* Pointer to bucket array.  Each
-					 * element points to first entry in
-					 * bucket's hash chain, or NULL. */
+    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
+				 * points to first entry in bucket's hash
+				 * chain, or NULL. */
     Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
-					/* Bucket array used for small tables
-					 * (to avoid mallocs and frees). */
-    int numBuckets;			/* Total number of buckets allocated
-					 * at **bucketPtr. */
-    int numEntries;			/* Total number of entries present
-					 * in table. */
-    int rebuildSize;			/* Enlarge table when numEntries gets
-					 * to be this large. */
-    int downShift;			/* Shift count used in hashing
-					 * function.  Designed to use high-
-					 * order bits of randomized keys. */
-    int mask;				/* Mask value used in hashing
-					 * function. */
-    int keyType;			/* Type of keys used in this table. 
-					 * It's either TCL_CUSTOM_KEYS,
-					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
-					 * or an integer giving the number of
-					 * ints that is the size of the key.
-					 */
-#if TCL_PRESERVE_BINARY_COMPATABILITY
+				/* Bucket array used for small tables (to
+				 * avoid mallocs and frees). */
+    int numBuckets;		/* Total number of buckets allocated at
+				 * **bucketPtr. */
+    int numEntries;		/* Total number of entries present in
+				 * table. */
+    int rebuildSize;		/* Enlarge table when numEntries gets to be
+				 * this large. */
+    int downShift;		/* Shift count used in hashing function.
+				 * Designed to use high-order bits of
+				 * randomized keys. */
+    int mask;			/* Mask value used in hashing function. */
+    int keyType;		/* Type of keys used in this table. It's
+				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
+				 * TCL_ONE_WORD_KEYS, or an integer giving the
+				 * number of ints that is the size of the
+				 * key. */
     Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
 	    CONST char *key));
     Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
 	    CONST char *key, int *newPtr));
-#endif
-    Tcl_HashKeyType *typePtr;		/* Type of the keys used in the
-					 * Tcl_HashTable. */
+    Tcl_HashKeyType *typePtr;	/* Type of the keys used in the
+				 * Tcl_HashTable. */
 };
 
 /*
- * Structure definition for information used to keep track of searches
- * through hash tables:
+ * Structure definition for information used to keep track of searches through
+ * hash tables:
  */
 
 typedef struct Tcl_HashSearch {
-    Tcl_HashTable *tablePtr;		/* Table being searched. */
-    int nextIndex;			/* Index of next bucket to be
-					 * enumerated after present one. */
-    Tcl_HashEntry *nextEntryPtr;	/* Next entry to be enumerated in the
-					 * the current bucket. */
+    Tcl_HashTable *tablePtr;	/* Table being searched. */
+    int nextIndex;		/* Index of next bucket to be enumerated after
+				 * present one. */
+    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
+				 * bucket. */
 } Tcl_HashSearch;
 
 /*
  * Acceptable key types for hash tables:
  *
- * TCL_STRING_KEYS:		The keys are strings, they are copied into
- *				the entry.
+ * TCL_STRING_KEYS:		The keys are strings, they are copied into the
+ *				entry.
  * TCL_ONE_WORD_KEYS:		The keys are pointers, the pointer is stored
  *				in the entry.
  * TCL_CUSTOM_TYPE_KEYS:	The keys are arbitrary types which are copied
@@ -1308,69 +1261,39 @@ typedef struct Tcl_HashSearch {
  * TCL_CUSTOM_PTR_KEYS:		The keys are pointers to arbitrary types, the
  *				pointer is stored in the entry.
  *
- * While maintaining binary compatability the above have to be distinct
- * values as they are used to differentiate between old versions of the
- * hash table which don't have a typePtr and new ones which do. Once binary
- * compatability is discarded in favour of making more wide spread changes
- * TCL_STRING_KEYS can be the same as TCL_CUSTOM_TYPE_KEYS, and
- * TCL_ONE_WORD_KEYS can be the same as TCL_CUSTOM_PTR_KEYS because they
- * simply determine how the key is accessed from the entry and not the
- * behaviour.
+ * While maintaining binary compatability the above have to be distinct values
+ * as they are used to differentiate between old versions of the hash table
+ * which don't have a typePtr and new ones which do. Once binary compatability
+ * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
+ * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
+ * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
+ * accessed from the entry and not the behaviour.
  */
 
 #define TCL_STRING_KEYS		0
 #define TCL_ONE_WORD_KEYS	1
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-#   define TCL_CUSTOM_TYPE_KEYS		-2
-#   define TCL_CUSTOM_PTR_KEYS		-1
-#else
-#   define TCL_CUSTOM_TYPE_KEYS		TCL_STRING_KEYS
-#   define TCL_CUSTOM_PTR_KEYS		TCL_ONE_WORD_KEYS
-#endif
+#define TCL_CUSTOM_TYPE_KEYS	-2
+#define TCL_CUSTOM_PTR_KEYS	-1
 
 /*
- * Macros for clients to use to access fields of hash entries:
+ * Structure definition for information used to keep track of searches through
+ * dictionaries. These fields should not be accessed by code outside
+ * tclDictObj.c
  */
 
-#define Tcl_GetHashValue(h) ((h)->clientData)
-#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-#   define Tcl_GetHashKey(tablePtr, h) \
-	((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
-		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
-		   ? (h)->key.oneWordValue \
-		   : (h)->key.string))
-#else
-#   define Tcl_GetHashKey(tablePtr, h) \
-	((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) \
-		   ? (h)->key.oneWordValue \
-		   : (h)->key.string))
-#endif
-
-/*
- * Macros to use for clients to use to invoke find and create procedures
- * for hash tables:
- */
+typedef struct {
+    void *next;			/* Search position for underlying hash
+				 * table. */
+    int epoch;			/* Epoch marker for dictionary being searched,
+				 * or -1 if search has terminated. */
+    Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
+} Tcl_DictSearch;
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-#   define Tcl_FindHashEntry(tablePtr, key) \
-	(*((tablePtr)->findProc))(tablePtr, key)
-#   define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
-	(*((tablePtr)->createProc))(tablePtr, key, newPtr)
-#else /* !TCL_PRESERVE_BINARY_COMPATABILITY */
 /*
- * Macro to use new extended version of Tcl_InitHashTable.
+ * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
+ * events:
  */
-#   define Tcl_InitHashTable(tablePtr, keyType) \
-	Tcl_InitHashTableEx(tablePtr, keyType, NULL)
-#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */
-
 
-/*
- * Flag values to pass to Tcl_DoOneEvent to disable searches
- * for some kinds of events:
- */
 #define TCL_DONT_WAIT		(1<<1)
 #define TCL_WINDOW_EVENTS	(1<<2)
 #define TCL_FILE_EVENTS		(1<<3)
@@ -1379,17 +1302,16 @@ typedef struct Tcl_HashSearch {
 #define TCL_ALL_EVENTS		(~TCL_DONT_WAIT)
 
 /*
- * The following structure defines a generic event for the Tcl event
- * system.  These are the things that are queued in calls to Tcl_QueueEvent
- * and serviced later by Tcl_DoOneEvent.  There can be many different
- * kinds of events with different fields, corresponding to window events,
- * timer events, etc.  The structure for a particular event consists of
- * a Tcl_Event header followed by additional information specific to that
- * event.
+ * The following structure defines a generic event for the Tcl event system.
+ * These are the things that are queued in calls to Tcl_QueueEvent and
+ * serviced later by Tcl_DoOneEvent. There can be many different kinds of
+ * events with different fields, corresponding to window events, timer events,
+ * etc. The structure for a particular event consists of a Tcl_Event header
+ * followed by additional information specific to that event.
  */
 
 struct Tcl_Event {
-    Tcl_EventProc *proc;	/* Procedure to call to service this event. */
+    Tcl_EventProc *proc;	/* Function to call to service this event. */
     struct Tcl_Event *nextPtr;	/* Next in list of pending events, or NULL. */
 };
 
@@ -1410,9 +1332,9 @@ typedef enum {
 #define TCL_SERVICE_ALL 1
 
 /*
- * The following structure keeps is used to hold a time value, either as
- * an absolute time (the number of seconds from the epoch) or as an
- * elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ * The following structure keeps is used to hold a time value, either as an
+ * absolute time (the number of seconds from the epoch) or as an elapsed time.
+ * On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
  */
 
 typedef struct Tcl_Time {
@@ -1424,20 +1346,30 @@ typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
 typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
 
 /*
- * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
- * to indicate what sorts of events are of interest:
+ * TIP #233 (Virtualized Time)
  */
-#define TCL_READABLE	(1<<1)
-#define TCL_WRITABLE	(1<<2)
-#define TCL_EXCEPTION	(1<<3)
+
+typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_((Tcl_Time *timebuf,
+	ClientData clientData));
+typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_((Tcl_Time *timebuf,
+	ClientData clientData));
 
 /*
- * Flag values to pass to Tcl_OpenCommandChannel to indicate the
- * disposition of the stdio handles.  TCL_STDIN, TCL_STDOUT, TCL_STDERR,
- * are also used in Tcl_GetStdChannel.
+ * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
+ * indicate what sorts of events are of interest:
  */
 
-#define TCL_STDIN		(1<<1)	
+#define TCL_READABLE		(1<<1)
+#define TCL_WRITABLE		(1<<2)
+#define TCL_EXCEPTION		(1<<3)
+
+/*
+ * Flag values to pass to Tcl_OpenCommandChannel to indicate the disposition
+ * of the stdio handles. TCL_STDIN, TCL_STDOUT, TCL_STDERR, are also used in
+ * Tcl_GetStdChannel.
+ */
+
+#define TCL_STDIN		(1<<1)
 #define TCL_STDOUT		(1<<2)
 #define TCL_STDERR		(1<<3)
 #define TCL_ENFORCE_MODE	(1<<4)
@@ -1446,27 +1378,29 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
  * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel
  * should be closed.
  */
-#define TCL_CLOSE_READ	(1<<1)
-#define TCL_CLOSE_WRITE	(1<<2)
+
+#define TCL_CLOSE_READ		(1<<1)
+#define TCL_CLOSE_WRITE		(1<<2)
 
 /*
- * Value to use as the closeProc for a channel that supports the
- * close2Proc interface.
+ * Value to use as the closeProc for a channel that supports the close2Proc
+ * interface.
  */
 
-#define TCL_CLOSE2PROC	((Tcl_DriverCloseProc *)1)
+#define TCL_CLOSE2PROC		((Tcl_DriverCloseProc *) 1)
 
 /*
- * Channel version tag.  This was introduced in 8.3.2/8.4.
+ * Channel version tag. This was introduced in 8.3.2/8.4.
  */
 
 #define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
 #define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
 #define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
 #define TCL_CHANNEL_VERSION_4	((Tcl_ChannelTypeVersion) 0x4)
+#define TCL_CHANNEL_VERSION_5	((Tcl_ChannelTypeVersion) 0x5)
 
 /*
- * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc
+ * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc.
  */
 
 #define TCL_CHANNEL_THREAD_INSERT (0)
@@ -1490,7 +1424,7 @@ typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
 		    long offset, int mode, int *errorCodePtr));
 typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_Interp *interp,
-	            CONST char *optionName, CONST char *value));
+		    CONST char *optionName, CONST char *value));
 typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_Interp *interp,
 		    CONST84 char *optionName, Tcl_DString *dsPtr));
@@ -1499,125 +1433,111 @@ typedef void	(Tcl_DriverWatchProc) _ANSI_ARGS_((
 typedef int	(Tcl_DriverGetHandleProc) _ANSI_ARGS_((
 		    ClientData instanceData, int direction,
 		    ClientData *handlePtr));
-typedef int	(Tcl_DriverFlushProc) _ANSI_ARGS_((
-		    ClientData instanceData));
+typedef int	(Tcl_DriverFlushProc) _ANSI_ARGS_((ClientData instanceData));
 typedef int	(Tcl_DriverHandlerProc) _ANSI_ARGS_((
 		    ClientData instanceData, int interestMask));
 typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
 		    ClientData instanceData, Tcl_WideInt offset,
 		    int mode, int *errorCodePtr));
-
-  /* TIP #218, Channel Thread Actions */
-typedef void     (Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
-		    ClientData instanceData, int action));
-
 /*
- * The following declarations either map ckalloc and ckfree to
- * malloc and free, or they map them to procedures with all sorts
- * of debugging hooks defined in tclCkalloc.c.
+ * TIP #218, Channel Thread Actions
  */
-#ifdef TCL_MEM_DEBUG
-
-#   define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-#   define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
-#   define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-#   define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__)
-#   define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)
-#else /* !TCL_MEM_DEBUG */
-
+typedef void	(Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
+		    ClientData instanceData, int action));
 /*
- * If we are not using the debugging allocator, we should call the 
- * Tcl_Alloc, et al. routines in order to guarantee that every module
- * is using the same memory allocator both inside and outside of the
- * Tcl library.
+ * TIP #208, File Truncation (etc.)
  */
-#   define ckalloc(x) Tcl_Alloc(x)
-#   define ckfree(x) Tcl_Free(x)
-#   define ckrealloc(x,y) Tcl_Realloc(x,y)
-#   define attemptckalloc(x) Tcl_AttemptAlloc(x)
-#   define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y)
-#   define Tcl_InitMemory(x)
-#   define Tcl_DumpActiveMemory(x)
-#   define Tcl_ValidateAllMemory(x,y)
-
-#endif /* !TCL_MEM_DEBUG */
+typedef int	(Tcl_DriverTruncateProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_WideInt length));
 
 /*
  * struct Tcl_ChannelType:
  *
- * One such structure exists for each type (kind) of channel.
- * It collects together in one place all the functions that are
- * part of the specific channel type.
+ * One such structure exists for each type (kind) of channel. It collects
+ * together in one place all the functions that are part of the specific
+ * channel type.
  *
- * It is recommend that the Tcl_Channel* functions are used to access
- * elements of this structure, instead of direct accessing.
+ * It is recommend that the Tcl_Channel* functions are used to access elements
+ * of this structure, instead of direct accessing.
  */
 
 typedef struct Tcl_ChannelType {
-    char *typeName;			/* The name of the channel type in Tcl
-                                         * commands. This storage is owned by
-                                         * channel type. */
-    Tcl_ChannelTypeVersion version;	/* Version of the channel type. */
-    Tcl_DriverCloseProc *closeProc;	/* Procedure to call to close the
-					 * channel, or TCL_CLOSE2PROC if the
-					 * close2Proc should be used
-					 * instead. */
-    Tcl_DriverInputProc *inputProc;	/* Procedure to call for input
-					 * on channel. */
-    Tcl_DriverOutputProc *outputProc;	/* Procedure to call for output
-					 * on channel. */
-    Tcl_DriverSeekProc *seekProc;	/* Procedure to call to seek
-					 * on the channel. May be NULL. */
+    char *typeName;		/* The name of the channel type in Tcl
+				 * commands. This storage is owned by channel
+				 * type. */
+    Tcl_ChannelTypeVersion version;
+				/* Version of the channel type. */
+    Tcl_DriverCloseProc *closeProc;
+				/* Function to call to close the channel, or
+				 * TCL_CLOSE2PROC if the close2Proc should be
+				 * used instead. */
+    Tcl_DriverInputProc *inputProc;
+				/* Function to call for input on channel. */
+    Tcl_DriverOutputProc *outputProc;
+				/* Function to call for output on channel. */
+    Tcl_DriverSeekProc *seekProc;
+				/* Function to call to seek on the channel.
+				 * May be NULL. */
     Tcl_DriverSetOptionProc *setOptionProc;
-					/* Set an option on a channel. */
+				/* Set an option on a channel. */
     Tcl_DriverGetOptionProc *getOptionProc;
-					/* Get an option from a channel. */
-    Tcl_DriverWatchProc *watchProc;	/* Set up the notifier to watch
-					 * for events on this channel. */
+				/* Get an option from a channel. */
+    Tcl_DriverWatchProc *watchProc;
+				/* Set up the notifier to watch for events on
+				 * this channel. */
     Tcl_DriverGetHandleProc *getHandleProc;
-					/* Get an OS handle from the channel
-					 * or NULL if not supported. */
-    Tcl_DriverClose2Proc *close2Proc;	/* Procedure to call to close the
-					 * channel if the device supports
-					 * closing the read & write sides
-					 * independently. */
+				/* Get an OS handle from the channel or NULL
+				 * if not supported. */
+    Tcl_DriverClose2Proc *close2Proc;
+				/* Function to call to close the channel if
+				 * the device supports closing the read &
+				 * write sides independently. */
     Tcl_DriverBlockModeProc *blockModeProc;
-					/* Set blocking mode for the
-					 * raw channel. May be NULL. */
+				/* Set blocking mode for the raw channel. May
+				 * be NULL. */
     /*
-     * Only valid in TCL_CHANNEL_VERSION_2 channels or later
+     * Only valid in TCL_CHANNEL_VERSION_2 channels or later.
      */
-    Tcl_DriverFlushProc *flushProc;	/* Procedure to call to flush a
-					 * channel. May be NULL. */
-    Tcl_DriverHandlerProc *handlerProc;	/* Procedure to call to handle a
-					 * channel event.  This will be passed
-					 * up the stacked channel chain. */
+    Tcl_DriverFlushProc *flushProc;
+				/* Function to call to flush a channel. May be
+				 * NULL. */
+    Tcl_DriverHandlerProc *handlerProc;
+				/* Function to call to handle a channel event.
+				 * This will be passed up the stacked channel
+				 * chain. */
     /*
-     * Only valid in TCL_CHANNEL_VERSION_3 channels or later
+     * Only valid in TCL_CHANNEL_VERSION_3 channels or later.
      */
     Tcl_DriverWideSeekProc *wideSeekProc;
-					/* Procedure to call to seek
-					 * on the channel which can
-					 * handle 64-bit offsets. May be
-					 * NULL, and must be NULL if
-					 * seekProc is NULL. */
-
-     /*
-      * Only valid in TCL_CHANNEL_VERSION_4 channels or later
-      * TIP #218, Channel Thread Actions
-      */
-     Tcl_DriverThreadActionProc *threadActionProc;
- 					/* Procedure to call to notify
- 					 * the driver of thread specific
- 					 * activity for a channel.
-					 * May be NULL. */
+				/* Function to call to seek on the channel
+				 * which can handle 64-bit offsets. May be
+				 * NULL, and must be NULL if seekProc is
+				 * NULL. */
+    /*
+     * Only valid in TCL_CHANNEL_VERSION_4 channels or later.
+     * TIP #218, Channel Thread Actions.
+     */
+    Tcl_DriverThreadActionProc *threadActionProc;
+				/* Function to call to notify the driver of
+				 * thread specific activity for a channel. May
+				 * be NULL. */
+
+    /*
+     * Only valid in TCL_CHANNEL_VERSION_5 channels or later.
+     * TIP #208, File Truncation.
+     */
+    Tcl_DriverTruncateProc *truncateProc;
+				/* Function to call to truncate the underlying
+				 * file to a particular length. May be NULL if
+				 * the channel does not support truncation. */
 } Tcl_ChannelType;
 
 /*
- * The following flags determine whether the blockModeProc above should
- * set the channel into blocking or nonblocking mode. They are passed
- * as arguments to the blockModeProc procedure in the above structure.
+ * The following flags determine whether the blockModeProc above should set
+ * the channel into blocking or nonblocking mode. They are passed as arguments
+ * to the blockModeProc function in the above structure.
  */
+
 #define TCL_MODE_BLOCKING	0	/* Put channel into blocking mode. */
 #define TCL_MODE_NONBLOCKING	1	/* Put channel into nonblocking
 					 * mode. */
@@ -1632,23 +1552,20 @@ typedef enum Tcl_PathType {
     TCL_PATH_VOLUME_RELATIVE
 } Tcl_PathType;
 
-/* 
- * The following structure is used to pass glob type data amongst
- * the various glob routines and Tcl_FSMatchInDirectory.
+/*
+ * The following structure is used to pass glob type data amongst the various
+ * glob routines and Tcl_FSMatchInDirectory.
  */
+
 typedef struct Tcl_GlobTypeData {
-    /* Corresponds to bcdpfls as in 'find -t' */
-    int type;
-    /* Corresponds to file permissions */
-    int perm;
-    /* Acceptable mac type */
-    Tcl_Obj* macType;
-    /* Acceptable mac creator */
-    Tcl_Obj* macCreator;
+    int type;			/* Corresponds to bcdpfls as in 'find -t'. */
+    int perm;			/* Corresponds to file permissions. */
+    Tcl_Obj *macType;		/* Acceptable Mac type. */
+    Tcl_Obj *macCreator;	/* Acceptable Mac creator. */
 } Tcl_GlobTypeData;
 
 /*
- * type and permission definitions for glob command
+ * Type and permission definitions for glob command.
  */
 
 #define TCL_GLOB_TYPE_BLOCK		(1<<0)
@@ -1667,65 +1584,69 @@ typedef struct Tcl_GlobTypeData {
 #define TCL_GLOB_PERM_X			(1<<4)
 
 /*
+ * Flags for the unload callback function.
+ */
+
+#define TCL_UNLOAD_DETACH_FROM_INTERPRETER	(1<<0)
+#define TCL_UNLOAD_DETACH_FROM_PROCESS		(1<<1)
+
+/*
  * Typedefs for the various filesystem operations:
  */
 
 typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
 typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
-typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) 
-	_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, 
-	int mode, int permissions));
-typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, 
-	Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, 
+typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((
+	Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions));
+typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
 	Tcl_GlobTypeData * types));
-typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef Tcl_Obj * (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
 typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
-typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-					   Tcl_StatBuf *buf));
+typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+	Tcl_StatBuf *buf));
 typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
 typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
 typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-	   Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
+	Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
 typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-			    Tcl_Obj *destPathPtr));
+	Tcl_Obj *destPathPtr));
 typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
-			    int recursive, Tcl_Obj **errorPtr));
+	int recursive, Tcl_Obj **errorPtr));
 typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-			    Tcl_Obj *destPathPtr));
+	Tcl_Obj *destPathPtr));
 typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
-typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
+typedef Tcl_Obj * (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
 /* We have to declare the utime structure here. */
 struct utimbuf;
-typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-					   struct utimbuf *tval));
-typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp, 
-			 Tcl_Obj *pathPtr, int nextCheckpoint));
+typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+	struct utimbuf *tval));
+typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	Tcl_Obj *pathPtr, int nextCheckpoint));
 typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
-			    int index, Tcl_Obj *pathPtr,
-			    Tcl_Obj **objPtrRef));
-typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-			    Tcl_Obj** objPtrRef));
+	int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
+typedef CONST char ** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((
+	Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
 typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
-			    int index, Tcl_Obj *pathPtr,
-			    Tcl_Obj *objPtr));
-typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-					       Tcl_Obj *toPtr, int linkType));
-typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp, 
-			    Tcl_Obj *pathPtr,
-			    Tcl_LoadHandle *handlePtr,
-			    Tcl_FSUnloadFileProc **unloadProcPtr));
-typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-			    ClientData *clientDataPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc) 
-			    _ANSI_ARGS_((Tcl_Obj *pathPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc) 
-			    _ANSI_ARGS_((Tcl_Obj *pathPtr));
+	int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
+typedef Tcl_Obj * (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+	Tcl_Obj *toPtr, int linkType));
+typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp,
+	Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr,
+	Tcl_FSUnloadFileProc **unloadProcPtr));
+typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+	ClientData *clientDataPtr));
+typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((
+	Tcl_Obj *pathPtr));
+typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((
+	Tcl_Obj *pathPtr));
 typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
-typedef ClientData (Tcl_FSDupInternalRepProc) 
-			    _ANSI_ARGS_((ClientData clientData));
-typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc) 
-			    _ANSI_ARGS_((ClientData clientData));
-typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
+typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((
+	ClientData clientData));
+typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((
+	ClientData clientData));
+typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((
+	Tcl_Obj *pathPtr));
 
 typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
 
@@ -1743,207 +1664,181 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
 /*
  * struct Tcl_Filesystem:
  *
- * One such structure exists for each type (kind) of filesystem.
- * It collects together in one place all the functions that are
- * part of the specific filesystem.  Tcl always accesses the
- * filesystem through one of these structures.
- * 
- * Not all entries need be non-NULL; any which are NULL are simply
- * ignored.  However, a complete filesystem should provide all of
- * these functions.  The explanations in the structure show
- * the importance of each function.
+ * One such structure exists for each type (kind) of filesystem. It collects
+ * together in one place all the functions that are part of the specific
+ * filesystem. Tcl always accesses the filesystem through one of these
+ * structures.
+ *
+ * Not all entries need be non-NULL; any which are NULL are simply ignored.
+ * However, a complete filesystem should provide all of these functions. The
+ * explanations in the structure show the importance of each function.
  */
 
 typedef struct Tcl_Filesystem {
-    CONST char *typeName;   /* The name of the filesystem. */
-    int structureLength;    /* Length of this structure, so future
-			     * binary compatibility can be assured. */
-    Tcl_FSVersion version;  
-			    /* Version of the filesystem type. */
+    CONST char *typeName;	/* The name of the filesystem. */
+    int structureLength;	/* Length of this structure, so future binary
+				 * compatibility can be assured. */
+    Tcl_FSVersion version;	/* Version of the filesystem type. */
     Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
-			    /* Function to check whether a path is in 
-			     * this filesystem.  This is the most
-			     * important filesystem procedure. */
+				/* Function to check whether a path is in this
+				 * filesystem. This is the most important
+				 * filesystem function. */
     Tcl_FSDupInternalRepProc *dupInternalRepProc;
-			    /* Function to duplicate internal fs rep.  May
-			     * be NULL (but then fs is less efficient). */ 
+				/* Function to duplicate internal fs rep. May
+				 * be NULL (but then fs is less efficient). */
     Tcl_FSFreeInternalRepProc *freeInternalRepProc;
-			    /* Function to free internal fs rep.  Must
-			     * be implemented, if internal representations
-			     * need freeing, otherwise it can be NULL. */ 
+				/* Function to free internal fs rep. Must be
+				 * implemented if internal representations
+				 * need freeing, otherwise it can be NULL. */
     Tcl_FSInternalToNormalizedProc *internalToNormalizedProc;
-			    /* Function to convert internal representation
-			     * to a normalized path.  Only required if
-			     * the fs creates pure path objects with no
-			     * string/path representation. */
+				/* Function to convert internal representation
+				 * to a normalized path. Only required if the
+				 * fs creates pure path objects with no
+				 * string/path representation. */
     Tcl_FSCreateInternalRepProc *createInternalRepProc;
-			    /* Function to create a filesystem-specific
-			     * internal representation.  May be NULL
-			     * if paths have no internal representation, 
-			     * or if the Tcl_FSPathInFilesystemProc
-			     * for this filesystem always immediately 
-			     * creates an internal representation for 
-			     * paths it accepts. */
-    Tcl_FSNormalizePathProc *normalizePathProc;       
-			    /* Function to normalize a path.  Should
-			     * be implemented for all filesystems
-			     * which can have multiple string 
-			     * representations for the same path 
-			     * object. */
+				/* Function to create a filesystem-specific
+				 * internal representation. May be NULL if
+				 * paths have no internal representation, or
+				 * if the Tcl_FSPathInFilesystemProc for this
+				 * filesystem always immediately creates an
+				 * internal representation for paths it
+				 * accepts. */
+    Tcl_FSNormalizePathProc *normalizePathProc;
+				/* Function to normalize a path.  Should be
+				 * implemented for all filesystems which can
+				 * have multiple string representations for
+				 * the same path object. */
     Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc;
-			    /* Function to determine the type of a 
-			     * path in this filesystem.  May be NULL. */
+				/* Function to determine the type of a path in
+				 * this filesystem. May be NULL. */
     Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc;
-			    /* Function to return the separator 
-			     * character(s) for this filesystem.  Must
-			     * be implemented. */
-    Tcl_FSStatProc *statProc; 
-			    /* 
-			     * Function to process a 'Tcl_FSStat()'
-			     * call.  Must be implemented for any
-			     * reasonable filesystem.
-			     */
-    Tcl_FSAccessProc *accessProc;	    
-			    /* 
-			     * Function to process a 'Tcl_FSAccess()'
-			     * call.  Must be implemented for any
-			     * reasonable filesystem.
-			     */
-    Tcl_FSOpenFileChannelProc *openFileChannelProc; 
-			    /* 
-			     * Function to process a
-			     * 'Tcl_FSOpenFileChannel()' call.  Must be
-			     * implemented for any reasonable
-			     * filesystem.
-			     */
-    Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;  
-			    /* Function to process a 
-			     * 'Tcl_FSMatchInDirectory()'.  If not
-			     * implemented, then glob and recursive
-			     * copy functionality will be lacking in
-			     * the filesystem. */
-    Tcl_FSUtimeProc *utimeProc;       
-			    /* Function to process a 
-			     * 'Tcl_FSUtime()' call.  Required to
-			     * allow setting (not reading) of times 
-			     * with 'file mtime', 'file atime' and
-			     * the open-r/open-w/fcopy implementation
-			     * of 'file copy'. */
-    Tcl_FSLinkProc *linkProc; 
-			    /* Function to process a 
-			     * 'Tcl_FSLink()' call.  Should be
-			     * implemented only if the filesystem supports
-			     * links (reading or creating). */
-    Tcl_FSListVolumesProc *listVolumesProc;	    
-			    /* Function to list any filesystem volumes 
-			     * added by this filesystem.  Should be
-			     * implemented only if the filesystem adds
-			     * volumes at the head of the filesystem. */
+				/* Function to return the separator
+				 * character(s) for this filesystem. Must be
+				 * implemented. */
+    Tcl_FSStatProc *statProc;	/* Function to process a 'Tcl_FSStat()' call.
+				 * Must be implemented for any reasonable
+				 * filesystem. */
+    Tcl_FSAccessProc *accessProc;
+				/* Function to process a 'Tcl_FSAccess()'
+				 * call. Must be implemented for any
+				 * reasonable filesystem. */
+    Tcl_FSOpenFileChannelProc *openFileChannelProc;
+				/* Function to process a
+				 * 'Tcl_FSOpenFileChannel()' call. Must be
+				 * implemented for any reasonable
+				 * filesystem. */
+    Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;
+				/* Function to process a
+				 * 'Tcl_FSMatchInDirectory()'.  If not
+				 * implemented, then glob and recursive copy
+				 * functionality will be lacking in the
+				 * filesystem. */
+    Tcl_FSUtimeProc *utimeProc;	/* Function to process a 'Tcl_FSUtime()' call.
+				 * Required to allow setting (not reading) of
+				 * times with 'file mtime', 'file atime' and
+				 * the open-r/open-w/fcopy implementation of
+				 * 'file copy'. */
+    Tcl_FSLinkProc *linkProc;	/* Function to process a 'Tcl_FSLink()' call.
+				 * Should be implemented only if the
+				 * filesystem supports links (reading or
+				 * creating). */
+    Tcl_FSListVolumesProc *listVolumesProc;
+				/* Function to list any filesystem volumes
+				 * added by this filesystem. Should be
+				 * implemented only if the filesystem adds
+				 * volumes at the head of the filesystem. */
     Tcl_FSFileAttrStringsProc *fileAttrStringsProc;
-			    /* Function to list all attributes strings 
-			     * which are valid for this filesystem.  
-			     * If not implemented the filesystem will
-			     * not support the 'file attributes' command.
-			     * This allows arbitrary additional information
-			     * to be attached to files in the filesystem. */
+				/* Function to list all attributes strings
+				 * which are valid for this filesystem. If not
+				 * implemented the filesystem will not support
+				 * the 'file attributes' command. This allows
+				 * arbitrary additional information to be
+				 * attached to files in the filesystem. */
     Tcl_FSFileAttrsGetProc *fileAttrsGetProc;
-			    /* Function to process a 
-			     * 'Tcl_FSFileAttrsGet()' call, used by
-			     * 'file attributes'. */
+				/* Function to process a
+				 * 'Tcl_FSFileAttrsGet()' call, used by 'file
+				 * attributes'. */
     Tcl_FSFileAttrsSetProc *fileAttrsSetProc;
-			    /* Function to process a 
-			     * 'Tcl_FSFileAttrsSet()' call, used by
-			     * 'file attributes'.  */
-    Tcl_FSCreateDirectoryProc *createDirectoryProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSCreateDirectory()' call. Should
-			     * be implemented unless the FS is
-			     * read-only. */
-    Tcl_FSRemoveDirectoryProc *removeDirectoryProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSRemoveDirectory()' call. Should
-			     * be implemented unless the FS is
-			     * read-only. */
-    Tcl_FSDeleteFileProc *deleteFileProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSDeleteFile()' call.  Should
-			     * be implemented unless the FS is
-			     * read-only. */
-    Tcl_FSCopyFileProc *copyFileProc; 
-			    /* Function to process a 
-			     * 'Tcl_FSCopyFile()' call.  If not
-			     * implemented Tcl will fall back
-			     * on open-r, open-w and fcopy as
-			     * a copying mechanism, for copying
-			     * actions initiated in Tcl (not C). */
-    Tcl_FSRenameFileProc *renameFileProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSRenameFile()' call.  If not
-			     * implemented, Tcl will fall back on
-			     * a copy and delete mechanism, for 
-			     * rename actions initiated in Tcl (not C). */
-    Tcl_FSCopyDirectoryProc *copyDirectoryProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSCopyDirectory()' call.  If
-			     * not implemented, Tcl will fall back
-			     * on a recursive create-dir, file copy
-			     * mechanism, for copying actions
-			     * initiated in Tcl (not C). */
-    Tcl_FSLstatProc *lstatProc;	    
-			    /* Function to process a 
-			     * 'Tcl_FSLstat()' call.  If not implemented,
-			     * Tcl will attempt to use the 'statProc'
-			     * defined above instead. */
-    Tcl_FSLoadFileProc *loadFileProc; 
-			    /* Function to process a 
-			     * 'Tcl_FSLoadFile()' call.  If not
-			     * implemented, Tcl will fall back on
-			     * a copy to native-temp followed by a 
-			     * Tcl_FSLoadFile on that temporary copy. */
-    Tcl_FSGetCwdProc *getCwdProc;     
-			    /* 
-			     * Function to process a 'Tcl_FSGetCwd()'
-			     * call.  Most filesystems need not
-			     * implement this.  It will usually only be
-			     * called once, if 'getcwd' is called
-			     * before 'chdir'.  May be NULL.
-			     */
-    Tcl_FSChdirProc *chdirProc;	    
-			    /* 
-			     * Function to process a 'Tcl_FSChdir()'
-			     * call.  If filesystems do not implement
-			     * this, it will be emulated by a series of
-			     * directory access checks.  Otherwise,
-			     * virtual filesystems which do implement
-			     * it need only respond with a positive
-			     * return result if the dirName is a valid
-			     * directory in their filesystem.  They
-			     * need not remember the result, since that
-			     * will be automatically remembered for use
-			     * by GetCwd.  Real filesystems should
-			     * carry out the correct action (i.e. call
-			     * the correct system 'chdir' api).  If not
-			     * implemented, then 'cd' and 'pwd' will
-			     * fail inside the filesystem.
-			     */
+				/* Function to process a
+				 * 'Tcl_FSFileAttrsSet()' call, used by 'file
+				 * attributes'.  */
+    Tcl_FSCreateDirectoryProc *createDirectoryProc;
+				/* Function to process a
+				 * 'Tcl_FSCreateDirectory()' call. Should be
+				 * implemented unless the FS is read-only. */
+    Tcl_FSRemoveDirectoryProc *removeDirectoryProc;
+				/* Function to process a
+				 * 'Tcl_FSRemoveDirectory()' call. Should be
+				 * implemented unless the FS is read-only. */
+    Tcl_FSDeleteFileProc *deleteFileProc;
+				/* Function to process a 'Tcl_FSDeleteFile()'
+				 * call. Should be implemented unless the FS
+				 * is read-only. */
+    Tcl_FSCopyFileProc *copyFileProc;
+				/* Function to process a 'Tcl_FSCopyFile()'
+				 * call. If not implemented Tcl will fall back
+				 * on open-r, open-w and fcopy as a copying
+				 * mechanism, for copying actions initiated in
+				 * Tcl (not C). */
+    Tcl_FSRenameFileProc *renameFileProc;
+				/* Function to process a 'Tcl_FSRenameFile()'
+				 * call. If not implemented, Tcl will fall
+				 * back on a copy and delete mechanism, for
+				 * rename actions initiated in Tcl (not C). */
+    Tcl_FSCopyDirectoryProc *copyDirectoryProc;
+				/* Function to process a
+				 * 'Tcl_FSCopyDirectory()' call. If not
+				 * implemented, Tcl will fall back on a
+				 * recursive create-dir, file copy mechanism,
+				 * for copying actions initiated in Tcl (not
+				 * C). */
+    Tcl_FSLstatProc *lstatProc;	/* Function to process a 'Tcl_FSLstat()' call.
+				 * If not implemented, Tcl will attempt to use
+				 * the 'statProc' defined above instead. */
+    Tcl_FSLoadFileProc *loadFileProc;
+				/* Function to process a 'Tcl_FSLoadFile()'
+				 * call. If not implemented, Tcl will fall
+				 * back on a copy to native-temp followed by a
+				 * Tcl_FSLoadFile on that temporary copy. */
+    Tcl_FSGetCwdProc *getCwdProc;
+				/* Function to process a 'Tcl_FSGetCwd()'
+				 * call. Most filesystems need not implement
+				 * this. It will usually only be called once,
+				 * if 'getcwd' is called before 'chdir'. May
+				 * be NULL. */
+    Tcl_FSChdirProc *chdirProc;	/* Function to process a 'Tcl_FSChdir()' call.
+				 * If filesystems do not implement this, it
+				 * will be emulated by a series of directory
+				 * access checks. Otherwise, virtual
+				 * filesystems which do implement it need only
+				 * respond with a positive return result if
+				 * the dirName is a valid directory in their
+				 * filesystem. They need not remember the
+				 * result, since that will be automatically
+				 * remembered for use by GetCwd. Real
+				 * filesystems should carry out the correct
+				 * action (i.e. call the correct system
+				 * 'chdir' api). If not implemented, then 'cd'
+				 * and 'pwd' will fail inside the
+				 * filesystem. */
 } Tcl_Filesystem;
 
 /*
- * The following definitions are used as values for the 'linkAction' flag
- * to Tcl_FSLink, or the linkProc of any filesystem.  Any combination
- * of flags can be given.  For link creation, the linkProc should create
- * a link which matches any of the types given.
- * 
- * TCL_CREATE_SYMBOLIC_LINK:  Create a symbolic or soft link.
- * TCL_CREATE_HARD_LINK:      Create a hard link.
+ * The following definitions are used as values for the 'linkAction' flag to
+ * Tcl_FSLink, or the linkProc of any filesystem. Any combination of flags can
+ * be given. For link creation, the linkProc should create a link which
+ * matches any of the types given.
+ *
+ * TCL_CREATE_SYMBOLIC_LINK -	Create a symbolic or soft link.
+ * TCL_CREATE_HARD_LINK -	Create a hard link.
  */
 
-#define TCL_CREATE_SYMBOLIC_LINK   0x01
-#define TCL_CREATE_HARD_LINK       0x02
+#define TCL_CREATE_SYMBOLIC_LINK	0x01
+#define TCL_CREATE_HARD_LINK		0x02
 
 /*
- * The following structure represents the Notifier functions that
- * you can override with the Tcl_SetNotifier call.
+ * The following structure represents the Notifier functions that you can
+ * override with the Tcl_SetNotifier call.
  */
 
 typedef struct Tcl_NotifierProcs {
@@ -1958,163 +1853,159 @@ typedef struct Tcl_NotifierProcs {
 } Tcl_NotifierProcs;
 
 /*
- * The following structure represents a user-defined encoding.  It collects
+ * The following structure represents a user-defined encoding. It collects
  * together all the functions that are used by the specific encoding.
  */
 
 typedef struct Tcl_EncodingType {
-    CONST char *encodingName;	/* The name of the encoding, e.g.  "euc-jp".
+    CONST char *encodingName;	/* The name of the encoding, e.g. "euc-jp".
 				 * This name is the unique key for this
 				 * encoding type. */
     Tcl_EncodingConvertProc *toUtfProc;
-				/* Procedure to convert from external
-				 * encoding into UTF-8. */
+				/* Function to convert from external encoding
+				 * into UTF-8. */
     Tcl_EncodingConvertProc *fromUtfProc;
-				/* Procedure to convert from UTF-8 into
+				/* Function to convert from UTF-8 into
 				 * external encoding. */
     Tcl_EncodingFreeProc *freeProc;
-				/* If non-NULL, procedure to call when this
+				/* If non-NULL, function to call when this
 				 * encoding is deleted. */
     ClientData clientData;	/* Arbitrary value associated with encoding
-				 * type.  Passed to conversion procedures. */
+				 * type. Passed to conversion functions. */
     int nullSize;		/* Number of zero bytes that signify
-				 * end-of-string in this encoding.  This
-				 * number is used to determine the source
-				 * string length when the srcLen argument is
-				 * negative.  Must be 1 or 2. */
-} Tcl_EncodingType;    
+				 * end-of-string in this encoding. This number
+				 * is used to determine the source string
+				 * length when the srcLen argument is
+				 * negative. Must be 1 or 2. */
+} Tcl_EncodingType;
 
 /*
  * The following definitions are used as values for the conversion control
  * flags argument when converting text from one character set to another:
  *
- * TCL_ENCODING_START:	     	Signifies that the source buffer is the first
+ * TCL_ENCODING_START -		Signifies that the source buffer is the first
  *				block in a (potentially multi-block) input
- *				stream.  Tells the conversion procedure to
- *				reset to an initial state and perform any
+ *				stream. Tells the conversion function to reset
+ *				to an initial state and perform any
  *				initialization that needs to occur before the
- *				first byte is converted.  If the source
- *				buffer contains the entire input stream to be
+ *				first byte is converted. If the source buffer
+ *				contains the entire input stream to be
  *				converted, this flag should be set.
- *
- * TCL_ENCODING_END:		Signifies that the source buffer is the last
+ * TCL_ENCODING_END -		Signifies that the source buffer is the last
  *				block in a (potentially multi-block) input
- *				stream.  Tells the conversion routine to
+ *				stream. Tells the conversion routine to
  *				perform any finalization that needs to occur
  *				after the last byte is converted and then to
- *				reset to an initial state.  If the source
+ *				reset to an initial state. If the source
  *				buffer contains the entire input stream to be
  *				converted, this flag should be set.
- *				
- * TCL_ENCODING_STOPONERROR:	If set, then the converter will return
- *				immediately upon encountering an invalid
- *				byte sequence or a source character that has
- *				no mapping in the target encoding.  If clear,
- *				then the converter will skip the problem,
- *				substituting one or more "close" characters
- *				in the destination buffer and then continue
- *				to sonvert the source.
+ * TCL_ENCODING_STOPONERROR -	If set, then the converter will return
+ *				immediately upon encountering an invalid byte
+ *				sequence or a source character that has no
+ *				mapping in the target encoding. If clear, then
+ *				the converter will skip the problem,
+ *				substituting one or more "close" characters in
+ *				the destination buffer and then continue to
+ *				convert the source.
  */
+
 #define TCL_ENCODING_START		0x01
 #define TCL_ENCODING_END		0x02
 #define TCL_ENCODING_STOPONERROR	0x04
 
 /*
- * The following data structures and declarations are for the new Tcl
- * parser.
+ * The following data structures and declarations are for the new Tcl parser.
  */
 
 /*
- * For each word of a command, and for each piece of a word such as a
- * variable reference, one of the following structures is created to
- * describe the token.
+ * For each word of a command, and for each piece of a word such as a variable
+ * reference, one of the following structures is created to describe the
+ * token.
  */
 
 typedef struct Tcl_Token {
-    int type;			/* Type of token, such as TCL_TOKEN_WORD;
-				 * see below for valid types. */
+    int type;			/* Type of token, such as TCL_TOKEN_WORD; see
+				 * below for valid types. */
     CONST char *start;		/* First character in token. */
     int size;			/* Number of bytes in token. */
-    int numComponents;		/* If this token is composed of other
-				 * tokens, this field tells how many of
-				 * them there are (including components of
-				 * components, etc.).  The component tokens
-				 * immediately follow this one. */
+    int numComponents;		/* If this token is composed of other tokens,
+				 * this field tells how many of them there are
+				 * (including components of components, etc.).
+				 * The component tokens immediately follow
+				 * this one. */
 } Tcl_Token;
 
 /*
- * Type values defined for Tcl_Token structures.  These values are
- * defined as mask bits so that it's easy to check for collections of
- * types.
+ * Type values defined for Tcl_Token structures. These values are defined as
+ * mask bits so that it's easy to check for collections of types.
  *
  * TCL_TOKEN_WORD -		The token describes one word of a command,
- *				from the first non-blank character of
- *				the word (which may be " or {) up to but
- *				not including the space, semicolon, or
- *				bracket that terminates the word. 
- *				NumComponents counts the total number of
- *				sub-tokens that make up the word.  This
- *				includes, for example, sub-tokens of
- *				TCL_TOKEN_VARIABLE tokens.
- * TCL_TOKEN_SIMPLE_WORD -	This token is just like TCL_TOKEN_WORD
- *				except that the word is guaranteed to
- *				consist of a single TCL_TOKEN_TEXT
- *				sub-token.
- * TCL_TOKEN_TEXT -		The token describes a range of literal
- *				text that is part of a word. 
- *				NumComponents is always 0.
- * TCL_TOKEN_BS -		The token describes a backslash sequence
- *				that must be collapsed.	 NumComponents
- *				is always 0.
+ *				from the first non-blank character of the word
+ *				(which may be " or {) up to but not including
+ *				the space, semicolon, or bracket that
+ *				terminates the word. NumComponents counts the
+ *				total number of sub-tokens that make up the
+ *				word. This includes, for example, sub-tokens
+ *				of TCL_TOKEN_VARIABLE tokens.
+ * TCL_TOKEN_SIMPLE_WORD -	This token is just like TCL_TOKEN_WORD except
+ *				that the word is guaranteed to consist of a
+ *				single TCL_TOKEN_TEXT sub-token.
+ * TCL_TOKEN_TEXT -		The token describes a range of literal text
+ *				that is part of a word. NumComponents is
+ *				always 0.
+ * TCL_TOKEN_BS -		The token describes a backslash sequence that
+ *				must be collapsed. NumComponents is always 0.
  * TCL_TOKEN_COMMAND -		The token describes a command whose result
- *				must be substituted into the word.  The
- *				token includes the enclosing brackets. 
- *				NumComponents is always 0.
- * TCL_TOKEN_VARIABLE -		The token describes a variable
- *				substitution, including the dollar sign,
- *				variable name, and array index (if there
- *				is one) up through the right
- *				parentheses.  NumComponents tells how
- *				many additional tokens follow to
- *				represent the variable name.  The first
- *				token will be a TCL_TOKEN_TEXT token
- *				that describes the variable name.  If
- *				the variable is an array reference then
- *				there will be one or more additional
- *				tokens, of type TCL_TOKEN_TEXT,
+ *				must be substituted into the word. The token
+ *				includes the enclosing brackets. NumComponents
+ *				is always 0.
+ * TCL_TOKEN_VARIABLE -		The token describes a variable substitution,
+ *				including the dollar sign, variable name, and
+ *				array index (if there is one) up through the
+ *				right parentheses. NumComponents tells how
+ *				many additional tokens follow to represent the
+ *				variable name. The first token will be a
+ *				TCL_TOKEN_TEXT token that describes the
+ *				variable name. If the variable is an array
+ *				reference then there will be one or more
+ *				additional tokens, of type TCL_TOKEN_TEXT,
  *				TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and
- *				TCL_TOKEN_VARIABLE, that describe the
- *				array index; numComponents counts the
- *				total number of nested tokens that make
- *				up the variable reference, including
- *				sub-tokens of TCL_TOKEN_VARIABLE tokens.
- * TCL_TOKEN_SUB_EXPR -		The token describes one subexpression of a
- *				expression, from the first non-blank
- *				character of the subexpression up to but not
- *				including the space, brace, or bracket
- *				that terminates the subexpression. 
- *				NumComponents counts the total number of
- *				following subtokens that make up the
- *				subexpression; this includes all subtokens
- *				for any nested TCL_TOKEN_SUB_EXPR tokens.
- *				For example, a numeric value used as a
+ *				TCL_TOKEN_VARIABLE, that describe the array
+ *				index; numComponents counts the total number
+ *				of nested tokens that make up the variable
+ *				reference, including sub-tokens of
+ *				TCL_TOKEN_VARIABLE tokens.
+ * TCL_TOKEN_SUB_EXPR -		The token describes one subexpression of an
+ *				expression, from the first non-blank character
+ *				of the subexpression up to but not including
+ *				the space, brace, or bracket that terminates
+ *				the subexpression. NumComponents counts the
+ *				total number of following subtokens that make
+ *				up the subexpression; this includes all
+ *				subtokens for any nested TCL_TOKEN_SUB_EXPR
+ *				tokens. For example, a numeric value used as a
  *				primitive operand is described by a
  *				TCL_TOKEN_SUB_EXPR token followed by a
  *				TCL_TOKEN_TEXT token. A binary subexpression
  *				is described by a TCL_TOKEN_SUB_EXPR token
- *				followed by the	TCL_TOKEN_OPERATOR token
- *				for the operator, then TCL_TOKEN_SUB_EXPR
- *				tokens for the left then the right operands.
+ *				followed by the TCL_TOKEN_OPERATOR token for
+ *				the operator, then TCL_TOKEN_SUB_EXPR tokens
+ *				for the left then the right operands.
  * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
  *				An operator might be the name of a math
  *				function such as "abs". A TCL_TOKEN_OPERATOR
  *				token is always preceeded by one
  *				TCL_TOKEN_SUB_EXPR token for the operator's
- *				subexpression, and is followed by zero or
- *				more TCL_TOKEN_SUB_EXPR tokens for the
- *				operator's operands. NumComponents is
- *				always 0.
+ *				subexpression, and is followed by zero or more
+ *				TCL_TOKEN_SUB_EXPR tokens for the operator's
+ *				operands. NumComponents is always 0.
+ * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
+ *				that it marks a word that began with the
+ *				literal character prefix "{*}". This word is
+ *				marked to be expanded - that is, broken into
+ *				words after substitution is complete.
  */
+
 #define TCL_TOKEN_WORD		1
 #define TCL_TOKEN_SIMPLE_WORD	2
 #define TCL_TOKEN_TEXT		4
@@ -2123,11 +2014,11 @@ typedef struct Tcl_Token {
 #define TCL_TOKEN_VARIABLE	32
 #define TCL_TOKEN_SUB_EXPR	64
 #define TCL_TOKEN_OPERATOR	128
+#define TCL_TOKEN_EXPAND_WORD	256
 
 /*
- * Parsing error types.  On any parsing error, one of these values
- * will be stored in the error field of the Tcl_Parse structure
- * defined below.
+ * Parsing error types. On any parsing error, one of these values will be
+ * stored in the error field of the Tcl_Parse structure defined below.
  */
 
 #define TCL_PARSE_SUCCESS		0
@@ -2142,32 +2033,32 @@ typedef struct Tcl_Token {
 #define TCL_PARSE_BAD_NUMBER		9
 
 /*
- * A structure of the following type is filled in by Tcl_ParseCommand.
- * It describes a single command parsed from an input string.
+ * A structure of the following type is filled in by Tcl_ParseCommand. It
+ * describes a single command parsed from an input string.
  */
 
 #define NUM_STATIC_TOKENS 20
 
 typedef struct Tcl_Parse {
-    CONST char *commentStart;	/* Pointer to # that begins the first of
-				 * one or more comments preceding the
-				 * command. */
+    CONST char *commentStart;	/* Pointer to # that begins the first of one
+				 * or more comments preceding the command. */
     int commentSize;		/* Number of bytes in comments (up through
-				 * newline character that terminates the
-				 * last comment).  If there were no
-				 * comments, this field is 0. */
-    CONST char *commandStart;	/* First character in first word of command. */
-    int commandSize;		/* Number of bytes in command, including
-				 * first character of first word, up
-				 * through the terminating newline,
-				 * close bracket, or semicolon. */
-    int numWords;		/* Total number of words in command.  May
-				 * be 0. */
-    Tcl_Token *tokenPtr;	/* Pointer to first token representing
-				 * the words of the command.  Initially
-				 * points to staticTokens, but may change
-				 * to point to malloc-ed space if command
-				 * exceeds space in staticTokens. */
+				 * newline character that terminates the last
+				 * comment). If there were no comments, this
+				 * field is 0. */
+    CONST char *commandStart;	/* First character in first word of
+				 * command. */
+    int commandSize;		/* Number of bytes in command, including first
+				 * character of first word, up through the
+				 * terminating newline, close bracket, or
+				 * semicolon. */
+    int numWords;		/* Total number of words in command. May be
+				 * 0. */
+    Tcl_Token *tokenPtr;	/* Pointer to first token representing the
+				 * words of the command. Initially points to
+				 * staticTokens, but may change to point to
+				 * malloc-ed space if command exceeds space in
+				 * staticTokens. */
     int numTokens;		/* Total number of tokens in command. */
     int tokensAvailable;	/* Total number of tokens available at
 				 * *tokenPtr. */
@@ -2175,81 +2066,75 @@ typedef struct Tcl_Parse {
 				 * above. */
 
     /*
-     * The fields below are intended only for the private use of the
-     * parser.	They should not be used by procedures that invoke
-     * Tcl_ParseCommand.
+     * The fields below are intended only for the private use of the parser.
+     * They should not be used by functions that invoke Tcl_ParseCommand.
      */
 
     CONST char *string;		/* The original command string passed to
 				 * Tcl_ParseCommand. */
-    CONST char *end;		/* Points to the character just after the
-				 * last one in the command string. */
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting,
-				 * or NULL. */
+    CONST char *end;		/* Points to the character just after the last
+				 * one in the command string. */
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting, or
+				 * NULL. */
     CONST char *term;		/* Points to character in string that
-				 * terminated most recent token.  Filled in
-				 * by ParseTokens.  If an error occurs,
-				 * points to beginning of region where the
-				 * error occurred (e.g. the open brace if
-				 * the close brace is missing). */
+				 * terminated most recent token. Filled in by
+				 * ParseTokens. If an error occurs, points to
+				 * beginning of region where the error
+				 * occurred (e.g. the open brace if the close
+				 * brace is missing). */
     int incomplete;		/* This field is set to 1 by Tcl_ParseCommand
 				 * if the command appears to be incomplete.
 				 * This information is used by
 				 * Tcl_CommandComplete. */
     Tcl_Token staticTokens[NUM_STATIC_TOKENS];
-				/* Initial space for tokens for command.
-				 * This space should be large enough to
-				 * accommodate most commands; dynamic
-				 * space is allocated for very large
-				 * commands that don't fit here. */
+				/* Initial space for tokens for command. This
+				 * space should be large enough to accommodate
+				 * most commands; dynamic space is allocated
+				 * for very large commands that don't fit
+				 * here. */
 } Tcl_Parse;
 
 /*
  * The following definitions are the error codes returned by the conversion
  * routines:
  *
- * TCL_OK:			All characters were converted.
- *
- * TCL_CONVERT_NOSPACE:		The output buffer would not have been large
+ * TCL_OK -			All characters were converted.
+ * TCL_CONVERT_NOSPACE -	The output buffer would not have been large
  *				enough for all of the converted data; as many
  *				characters as could fit were converted though.
- *
- * TCL_CONVERT_MULTIBYTE:	The last few bytes in the source string were
+ * TCL_CONVERT_MULTIBYTE -	The last few bytes in the source string were
  *				the beginning of a multibyte sequence, but
  *				more bytes were needed to complete this
- *				sequence.  A subsequent call to the conversion
+ *				sequence. A subsequent call to the conversion
  *				routine should pass the beginning of this
  *				unconverted sequence plus additional bytes
- *				from the source stream to properly convert
- *				the formerly split-up multibyte sequence.
- *
- * TCL_CONVERT_SYNTAX:		The source stream contained an invalid
- *				character sequence.  This may occur if the
+ *				from the source stream to properly convert the
+ *				formerly split-up multibyte sequence.
+ * TCL_CONVERT_SYNTAX -		The source stream contained an invalid
+ *				character sequence. This may occur if the
  *				input stream has been damaged or if the input
- *				encoding method was misidentified.  This error
+ *				encoding method was misidentified. This error
  *				is reported only if TCL_ENCODING_STOPONERROR
  *				was specified.
- *
- * TCL_CONVERT_UNKNOWN:		The source string contained a character
- *				that could not be represented in the target
- *				encoding.  This error is reported only if
+ * TCL_CONVERT_UNKNOWN -	The source string contained a character that
+ *				could not be represented in the target
+ *				encoding. This error is reported only if
  *				TCL_ENCODING_STOPONERROR was specified.
  */
 
-#define TCL_CONVERT_MULTIBYTE		-1
-#define TCL_CONVERT_SYNTAX		-2
-#define TCL_CONVERT_UNKNOWN		-3
-#define TCL_CONVERT_NOSPACE		-4
+#define TCL_CONVERT_MULTIBYTE	-1
+#define TCL_CONVERT_SYNTAX	-2
+#define TCL_CONVERT_UNKNOWN	-3
+#define TCL_CONVERT_NOSPACE	-4
 
 /*
  * The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8.  The valid values should be 3 or 6 (or
- * perhaps 1 if we want to support a non-unicode enabled core).
- * If 3, then Tcl_UniChar must be 2-bytes in size (UCS-2). (default)
- * If 6, then Tcl_UniChar must be 4-bytes in size (UCS-4).
- * At this time UCS-2 mode is the default and recommended mode.
- * UCS-4 is experimental and not recommended.  It works for the core,
- * but most extensions expect UCS-2.
+ * Unicode character in UTF-8. The valid values should be 3 or 6 (or perhaps 1
+ * if we want to support a non-unicode enabled core). If 3, then Tcl_UniChar
+ * must be 2-bytes in size (UCS-2) (the default). If 6, then Tcl_UniChar must
+ * be 4-bytes in size (UCS-4). At this time UCS-2 mode is the default and
+ * recommended mode. UCS-4 is experimental and not recommended. It works for
+ * the core, but most extensions expect UCS-2.
  */
 
 #ifndef TCL_UTF_MAX
@@ -2257,15 +2142,15 @@ typedef struct Tcl_Parse {
 #endif
 
 /*
- * This represents a Unicode character.  Any changes to this should
- * also be reflected in regcustom.h.
+ * This represents a Unicode character. Any changes to this should also be
+ * reflected in regcustom.h.
  */
 
 #if TCL_UTF_MAX > 4
     /*
-     * unsigned int isn't 100% accurate as it should be a strict 4-byte
-     * value (perhaps wchar_t).  64-bit systems may have troubles.  The
-     * size of this value must be reflected correctly in regcustom.h and
+     * unsigned int isn't 100% accurate as it should be a strict 4-byte value
+     * (perhaps wchar_t). 64-bit systems may have troubles. The size of this
+     * value must be reflected correctly in regcustom.h and
      * in tclEncoding.c.
      * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode
      * XXX: string rep that Tcl_UniChar represents.  Changing the size
@@ -2276,39 +2161,62 @@ typedef unsigned int Tcl_UniChar;
 typedef unsigned short Tcl_UniChar;
 #endif
 
+/*
+ * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to
+ * provide the system with the embedded configuration data.
+ */
+
+typedef struct Tcl_Config {
+    CONST char *key;		/* Configuration key to register. ASCII
+				 * encoded, thus UTF-8. */
+    CONST char *value;		/* The value associated with the key. System
+				 * encoding. */
+} Tcl_Config;
 
 /*
- * These function have been renamed. The old names are deprecated, but we
- * define these macros for backwards compatibilty.
+ * Flags for TIP#143 limits, detailing which limits are active in an
+ * interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument.
  */
-#define Tcl_Ckalloc Tcl_Alloc
-#define Tcl_Ckfree Tcl_Free
-#define Tcl_Ckrealloc Tcl_Realloc
-#define Tcl_Return Tcl_SetResult
-#define Tcl_TildeSubst Tcl_TranslateFileName
-#define panic Tcl_Panic
-#define panicVA Tcl_PanicVA
+
+#define TCL_LIMIT_COMMANDS	0x01
+#define TCL_LIMIT_TIME		0x02
 
 /*
- * The following constant is used to test for older versions of Tcl
- * in the stubs tables.
+ * Structure containing information about a limit handler to be called when a
+ * command- or time-limit is exceeded by an interpreter.
+ */
+
+typedef void (Tcl_LimitHandlerProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp));
+typedef void (Tcl_LimitHandlerDeleteProc) _ANSI_ARGS_((ClientData clientData));
+
+typedef struct mp_int mp_int;
+#define MP_INT_DECLARED
+typedef unsigned int mp_digit;
+#define MP_DIGIT_DECLARED
+
+/*
+ * The following constant is used to test for older versions of Tcl in the
+ * stubs tables.
  *
  * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
  * value since the stubs tables don't match.
  */
 
-#define TCL_STUB_MAGIC ((int)0xFCA3BACF)
+#define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
 
 /*
  * The following function is required to be defined in all stubs aware
- * extensions.  The function is actually implemented in the stub
- * library, not the main Tcl library, although there is a trivial
- * implementation in the main library in case an extension is statically
- * linked into an application.
+ * extensions. The function is actually implemented in the stub library, not
+ * the main Tcl library, although there is a trivial implementation in the
+ * main library in case an extension is statically linked into an application.
  */
 
 EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *version, int exact));
+EXTERN CONST char *	TclTomMathInitializeStubs _ANSI_ARGS_((
+			    Tcl_Interp *interp, CONST char *version,
+			    int epoch, int revision));
 
 #ifndef USE_TCL_STUBS
 
@@ -2317,36 +2225,205 @@ EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
  */
 
 #define Tcl_InitStubs(interp, version, exact) \
-    Tcl_PkgRequire(interp, "Tcl", version, exact)
+    Tcl_PkgInitStubsCheck(interp, version, exact)
 
 #endif
 
+    /*
+     * TODO - tommath stubs export goes here!
+     */
+
+
+/*
+ * Public functions that are not accessible via the stubs table.
+ * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
+ */
+
+EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
+			    Tcl_AppInitProc *appInitProc));
+EXTERN CONST char *	Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
+			    CONST char *version, int exact));
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
+#endif
 
 /*
- * Include the public function declarations that are accessible via
- * the stubs table.
+ * Include the public function declarations that are accessible via the stubs
+ * table.
  */
 
 #include "tclDecls.h"
 
 /*
- * Include platform specific public function declarations that are
- * accessible via the stubs table.
+ * Include platform specific public function declarations that are accessible
+ * via the stubs table.
  */
 
 #include "tclPlatDecls.h"
 
 /*
- * Public functions that are not accessible via the stubs table.
+ * The following declarations either map ckalloc and ckfree to malloc and
+ * free, or they map them to functions with all sorts of debugging hooks
+ * defined in tclCkalloc.c.
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+#   define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+#   define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
+#   define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+#   define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__)
+#   define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)
+
+#else /* !TCL_MEM_DEBUG */
+
+/*
+ * If we are not using the debugging allocator, we should call the Tcl_Alloc,
+ * et al. routines in order to guarantee that every module is using the same
+ * memory allocator both inside and outside of the Tcl library.
  */
 
-EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
-	Tcl_AppInitProc *appInitProc));
+#   define ckalloc(x) Tcl_Alloc(x)
+#   define ckfree(x) Tcl_Free(x)
+#   define ckrealloc(x,y) Tcl_Realloc(x,y)
+#   define attemptckalloc(x) Tcl_AttemptAlloc(x)
+#   define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y)
+#   undef  Tcl_InitMemory
+#   define Tcl_InitMemory(x)
+#   undef  Tcl_DumpActiveMemory
+#   define Tcl_DumpActiveMemory(x)
+#   undef  Tcl_ValidateAllMemory
+#   define Tcl_ValidateAllMemory(x,y)
+
+#endif /* !TCL_MEM_DEBUG */
+
+#ifdef TCL_MEM_DEBUG
+#   define Tcl_IncrRefCount(objPtr) \
+	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_DecrRefCount(objPtr) \
+	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#   define Tcl_IsShared(objPtr) \
+	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
+#else
+#   define Tcl_IncrRefCount(objPtr) \
+	++(objPtr)->refCount
+    /*
+     * Use do/while0 idiom for optimum correctness without compiler warnings.
+     * http://c2.com/cgi/wiki?TrivialDoWhileLoop
+     */
+#   define Tcl_DecrRefCount(objPtr) \
+	do { \
+	    Tcl_Obj *_objPtr = (objPtr); \
+	    if (--(_objPtr)->refCount <= 0) { \
+		TclFreeObj(_objPtr); \
+	    } \
+	} while(0)
+#   define Tcl_IsShared(objPtr) \
+	((objPtr)->refCount > 1)
+#endif
+
+/*
+ * Macros and definitions that help to debug the use of Tcl objects. When
+ * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
+ * debugging versions of the object creation functions.
+ */
+
+#ifdef TCL_MEM_DEBUG
+#  undef  Tcl_NewBignumObj
+#  define Tcl_NewBignumObj(val) \
+     Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
+#  undef  Tcl_NewBooleanObj
+#  define Tcl_NewBooleanObj(val) \
+     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+#  undef  Tcl_NewByteArrayObj
+#  define Tcl_NewByteArrayObj(bytes, len) \
+     Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
+#  undef  Tcl_NewDoubleObj
+#  define Tcl_NewDoubleObj(val) \
+     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
+#  undef  Tcl_NewIntObj
+#  define Tcl_NewIntObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  undef  Tcl_NewListObj
+#  define Tcl_NewListObj(objc, objv) \
+     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
+#  undef  Tcl_NewLongObj
+#  define Tcl_NewLongObj(val) \
+     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
+#  undef  Tcl_NewObj
+#  define Tcl_NewObj() \
+     Tcl_DbNewObj(__FILE__, __LINE__)
+#  undef  Tcl_NewStringObj
+#  define Tcl_NewStringObj(bytes, len) \
+     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
+#  undef  Tcl_NewWideIntObj
+#  define Tcl_NewWideIntObj(val) \
+     Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * Macros for clients to use to access fields of hash entries:
+ */
+
+#define Tcl_GetHashValue(h) ((h)->clientData)
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_GetHashKey(tablePtr, h) \
+	((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
+		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
+		   ? (h)->key.oneWordValue \
+		   : (h)->key.string))
+
+/*
+ * Macros to use for clients to use to invoke find and create functions for
+ * hash tables:
+ */
+
+#undef  Tcl_FindHashEntry
+#define Tcl_FindHashEntry(tablePtr, key) \
+	(*((tablePtr)->findProc))(tablePtr, key)
+#undef  Tcl_CreateHashEntry
+#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+	(*((tablePtr)->createProc))(tablePtr, key, newPtr)
+
+/*
+ * Macros that eliminate the overhead of the thread synchronization functions
+ * when compiling without thread support.
+ */
+
+#ifndef TCL_THREADS
+#undef  Tcl_MutexLock
+#define Tcl_MutexLock(mutexPtr)
+#undef  Tcl_MutexUnlock
+#define Tcl_MutexUnlock(mutexPtr)
+#undef  Tcl_MutexFinalize
+#define Tcl_MutexFinalize(mutexPtr)
+#undef  Tcl_ConditionNotify
+#define Tcl_ConditionNotify(condPtr)
+#undef  Tcl_ConditionWait
+#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+#undef  Tcl_ConditionFinalize
+#define Tcl_ConditionFinalize(condPtr)
+#endif /* TCL_THREADS */
+
+#ifndef TCL_NO_DEPRECATED
+    /*
+     * These function have been renamed. The old names are deprecated, but we
+     * define these macros for backwards compatibilty.
+     */
+
+#   define Tcl_Ckalloc		Tcl_Alloc
+#   define Tcl_Ckfree		Tcl_Free
+#   define Tcl_Ckrealloc	Tcl_Realloc
+#   define Tcl_Return		Tcl_SetResult
+#   define Tcl_TildeSubst	Tcl_TranslateFileName
+#   define panic		Tcl_Panic
+#   define panicVA		Tcl_PanicVA
+#endif
 
 /*
- * Convenience declaration of Tcl_AppInit for backwards compatibility.
- * This function is not *implemented* by the tcl library, so the storage
- * class is neither DLLEXPORT nor DLLIMPORT
+ * Convenience declaration of Tcl_AppInit for backwards compatibility. This
+ * function is not *implemented* by the tcl library, so the storage class is
+ * neither DLLEXPORT nor DLLIMPORT.
  */
 
 #undef TCL_STORAGE_CLASS
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 5967201..8d0a2cc 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -1,10 +1,10 @@
-/* 
+/*
  * tclAlloc.c --
  *
- *	This is a very fast storage allocator.  It allocates blocks of a
- *	small number of different sizes, and keeps free lists of each size.
- *	Blocks that don't exactly fit are passed up to the next larger size.
- *	Blocks over a certain size are directly allocated from the system.
+ *	This is a very fast storage allocator. It allocates blocks of a small
+ *	number of different sizes, and keeps free lists of each size. Blocks
+ *	that don't exactly fit are passed up to the next larger size. Blocks
+ *	over a certain size are directly allocated from the system.
  *
  * Copyright (c) 1983 Regents of the University of California.
  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
@@ -12,8 +12,8 @@
  *
  * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 /*
@@ -21,66 +21,55 @@
  * that has significantly reduced lock contention.
  */
 
-#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) || defined(TCL_MEM_DEBUG)
-
 #include "tclInt.h"
-#include "tclPort.h"
+#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
 
 #if USE_TCLALLOC
 
 /*
- * We should really make use of AC_CHECK_TYPE(caddr_t)
- * here, but it can wait until Tcl uses config.h properly.
+ * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
+ * until Tcl uses config.h properly.
  */
+
 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
 typedef unsigned long caddr_t;
 #endif
 
 /*
- * Alignment for allocated memory.
- */
-
-#if defined(__APPLE__)
-#define ALLOCALIGN	16
-#else
-#define ALLOCALIGN	8
-#endif
-
-/*
- * The overhead on a block is at least 8 bytes.  When free, this space
- * contains a pointer to the next free block, and the bottom two bits must
- * be zero.  When in use, the first byte is set to MAGIC, and the second
- * byte is the size index.  The remaining bytes are for alignment.
- * If range checking is enabled then a second word holds the size of the
- * requested block, less 1, rounded up to a multiple of sizeof(RMAGIC).
- * The order of elements is critical: ov_magic must overlay the low order
- * bits of ov_next, and ov_magic can not be a valid ov_next bit pattern.
+ * The overhead on a block is at least 8 bytes. When free, this space contains
+ * a pointer to the next free block, and the bottom two bits must be zero.
+ * When in use, the first byte is set to MAGIC, and the second byte is the
+ * size index. The remaining bytes are for alignment. If range checking is
+ * enabled then a second word holds the size of the requested block, less 1,
+ * rounded up to a multiple of sizeof(RMAGIC). The order of elements is
+ * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic
+ * can not be a valid ov.next bit pattern.
  */
 
 union overhead {
-    union overhead *ov_next;		/* when free */
-    unsigned char ov_padding[ALLOCALIGN];/* align struct to ALLOCALIGN bytes */
+    union overhead *next;		/* when free */
+    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */
     struct {
-	unsigned char	ovu_magic0;	/* magic number */
-	unsigned char	ovu_index;	/* bucket # */
-	unsigned char	ovu_unused;	/* unused */
-	unsigned char	ovu_magic1;	/* other magic number */
+	unsigned char magic0;		/* magic number */
+	unsigned char index;		/* bucket # */
+	unsigned char unused;		/* unused */
+	unsigned char magic1;		/* other magic number */
 #ifndef NDEBUG
-	unsigned short	ovu_rmagic;	/* range magic number */
-	unsigned long	ovu_size;	/* actual block size */
-	unsigned short  ovu_unused2;    /* padding to 8-byte align */
+	unsigned short rmagic;		/* range magic number */
+	unsigned long size;		/* actual block size */
+	unsigned short unused2;		/* padding to 8-byte align */
 #endif
     } ovu;
-#define ov_magic0	ovu.ovu_magic0
-#define ov_magic1	ovu.ovu_magic1
-#define ov_index	ovu.ovu_index
-#define ov_rmagic	ovu.ovu_rmagic
-#define ov_size		ovu.ovu_size
+#define overMagic0	ovu.magic0
+#define overMagic1	ovu.magic1
+#define bucketIndex	ovu.index
+#define rangeCheckMagic	ovu.rmagic
+#define realBlockSize	ovu.size
 };
 
 
-#define MAGIC		0xef		/* magic # on accounting info */
-#define RMAGIC		0x5555		/* magic # on range info */
+#define MAGIC		0xef	/* magic # on accounting info */
+#define RMAGIC		0x5555	/* magic # on range info */
 
 #ifndef NDEBUG
 #define	RSLOP		sizeof (unsigned short)
@@ -91,38 +80,45 @@ union overhead {
 #define OVERHEAD (sizeof(union overhead) + RSLOP)
 
 /*
- * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
+ * Macro to make it easier to refer to the end-of-block guard magic.
+ */
+
+#define BLOCK_END(overPtr) \
+    (*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize))
+
+/*
+ * nextf[i] is the pointer to the next free block of size 2^(i+3). The
  * smallest allocatable block is MINBLOCK bytes. The overhead information
  * precedes the data area returned to the user.
  */
 
-#define MINBLOCK	((sizeof(union overhead) + (ALLOCALIGN-1)) & ~(ALLOCALIGN-1))
+#define MINBLOCK	((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
 #define NBUCKETS	(13 - (MINBLOCK >> 4))
 #define MAXMALLOC	(1<<(NBUCKETS+2))
-static	union overhead *nextf[NBUCKETS];
+static union overhead *nextf[NBUCKETS];
 
-/* 
- * The following structure is used to keep track of all system memory 
- * currently owned by Tcl.  When finalizing, all this memory will
- * be returned to the system.
+/*
+ * The following structure is used to keep track of all system memory
+ * currently owned by Tcl. When finalizing, all this memory will be returned
+ * to the system.
  */
 
 struct block {
     struct block *nextPtr;	/* Linked list. */
-    struct block *prevPtr;	/* Linked list for big blocks, ensures 8-byte 
+    struct block *prevPtr;	/* Linked list for big blocks, ensures 8-byte
 				 * alignment for suballocated blocks. */
 };
 
-static struct block *blockList;		/* Tracks the suballocated blocks. */
-static struct block bigBlocks = {	/* Big blocks aren't suballocated. */
+static struct block *blockList;	/* Tracks the suballocated blocks. */
+static struct block bigBlocks={	/* Big blocks aren't suballocated. */
     &bigBlocks, &bigBlocks
 };
 
 /*
- * The allocator is protected by a special mutex that must be
- * explicitly initialized.  Futhermore, because Tcl_Alloc may be
- * used before anything else in Tcl, we make this module self-initializing
- * after all with the allocInit variable.
+ * The allocator is protected by a special mutex that must be explicitly
+ * initialized. Futhermore, because Tcl_Alloc may be used before anything else
+ * in Tcl, we make this module self-initializing after all with the allocInit
+ * variable.
  */
 
 #ifdef TCL_THREADS
@@ -130,21 +126,20 @@ static Tcl_Mutex *allocMutexPtr;
 #endif
 static int allocInit = 0;
 
-
 #ifdef MSTATS
 
 /*
- * nmalloc[i] is the difference between the number of mallocs and frees
- * for a given block size.
+ * numMallocs[i] is the difference between the number of mallocs and frees for
+ * a given block size.
  */
 
-static	unsigned int nmalloc[NBUCKETS+1];
+static	unsigned int numMallocs[NBUCKETS+1];
 #include <stdio.h>
 #endif
 
 #if !defined(NDEBUG)
-#define	ASSERT(p)   if (!(p)) panic(# p)
-#define RANGE_ASSERT(p) if (!(p)) panic(# p)
+#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)
+#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
 #else
 #define	ASSERT(p)
 #define RANGE_ASSERT(p)
@@ -154,8 +149,7 @@ static	unsigned int nmalloc[NBUCKETS+1];
  * Prototypes for functions used only in this file.
  */
 
-static void 		MoreCore _ANSI_ARGS_((int bucket));
-
+static void 		MoreCore(int bucket);
 
 /*
  *-------------------------------------------------------------------------
@@ -174,7 +168,7 @@ static void 		MoreCore _ANSI_ARGS_((int bucket));
  */
 
 void
-TclInitAlloc()
+TclInitAlloc(void)
 {
     if (!allocInit) {
 	allocInit = 1;
@@ -189,27 +183,26 @@ TclInitAlloc()
  *
  * TclFinalizeAllocSubsystem --
  *
- *	Release all resources being used by this subsystem, including 
- *	aggressively freeing all memory allocated by TclpAlloc() that 
- *	has not yet been released with TclpFree().
- *	
- *	After this function is called, all memory allocated with 
- *	TclpAlloc() should be considered unusable.
+ *	Release all resources being used by this subsystem, including
+ *	aggressively freeing all memory allocated by TclpAlloc() that has not
+ *	yet been released with TclpFree().
+ *
+ *	After this function is called, all memory allocated with TclpAlloc()
+ *	should be considered unusable.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	This subsystem is self-initializing, since memory can be 
- *	allocated before Tcl is formally initialized.  After this call,
- *	this subsystem has been reset to its initial state and is 
- *	usable again.
+ *	This subsystem is self-initializing, since memory can be allocated
+ *	before Tcl is formally initialized. After this call, this subsystem
+ *	has been reset to its initial state and is usable again.
  *
  *-------------------------------------------------------------------------
  */
 
 void
-TclFinalizeAllocSubsystem()
+TclFinalizeAllocSubsystem(void)
 {
     unsigned int i;
     struct block *blockPtr, *nextPtr;
@@ -229,14 +222,14 @@ TclFinalizeAllocSubsystem()
     bigBlocks.nextPtr = &bigBlocks;
     bigBlocks.prevPtr = &bigBlocks;
 
-    for (i = 0; i < NBUCKETS; i++) {
+    for (i=0 ; i<NBUCKETS ; i++) {
 	nextf[i] = NULL;
 #ifdef MSTATS
-	nmalloc[i] = 0;
+	numMallocs[i] = 0;
 #endif
     }
 #ifdef MSTATS
-    nmalloc[i] = 0;
+    numMallocs[i] = 0;
 #endif
     Tcl_MutexUnlock(allocMutexPtr);
 }
@@ -258,30 +251,32 @@ TclFinalizeAllocSubsystem()
  */
 
 char *
-TclpAlloc(nbytes)
-    unsigned int nbytes;	/* Number of bytes to allocate. */
+TclpAlloc(
+    unsigned int numBytes)	/* Number of bytes to allocate. */
 {
-    register union overhead *op;
+    register union overhead *overPtr;
     register long bucket;
-    register unsigned amt;
+    register unsigned amount;
     struct block *bigBlockPtr = NULL;
 
     if (!allocInit) {
 	/*
-	 * We have to make the "self initializing" because Tcl_Alloc
-	 * may be used before any other part of Tcl.  E.g., see
-	 * main() for tclsh!
+	 * We have to make the "self initializing" because Tcl_Alloc may be
+	 * used before any other part of Tcl. E.g., see main() for tclsh!
 	 */
+
 	TclInitAlloc();
     }
     Tcl_MutexLock(allocMutexPtr);
+
     /*
-     * First the simple case: we simple allocate big blocks directly
+     * First the simple case: we simple allocate big blocks directly.
      */
-    if (nbytes >= MAXMALLOC - OVERHEAD) {
-	if (nbytes <= UINT_MAX - OVERHEAD - sizeof(struct block)) {
-	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 
-		    (sizeof(struct block) + OVERHEAD + nbytes), 0);
+
+    if (numBytes >= MAXMALLOC - OVERHEAD) {
+	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
+	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
+		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
 	}
 	if (bigBlockPtr == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
@@ -292,74 +287,83 @@ TclpAlloc(nbytes)
 	bigBlockPtr->prevPtr = &bigBlocks;
 	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
 
-	op = (union overhead *) (bigBlockPtr + 1);
-	op->ov_magic0 = op->ov_magic1 = MAGIC;
-	op->ov_index = 0xff;
+	overPtr = (union overhead *) (bigBlockPtr + 1);
+	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
+	overPtr->bucketIndex = 0xff;
 #ifdef MSTATS
-	nmalloc[NBUCKETS]++;
+	numMallocs[NBUCKETS]++;
 #endif
+
 #ifndef NDEBUG
 	/*
-	 * Record allocated size of block and
-	 * bound space with magic numbers.
+	 * Record allocated size of block and bound space with magic numbers.
 	 */
-	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
-	op->ov_rmagic = RMAGIC;
-	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+
+	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
+	overPtr->rangeCheckMagic = RMAGIC;
+	BLOCK_END(overPtr) = RMAGIC;
 #endif
+
 	Tcl_MutexUnlock(allocMutexPtr);
-	return (void *)(op+1);
+	return (void *)(overPtr+1);
     }
+
     /*
-     * Convert amount of memory requested into closest block size
-     * stored in hash buckets which satisfies request.
-     * Account for space used per block for accounting.
+     * Convert amount of memory requested into closest block size stored in
+     * hash buckets which satisfies request. Account for space used per block
+     * for accounting.
      */
 
-    amt = MINBLOCK;		/* size of first bucket */
+    amount = MINBLOCK;		/* size of first bucket */
     bucket = MINBLOCK >> 4;
 
-    while (nbytes + OVERHEAD > amt) {
-	amt <<= 1;
-	if (amt == 0) {
+    while (numBytes + OVERHEAD > amount) {
+	amount <<= 1;
+	if (amount == 0) {
 	    Tcl_MutexUnlock(allocMutexPtr);
-	    return (NULL);
+	    return NULL;
 	}
 	bucket++;
     }
-    ASSERT( bucket < NBUCKETS );
+    ASSERT(bucket < NBUCKETS);
 
     /*
-     * If nothing in hash bucket right now,
-     * request more memory from the system.
+     * If nothing in hash bucket right now, request more memory from the
+     * system.
      */
-    if ((op = nextf[bucket]) == NULL) {
+
+    if ((overPtr = nextf[bucket]) == NULL) {
 	MoreCore(bucket);
-	if ((op = nextf[bucket]) == NULL) {
+	if ((overPtr = nextf[bucket]) == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
-	    return (NULL);
+	    return NULL;
 	}
     }
+
     /*
      * Remove from linked list
      */
-    nextf[bucket] = op->ov_next;
-    op->ov_magic0 = op->ov_magic1 = MAGIC;
-    op->ov_index = (unsigned char) bucket;
+
+    nextf[bucket] = overPtr->next;
+    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
+    overPtr->bucketIndex = (unsigned char) bucket;
+
 #ifdef MSTATS
-    nmalloc[bucket]++;
+    numMallocs[bucket]++;
 #endif
+
 #ifndef NDEBUG
     /*
-     * Record allocated size of block and
-     * bound space with magic numbers.
+     * Record allocated size of block and bound space with magic numbers.
      */
-    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
-    op->ov_rmagic = RMAGIC;
-    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+
+    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
+    overPtr->rangeCheckMagic = RMAGIC;
+    BLOCK_END(overPtr) = RMAGIC;
 #endif
+
     Tcl_MutexUnlock(allocMutexPtr);
-    return ((char *)(op + 1));
+    return ((char *)(overPtr + 1));
 }
 
 /*
@@ -381,28 +385,29 @@ TclpAlloc(nbytes)
  */
 
 static void
-MoreCore(bucket)
-    int bucket;		/* What bucket to allocat to. */
+MoreCore(
+    int bucket)			/* What bucket to allocat to. */
 {
-    register union overhead *op;
-    register long sz;		/* size of desired block */
-    long amt;			/* amount to allocate */
-    int nblks;			/* how many blocks we get */
+    register union overhead *overPtr;
+    register long size;		/* size of desired block */
+    long amount;		/* amount to allocate */
+    int numBlocks;		/* how many blocks we get */
     struct block *blockPtr;
 
     /*
-     * sbrk_size <= 0 only for big, FLUFFY, requests (about
-     * 2^30 bytes on a VAX, I think) or for a negative arg.
+     * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
+     * VAX, I think) or for a negative arg.
      */
-    sz = 1 << (bucket + 3);
-    ASSERT(sz > 0);
 
-    amt = MAXMALLOC;
-    nblks = amt / sz;
-    ASSERT(nblks*sz == amt);
+    size = 1 << (bucket + 3);
+    ASSERT(size > 0);
 
-    blockPtr = (struct block *) TclpSysAlloc((unsigned) 
-	    (sizeof(struct block) + amt), 1);
+    amount = MAXMALLOC;
+    numBlocks = amount / size;
+    ASSERT(numBlocks*size == amount);
+
+    blockPtr = (struct block *) TclpSysAlloc((unsigned)
+	    (sizeof(struct block) + amount), 1);
     /* no more room! */
     if (blockPtr == NULL) {
 	return;
@@ -410,18 +415,18 @@ MoreCore(bucket)
     blockPtr->nextPtr = blockList;
     blockList = blockPtr;
 
-    op = (union overhead *) (blockPtr + 1);
-    
+    overPtr = (union overhead *) (blockPtr + 1);
+
     /*
-     * Add new memory allocated to that on
-     * free list for this hash bucket.
+     * Add new memory allocated to that on free list for this hash bucket.
      */
-    nextf[bucket] = op;
-    while (--nblks > 0) {
-	op->ov_next = (union overhead *)((caddr_t)op + sz);
-	op = (union overhead *)((caddr_t)op + sz);
+
+    nextf[bucket] = overPtr;
+    while (--numBlocks > 0) {
+	overPtr->next = (union overhead *)((caddr_t)overPtr + size);
+	overPtr = (union overhead *)((caddr_t)overPtr + size);
     }
-    op->ov_next = (union overhead *)NULL;
+    overPtr->next = NULL;
 }
 
 /*
@@ -441,47 +446,51 @@ MoreCore(bucket)
  */
 
 void
-TclpFree(cp)
-    char *cp;		/* Pointer to memory to free. */
-{   
+TclpFree(
+    char *oldPtr)		/* Pointer to memory to free. */
+{
     register long size;
-    register union overhead *op;
+    register union overhead *overPtr;
     struct block *bigBlockPtr;
 
-    if (cp == NULL) {
+    if (oldPtr == NULL) {
 	return;
     }
 
     Tcl_MutexLock(allocMutexPtr);
-    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
 
-    ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
-    ASSERT(op->ov_magic1 == MAGIC);
-    if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
+    ASSERT(overPtr->overMagic1 == MAGIC);
+    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
 	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
 
-    RANGE_ASSERT(op->ov_rmagic == RMAGIC);
-    RANGE_ASSERT(*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) == RMAGIC);
-    size = op->ov_index;
-    if ( size == 0xff ) {
+    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
+    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
+    size = overPtr->bucketIndex;
+    if (size == 0xff) {
 #ifdef MSTATS
-	nmalloc[NBUCKETS]--;
+	numMallocs[NBUCKETS]--;
 #endif
-	bigBlockPtr = (struct block *) op - 1;
+
+	bigBlockPtr = (struct block *) overPtr - 1;
 	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
 	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
 	TclpSysFree(bigBlockPtr);
+
 	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
     ASSERT(size < NBUCKETS);
-    op->ov_next = nextf[size];	/* also clobbers ov_magic */
-    nextf[size] = op;
+    overPtr->next = nextf[size];	/* also clobbers overMagic */
+    nextf[size] = overPtr;
+
 #ifdef MSTATS
-    nmalloc[size]--;
+    numMallocs[size]--;
 #endif
+
     Tcl_MutexUnlock(allocMutexPtr);
 }
 
@@ -502,34 +511,34 @@ TclpFree(cp)
  */
 
 char *
-TclpRealloc(cp, nbytes)
-    char *cp;			/* Pointer to alloced block. */
-    unsigned int nbytes;	/* New size of memory. */
-{   
+TclpRealloc(
+    char *oldPtr,		/* Pointer to alloced block. */
+    unsigned int numBytes)	/* New size of memory. */
+{
     int i;
-    union overhead *op;
+    union overhead *overPtr;
     struct block *bigBlockPtr;
     int expensive;
-    unsigned long maxsize;
+    unsigned long maxSize;
 
-    if (cp == NULL) {
-	return (TclpAlloc(nbytes));
+    if (oldPtr == NULL) {
+	return TclpAlloc(numBytes);
     }
 
     Tcl_MutexLock(allocMutexPtr);
 
-    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
 
-    ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
-    ASSERT(op->ov_magic1 == MAGIC);
-    if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
+    ASSERT(overPtr->overMagic1 == MAGIC);
+    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
 	Tcl_MutexUnlock(allocMutexPtr);
 	return NULL;
     }
 
-    RANGE_ASSERT(op->ov_rmagic == RMAGIC);
-    RANGE_ASSERT(*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) == RMAGIC);
-    i = op->ov_index;
+    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
+    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
+    i = overPtr->bucketIndex;
 
     /*
      * If the block isn't in a bin, just realloc it.
@@ -537,11 +546,11 @@ TclpRealloc(cp, nbytes)
 
     if (i == 0xff) {
 	struct block *prevPtr, *nextPtr;
-	bigBlockPtr = (struct block *) op - 1;
+	bigBlockPtr = (struct block *) overPtr - 1;
 	prevPtr = bigBlockPtr->prevPtr;
 	nextPtr = bigBlockPtr->nextPtr;
-	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, 
-		sizeof(struct block) + OVERHEAD + nbytes);
+	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
+		sizeof(struct block) + OVERHEAD + numBytes);
 	if (bigBlockPtr == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
 	    return NULL;
@@ -549,63 +558,69 @@ TclpRealloc(cp, nbytes)
 
 	if (prevPtr->nextPtr != bigBlockPtr) {
 	    /*
-	     * If the block has moved, splice the new block into the list where
-	     * the old block used to be. 
+	     * If the block has moved, splice the new block into the list
+	     * where the old block used to be.
 	     */
 
 	    prevPtr->nextPtr = bigBlockPtr;
 	    nextPtr->prevPtr = bigBlockPtr;
 	}
 
-	op = (union overhead *) (bigBlockPtr + 1);
+	overPtr = (union overhead *) (bigBlockPtr + 1);
+
 #ifdef MSTATS
-	nmalloc[NBUCKETS]++;
+	numMallocs[NBUCKETS]++;
 #endif
+
 #ifndef NDEBUG
 	/*
 	 * Record allocated size of block and update magic number bounds.
 	 */
 
-	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
-	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
+	BLOCK_END(overPtr) = RMAGIC;
 #endif
+
 	Tcl_MutexUnlock(allocMutexPtr);
-	return (char *)(op+1);
+	return (char *)(overPtr+1);
     }
-    maxsize = 1 << (i+3);
+    maxSize = 1 << (i+3);
     expensive = 0;
-    if ( nbytes + OVERHEAD > maxsize ) {
+    if (numBytes+OVERHEAD > maxSize) {
 	expensive = 1;
-    } else if ( i > 0 && nbytes + OVERHEAD < (maxsize/2) ) {
+    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
 	expensive = 1;
     }
 
     if (expensive) {
-	void *newp;
+	void *newPtr;
 
 	Tcl_MutexUnlock(allocMutexPtr);
 
-	newp = TclpAlloc(nbytes);
-	if ( newp == NULL ) {
+	newPtr = TclpAlloc(numBytes);
+	if (newPtr == NULL) {
 	    return NULL;
 	}
-	maxsize -= OVERHEAD;
-	if ( maxsize < nbytes )
-	    nbytes = maxsize;
-	memcpy((VOID *) newp, (VOID *) cp, (size_t) nbytes);
-	TclpFree(cp);
-	return newp;
+	maxSize -= OVERHEAD;
+	if (maxSize < numBytes) {
+	    numBytes = maxSize;
+	}
+	memcpy(newPtr, oldPtr, (size_t) numBytes);
+	TclpFree(oldPtr);
+	return newPtr;
     }
-    
+
     /*
      * Ok, we don't have to copy, it fits as-is
      */
+
 #ifndef NDEBUG
-    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
-    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
+    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
+    BLOCK_END(overPtr) = RMAGIC;
 #endif
+
     Tcl_MutexUnlock(allocMutexPtr);
-    return(cp);
+    return(oldPtr);
 }
 
 /*
@@ -613,9 +628,9 @@ TclpRealloc(cp, nbytes)
  *
  * mstats --
  *
- *	Prints two lines of numbers, one showing the length of the 
- *	free list for each size category, the second showing the 
- *	number of mallocs - frees for each size category.
+ *	Prints two lines of numbers, one showing the length of the free list
+ *	for each size category, the second showing the number of mallocs -
+ *	frees for each size category.
  *
  * Results:
  *	None.
@@ -628,35 +643,39 @@ TclpRealloc(cp, nbytes)
 
 #ifdef MSTATS
 void
-mstats(s)
-    char *s;	/* Where to write info. */
+mstats(
+    char *s)			/* Where to write info. */
 {
     register int i, j;
-    register union overhead *p;
-    int totfree = 0,
-	totused = 0;
+    register union overhead *overPtr;
+    int totalFree = 0, totalUsed = 0;
 
     Tcl_MutexLock(allocMutexPtr);
+
     fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
     for (i = 0; i < NBUCKETS; i++) {
-	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
 	    fprintf(stderr, " %d", j);
-	totfree += j * (1 << (i + 3));
+	}
+	totalFree += j * (1 << (i + 3));
     }
+
     fprintf(stderr, "\nused:\t");
     for (i = 0; i < NBUCKETS; i++) {
-	fprintf(stderr, " %d", nmalloc[i]);
-	totused += nmalloc[i] * (1 << (i + 3));
+	fprintf(stderr, " %d", numMallocs[i]);
+	totalUsed += numMallocs[i] * (1 << (i + 3));
     }
+
     fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
-	    totused, totfree);
-    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
-	    MAXMALLOC, nmalloc[NBUCKETS]);
+	    totalUsed, totalFree);
+    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
+	    MAXMALLOC, numMallocs[NBUCKETS]);
+
     Tcl_MutexUnlock(allocMutexPtr);
 }
 #endif
 
-#else  /* !USE_TCLALLOC */
+#else	/* !USE_TCLALLOC */
 
 /*
  *----------------------------------------------------------------------
@@ -675,10 +694,10 @@ mstats(s)
  */
 
 char *
-TclpAlloc(nbytes)
-    unsigned int nbytes;	/* Number of bytes to allocate. */
+TclpAlloc(
+    unsigned int numBytes)	/* Number of bytes to allocate. */
 {
-    return (char*) malloc(nbytes);
+    return (char*) malloc(numBytes);
 }
 
 /*
@@ -698,10 +717,10 @@ TclpAlloc(nbytes)
  */
 
 void
-TclpFree(cp)
-    char *cp;		/* Pointer to memory to free. */
-{   
-    free(cp);
+TclpFree(
+    char *oldPtr)		/* Pointer to memory to free. */
+{
+    free(oldPtr);
     return;
 }
 
@@ -722,12 +741,20 @@ TclpFree(cp)
  */
 
 char *
-TclpRealloc(cp, nbytes)
-    char *cp;			/* Pointer to alloced block. */
-    unsigned int nbytes;	/* New size of memory. */
-{   
-    return (char*) realloc(cp, nbytes);
+TclpRealloc(
+    char *oldPtr,		/* Pointer to alloced block. */
+    unsigned int numBytes)	/* New size of memory. */
+{
+    return (char*) realloc(oldPtr, numBytes);
 }
 
 #endif /* !USE_TCLALLOC */
 #endif /* !TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index 98087c5..ca18f5e 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -1,91 +1,78 @@
-/* 
+/*
  * tclAsync.c --
  *
- *	This file provides low-level support needed to invoke signal
- *	handlers in a safe way.  The code here doesn't actually handle
- *	signals, though.  This code is based on proposals made by
- *	Mark Diekhans and Don Libes.
+ *	This file provides low-level support needed to invoke signal handlers
+ *	in a safe way. The code here doesn't actually handle signals, though.
+ *	This code is based on proposals made by Mark Diekhans and Don Libes.
  *
  * Copyright (c) 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /* Forward declaration */
 struct ThreadSpecificData;
 
 /*
- * One of the following structures exists for each asynchronous
- * handler:
+ * One of the following structures exists for each asynchronous handler:
  */
 
 typedef struct AsyncHandler {
-    int ready;				/* Non-zero means this handler should
-					 * be invoked in the next call to
-					 * Tcl_AsyncInvoke. */
-    struct AsyncHandler *nextPtr;	/* Next in list of all handlers for
-					 * the process. */
-    Tcl_AsyncProc *proc;		/* Procedure to call when handler
-					 * is invoked. */
-    ClientData clientData;		/* Value to pass to handler when it
-					 * is invoked. */
+    int ready;			/* Non-zero means this handler should be
+				 * invoked in the next call to
+				 * Tcl_AsyncInvoke. */
+    struct AsyncHandler *nextPtr;
+				/* Next in list of all handlers for the
+				 * process. */
+    Tcl_AsyncProc *proc;	/* Procedure to call when handler is
+				 * invoked. */
+    ClientData clientData;	/* Value to pass to handler when it is
+				 * invoked. */
     struct ThreadSpecificData *originTsd;
-					/* Used in Tcl_AsyncMark to modify thread-
-					 * specific data from outside the thread
-					 * it is associated to. */
-    Tcl_ThreadId originThrdId;		/* Origin thread where this token was
-					 * created and where it will be
-					 * yielded. */
+				/* Used in Tcl_AsyncMark to modify thread-
+				 * specific data from outside the thread it is
+				 * associated to. */
+    Tcl_ThreadId originThrdId;	/* Origin thread where this token was created
+				 * and where it will be yielded. */
 } AsyncHandler;
 
-
 typedef struct ThreadSpecificData {
     /*
-     * The variables below maintain a list of all existing handlers
-     * specific to the calling thread.
-     */
-    AsyncHandler *firstHandler;	    /* First handler defined for process,
-				     * or NULL if none. */
-    AsyncHandler *lastHandler;	    /* Last handler or NULL. */
-
-    /*
-     * The variable below is set to 1 whenever a handler becomes ready and
-     * it is cleared to zero whenever Tcl_AsyncInvoke is called.  It can be
-     * checked elsewhere in the application by calling Tcl_AsyncReady to see
-     * if Tcl_AsyncInvoke should be invoked.
+     * The variables below maintain a list of all existing handlers specific
+     * to the calling thread.
      */
-
-    int asyncReady;
-
-    /*
-     * The variable below indicates whether Tcl_AsyncInvoke is currently
-     * working.  If so then we won't set asyncReady again until
-     * Tcl_AsyncInvoke returns.
-     */
-
-    int asyncActive;
-
-    Tcl_Mutex asyncMutex;   /* Thread-specific AsyncHandler linked-list lock */
-
+    AsyncHandler *firstHandler;	/* First handler defined for process, or NULL
+				 * if none. */
+    AsyncHandler *lastHandler;	/* Last handler or NULL. */
+    int asyncReady;		/* This is set to 1 whenever a handler becomes
+				 * ready and it is cleared to zero whenever
+				 * Tcl_AsyncInvoke is called. It can be
+				 * checked elsewhere in the application by
+				 * calling Tcl_AsyncReady to see if
+				 * Tcl_AsyncInvoke should be invoked. */
+    int asyncActive;		/* Indicates whether Tcl_AsyncInvoke is
+				 * currently working. If so then we won't set
+				 * asyncReady again until Tcl_AsyncInvoke
+				 * returns. */
+    Tcl_Mutex asyncMutex;	/* Thread-specific AsyncHandler linked-list
+				 * lock */
 } ThreadSpecificData;
 static Tcl_ThreadDataKey dataKey;
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclFinalizeAsync --
  *
- *	Finalizes the mutex in the thread local data structure for the
- *	async subsystem.
+ *	Finalizes the mutex in the thread local data structure for the async
+ *	subsystem.
  *
  * Results:
- *	None.	
+ *	None.
  *
  * Side effects:
  *	Forgets knowledge of the mutex should it have been created.
@@ -94,7 +81,7 @@ static Tcl_ThreadDataKey dataKey;
  */
 
 void
-TclFinalizeAsync()
+TclFinalizeAsync(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -109,12 +96,12 @@ TclFinalizeAsync()
  * Tcl_AsyncCreate --
  *
  *	This procedure creates the data structures for an asynchronous
- *	handler, so that no memory has to be allocated when the handler
- *	is activated.
+ *	handler, so that no memory has to be allocated when the handler is
+ *	activated.
  *
  * Results:
- *	The return value is a token for the handler, which can be used
- *	to activate it later on.
+ *	The return value is a token for the handler, which can be used to
+ *	activate it later on.
  *
  * Side effects:
  *	Information about the handler is recorded.
@@ -123,10 +110,10 @@ TclFinalizeAsync()
  */
 
 Tcl_AsyncHandler
-Tcl_AsyncCreate(proc, clientData)
-    Tcl_AsyncProc *proc;		/* Procedure to call when handler
-					 * is invoked. */
-    ClientData clientData;		/* Argument to pass to handler. */
+Tcl_AsyncCreate(
+    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
+				 * invoked. */
+    ClientData clientData)	/* Argument to pass to handler. */
 {
     AsyncHandler *asyncPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -155,10 +142,10 @@ Tcl_AsyncCreate(proc, clientData)
  *
  * Tcl_AsyncMark --
  *
- *	This procedure is called to request that an asynchronous handler
- *	be invoked as soon as possible.  It's typically called from
- *	an interrupt handler, where it isn't safe to do anything that
- *	depends on or modifies application state.
+ *	This procedure is called to request that an asynchronous handler be
+ *	invoked as soon as possible. It's typically called from an interrupt
+ *	handler, where it isn't safe to do anything that depends on or
+ *	modifies application state.
  *
  * Results:
  *	None.
@@ -170,8 +157,8 @@ Tcl_AsyncCreate(proc, clientData)
  */
 
 void
-Tcl_AsyncMark(async)
-    Tcl_AsyncHandler async;		/* Token for handler. */
+Tcl_AsyncMark(
+    Tcl_AsyncHandler async)		/* Token for handler. */
 {
     AsyncHandler *token = (AsyncHandler *) async;
 
@@ -189,13 +176,12 @@ Tcl_AsyncMark(async)
  *
  * Tcl_AsyncInvoke --
  *
- *	This procedure is called at a "safe" time at background level
- *	to invoke any active asynchronous handlers.
+ *	This procedure is called at a "safe" time at background level to
+ *	invoke any active asynchronous handlers.
  *
  * Results:
- *	The return value is a normal Tcl result, which is intended to
- *	replace the code argument as the current completion code for
- *	interp.
+ *	The return value is a normal Tcl result, which is intended to replace
+ *	the code argument as the current completion code for interp.
  *
  * Side effects:
  *	Depends on the handlers that are active.
@@ -204,14 +190,13 @@ Tcl_AsyncMark(async)
  */
 
 int
-Tcl_AsyncInvoke(interp, code)
-    Tcl_Interp *interp;			/* If invoked from Tcl_Eval just after
-					 * completing a command, points to
-					 * interpreter.  Otherwise it is
-					 * NULL. */
-    int code; 				/* If interp is non-NULL, this gives
-					 * completion code from command that
-					 * just completed. */
+Tcl_AsyncInvoke(
+    Tcl_Interp *interp,		/* If invoked from Tcl_Eval just after
+				 * completing a command, points to
+				 * interpreter. Otherwise it is NULL. */
+    int code)			/* If interp is non-NULL, this gives
+				 * completion code from command that just
+				 * completed. */
 {
     AsyncHandler *asyncPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -229,13 +214,12 @@ Tcl_AsyncInvoke(interp, code)
     }
 
     /*
-     * Make one or more passes over the list of handlers, invoking
-     * at most one handler in each pass.  After invoking a handler,
-     * go back to the start of the list again so that (a) if a new
-     * higher-priority handler gets marked while executing a lower
-     * priority handler, we execute the higher-priority handler
-     * next, and (b) if a handler gets deleted during the execution
-     * of a handler, then the list structure may change so it isn't
+     * Make one or more passes over the list of handlers, invoking at most one
+     * handler in each pass. After invoking a handler, go back to the start of
+     * the list again so that (a) if a new higher-priority handler gets marked
+     * while executing a lower priority handler, we execute the higher-
+     * priority handler next, and (b) if a handler gets deleted during the
+     * execution of a handler, then the list structure may change so it isn't
      * safe to continue down the list anyway.
      */
 
@@ -264,8 +248,8 @@ Tcl_AsyncInvoke(interp, code)
  *
  * Tcl_AsyncDelete --
  *
- *	Frees up all the state for an asynchronous handler.  The handler
- *	should never be used again.
+ *	Frees up all the state for an asynchronous handler. The handler should
+ *	never be used again.
  *
  * Results:
  *	None.
@@ -284,8 +268,8 @@ Tcl_AsyncInvoke(interp, code)
  */
 
 void
-Tcl_AsyncDelete(async)
-    Tcl_AsyncHandler async;		/* Token for handler to delete. */
+Tcl_AsyncDelete(
+    Tcl_AsyncHandler async)		/* Token for handler to delete. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     AsyncHandler *asyncPtr = (AsyncHandler *) async;
@@ -296,7 +280,7 @@ Tcl_AsyncDelete(async)
      */
 
     if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) {
-	panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
+	Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
     }
 
     /*
@@ -314,7 +298,7 @@ Tcl_AsyncDelete(async)
 	    thisPtr = thisPtr->nextPtr;
 	}
 	if (thisPtr == NULL) {
-	    panic("Tcl_AsyncDelete: cannot find async handler");
+	    Tcl_Panic("Tcl_AsyncDelete: cannot find async handler");
 	}
 	if (asyncPtr == tsdPtr->firstHandler) {
 	    tsdPtr->firstHandler = asyncPtr->nextPtr;
@@ -334,13 +318,13 @@ Tcl_AsyncDelete(async)
  *
  * Tcl_AsyncReady --
  *
- *	This procedure can be used to tell whether Tcl_AsyncInvoke
- *	needs to be called.  This procedure is the external interface
- *	for checking the thread-specific asyncReady variable.
+ *	This procedure can be used to tell whether Tcl_AsyncInvoke needs to be
+ *	called. This procedure is the external interface for checking the
+ *	thread-specific asyncReady variable.
  *
  * Results:
- * 	The return value is 1 whenever a handler is ready and is 0
- *	when no handlers are ready.
+ *	The return value is 1 whenever a handler is ready and is 0 when no
+ *	handlers are ready.
  *
  * Side effects:
  *	None.
@@ -349,8 +333,23 @@ Tcl_AsyncDelete(async)
  */
 
 int
-Tcl_AsyncReady()
+Tcl_AsyncReady(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     return tsdPtr->asyncReady;
 }
+
+int *
+TclGetAsyncReadyPtr(void)
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    return &(tsdPtr->asyncReady);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 134deac..5779ca5 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1,9 +1,9 @@
-/* 
+/*
  * tclBasic.c --
  *
  *	Contains the basic facilities for TCL command interpretation,
- *	including interpreter creation and deletion, command creation
- *	and deletion, and command/script execution. 
+ *	including interpreter creation and deletion, command creation and
+ *	deletion, and command/script execution.
  *
  * Copyright (c) 1987-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -11,256 +11,353 @@
  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 #include "tclCompile.h"
-#ifndef TCL_GENERIC_ONLY
-#   include "tclPort.h"
-#endif
+#include <float.h>
+#include <limits.h>
+#include <math.h>
+#include "tommath.h"
 
 /*
- * Static procedures in this file:
+ * Determine whether we're using IEEE floating point
  */
 
-static char *		CallCommandTraces _ANSI_ARGS_((Interp *iPtr, 
-			    Command *cmdPtr, CONST char *oldName, 
-			    CONST char* newName, int flags));
-static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
-static void		ProcessUnexpectedResult _ANSI_ARGS_((
-			    Tcl_Interp *interp, int returnCode));
-static int	        StringTraceProc _ANSI_ARGS_((ClientData clientData,
-						     Tcl_Interp* interp,
-						     int level,
-						     CONST char* command,
-						    Tcl_Command commandInfo,
-						    int objc,
-						    Tcl_Obj *CONST objv[]));
-static void           StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));
-
-#ifdef TCL_TIP280
-/* TIP #280 - Modified token based evaluation, with line information */
-static int            EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script,
-					  int numBytes, int flags, int line,
-					  int* clNextOuter, CONST char* outerScript));
-
-static int            EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp,
-						      Tcl_Token *tokenPtr,
-						      int count, int line,
-						      int* clNextOuter, CONST char* outerScript));
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+#   define IEEE_FLOATING_POINT
+/* Largest odd integer that can be represented exactly in a double */
+#   define MAX_EXACT 9007199254740991.0
 #endif
 
+/*
+ * The following structure defines the client data for a math function
+ * registered with Tcl_CreateMathFunc
+ */
+
+typedef struct OldMathFuncData {
+    Tcl_MathProc *proc;		/* Handler function */
+    int numArgs;		/* Number of args expected */
+    Tcl_ValueType *argTypes;	/* Types of the args */
+    ClientData clientData;	/* Client data for the handler function */
+} OldMathFuncData;
+
+/*
+ * Static functions in this file:
+ */
+
+static char *	CallCommandTraces(Interp *iPtr, Command *cmdPtr,
+		    const char *oldName, const char *newName, int flags);
+static int	CheckDoubleResult(Tcl_Interp *interp, double dResult);
+static void	DeleteInterpProc(Tcl_Interp *interp);
+static void	DeleteOpCmdClientData(ClientData clientData);
+static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
+	            int numChars, int objc, Tcl_Obj *const objv[]);
+static void	ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
+static int	OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static void	OldMathFuncDeleteProc(ClientData clientData);
+static int	ExprAbsFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprBoolFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprCeilFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprEntierFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprFloorFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprIntFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprRandFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprRoundFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprSrandFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static int	ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
+		    int argc, Tcl_Obj *const *objv);
+static void	MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
+		    int actual, Tcl_Obj *const *objv);
 #ifdef USE_DTRACE
 static int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
-		    Tcl_Obj *CONST objv[]);
+		    Tcl_Obj *const objv[]);
 #endif
 
 extern TclStubs tclStubs;
 
 /*
- * The following structure defines the commands in the Tcl core.
+ * The following structure define the commands in the Tcl core.
  */
 
 typedef struct {
-    CONST char *name;		/* Name of object-based command. */
-    Tcl_CmdProc *proc;		/* String-based procedure for command. */
-    Tcl_ObjCmdProc *objProc;	/* Object-based procedure for command. */
-    CompileProc *compileProc;	/* Procedure called to compile command. */
-    int isSafe;			/* If non-zero, command will be present
-                                 * in safe interpreter. Otherwise it will
-                                 * be hidden. */
+    const char *name;		/* Name of object-based command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
+    CompileProc *compileProc;	/* Function called to compile command. */
+    int isSafe;			/* If non-zero, command will be present in
+				 * safe interpreter. Otherwise it will be
+				 * hidden. */
 } CmdInfo;
 
 /*
- * The built-in commands, and the procedures that implement them:
+ * The built-in commands, and the functions that implement them:
  */
 
-static CONST CmdInfo builtInCmds[] = {
-    /*
-     * Commands in the generic core. Note that at least one of the proc or
-     * objProc members should be non-NULL. This avoids infinitely recursive
-     * calls between TclInvokeObjectCommand and TclInvokeStringCommand if a
-     * command name is computed at runtime and results in the name of a
-     * compiled command.
-     */
-
-    {"append",		(Tcl_CmdProc *) NULL,	Tcl_AppendObjCmd,
-	TclCompileAppendCmd,		1},
-    {"array",		(Tcl_CmdProc *) NULL,	Tcl_ArrayObjCmd,
-        (CompileProc *) NULL,		1},
-    {"binary",		(Tcl_CmdProc *) NULL,	Tcl_BinaryObjCmd,
-        (CompileProc *) NULL,		1},
-    {"break",		(Tcl_CmdProc *) NULL,	Tcl_BreakObjCmd,
-        TclCompileBreakCmd,		1},
-    {"case",		(Tcl_CmdProc *) NULL,	Tcl_CaseObjCmd,
-        (CompileProc *) NULL,		1},
-    {"catch",		(Tcl_CmdProc *) NULL,	Tcl_CatchObjCmd,	
-        TclCompileCatchCmd,		1},
-    {"clock",		(Tcl_CmdProc *) NULL,	Tcl_ClockObjCmd,
-        (CompileProc *) NULL,		1},
-    {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
-        (CompileProc *) NULL,		1},
-    {"continue",	(Tcl_CmdProc *) NULL,	Tcl_ContinueObjCmd,
-        TclCompileContinueCmd,		1},
-    {"encoding",	(Tcl_CmdProc *) NULL,	Tcl_EncodingObjCmd,
-        (CompileProc *) NULL,		0},
-    {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
-        (CompileProc *) NULL,		1},
-    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
-        (CompileProc *) NULL,		1},
-    {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
-        (CompileProc *) NULL,		0},
-    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,
-        TclCompileExprCmd,		1},
-    {"fcopy",		(Tcl_CmdProc *) NULL,	Tcl_FcopyObjCmd,
-        (CompileProc *) NULL,		1},
-    {"fileevent",	(Tcl_CmdProc *) NULL,	Tcl_FileEventObjCmd,
-        (CompileProc *) NULL,		1},
-    {"for",		(Tcl_CmdProc *) NULL,	Tcl_ForObjCmd,
-        TclCompileForCmd,		1},
-    {"foreach",		(Tcl_CmdProc *) NULL,	Tcl_ForeachObjCmd,
-        TclCompileForeachCmd,		1},
-    {"format",		(Tcl_CmdProc *) NULL,	Tcl_FormatObjCmd,
-        (CompileProc *) NULL,		1},
-    {"global",		(Tcl_CmdProc *) NULL,	Tcl_GlobalObjCmd,
-        (CompileProc *) NULL,		1},
-    {"if",		(Tcl_CmdProc *) NULL,	Tcl_IfObjCmd,
-        TclCompileIfCmd,		1},
-    {"incr",		(Tcl_CmdProc *) NULL,	Tcl_IncrObjCmd,
-        TclCompileIncrCmd,		1},
-    {"info",		(Tcl_CmdProc *) NULL,	Tcl_InfoObjCmd,
-        (CompileProc *) NULL,		1},
-    {"join",		(Tcl_CmdProc *) NULL,	Tcl_JoinObjCmd,
-        (CompileProc *) NULL,		1},
-    {"lappend",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
-        TclCompileLappendCmd,		1},
-    {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,
-        TclCompileLindexCmd,		1},
-    {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
-        (CompileProc *) NULL,		1},
-    {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
-        TclCompileListCmd,		1},
-    {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
-        TclCompileLlengthCmd,		1},
-    {"load",		(Tcl_CmdProc *) NULL,	Tcl_LoadObjCmd,
-        (CompileProc *) NULL,		0},
-    {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
-        (CompileProc *) NULL,		1},
-    {"lreplace",	(Tcl_CmdProc *) NULL,	Tcl_LreplaceObjCmd,
-        (CompileProc *) NULL,		1},
-    {"lsearch",		(Tcl_CmdProc *) NULL,	Tcl_LsearchObjCmd,
-        (CompileProc *) NULL,		1},
-    {"lset",            (Tcl_CmdProc *) NULL,   Tcl_LsetObjCmd,
-        TclCompileLsetCmd,           	1},
-    {"lsort",		(Tcl_CmdProc *) NULL,	Tcl_LsortObjCmd,
-        (CompileProc *) NULL,		1},
-    {"namespace",	(Tcl_CmdProc *) NULL,	Tcl_NamespaceObjCmd,
-        (CompileProc *) NULL,		1},
-    {"package",		(Tcl_CmdProc *) NULL,	Tcl_PackageObjCmd,
-        (CompileProc *) NULL,		1},
-    {"proc",		(Tcl_CmdProc *) NULL,	Tcl_ProcObjCmd,	
-        (CompileProc *) NULL,		1},
-    {"regexp",		(Tcl_CmdProc *) NULL,	Tcl_RegexpObjCmd,
-        TclCompileRegexpCmd,		1},
-    {"regsub",		(Tcl_CmdProc *) NULL,	Tcl_RegsubObjCmd,
-        (CompileProc *) NULL,		1},
-    {"rename",		(Tcl_CmdProc *) NULL,	Tcl_RenameObjCmd,
-        (CompileProc *) NULL,		1},
-    {"return",		(Tcl_CmdProc *) NULL,	Tcl_ReturnObjCmd,	
-        TclCompileReturnCmd,		1},
-    {"scan",		(Tcl_CmdProc *) NULL,	Tcl_ScanObjCmd,
-        (CompileProc *) NULL,		1},
-    {"set",		(Tcl_CmdProc *) NULL,	Tcl_SetObjCmd,
-        TclCompileSetCmd,		1},
-    {"split",		(Tcl_CmdProc *) NULL,	Tcl_SplitObjCmd,
-        (CompileProc *) NULL,		1},
-    {"string",		(Tcl_CmdProc *) NULL,	Tcl_StringObjCmd,
-        TclCompileStringCmd,		1},
-    {"subst",		(Tcl_CmdProc *) NULL,	Tcl_SubstObjCmd,
-        (CompileProc *) NULL,		1},
-    {"switch",		(Tcl_CmdProc *) NULL,	Tcl_SwitchObjCmd,	
-        (CompileProc *) NULL,		1},
-    {"trace",		(Tcl_CmdProc *) NULL,	Tcl_TraceObjCmd,
-        (CompileProc *) NULL,		1},
-    {"unset",		(Tcl_CmdProc *) NULL,	Tcl_UnsetObjCmd,	
-        (CompileProc *) NULL,		1},
-    {"uplevel",		(Tcl_CmdProc *) NULL,	Tcl_UplevelObjCmd,	
-        (CompileProc *) NULL,		1},
-    {"upvar",		(Tcl_CmdProc *) NULL,	Tcl_UpvarObjCmd,	
-        (CompileProc *) NULL,		1},
-    {"variable",	(Tcl_CmdProc *) NULL,	Tcl_VariableObjCmd,
-        (CompileProc *) NULL,		1},
-    {"while",		(Tcl_CmdProc *) NULL,	Tcl_WhileObjCmd,
-        TclCompileWhileCmd,		1},
-
-    /*
-     * Commands in the UNIX core:
-     */
-
-#ifndef TCL_GENERIC_ONLY
-    {"after",		(Tcl_CmdProc *) NULL,	Tcl_AfterObjCmd,
-        (CompileProc *) NULL,		1},
-    {"cd",		(Tcl_CmdProc *) NULL,	Tcl_CdObjCmd,
-        (CompileProc *) NULL,		0},
-    {"close",		(Tcl_CmdProc *) NULL,	Tcl_CloseObjCmd,
-        (CompileProc *) NULL,		1},
-    {"eof",		(Tcl_CmdProc *) NULL,	Tcl_EofObjCmd,
-        (CompileProc *) NULL,		1},
-    {"fblocked",	(Tcl_CmdProc *) NULL,	Tcl_FblockedObjCmd,
-        (CompileProc *) NULL,		1},
-    {"fconfigure",	(Tcl_CmdProc *) NULL,	Tcl_FconfigureObjCmd,
-        (CompileProc *) NULL,		0},
-    {"file",		(Tcl_CmdProc *) NULL,	Tcl_FileObjCmd,
-        (CompileProc *) NULL,		0},
-    {"flush",		(Tcl_CmdProc *) NULL,	Tcl_FlushObjCmd,
-        (CompileProc *) NULL,		1},
-    {"gets",		(Tcl_CmdProc *) NULL,	Tcl_GetsObjCmd,
-        (CompileProc *) NULL,		1},
-    {"glob",		(Tcl_CmdProc *) NULL,	Tcl_GlobObjCmd,
-        (CompileProc *) NULL,		0},
-    {"open",		(Tcl_CmdProc *) NULL,	Tcl_OpenObjCmd,
-        (CompileProc *) NULL,		0},
-    {"pid",		(Tcl_CmdProc *) NULL,	Tcl_PidObjCmd,
-        (CompileProc *) NULL,		1},
-    {"puts",		(Tcl_CmdProc *) NULL,	Tcl_PutsObjCmd,
-        (CompileProc *) NULL,		1},
-    {"pwd",		(Tcl_CmdProc *) NULL,	Tcl_PwdObjCmd,
-        (CompileProc *) NULL,		0},
-    {"read",		(Tcl_CmdProc *) NULL,	Tcl_ReadObjCmd,
-        (CompileProc *) NULL,		1},
-    {"seek",		(Tcl_CmdProc *) NULL,	Tcl_SeekObjCmd,
-        (CompileProc *) NULL,		1},
-    {"socket",		(Tcl_CmdProc *) NULL,	Tcl_SocketObjCmd,
-        (CompileProc *) NULL,		0},
-    {"tell",		(Tcl_CmdProc *) NULL,	Tcl_TellObjCmd,
-        (CompileProc *) NULL,		1},
-    {"time",		(Tcl_CmdProc *) NULL,	Tcl_TimeObjCmd,
-        (CompileProc *) NULL,		1},
-    {"update",		(Tcl_CmdProc *) NULL,	Tcl_UpdateObjCmd,
-        (CompileProc *) NULL,		1},
-    {"vwait",		(Tcl_CmdProc *) NULL,	Tcl_VwaitObjCmd,
-        (CompileProc *) NULL,		1},
-    {"exec",		(Tcl_CmdProc *) NULL,	Tcl_ExecObjCmd,
-        (CompileProc *) NULL,		0},
-    {"source",		(Tcl_CmdProc *) NULL,	Tcl_SourceObjCmd,
-        (CompileProc *) NULL,		0},
-    
-#endif /* TCL_GENERIC_ONLY */
-    {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
-        (CompileProc *) NULL,		0}
+static const CmdInfo builtInCmds[] = {
+    /*
+     * Commands in the generic core.
+     */
+
+    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	1},
+    {"apply",		Tcl_ApplyObjCmd,	NULL,			1},
+    {"array",		Tcl_ArrayObjCmd,	NULL,			1},
+    {"binary",		Tcl_BinaryObjCmd,	NULL,			1},
+    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	1},
+#ifndef EXCLUDE_OBSOLETE_COMMANDS
+    {"case",		Tcl_CaseObjCmd,		NULL,			1},
+#endif
+    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	1},
+    {"concat",		Tcl_ConcatObjCmd,	NULL,			1},
+    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	1},
+    {"error",		Tcl_ErrorObjCmd,	NULL,			1},
+    {"eval",		Tcl_EvalObjCmd,		NULL,			1},
+    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	1},
+    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	1},
+    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	1},
+    {"format",		Tcl_FormatObjCmd,	NULL,			1},
+    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	1},
+    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	1},
+    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	1},
+    {"join",		Tcl_JoinObjCmd,		NULL,			1},
+    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	1},
+    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	1},
+    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	1},
+    {"linsert",		Tcl_LinsertObjCmd,	NULL,			1},
+    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	1},
+    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	1},
+    {"lrange",		Tcl_LrangeObjCmd,	NULL,			1},
+    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			1},
+    {"lreplace",	Tcl_LreplaceObjCmd,	NULL,			1},
+    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			1},
+    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			1},
+    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	1},
+    {"lsort",		Tcl_LsortObjCmd,	NULL,			1},
+    {"namespace",	Tcl_NamespaceObjCmd,	TclCompileNamespaceCmd,	1},
+    {"package",		Tcl_PackageObjCmd,	NULL,			1},
+    {"proc",		Tcl_ProcObjCmd,		NULL,			1},
+    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	1},
+    {"regsub",		Tcl_RegsubObjCmd,	NULL,			1},
+    {"rename",		Tcl_RenameObjCmd,	NULL,			1},
+    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	1},
+    {"scan",		Tcl_ScanObjCmd,		NULL,			1},
+    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	1},
+    {"split",		Tcl_SplitObjCmd,	NULL,			1},
+    {"subst",		Tcl_SubstObjCmd,	NULL,			1},
+    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	1},
+    {"trace",		Tcl_TraceObjCmd,	NULL,			1},
+    {"unset",		Tcl_UnsetObjCmd,	NULL,			1},
+    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			1},
+    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	1},
+    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	1},
+    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	1},
+
+    /*
+     * Commands in the OS-interface. Note that many of these are unsafe.
+     */
+
+    {"after",		Tcl_AfterObjCmd,	NULL,			1},
+    {"cd",		Tcl_CdObjCmd,		NULL,			0},
+    {"close",		Tcl_CloseObjCmd,	NULL,			1},
+    {"eof",		Tcl_EofObjCmd,		NULL,			1},
+    {"encoding",	Tcl_EncodingObjCmd,	NULL,			0},
+    {"exec",		Tcl_ExecObjCmd,		NULL,			0},
+    {"exit",		Tcl_ExitObjCmd,		NULL,			0},
+    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			1},
+    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			0},
+    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			1},
+    {"file",		Tcl_FileObjCmd,		NULL,			0},
+    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			1},
+    {"flush",		Tcl_FlushObjCmd,	NULL,			1},
+    {"gets",		Tcl_GetsObjCmd,		NULL,			1},
+    {"glob",		Tcl_GlobObjCmd,		NULL,			0},
+    {"load",		Tcl_LoadObjCmd,		NULL,			0},
+    {"open",		Tcl_OpenObjCmd,		NULL,			0},
+    {"pid",		Tcl_PidObjCmd,		NULL,			1},
+    {"puts",		Tcl_PutsObjCmd,		NULL,			1},
+    {"pwd",		Tcl_PwdObjCmd,		NULL,			0},
+    {"read",		Tcl_ReadObjCmd,		NULL,			1},
+    {"seek",		Tcl_SeekObjCmd,		NULL,			1},
+    {"socket",		Tcl_SocketObjCmd,	NULL,			0},
+    {"source",		Tcl_SourceObjCmd,	NULL,			0},
+    {"tell",		Tcl_TellObjCmd,		NULL,			1},
+    {"time",		Tcl_TimeObjCmd,		NULL,			1},
+    {"unload",		Tcl_UnloadObjCmd,	NULL,			0},
+    {"update",		Tcl_UpdateObjCmd,	NULL,			1},
+    {"vwait",		Tcl_VwaitObjCmd,	NULL,			1},
+    {NULL,		NULL,			NULL,			0}
 };
 
 /*
- * The following structure holds the client data for string-based
- * trace procs
+ * Math functions. All are safe.
+ */
+
+typedef struct {
+    const char *name;		/* Name of the function. The full name is
+				 * "::tcl::mathfunc::<name>".  */
+    Tcl_ObjCmdProc *objCmdProc;	/* Function that evaluates the function */
+    ClientData clientData;	/* Client data for the function */
+} BuiltinFuncDef;
+static const BuiltinFuncDef BuiltinFuncTable[] = {
+    { "abs",	ExprAbsFunc,	NULL 			},
+    { "acos",	ExprUnaryFunc,	(ClientData) acos 	},
+    { "asin",	ExprUnaryFunc,	(ClientData) asin 	},
+    { "atan",	ExprUnaryFunc,	(ClientData) atan 	},
+    { "atan2",	ExprBinaryFunc,	(ClientData) atan2 	},
+    { "bool",	ExprBoolFunc,	NULL			},
+    { "ceil",	ExprCeilFunc,	NULL		 	},
+    { "cos",	ExprUnaryFunc,	(ClientData) cos 	},
+    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
+    { "double",	ExprDoubleFunc,	NULL			},
+    { "entier",	ExprEntierFunc,	NULL			},
+    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
+    { "floor",	ExprFloorFunc,	NULL		 	},
+    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
+    { "hypot",	ExprBinaryFunc,	(ClientData) hypot 	},
+    { "int",	ExprIntFunc,	NULL			},
+    { "isqrt",	ExprIsqrtFunc,	NULL			},
+    { "log",	ExprUnaryFunc,	(ClientData) log 	},
+    { "log10",	ExprUnaryFunc,	(ClientData) log10 	},
+    { "pow",	ExprBinaryFunc,	(ClientData) pow 	},
+    { "rand",	ExprRandFunc,	NULL			},
+    { "round",	ExprRoundFunc,	NULL			},
+    { "sin",	ExprUnaryFunc,	(ClientData) sin 	},
+    { "sinh",	ExprUnaryFunc,	(ClientData) sinh 	},
+    { "sqrt",	ExprSqrtFunc,	NULL		 	},
+    { "srand",	ExprSrandFunc,	NULL			},
+    { "tan",	ExprUnaryFunc,	(ClientData) tan 	},
+    { "tanh",	ExprUnaryFunc,	(ClientData) tanh 	},
+    { "wide",	ExprWideFunc,	NULL		 	},
+    { NULL, NULL, NULL }
+};
+
+/*
+ * TIP#174's math operators. All are safe.
+ */
+
+typedef struct {
+    const char *name;		/* Name of object-based command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
+    CompileProc *compileProc;	/* Function called to compile command. */
+    union {
+	int numArgs;
+	int identity;
+    } i;
+    const char *expected;	/* For error message, what argument(s)
+				 * were expected. */
+} OpCmdInfo;
+static const OpCmdInfo mathOpCmds[] = {
+    { "~",	TclSingleOpCmd,		TclCompileInvertOpCmd,
+		/* numArgs */ {1},	"integer"},
+    { "!",	TclSingleOpCmd,		TclCompileNotOpCmd,
+		/* numArgs */ {1},	"boolean"},
+    { "+",	TclVariadicOpCmd,	TclCompileAddOpCmd,
+		/* identity */ {0},	NULL},
+    { "*",	TclVariadicOpCmd,	TclCompileMulOpCmd,
+		/* identity */ {1},	NULL},
+    { "&",	TclVariadicOpCmd,	TclCompileAndOpCmd,
+		/* identity */ {-1},	NULL},
+    { "|",	TclVariadicOpCmd,	TclCompileOrOpCmd,
+		/* identity */ {0},	NULL},
+    { "^",	TclVariadicOpCmd,	TclCompileXorOpCmd,
+		/* identity */ {0},	NULL},
+    { "**",	TclVariadicOpCmd,	TclCompilePowOpCmd,
+		/* identity */ {1},	NULL},
+    { "<<",	TclSingleOpCmd,		TclCompileLshiftOpCmd,
+		/* numArgs */ {2},	"integer shift"},
+    { ">>",	TclSingleOpCmd,		TclCompileRshiftOpCmd,
+		/* numArgs */ {2},	"integer shift"},
+    { "%",	TclSingleOpCmd,		TclCompileModOpCmd,
+		/* numArgs */ {2},	"integer integer"},
+    { "!=",	TclSingleOpCmd,		TclCompileNeqOpCmd,
+		/* numArgs */ {2},	"value value"},
+    { "ne",	TclSingleOpCmd,		TclCompileStrneqOpCmd,
+		/* numArgs */ {2},	"value value"},
+    { "in",	TclSingleOpCmd,		TclCompileInOpCmd,
+		/* numArgs */ {2},	"value list"},
+    { "ni",	TclSingleOpCmd,		TclCompileNiOpCmd,
+		/* numArgs */ {2},	"value list"},
+    { "-",	TclNoIdentOpCmd,	TclCompileMinusOpCmd,
+		/* unused */ {0},	"value ?value ...?"},
+    { "/",	TclNoIdentOpCmd,	TclCompileDivOpCmd,
+		/* unused */ {0},	"value ?value ...?"},
+    { "<",	TclSortingOpCmd,	TclCompileLessOpCmd,
+		/* unused */ {0},	NULL},
+    { "<=",	TclSortingOpCmd,	TclCompileLeqOpCmd,
+		/* unused */ {0},	NULL},
+    { ">",	TclSortingOpCmd,	TclCompileGreaterOpCmd,
+		/* unused */ {0},	NULL},
+    { ">=",	TclSortingOpCmd,	TclCompileGeqOpCmd,
+		/* unused */ {0},	NULL},
+    { "==",	TclSortingOpCmd,	TclCompileEqOpCmd,
+		/* unused */ {0},	NULL},
+    { "eq",	TclSortingOpCmd,	TclCompileStreqOpCmd,
+		/* unused */ {0},	NULL},
+    { NULL,	NULL,			NULL,
+		{0},			NULL}
+};
+
+/*
+ * Macros for stack checks. The goal of these macros is to allow the size of
+ * the stack to be checked (so preventing overflow) in a *cheap* way. Note
+ * that the check needs to be (amortized) cheap since it is on the critical
+ * path for recursion.
+ */
+
+#if defined(TCL_NO_STACK_CHECK)
+/*
+ * Stack check disabled: make them noops.
  */
 
-typedef struct StringTraceData {
-    ClientData clientData;	/* Client data from Tcl_CreateTrace */
-    Tcl_CmdTraceProc* proc;	/* Trace procedure from Tcl_CreateTrace */
-} StringTraceData;
+#   define CheckCStack(interp, localIntPtr)	1
+#   define GetCStackParams(iPtr)		/* do nothing */
+#elif defined(TCL_CROSS_COMPILE)
+
+/*
+ * This variable is static and only set *once*, during library initialization.
+ * It therefore needs no thread guards.
+ */
+
+static int stackGrowsDown = 1;
+#   define GetCStackParams(iPtr) \
+    stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
+#   define CheckCStack(iPtr, localIntPtr) \
+    (stackGrowsDown \
+	    ? ((localIntPtr) > (iPtr)->stackBound) \
+	    : ((localIntPtr) < (iPtr)->stackBound) \
+    )
+#else /* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
+#   define GetCStackParams(iPtr) \
+    TclpGetCStackParams(&((iPtr)->stackBound))
+#   ifdef TCL_STACK_GROWS_UP
+#	define CheckCStack(iPtr, localIntPtr) \
+	   (!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
+#    else /* TCL_STACK_GROWS_UP */
+#	define CheckCStack(iPtr, localIntPtr) \
+	   ((localIntPtr) > (iPtr)->stackBound)
+#    endif /* TCL_STACK_GROWS_UP */
+#endif /* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */
 
 /*
  *----------------------------------------------------------------------
@@ -270,28 +367,26 @@ typedef struct StringTraceData {
  *	Create a new TCL command interpreter.
  *
  * Results:
- *	The return value is a token for the interpreter, which may be
- *	used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
- *	Tcl_DeleteInterp.
+ *	The return value is a token for the interpreter, which may be used in
+ *	calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
  *
  * Side effects:
- *	The command interpreter is initialized with the built-in commands
- *      and with the variables documented in tclvars(n).
+ *	The command interpreter is initialized with the built-in commands and
+ *	with the variables documented in tclvars(n).
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Interp *
-Tcl_CreateInterp()
+Tcl_CreateInterp(void)
 {
     Interp *iPtr;
     Tcl_Interp *interp;
     Command *cmdPtr;
-    BuiltinFunc *builtinFuncPtr;
-    MathFunc *mathFuncPtr;
-    Tcl_HashEntry *hPtr;
-    CONST CmdInfo *cmdInfoPtr;
-    int i;
+    const BuiltinFuncDef *builtinFuncPtr;
+    const OpCmdInfo *opcmdInfoPtr;
+    const CmdInfo *cmdInfoPtr;
+    Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
     union {
 	char c[sizeof(short)];
 	short s;
@@ -299,65 +394,76 @@ Tcl_CreateInterp()
 #ifdef TCL_COMPILE_STATS
     ByteCodeStats *statsPtr;
 #endif /* TCL_COMPILE_STATS */
+    char mathFuncName[32];
+    CallFrame *framePtr;
+    int result;
 
-    TclInitSubsystems(NULL);
+    TclInitSubsystems();
 
     /*
-     * Panic if someone updated the CallFrame structure without
-     * also updating the Tcl_CallFrame structure (or vice versa).
-     */  
+     * Panic if someone updated the CallFrame structure without also updating
+     * the Tcl_CallFrame structure (or vice versa).
+     */
 
     if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
 	/*NOTREACHED*/
-	panic("Tcl_CallFrame must not be smaller than CallFrame");
+	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
     }
 
     /*
      * Initialize support for namespaces and create the global namespace
-     * (whose name is ""; an alias is "::"). This also initializes the
-     * Tcl object type table and other object management code.
+     * (whose name is ""; an alias is "::"). This also initializes the Tcl
+     * object type table and other object management code.
      */
 
     iPtr = (Interp *) ckalloc(sizeof(Interp));
     interp = (Tcl_Interp *) iPtr;
 
-    iPtr->result		= iPtr->resultSpace;
-    iPtr->freeProc		= NULL;
-    iPtr->errorLine		= 0;
-    iPtr->objResultPtr		= Tcl_NewObj();
+    iPtr->result = iPtr->resultSpace;
+    iPtr->freeProc = NULL;
+    iPtr->errorLine = 0;
+    iPtr->objResultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(iPtr->objResultPtr);
-    iPtr->handle		= TclHandleCreate(iPtr);
-    iPtr->globalNsPtr		= NULL;
-    iPtr->hiddenCmdTablePtr	= NULL;
-    iPtr->interpInfo		= NULL;
-    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
+    iPtr->handle = TclHandleCreate(iPtr);
+    iPtr->globalNsPtr = NULL;
+    iPtr->hiddenCmdTablePtr = NULL;
+    iPtr->interpInfo = NULL;
 
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
-    iPtr->framePtr = NULL;
-    iPtr->varFramePtr = NULL;
+    iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
+    iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */
 
-#ifdef TCL_TIP280
     /*
      * TIP #280 - Initialize the arrays used to extend the ByteCode and
      * Proc structures.
      */
-    iPtr->cmdFramePtr  = NULL;
-    iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
-    iPtr->lineBCPtr    = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
-    iPtr->lineLAPtr    = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
-    iPtr->lineLABCPtr  = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+
+    iPtr->cmdFramePtr = NULL;
+    iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+    iPtr->lineLABCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
     Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
-    Tcl_InitHashTable(iPtr->lineBCPtr,    TCL_ONE_WORD_KEYS);
-    Tcl_InitHashTable(iPtr->lineLAPtr,    TCL_ONE_WORD_KEYS);
-    Tcl_InitHashTable(iPtr->lineLABCPtr,  TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
     iPtr->scriptCLLocPtr = NULL;
-#endif
 
     iPtr->activeVarTracePtr = NULL;
-    iPtr->returnCode = TCL_OK;
+
+    iPtr->returnOpts = NULL;
     iPtr->errorInfo = NULL;
+    TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
+    Tcl_IncrRefCount(iPtr->eiVar);
     iPtr->errorCode = NULL;
+    TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
+    Tcl_IncrRefCount(iPtr->ecVar);
+    iPtr->returnLevel = 1;
+    iPtr->returnCode = TCL_OK;
+
+    iPtr->rootFramePtr = NULL;	/* Initialise as soon as :: is available */
+    iPtr->lookupNsPtr = NULL;
 
     iPtr->appendResult = NULL;
     iPtr->appendAvl = 0;
@@ -365,14 +471,15 @@ Tcl_CreateInterp()
 
     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
     iPtr->packageUnknown = NULL;
-#ifdef TCL_TIP268
+
     /* TIP #268 */
-    iPtr->packagePrefer = (getenv ("TCL_PKG_PREFER_LATEST") == NULL ? 
-			   PKG_PREFER_STABLE   :
-			   PKG_PREFER_LATEST);
-#endif
+    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
+	iPtr->packagePrefer = PKG_PREFER_STABLE;
+    } else {
+	iPtr->packagePrefer = PKG_PREFER_LATEST;
+    }
+
     iPtr->cmdCount = 0;
-    iPtr->termOffset = 0;
     TclInitLiteralTable(&(iPtr->literalTable));
     iPtr->compileEpoch = 0;
     iPtr->compiledProcPtr = NULL;
@@ -384,21 +491,58 @@ Tcl_CreateInterp()
     iPtr->tracesForbiddingInline = 0;
     iPtr->activeCmdTracePtr = NULL;
     iPtr->activeInterpTracePtr = NULL;
-    iPtr->assocData = (Tcl_HashTable *) NULL;
-    iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
-    iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
+    iPtr->assocData = NULL;
+    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
+    iPtr->emptyObjPtr = Tcl_NewObj();
+				/* Another empty object. */
     Tcl_IncrRefCount(iPtr->emptyObjPtr);
     iPtr->resultSpace[0] = 0;
     iPtr->threadId = Tcl_GetCurrentThread();
 
-    iPtr->globalNsPtr = NULL;	/* force creation of global ns below */
+    /* TIP #378 */
+#ifdef TCL_INTERP_DEBUG_FRAME
+    iPtr->flags |= INTERP_DEBUG_FRAME;
+#else
+    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
+        iPtr->flags |= INTERP_DEBUG_FRAME;
+    }
+#endif
+
+    /*
+     * Initialise the tables for variable traces and searches *before*
+     * creating the global ns - so that the trace on errorInfo can be
+     * recorded.
+     */
+
+    Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);
+
+    iPtr->globalNsPtr = NULL;	/* Force creation of global ns below. */
     iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
-	    (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+	    NULL, NULL);
     if (iPtr->globalNsPtr == NULL) {
-        panic("Tcl_CreateInterp: can't create global namespace");
+	Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
     }
 
     /*
+     * Initialise the rootCallframe. It cannot be allocated on the stack, as
+     * it has to be in place before TclCreateExecEnv tries to use a variable.
+     */
+
+    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
+    framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+	Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
+    }
+    framePtr->objc = 0;
+
+    iPtr->framePtr = framePtr;
+    iPtr->varFramePtr = framePtr;
+    iPtr->rootFramePtr = framePtr;
+
+    /*
      * Initialize support for code compilation and execution. We call
      * TclCreateExecEnv after initializing namespaces since it tries to
      * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
@@ -408,6 +552,12 @@ Tcl_CreateInterp()
     iPtr->execEnvPtr = TclCreateExecEnv(interp);
 
     /*
+     * TIP #219, Tcl Channel Reflection API support.
+     */
+
+    iPtr->chanMsg = NULL;
+
+    /*
      * Initialize the compilation and execution statistics kept for this
      * interpreter.
      */
@@ -417,31 +567,28 @@ Tcl_CreateInterp()
     statsPtr->numExecutions = 0;
     statsPtr->numCompilations = 0;
     statsPtr->numByteCodesFreed = 0;
-    (VOID *) memset(statsPtr->instructionCount, 0,
+    (void) memset(statsPtr->instructionCount, 0,
 	    sizeof(statsPtr->instructionCount));
 
     statsPtr->totalSrcBytes = 0.0;
     statsPtr->totalByteCodeBytes = 0.0;
     statsPtr->currentSrcBytes = 0.0;
     statsPtr->currentByteCodeBytes = 0.0;
-    (VOID *) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
-    (VOID *) memset(statsPtr->byteCodeCount, 0,
-	    sizeof(statsPtr->byteCodeCount));
-    (VOID *) memset(statsPtr->lifetimeCount, 0,
-	    sizeof(statsPtr->lifetimeCount));
-    
-    statsPtr->currentInstBytes   = 0.0;
-    statsPtr->currentLitBytes    = 0.0;
+    (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
+    (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
+    (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));
+
+    statsPtr->currentInstBytes = 0.0;
+    statsPtr->currentLitBytes = 0.0;
     statsPtr->currentExceptBytes = 0.0;
-    statsPtr->currentAuxBytes    = 0.0;
+    statsPtr->currentAuxBytes = 0.0;
     statsPtr->currentCmdMapBytes = 0.0;
-    
-    statsPtr->numLiteralsCreated    = 0;
-    statsPtr->totalLitStringBytes   = 0.0;
+
+    statsPtr->numLiteralsCreated = 0;
+    statsPtr->totalLitStringBytes = 0.0;
     statsPtr->currentLitStringBytes = 0.0;
-    (VOID *) memset(statsPtr->literalCount, 0,
-            sizeof(statsPtr->literalCount));
-#endif /* TCL_COMPILE_STATS */    
+    (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
+#endif /* TCL_COMPILE_STATS */
 
     /*
      * Initialise the stub table pointer.
@@ -449,54 +596,74 @@ Tcl_CreateInterp()
 
     iPtr->stubTable = &tclStubs;
 
-    
+    /*
+     * Initialize the ensemble error message rewriting support.
+     */
+
+    iPtr->ensembleRewrite.sourceObjs = NULL;
+    iPtr->ensembleRewrite.numRemovedObjs = 0;
+    iPtr->ensembleRewrite.numInsertedObjs = 0;
+
+    /*
+     * TIP#143: Initialise the resource limit support.
+     */
+
+    TclInitLimitSupport(interp);
+
+    /*
+     * Initialise the thread-specific data ekeko.
+     */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    iPtr->allocCache = TclpGetAllocCache();
+#else
+    iPtr->allocCache = NULL;
+#endif
+    iPtr->pendingObjDataPtr = NULL;
+    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
+
+    /*
+     * Insure that the stack checking mechanism for this interp is
+     * initialized.
+     */
+
+    GetCStackParams(iPtr);
+
     /*
      * Create the core commands. Do it here, rather than calling
-     * Tcl_CreateCommand, because it's faster (there's no need to check for
-     * a pre-existing command by the same name). If a command has a
-     * Tcl_CmdProc but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
-     * TclInvokeStringCommand. This is an object-based wrapper procedure
-     * that extracts strings, calls the string procedure, and creates an
-     * object for the result. Similarly, if a command has a Tcl_ObjCmdProc
-     * but no Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
-     */
-
-    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL;
-	    cmdInfoPtr++) {
-	int new;
+     * Tcl_CreateCommand, because it's faster (there's no need to check for a
+     * pre-existing command by the same name). If a command has a Tcl_CmdProc
+     * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
+     * TclInvokeStringCommand. This is an object-based wrapper function that
+     * extracts strings, calls the string function, and creates an object for
+     * the result. Similarly, if a command has a Tcl_ObjCmdProc but no
+     * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
+     */
+
+    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL; cmdInfoPtr++) {
+	int isNew;
 	Tcl_HashEntry *hPtr;
 
-	if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
-	        && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
-	        && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
-	    panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
+	if ((cmdInfoPtr->objProc == NULL)
+		&& (cmdInfoPtr->compileProc == NULL)) {
+	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
 	}
-	
+
 	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
-	        cmdInfoPtr->name, &new);
-	if (new) {
+		cmdInfoPtr->name, &isNew);
+	if (isNew) {
 	    cmdPtr = (Command *) ckalloc(sizeof(Command));
 	    cmdPtr->hPtr = hPtr;
 	    cmdPtr->nsPtr = iPtr->globalNsPtr;
 	    cmdPtr->refCount = 1;
 	    cmdPtr->cmdEpoch = 0;
 	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
-	    if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) {
-		cmdPtr->proc = TclInvokeObjectCommand;
-		cmdPtr->clientData = (ClientData) cmdPtr;
-	    } else {
-		cmdPtr->proc = cmdInfoPtr->proc;
-		cmdPtr->clientData = (ClientData) NULL;
-	    }
-	    if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
-		cmdPtr->objProc = TclInvokeStringCommand;
-		cmdPtr->objClientData = (ClientData) cmdPtr;
-	    } else {
-		cmdPtr->objProc = cmdInfoPtr->objProc;
-		cmdPtr->objClientData = (ClientData) NULL;
-	    }
+	    cmdPtr->proc = TclInvokeObjectCommand;
+	    cmdPtr->clientData = cmdPtr;
+	    cmdPtr->objProc = cmdInfoPtr->objProc;
+	    cmdPtr->objClientData = NULL;
 	    cmdPtr->deleteProc = NULL;
-	    cmdPtr->deleteData = (ClientData) NULL;
+	    cmdPtr->deleteData = NULL;
 	    cmdPtr->flags = 0;
 	    cmdPtr->importRefPtr = NULL;
 	    cmdPtr->tracePtr = NULL;
@@ -504,6 +671,44 @@ Tcl_CreateInterp()
 	}
     }
 
+    /*
+     * Create the "chan", "dict", "info" and "string" ensembles. Note that all
+     * these commands (and their subcommands that are not present in the
+     * global namespace) are wholly safe.
+     */
+
+    TclInitChanCmd(interp);
+    TclInitDictCmd(interp);
+    TclInitInfoCmd(interp);
+    TclInitStringCmd(interp);
+
+    /*
+     * Register "clock" subcommands. These *do* go through
+     * Tcl_CreateObjCommand, since they aren't in the global namespace and
+     * involve ensembles.
+     */
+
+    TclClockInit(interp);
+
+    /*
+     * Register the built-in functions. This is empty now that they are
+     * implemented as commands in the ::tcl::mathfunc namespace.
+     */
+
+    /*
+     * Register the default [interp bgerror] handler.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
+	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
+
+    /*
+     * Create an unsupported command for debugging bytecode.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
+	    Tcl_DisassembleObjCmd, NULL, NULL);
+
 #ifdef USE_DTRACE
     /*
      * Register the tcl::dtrace command.
@@ -516,57 +721,61 @@ Tcl_CreateInterp()
      * Register the builtin math functions.
      */
 
-    i = 0;
-    for (builtinFuncPtr = tclBuiltinFuncTable;  builtinFuncPtr->name != NULL;
+    mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
+    if (mathfuncNSPtr == NULL) {
+	Tcl_Panic("Can't create math function namespace");
+    }
+    strcpy(mathFuncName, "::tcl::mathfunc::");
+#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
+    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
 	    builtinFuncPtr++) {
-	Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
-		builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
-		(Tcl_MathProc *) NULL, (ClientData) 0);
-	hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
-		builtinFuncPtr->name);
-	if (hPtr == NULL) {
-	    panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name);
-	    return NULL;
+	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
+	Tcl_CreateObjCommand(interp, mathFuncName,
+		builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
+	Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
+    }
+
+    /*
+     * Register the mathematical "operator" commands. [TIP #174]
+     */
+
+    mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
+#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
+    if (mathopNSPtr == NULL) {
+	Tcl_Panic("can't create math operator namespace");
+    }
+    (void) Tcl_Export(interp, mathopNSPtr, "*", 1);
+    strcpy(mathFuncName, "::tcl::mathop::");
+    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
+	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
+		ckalloc(sizeof(TclOpCmdClientData));
+
+	occdPtr->op = opcmdInfoPtr->name;
+	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
+	occdPtr->expected = opcmdInfoPtr->expected;
+	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
+	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
+		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
+	if (cmdPtr == NULL) {
+	    Tcl_Panic("failed to create math operator %s",
+		    opcmdInfoPtr->name);
+	} else if (opcmdInfoPtr->compileProc != NULL) {
+	    cmdPtr->compileProc = opcmdInfoPtr->compileProc;
 	}
-	mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
-	mathFuncPtr->builtinFuncIndex = i;
-	i++;
     }
-    iPtr->flags |= EXPR_INITIALIZED;
 
     /*
      * Do Multiple/Safe Interps Tcl init stuff
      */
 
     TclInterpInit(interp);
+    TclSetupEnv(interp);
 
     /*
-     * We used to create the "errorInfo" and "errorCode" global vars at this
-     * point because so much of the Tcl implementation assumes they already
-     * exist. This is not quite enough, however, since they can be unset
-     * at any time.
-     *
-     * There are 2 choices:
-     *    + Check every place where a GetVar of those is used 
-     *      and the NULL result is not checked (like in tclLoad.c)
-     *    + Make SetVar,... NULL friendly
-     * We choose the second option because :
-     *    + It is easy and low cost to check for NULL pointer before
-     *      calling strlen()
-     *    + It can be helpfull to other people using those API
-     *    + Passing a NULL value to those closest 'meaning' is empty string
-     *      (specially with the new objects where 0 bytes strings are ok)
-     * So the following init is commented out:              -- dl
-     *
-     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
-     *       "", TCL_GLOBAL_ONLY);
-     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
-     *       "NONE", TCL_GLOBAL_ONLY);
+     * TIP #59: Make embedded configuration information available.
      */
 
-#ifndef TCL_GENERIC_ONLY
-    TclSetupEnv(interp);
-#endif
+    TclInitEmbeddedConfigurationInformation(interp);
 
     /*
      * Compute the byte order of this machine.
@@ -580,62 +789,66 @@ Tcl_CreateInterp()
     Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
 	    Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
 
+    /* TIP #291 */
+    Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
+	    Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
+
     /*
      * Set up other variables such as tcl_version and tcl_library
      */
 
     Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
     Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
-    Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
+    Tcl_TraceVar2(interp, "tcl_precision", NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    TclPrecTraceProc, (ClientData) NULL);
+	    TclPrecTraceProc, NULL);
     TclpSetVariables(interp);
 
 #ifdef TCL_THREADS
     /*
-     * The existence of the "threaded" element of the tcl_platform array indicates
-     * that this particular Tcl shell has been compiled with threads turned on.
-     * Using "info exists tcl_platform(threaded)" a Tcl script can introspect on the 
-     * interpreter level of thread safety.
+     * The existence of the "threaded" element of the tcl_platform array
+     * indicates that this particular Tcl shell has been compiled with threads
+     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
+     * introspect on the interpreter level of thread safety.
      */
 
-
-    Tcl_SetVar2(interp, "tcl_platform", "threaded", "1",
-	    TCL_GLOBAL_ONLY);
+    Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY);
 #endif
 
     /*
      * Register Tcl's version number.
-     * TIP#268: Expose information about its status,
-     *          for runtime switches in the core library
-     *          and tests.
+     * TIP #268: Full patchlevel instead of just major.minor
      */
 
-    Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
+    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
 
-#ifdef TCL_TIP268
-    Tcl_SetVar2(interp, "tcl_platform", "tip,268", "1",
-	    TCL_GLOBAL_ONLY);
-#endif
-#ifdef TCL_TIP280
-    Tcl_SetVar2(interp, "tcl_platform", "tip,280", "1",
-	    TCL_GLOBAL_ONLY);
-#endif
 #ifdef Tcl_InitStubs
 #undef Tcl_InitStubs
 #endif
     Tcl_InitStubs(interp, TCL_VERSION, 1);
 
+    if (TclTommath_Init(interp) != TCL_OK) {
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+    }
+
     return interp;
 }
+
+static void
+DeleteOpCmdClientData(
+    ClientData clientData)
+{
+    TclOpCmdClientData *occdPtr = clientData;
+
+    ckfree((char *) occdPtr);
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclHideUnsafeCommands --
  *
- *	Hides base commands that are not marked as safe from this
- *	interpreter.
+ *	Hides base commands that are not marked as safe from this interpreter.
  *
  * Results:
  *	TCL_OK if it succeeds, TCL_ERROR else.
@@ -647,18 +860,18 @@ Tcl_CreateInterp()
  */
 
 int
-TclHideUnsafeCommands(interp)
-    Tcl_Interp *interp;		/* Hide commands in this interpreter. */
+TclHideUnsafeCommands(
+    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
 {
-    register CONST CmdInfo *cmdInfoPtr;
+    register const CmdInfo *cmdInfoPtr;
 
-    if (interp == (Tcl_Interp *) NULL) {
-        return TCL_ERROR;
+    if (interp == NULL) {
+	return TCL_ERROR;
     }
     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
-        if (!cmdInfoPtr->isSafe) {
-            Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
-        }
+	if (!cmdInfoPtr->isSafe) {
+	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
+	}
     }
     return TCL_OK;
 }
@@ -668,36 +881,34 @@ TclHideUnsafeCommands(interp)
  *
  * Tcl_CallWhenDeleted --
  *
- *	Arrange for a procedure to be called before a given
- *	interpreter is deleted. The procedure is called as soon
- *	as Tcl_DeleteInterp is called; if Tcl_CallWhenDeleted is
- *	called on an interpreter that has already been deleted,
- *	the procedure will be called when the last Tcl_Release is
+ *	Arrange for a function to be called before a given interpreter is
+ *	deleted. The function is called as soon as Tcl_DeleteInterp is called;
+ *	if Tcl_CallWhenDeleted is called on an interpreter that has already
+ *	been deleted, the function will be called when the last Tcl_Release is
  *	done on the interpreter.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	When Tcl_DeleteInterp is invoked to delete interp,
- *	proc will be invoked.  See the manual entry for
- *	details.
+ *	When Tcl_DeleteInterp is invoked to delete interp, proc will be
+ *	invoked. See the manual entry for details.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_CallWhenDeleted(interp, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter to watch. */
-    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
-				 * is about to be deleted. */
-    ClientData clientData;	/* One-word value to pass to proc. */
+Tcl_CallWhenDeleted(
+    Tcl_Interp *interp,		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
+				 * to be deleted. */
+    ClientData clientData)	/* One-word value to pass to proc. */
 {
     Interp *iPtr = (Interp *) interp;
     static Tcl_ThreadDataKey assocDataCounterKey;
     int *assocDataCounterPtr =
 	    Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
-    int new;
+    int isNew;
     char buffer[32 + TCL_INTEGER_SPACE];
     AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
     Tcl_HashEntry *hPtr;
@@ -705,11 +916,11 @@ Tcl_CallWhenDeleted(interp, proc, clientData)
     sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
     (*assocDataCounterPtr)++;
 
-    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
-        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    if (iPtr->assocData == NULL) {
+	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
     }
-    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
     dPtr->proc = proc;
     dPtr->clientData = clientData;
     Tcl_SetHashValue(hPtr, dPtr);
@@ -720,27 +931,26 @@ Tcl_CallWhenDeleted(interp, proc, clientData)
  *
  * Tcl_DontCallWhenDeleted --
  *
- *	Cancel the arrangement for a procedure to be called when
- *	a given interpreter is deleted.
+ *	Cancel the arrangement for a function to be called when a given
+ *	interpreter is deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If proc and clientData were previously registered as a
- *	callback via Tcl_CallWhenDeleted, they are unregistered.
- *	If they weren't previously registered then nothing
- *	happens.
+ *	If proc and clientData were previously registered as a callback via
+ *	Tcl_CallWhenDeleted, they are unregistered. If they weren't previously
+ *	registered then nothing happens.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_DontCallWhenDeleted(interp, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter to watch. */
-    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
-				 * is about to be deleted. */
-    ClientData clientData;	/* One-word value to pass to proc. */
+Tcl_DontCallWhenDeleted(
+    Tcl_Interp *interp,		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
+				 * to be deleted. */
+    ClientData clientData)	/* One-word value to pass to proc. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashTable *hTablePtr;
@@ -749,17 +959,17 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
     AssocData *dPtr;
 
     hTablePtr = iPtr->assocData;
-    if (hTablePtr == (Tcl_HashTable *) NULL) {
-        return;
+    if (hTablePtr == NULL) {
+	return;
     }
     for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&hSearch)) {
-        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
-        if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
-            ckfree((char *) dPtr);
-            Tcl_DeleteHashEntry(hPtr);
-            return;
-        }
+	dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
+	    ckfree((char *) dPtr);
+	    Tcl_DeleteHashEntry(hPtr);
+	    return;
+	}
     }
 }
 
@@ -769,9 +979,9 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
  * Tcl_SetAssocData --
  *
  *	Creates a named association between user-specified data, a delete
- *	function and this interpreter. If the association already exists
- *	the data is overwritten with the new data. The delete function will
- *	be invoked when the interpreter is deleted.
+ *	function and this interpreter. If the association already exists the
+ *	data is overwritten with the new data. The delete function will be
+ *	invoked when the interpreter is deleted.
  *
  * Results:
  *	None.
@@ -783,27 +993,27 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
  */
 
 void
-Tcl_SetAssocData(interp, name, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter to associate with. */
-    CONST char *name;		/* Name for association. */
-    Tcl_InterpDeleteProc *proc;	/* Proc to call when interpreter is
-                                 * about to be deleted. */
-    ClientData clientData;	/* One-word value to pass to proc. */
+Tcl_SetAssocData(
+    Tcl_Interp *interp,		/* Interpreter to associate with. */
+    const char *name,		/* Name for association. */
+    Tcl_InterpDeleteProc *proc,	/* Proc to call when interpreter is about to
+				 * be deleted. */
+    ClientData clientData)	/* One-word value to pass to proc. */
 {
     Interp *iPtr = (Interp *) interp;
     AssocData *dPtr;
     Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
 
-    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
-        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    if (iPtr->assocData == NULL) {
+	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
     }
-    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
-    if (new == 0) {
-        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
+    if (isNew == 0) {
+	dPtr = Tcl_GetHashValue(hPtr);
     } else {
-        dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+	dPtr = (AssocData *) ckalloc(sizeof(AssocData));
     }
     dPtr->proc = proc;
     dPtr->clientData = clientData;
@@ -816,8 +1026,8 @@ Tcl_SetAssocData(interp, name, proc, clientData)
  *
  * Tcl_DeleteAssocData --
  *
- *	Deletes a named association of user-specified data with
- *	the specified interpreter.
+ *	Deletes a named association of user-specified data with the specified
+ *	interpreter.
  *
  * Results:
  *	None.
@@ -829,24 +1039,24 @@ Tcl_SetAssocData(interp, name, proc, clientData)
  */
 
 void
-Tcl_DeleteAssocData(interp, name)
-    Tcl_Interp *interp;			/* Interpreter to associate with. */
-    CONST char *name;			/* Name of association. */
+Tcl_DeleteAssocData(
+    Tcl_Interp *interp,		/* Interpreter to associate with. */
+    const char *name)		/* Name of association. */
 {
     Interp *iPtr = (Interp *) interp;
     AssocData *dPtr;
     Tcl_HashEntry *hPtr;
 
-    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
-        return;
+    if (iPtr->assocData == NULL) {
+	return;
     }
     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        return;
+    if (hPtr == NULL) {
+	return;
     }
-    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    dPtr = Tcl_GetHashValue(hPtr);
     if (dPtr->proc != NULL) {
-        (dPtr->proc) (dPtr->clientData, interp);
+	dPtr->proc(dPtr->clientData, interp);
     }
     ckfree((char *) dPtr);
     Tcl_DeleteHashEntry(hPtr);
@@ -857,8 +1067,8 @@ Tcl_DeleteAssocData(interp, name)
  *
  * Tcl_GetAssocData --
  *
- *	Returns the client data associated with this name in the
- *	specified interpreter.
+ *	Returns the client data associated with this name in the specified
+ *	interpreter.
  *
  * Results:
  *	The client data in the AssocData record denoted by the named
@@ -871,26 +1081,27 @@ Tcl_DeleteAssocData(interp, name)
  */
 
 ClientData
-Tcl_GetAssocData(interp, name, procPtr)
-    Tcl_Interp *interp;			/* Interpreter associated with. */
-    CONST char *name;			/* Name of association. */
-    Tcl_InterpDeleteProc **procPtr;	/* Pointer to place to store address
-					 * of current deletion callback. */
+Tcl_GetAssocData(
+    Tcl_Interp *interp,		/* Interpreter associated with. */
+    const char *name,		/* Name of association. */
+    Tcl_InterpDeleteProc **procPtr)
+				/* Pointer to place to store address of
+				 * current deletion callback. */
 {
     Interp *iPtr = (Interp *) interp;
     AssocData *dPtr;
     Tcl_HashEntry *hPtr;
 
-    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
-        return (ClientData) NULL;
+    if (iPtr->assocData == NULL) {
+	return NULL;
     }
     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        return (ClientData) NULL;
+    if (hPtr == NULL) {
+	return NULL;
     }
-    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
-    if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
-        *procPtr = dPtr->proc;
+    dPtr = Tcl_GetHashValue(hPtr);
+    if (procPtr != NULL) {
+	*procPtr = dPtr->proc;
     }
     return dPtr->clientData;
 }
@@ -900,8 +1111,8 @@ Tcl_GetAssocData(interp, name, procPtr)
  *
  * Tcl_InterpDeleted --
  *
- *	Returns nonzero if the interpreter has been deleted with a call
- *	to Tcl_DeleteInterp.
+ *	Returns nonzero if the interpreter has been deleted with a call to
+ *	Tcl_DeleteInterp.
  *
  * Results:
  *	Nonzero if the interpreter is deleted, zero otherwise.
@@ -913,8 +1124,8 @@ Tcl_GetAssocData(interp, name, procPtr)
  */
 
 int
-Tcl_InterpDeleted(interp)
-    Tcl_Interp *interp;
+Tcl_InterpDeleted(
+    Tcl_Interp *interp)
 {
     return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
 }
@@ -924,11 +1135,11 @@ Tcl_InterpDeleted(interp)
  *
  * Tcl_DeleteInterp --
  *
- *	Ensures that the interpreter will be deleted eventually. If there
- *	are no Tcl_Preserve calls in effect for this interpreter, it is
- *	deleted immediately, otherwise the interpreter is deleted when
- *	the last Tcl_Preserve is matched by a call to Tcl_Release. In either
- *	case, the procedure runs the currently registered deletion callbacks. 
+ *	Ensures that the interpreter will be deleted eventually. If there are
+ *	no Tcl_Preserve calls in effect for this interpreter, it is deleted
+ *	immediately, otherwise the interpreter is deleted when the last
+ *	Tcl_Preserve is matched by a call to Tcl_Release. In either case, the
+ *	function runs the currently registered deletion callbacks.
  *
  * Results:
  *	None.
@@ -943,9 +1154,9 @@ Tcl_InterpDeleted(interp)
  */
 
 void
-Tcl_DeleteInterp(interp)
-    Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by a previous call to Tcl_CreateInterp). */
+Tcl_DeleteInterp(
+    Tcl_Interp *interp)		/* Token for command interpreter (returned by
+				 * a previous call to Tcl_CreateInterp). */
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -954,21 +1165,22 @@ Tcl_DeleteInterp(interp)
      */
 
     if (iPtr->flags & DELETED) {
-        return;
+	return;
     }
-    
+
     /*
      * Mark the interpreter as deleted. No further evals will be allowed.
+     * Increase the compileEpoch as a signal to compiled bytecodes.
      */
 
     iPtr->flags |= DELETED;
+    iPtr->compileEpoch++;
 
     /*
      * Ensure that the interpreter is eventually deleted.
      */
 
-    Tcl_EventuallyFree((ClientData) interp,
-            (Tcl_FreeProc *) DeleteInterpProc);
+    Tcl_EventuallyFree(interp, (Tcl_FreeProc *) DeleteInterpProc);
 }
 
 /*
@@ -976,25 +1188,25 @@ Tcl_DeleteInterp(interp)
  *
  * DeleteInterpProc --
  *
- *	Helper procedure to delete an interpreter. This procedure is
- *	called when the last call to Tcl_Preserve on this interpreter
- *	is matched by a call to Tcl_Release. The procedure cleans up
- *	all resources used in the interpreter and calls all currently
- *	registered interpreter deletion callbacks.
+ *	Helper function to delete an interpreter. This function is called when
+ *	the last call to Tcl_Preserve on this interpreter is matched by a call
+ *	to Tcl_Release. The function cleans up all resources used in the
+ *	interpreter and calls all currently registered interpreter deletion
+ *	callbacks.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Whatever the interpreter deletion callbacks do. Frees resources
- *	used by the interpreter.
+ *	Whatever the interpreter deletion callbacks do. Frees resources used
+ *	by the interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DeleteInterpProc(interp)
-    Tcl_Interp *interp;			/* Interpreter to delete. */
+DeleteInterpProc(
+    Tcl_Interp *interp)		/* Interpreter to delete. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hPtr;
@@ -1005,120 +1217,137 @@ DeleteInterpProc(interp)
     /*
      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
      */
-    
+
     if (iPtr->numLevels > 0) {
-        panic("DeleteInterpProc called with active evals");
+	Tcl_Panic("DeleteInterpProc called with active evals");
     }
 
     /*
-     * The interpreter should already be marked deleted; otherwise how
-     * did we get here?
+     * The interpreter should already be marked deleted; otherwise how did we
+     * get here?
      */
 
     if (!(iPtr->flags & DELETED)) {
-        panic("DeleteInterpProc called on interpreter not marked deleted");
+	Tcl_Panic("DeleteInterpProc called on interpreter not marked deleted");
     }
 
-    TclHandleFree(iPtr->handle);
+    /*
+     * TIP #219, Tcl Channel Reflection API. Discard a leftover state.
+     */
+
+    if (iPtr->chanMsg != NULL) {
+	Tcl_DecrRefCount(iPtr->chanMsg);
+	iPtr->chanMsg = NULL;
+    }
+
+    /*
+     * Shut down all limit handler callback scripts that call back into this
+     * interpreter. Then eliminate all limit handlers for this interpreter.
+     */
+
+    TclRemoveScriptLimitCallbacks(interp);
+    TclLimitRemoveAllHandlers(interp);
 
     /*
-     * Dismantle everything in the global namespace except for the
-     * "errorInfo" and "errorCode" variables. These remain until the
-     * namespace is actually destroyed, in case any errors occur.
-     *   
      * Dismantle the namespace here, before we clear the assocData. If any
      * background errors occur here, they will be deleted below.
+     *
+     * Dismantle the namespace after freeing the iPtr->handle so that each
+     * bytecode releases its literals without caring to update the literal
+     * table, as it will be freed later in this function without further use.
      */
-    
+
+    TclHandleFree(iPtr->handle);
     TclTeardownNamespace(iPtr->globalNsPtr);
 
     /*
      * Delete all the hidden commands.
      */
-     
+
     hTablePtr = iPtr->hiddenCmdTablePtr;
     if (hTablePtr != NULL) {
 	/*
-	 * Non-pernicious deletion.  The deletion callbacks will not be
-	 * allowed to create any new hidden or non-hidden commands.
+	 * Non-pernicious deletion. The deletion callbacks will not be allowed
+	 * to create any new hidden or non-hidden commands.
 	 * Tcl_DeleteCommandFromToken() will remove the entry from the
 	 * hiddenCmdTablePtr.
 	 */
-	 
+
 	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
-	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 	    Tcl_DeleteCommandFromToken(interp,
 		    (Tcl_Command) Tcl_GetHashValue(hPtr));
 	}
 	Tcl_DeleteHashTable(hTablePtr);
 	ckfree((char *) hTablePtr);
     }
+
     /*
-     * Tear down the math function table.
+     * Invoke deletion callbacks; note that a callback can create new
+     * callbacks, so we iterate.
      */
 
-    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
-	     hPtr != NULL;
-             hPtr = Tcl_NextHashEntry(&search)) {
-	ckfree((char *) Tcl_GetHashValue(hPtr));
+    while (iPtr->assocData != NULL) {
+	AssocData *dPtr;
+
+	hTablePtr = iPtr->assocData;
+	iPtr->assocData = NULL;
+	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
+		hPtr != NULL;
+		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
+	    dPtr = Tcl_GetHashValue(hPtr);
+	    Tcl_DeleteHashEntry(hPtr);
+	    if (dPtr->proc != NULL) {
+		dPtr->proc(dPtr->clientData, interp);
+	    }
+	    ckfree((char *) dPtr);
+	}
+	Tcl_DeleteHashTable(hTablePtr);
+	ckfree((char *) hTablePtr);
     }
-    Tcl_DeleteHashTable(&iPtr->mathFuncTable);
 
     /*
-     * Invoke deletion callbacks; note that a callback can create new
-     * callbacks, so we iterate.
+     * Pop the root frame pointer and finish deleting the global
+     * namespace. The order is important [Bug 1658572].
      */
 
-    while (iPtr->assocData != (Tcl_HashTable *) NULL) {
-	AssocData *dPtr;
-	
-        hTablePtr = iPtr->assocData;
-        iPtr->assocData = (Tcl_HashTable *) NULL;
-        for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
-                 hPtr != NULL;
-                 hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
-            dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
-            Tcl_DeleteHashEntry(hPtr);
-            if (dPtr->proc != NULL) {
-                (*dPtr->proc)(dPtr->clientData, interp);
-            }
-            ckfree((char *) dPtr);
-        }
-        Tcl_DeleteHashTable(hTablePtr);
-        ckfree((char *) hTablePtr);
-    }
-
-    /*
-     * Finish deleting the global namespace.
-     */
-    
+    if (iPtr->framePtr != iPtr->rootFramePtr) {
+	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
+    }
+    Tcl_PopCallFrame(interp);
+    ckfree((char *) iPtr->rootFramePtr);
+    iPtr->rootFramePtr = NULL;
     Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
 
     /*
-     * Free up the result *after* deleting variables, since variable
-     * deletion could have transferred ownership of the result string
-     * to Tcl.
+     * Free up the result *after* deleting variables, since variable deletion
+     * could have transferred ownership of the result string to Tcl.
      */
 
     Tcl_FreeResult(interp);
     interp->result = NULL;
     Tcl_DecrRefCount(iPtr->objResultPtr);
     iPtr->objResultPtr = NULL;
-    if (iPtr->errorInfo != NULL) {
-	ckfree(iPtr->errorInfo);
-        iPtr->errorInfo = NULL;
+    Tcl_DecrRefCount(iPtr->ecVar);
+    if (iPtr->errorCode) {
+	Tcl_DecrRefCount(iPtr->errorCode);
+	iPtr->errorCode = NULL;
     }
-    if (iPtr->errorCode != NULL) {
-	ckfree(iPtr->errorCode);
-        iPtr->errorCode = NULL;
+    Tcl_DecrRefCount(iPtr->eiVar);
+    if (iPtr->errorInfo) {
+	Tcl_DecrRefCount(iPtr->errorInfo);
+	iPtr->errorInfo = NULL;
+    }
+    if (iPtr->returnOpts) {
+	Tcl_DecrRefCount(iPtr->returnOpts);
     }
     if (iPtr->appendResult != NULL) {
 	ckfree(iPtr->appendResult);
-        iPtr->appendResult = NULL;
+	iPtr->appendResult = NULL;
     }
     TclFreePackageInfo(iPtr);
     while (iPtr->tracePtr != NULL) {
-	Tcl_DeleteTrace((Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr);
+	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
     }
     if (iPtr->execEnvPtr != NULL) {
 	TclDeleteExecEnv(iPtr->execEnvPtr);
@@ -1135,9 +1364,9 @@ DeleteInterpProc(interp)
 	nextResPtr = resPtr->nextPtr;
 	ckfree(resPtr->name);
 	ckfree((char *) resPtr);
-        resPtr = nextResPtr;
+	resPtr = nextResPtr;
     }
-    
+
     /*
      * Free up literal objects created for scripts compiled by the
      * interpreter.
@@ -1145,60 +1374,62 @@ DeleteInterpProc(interp)
 
     TclDeleteLiteralTable(interp, &(iPtr->literalTable));
 
-#ifdef TCL_TIP280
-    /* TIP #280 - Release the arrays for ByteCode/Proc extension, and contents.
+    /*
+     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
+     * contents.
      */
+
     {
-        Tcl_HashEntry *hPtr;
+	Tcl_HashEntry *hPtr;
 	Tcl_HashSearch hSearch;
-	CmdFrame*      cfPtr;
-	ExtCmdLoc*     eclPtr;
-	int            i;
+	int i;
 
 	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
-	     hPtr != NULL;
-	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-
-	    cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr);
-
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	        Tcl_DecrRefCount (cfPtr->data.eval.path);
+		hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&hSearch)) {
+	    CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
+	    Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
+	    procPtr->iPtr = NULL;
+	    if (cfPtr) {
+		if (cfPtr->type == TCL_LOCATION_SOURCE) {
+		    Tcl_DecrRefCount(cfPtr->data.eval.path);
+		}
+		ckfree((char *) cfPtr->line);
+		ckfree((char *) cfPtr);
 	    }
-	    ckfree ((char*) cfPtr->line);
-	    ckfree ((char*) cfPtr);
-	    Tcl_DeleteHashEntry (hPtr);
-
+	    Tcl_DeleteHashEntry(hPtr);
 	}
-	Tcl_DeleteHashTable (iPtr->linePBodyPtr);
-	ckfree ((char*) iPtr->linePBodyPtr);
+	Tcl_DeleteHashTable(iPtr->linePBodyPtr);
+	ckfree((char *) iPtr->linePBodyPtr);
 	iPtr->linePBodyPtr = NULL;
 
-	/* See also tclCompile.c, TclCleanupByteCode */
+	/*
+	 * See also tclCompile.c, TclCleanupByteCode
+	 */
 
 	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
-	     hPtr != NULL;
-	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-
-	    eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr);
+		hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&hSearch)) {
+	    ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr);
 
 	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
-	        Tcl_DecrRefCount (eclPtr->path);
+		Tcl_DecrRefCount(eclPtr->path);
 	    }
 	    for (i=0; i< eclPtr->nuloc; i++) {
-	        ckfree ((char*) eclPtr->loc[i].line);
+		ckfree((char *) eclPtr->loc[i].line);
 	    }
 
-            if (eclPtr->loc != NULL) {
-		ckfree ((char*) eclPtr->loc);
+	    if (eclPtr->loc != NULL) {
+		ckfree((char *) eclPtr->loc);
 	    }
 
 	    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
-	    ckfree ((char*) eclPtr);
-	    Tcl_DeleteHashEntry (hPtr);
+	    ckfree((char *) eclPtr);
+	    Tcl_DeleteHashEntry(hPtr);
 	}
-	Tcl_DeleteHashTable (iPtr->lineBCPtr);
-	ckfree((char*) iPtr->lineBCPtr);
+	Tcl_DeleteHashTable(iPtr->lineBCPtr);
+	ckfree((char *) iPtr->lineBCPtr);
 	iPtr->lineBCPtr = NULL;
 
 	/*
@@ -1234,7 +1465,10 @@ DeleteInterpProc(interp)
 	ckfree((char*) iPtr->lineLABCPtr);
 	iPtr->lineLABCPtr = NULL;
     }
-#endif
+
+    Tcl_DeleteHashTable(&iPtr->varTraces);
+    Tcl_DeleteHashTable(&iPtr->varSearches);
+
     ckfree((char *) iPtr);
 }
 
@@ -1243,79 +1477,77 @@ DeleteInterpProc(interp)
  *
  * Tcl_HideCommand --
  *
- *	Makes a command hidden so that it cannot be invoked from within
- *	an interpreter, only from within an ancestor.
+ *	Makes a command hidden so that it cannot be invoked from within an
+ *	interpreter, only from within an ancestor.
  *
  * Results:
- *	A standard Tcl result; also leaves a message in the interp's result
- *	if an error occurs.
+ *	A standard Tcl result; also leaves a message in the interp's result if
+ *	an error occurs.
  *
  * Side effects:
- *	Removes a command from the command table and create an entry
- *      into the hidden command table under the specified token name.
+ *	Removes a command from the command table and create an entry into the
+ *	hidden command table under the specified token name.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
-    Tcl_Interp *interp;		/* Interpreter in which to hide command. */
-    CONST char *cmdName;	/* Name of command to hide. */
-    CONST char *hiddenCmdToken;	/* Token name of the to-be-hidden command. */
+Tcl_HideCommand(
+    Tcl_Interp *interp,		/* Interpreter in which to hide command. */
+    const char *cmdName,	/* Name of command to hide. */
+    const char *hiddenCmdToken)	/* Token name of the to-be-hidden command. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Command cmd;
     Command *cmdPtr;
     Tcl_HashTable *hiddenCmdTablePtr;
     Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
 
     if (iPtr->flags & DELETED) {
+	/*
+	 * The interpreter is being deleted. Do not create any new structures,
+	 * because it is not safe to modify the interpreter.
+	 */
 
-        /*
-         * The interpreter is being deleted. Do not create any new
-         * structures, because it is not safe to modify the interpreter.
-         */
-        
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Disallow hiding of commands that are currently in a namespace or
-     * renaming (as part of hiding) into a namespace.
-     *
-     * (because the current implementation with a single global table
-     *  and the needed uniqueness of names cause problems with namespaces)
+     * renaming (as part of hiding) into a namespace (because the current
+     * implementation with a single global table and the needed uniqueness of
+     * names cause problems with namespaces).
      *
-     * we don't need to check for "::" in cmdName because the real check is
-     * on the nsPtr below.
+     * We don't need to check for "::" in cmdName because the real check is on
+     * the nsPtr below.
      *
-     * hiddenCmdToken is just a string which is not interpreted in any way.
-     * It may contain :: but the string is not interpreted as a namespace
+     * hiddenCmdToken is just a string which is not interpreted in any way. It
+     * may contain :: but the string is not interpreted as a namespace
      * qualifier command name. Thus, hiding foo::bar to foo::bar and then
      * trying to expose or invoke ::foo::bar will NOT work; but if the
      * application always uses the same strings it will get consistent
      * behaviour.
      *
-     * But as we currently limit ourselves to the global namespace only
-     * for the source, in order to avoid potential confusion,
-     * lets prevent "::" in the token too.  --dl
+     * But as we currently limit ourselves to the global namespace only for
+     * the source, in order to avoid potential confusion, lets prevent "::" in
+     * the token too. - dl
      */
 
     if (strstr(hiddenCmdToken, "::") != NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "cannot use namespace qualifiers in hidden command",
-		" token (rename)", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"cannot use namespace qualifiers in hidden command"
+		" token (rename)", NULL);
+	return TCL_ERROR;
     }
 
     /*
-     * Find the command to hide. An error is returned if cmdName can't
-     * be found. Look up the command only from the global namespace.
-     * Full path of the command must be given if using namespaces.
+     * Find the command to hide. An error is returned if cmdName can't be
+     * found. Look up the command only from the global namespace. Full path of
+     * the command must be given if using namespaces.
      */
 
-    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+    cmd = Tcl_FindCommand(interp, cmdName, NULL,
 	    /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
     if (cmd == (Tcl_Command) NULL) {
 	return TCL_ERROR;
@@ -1326,22 +1558,21 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
      * Check that the command is really in global namespace
      */
 
-    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "can only hide global namespace commands",
-		" (use rename then hide)", (char *) NULL);
-        return TCL_ERROR;
+    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
+	Tcl_AppendResult(interp, "can only hide global namespace commands"
+		" (use rename then hide)", NULL);
+	return TCL_ERROR;
     }
-    
+
     /*
      * Initialize the hidden command table if necessary.
      */
 
     hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
     if (hiddenCmdTablePtr == NULL) {
-        hiddenCmdTablePtr = (Tcl_HashTable *)
-	        ckalloc((unsigned) sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
+	hiddenCmdTablePtr = (Tcl_HashTable *)
+		ckalloc((unsigned) sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
 	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
     }
 
@@ -1350,20 +1581,18 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
      * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
      * exists.
      */
-    
-    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new);
-    if (!new) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "hidden command named \"", hiddenCmdToken, "\" already exists",
-                (char *) NULL);
-        return TCL_ERROR;
+
+    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
+    if (!isNew) {
+	Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
+		"\" already exists", NULL);
+	return TCL_ERROR;
     }
 
     /*
-     * Nb : This code is currently 'like' a rename to a specialy set apart
-     * name table. Changes here and in TclRenameCommand must
-     * be kept in synch untill the common parts are actually
-     * factorized out.
+     * NB: This code is currently 'like' a rename to a specialy set apart name
+     * table. Changes here and in TclRenameCommand must be kept in synch until
+     * the common parts are actually factorized out.
      */
 
     /*
@@ -1373,26 +1602,34 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
      */
 
     if (cmdPtr->hPtr != NULL) {
-        Tcl_DeleteHashEntry(cmdPtr->hPtr);
-        cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
+	Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	cmdPtr->hPtr = NULL;
 	cmdPtr->cmdEpoch++;
     }
 
     /*
-     * Now link the hash table entry with the command structure.
-     * We ensured above that the nsPtr was right.
+     * The list of command exported from the namespace might have changed.
+     * However, we do not need to recompute this just yet; next time we need
+     * the info will be soon enough.
      */
-    
+
+    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
+    /*
+     * Now link the hash table entry with the command structure. We ensured
+     * above that the nsPtr was right.
+     */
+
     cmdPtr->hPtr = hPtr;
-    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    Tcl_SetHashValue(hPtr, cmdPtr);
 
     /*
-     * If the command being hidden has a compile procedure, increment the
-     * interpreter's compileEpoch to invalidate its compiled code. This
-     * makes sure that we don't later try to execute old code compiled with
-     * command-specific (i.e., inline) bytecodes for the now-hidden
-     * command. This field is checked in Tcl_EvalObj and ObjInterpProc,
-     * and code whose compilation epoch doesn't match is recompiled.
+     * If the command being hidden has a compile function, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This makes
+     * sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-hidden command.
+     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
+     * compilation epoch doesn't match is recompiled.
      */
 
     if (cmdPtr->compileProc != NULL) {
@@ -1406,12 +1643,12 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
  *
  * Tcl_ExposeCommand --
  *
- *	Makes a previously hidden command callable from inside the
- *	interpreter instead of only by its ancestors.
+ *	Makes a previously hidden command callable from inside the interpreter
+ *	instead of only by its ancestors.
  *
  * Results:
- *	A standard Tcl result. If an error occurs, a message is left
- *	in the interp's result.
+ *	A standard Tcl result. If an error occurs, a message is left in the
+ *	interp's result.
  *
  * Side effects:
  *	Moves commands from one hash table to another.
@@ -1420,40 +1657,38 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
  */
 
 int
-Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
-    Tcl_Interp *interp;		/* Interpreter in which to make command
-                                 * callable. */
-    CONST char *hiddenCmdToken;	/* Name of hidden command. */
-    CONST char *cmdName;	/* Name of to-be-exposed command. */
+Tcl_ExposeCommand(
+    Tcl_Interp *interp,		/* Interpreter in which to make command
+				 * callable. */
+    const char *hiddenCmdToken,	/* Name of hidden command. */
+    const char *cmdName)	/* Name of to-be-exposed command. */
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr;
     Namespace *nsPtr;
     Tcl_HashEntry *hPtr;
     Tcl_HashTable *hiddenCmdTablePtr;
-    int new;
+    int isNew;
 
     if (iPtr->flags & DELETED) {
-        /*
-         * The interpreter is being deleted. Do not create any new
-         * structures, because it is not safe to modify the interpreter.
-         */
-        
-        return TCL_ERROR;
+	/*
+	 * The interpreter is being deleted. Do not create any new structures,
+	 * because it is not safe to modify the interpreter.
+	 */
+
+	return TCL_ERROR;
     }
 
     /*
-     * Check that we have a regular name for the command
-     * (that the user is not trying to do an expose and a rename
-     *  (to another namespace) at the same time)
+     * Check that we have a regular name for the command (that the user is not
+     * trying to do an expose and a rename (to another namespace) at the same
+     * time).
      */
 
     if (strstr(cmdName, "::") != NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "can not expose to a namespace ",
-		"(use expose to toplevel, then rename)",
-                 (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "cannot expose to a namespace "
+		"(use expose to toplevel, then rename)", NULL);
+	return TCL_ERROR;
     }
 
     /*
@@ -1465,82 +1700,90 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
     if (hiddenCmdTablePtr != NULL) {
 	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
     }
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "unknown hidden command \"", hiddenCmdToken,
-                "\"", (char *) NULL);
-        return TCL_ERROR;
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
+		"\"", NULL);
+	return TCL_ERROR;
     }
-    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-    
+    cmdPtr = Tcl_GetHashValue(hPtr);
 
     /*
-     * Check that we have a true global namespace
-     * command (enforced by Tcl_HideCommand() but let's double
-     * check. (If it was not, we would not really know how to
-     * handle it).
+     * Check that we have a true global namespace command (enforced by
+     * Tcl_HideCommand() but let's double check. (If it was not, we would not
+     * really know how to handle it).
      */
-    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
-	/* 
-	 * This case is theoritically impossible,
-	 * we might rather panic() than 'nicely' erroring out ?
+
+    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
+	/*
+	 * This case is theoritically impossible, we might rather Tcl_Panic()
+	 * than 'nicely' erroring out ?
 	 */
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "trying to expose a non global command name space command",
-		(char *) NULL);
-        return TCL_ERROR;
+
+	Tcl_AppendResult(interp,
+		"trying to expose a non global command name space command",
+		NULL);
+	return TCL_ERROR;
     }
-    
-    /* This is the global table */
+
+    /*
+     * This is the global table.
+     */
+
     nsPtr = cmdPtr->nsPtr;
 
     /*
-     * It is an error to overwrite an existing exposed command as a result
-     * of exposing a previously hidden command.
+     * It is an error to overwrite an existing exposed command as a result of
+     * exposing a previously hidden command.
      */
 
-    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new);
-    if (!new) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "exposed command \"", cmdName,
-                "\" already exists", (char *) NULL);
-        return TCL_ERROR;
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
+    if (!isNew) {
+	Tcl_AppendResult(interp, "exposed command \"", cmdName,
+		"\" already exists", NULL);
+	return TCL_ERROR;
     }
 
     /*
+     * The list of command exported from the namespace might have changed.
+     * However, we do not need to recompute this just yet; next time we need
+     * the info will be soon enough.
+     */
+
+    TclInvalidateNsCmdLookup(nsPtr);
+
+    /*
      * Remove the hash entry for the command from the interpreter hidden
      * command table.
      */
 
     if (cmdPtr->hPtr != NULL) {
-        Tcl_DeleteHashEntry(cmdPtr->hPtr);
-        cmdPtr->hPtr = NULL;
+	Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	cmdPtr->hPtr = NULL;
     }
 
     /*
-     * Now link the hash table entry with the command structure.
-     * This is like creating a new command, so deal with any shadowing
-     * of commands in the global namespace.
+     * Now link the hash table entry with the command structure. This is like
+     * creating a new command, so deal with any shadowing of commands in the
+     * global namespace.
      */
-    
+
     cmdPtr->hPtr = hPtr;
 
-    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    Tcl_SetHashValue(hPtr, cmdPtr);
 
     /*
-     * Not needed as we are only in the global namespace
-     * (but would be needed again if we supported namespace command hiding)
+     * Not needed as we are only in the global namespace (but would be needed
+     * again if we supported namespace command hiding)
      *
      * TclResetShadowedCmdRefs(interp, cmdPtr);
      */
 
-
     /*
-     * If the command being exposed has a compile procedure, increment
-     * interpreter's compileEpoch to invalidate its compiled code. This
-     * makes sure that we don't later try to execute old code compiled
-     * assuming the command is hidden. This field is checked in Tcl_EvalObj
-     * and ObjInterpProc, and code whose compilation epoch doesn't match is
+     * If the command being exposed has a compile function, increment
+     * interpreter's compileEpoch to invalidate its compiled code. This makes
+     * sure that we don't later try to execute old code compiled assuming the
+     * command is hidden. This field is checked in Tcl_EvalObj and
+     * ObjInterpProc, and code whose compilation epoch doesn't match is
      * recompiled.
      */
 
@@ -1558,94 +1801,103 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
  *	Define a new command in a command table.
  *
  * Results:
- *	The return value is a token for the command, which can
- *	be used in future calls to Tcl_GetCommandName.
+ *	The return value is a token for the command, which can be used in
+ *	future calls to Tcl_GetCommandName.
  *
  * Side effects:
  *	If a command named cmdName already exists for interp, it is deleted.
  *	In the future, when cmdName is seen as the name of a command by
  *	Tcl_Eval, proc will be called. To support the bytecode interpreter,
  *	the command is created with a wrapper Tcl_ObjCmdProc
- *	(TclInvokeStringCommand) that eventially calls proc. When the
- *	command is deleted from the table, deleteProc will be called.
- *	See the manual entry for details on the calling sequence.
+ *	(TclInvokeStringCommand) that eventially calls proc. When the command
+ *	is deleted from the table, deleteProc will be called. See the manual
+ *	entry for details on the calling sequence.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
-    Tcl_Interp *interp;		/* Token for command interpreter returned by
-				 * a previous call to Tcl_CreateInterp. */
-    CONST char *cmdName;	/* Name of command. If it contains namespace
+Tcl_CreateCommand(
+    Tcl_Interp *interp,		/* Token for command interpreter returned by a
+				 * previous call to Tcl_CreateInterp. */
+    const char *cmdName,	/* Name of command. If it contains namespace
 				 * qualifiers, the new command is put in the
-				 * specified namespace; otherwise it is put
-				 * in the global namespace. */
-    Tcl_CmdProc *proc;		/* Procedure to associate with cmdName. */
-    ClientData clientData;	/* Arbitrary value passed to string proc. */
-    Tcl_CmdDeleteProc *deleteProc;
-				/* If not NULL, gives a procedure to call
-				 * when this command is deleted. */
+				 * specified namespace; otherwise it is put in
+				 * the global namespace. */
+    Tcl_CmdProc *proc,		/* Function to associate with cmdName. */
+    ClientData clientData,	/* Arbitrary value passed to string proc. */
+    Tcl_CmdDeleteProc *deleteProc)
+				/* If not NULL, gives a function to call when
+				 * this command is deleted. */
 {
     Interp *iPtr = (Interp *) interp;
     ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr, *dummy1, *dummy2;
     Command *cmdPtr, *refCmdPtr;
     Tcl_HashEntry *hPtr;
-    CONST char *tail;
-    int new;
+    const char *tail;
+    int isNew;
     ImportedCmdData *dataPtr;
 
     if (iPtr->flags & DELETED) {
 	/*
-	 * The interpreter is being deleted.  Don't create any new
-	 * commands; it's not safe to muck with the interpreter anymore.
+	 * The interpreter is being deleted. Don't create any new commands;
+	 * it's not safe to muck with the interpreter anymore.
 	 */
 
 	return (Tcl_Command) NULL;
     }
 
     /*
-     * Determine where the command should reside. If its name contains 
-     * namespace qualifiers, we put it in the specified namespace; 
-     * otherwise, we always put it in the global namespace.
+     * Determine where the command should reside. If its name contains
+     * namespace qualifiers, we put it in the specified namespace; otherwise,
+     * we always put it in the global namespace.
      */
 
     if (strstr(cmdName, "::") != NULL) {
-       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
-           CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-       if ((nsPtr == NULL) || (tail == NULL)) {
+	TclGetNamespaceForQualName(interp, cmdName, NULL,
+		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+	if ((nsPtr == NULL) || (tail == NULL)) {
 	    return (Tcl_Command) NULL;
 	}
     } else {
 	nsPtr = iPtr->globalNsPtr;
 	tail = cmdName;
     }
-    
-    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
-    if (!new) {
+
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+    if (!isNew) {
 	/*
-	 * Command already exists. Delete the old one.
-	 * Be careful to preserve any existing import links so we can
-	 * restore them down below.  That way, you can redefine a
-	 * command and its import status will remain intact.
+	 * Command already exists. Delete the old one. Be careful to preserve
+	 * any existing import links so we can restore them down below. That
+	 * way, you can redefine a command and its import status will remain
+	 * intact.
 	 */
 
-	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	cmdPtr = Tcl_GetHashValue(hPtr);
 	oldRefPtr = cmdPtr->importRefPtr;
 	cmdPtr->importRefPtr = NULL;
 
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
-	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
-	if (!new) {
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+	if (!isNew) {
 	    /*
-	     * If the deletion callback recreated the command, just throw
-             * away the new command (if we try to delete it again, we
-             * could get stuck in an infinite loop).
+	     * If the deletion callback recreated the command, just throw away
+	     * the new command (if we try to delete it again, we could get
+	     * stuck in an infinite loop).
 	     */
 
-	     ckfree((char*) Tcl_GetHashValue(hPtr));
+	     ckfree((char *) Tcl_GetHashValue(hPtr));
 	}
+    } else {
+	/*
+	 * The list of command exported from the namespace might have changed.
+	 * However, we do not need to recompute this just yet; next time we
+	 * need the info will be soon enough.
+	 */
+
+	TclInvalidateNsCmdLookup(nsPtr);
+	TclInvalidateNsPath(nsPtr);
     }
     cmdPtr = (Command *) ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
@@ -1653,9 +1905,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->nsPtr = nsPtr;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
-    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->compileProc = NULL;
     cmdPtr->objProc = TclInvokeStringCommand;
-    cmdPtr->objClientData = (ClientData) cmdPtr;
+    cmdPtr->objClientData = cmdPtr;
     cmdPtr->proc = proc;
     cmdPtr->clientData = clientData;
     cmdPtr->deleteProc = deleteProc;
@@ -1665,15 +1917,15 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->tracePtr = NULL;
 
     /*
-     * Plug in any existing import references found above.  Be sure
-     * to update all of these references to point to the new command.
+     * Plug in any existing import references found above. Be sure to update
+     * all of these references to point to the new command.
      */
 
     if (oldRefPtr != NULL) {
 	cmdPtr->importRefPtr = oldRefPtr;
 	while (oldRefPtr != NULL) {
 	    refCmdPtr = oldRefPtr->importedCmdPtr;
-	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr = refCmdPtr->objClientData;
 	    dataPtr->realCmdPtr = cmdPtr;
 	    oldRefPtr = oldRefPtr->nextPtr;
 	}
@@ -1685,7 +1937,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
      * shadowed commands are found, invalidate all cached command references
      * in the affected namespaces.
      */
-    
+
     TclResetShadowedCmdRefs(interp, cmdPtr);
     return (Tcl_Command) cmdPtr;
 }
@@ -1698,70 +1950,70 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
  *	Define a new object-based command in a command table.
  *
  * Results:
- *	The return value is a token for the command, which can
- *	be used in future calls to Tcl_GetCommandName.
+ *	The return value is a token for the command, which can be used in
+ *	future calls to Tcl_GetCommandName.
  *
  * Side effects:
  *	If no command named "cmdName" already exists for interp, one is
- *	created. Otherwise, if a command does exist, then if the
- *	object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume
- *	Tcl_CreateCommand was called previously for the same command and
- *	just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we
- *	delete the old command.
+ *	created. Otherwise, if a command does exist, then if the object-based
+ *	Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
+ *	was called previously for the same command and just set its
+ *	Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
+ *	command.
  *
  *	In the future, during bytecode evaluation when "cmdName" is seen as
  *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
  *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
- *	the table, deleteProc will be called. See the manual entry for
- *	details on the calling sequence.
+ *	the table, deleteProc will be called. See the manual entry for details
+ *	on the calling sequence.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
-    Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by previous call to Tcl_CreateInterp). */
-    CONST char *cmdName;	/* Name of command. If it contains namespace
+Tcl_CreateObjCommand(
+    Tcl_Interp *interp,		/* Token for command interpreter (returned by
+				 * previous call to Tcl_CreateInterp). */
+    const char *cmdName,	/* Name of command. If it contains namespace
 				 * qualifiers, the new command is put in the
-				 * specified namespace; otherwise it is put
-				 * in the global namespace. */
-    Tcl_ObjCmdProc *proc;	/* Object-based procedure to associate with
+				 * specified namespace; otherwise it is put in
+				 * the global namespace. */
+    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
 				 * name. */
-    ClientData clientData;	/* Arbitrary value to pass to object
-    				 * procedure. */
-    Tcl_CmdDeleteProc *deleteProc;
-				/* If not NULL, gives a procedure to call
-				 * when this command is deleted. */
+    ClientData clientData,	/* Arbitrary value to pass to object
+    				 * function. */
+    Tcl_CmdDeleteProc *deleteProc)
+				/* If not NULL, gives a function to call when
+				 * this command is deleted. */
 {
     Interp *iPtr = (Interp *) interp;
     ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr, *dummy1, *dummy2;
     Command *cmdPtr, *refCmdPtr;
     Tcl_HashEntry *hPtr;
-    CONST char *tail;
-    int new;
+    const char *tail;
+    int isNew;
     ImportedCmdData *dataPtr;
 
     if (iPtr->flags & DELETED) {
 	/*
-	 * The interpreter is being deleted.  Don't create any new
-	 * commands;  it's not safe to muck with the interpreter anymore.
+	 * The interpreter is being deleted. Don't create any new commands;
+	 * it's not safe to muck with the interpreter anymore.
 	 */
 
 	return (Tcl_Command) NULL;
     }
 
     /*
-     * Determine where the command should reside. If its name contains 
-     * namespace qualifiers, we put it in the specified namespace; 
-     * otherwise, we always put it in the global namespace.
+     * Determine where the command should reside. If its name contains
+     * namespace qualifiers, we put it in the specified namespace; otherwise,
+     * we always put it in the global namespace.
      */
 
     if (strstr(cmdName, "::") != NULL) {
-       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
-           CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-       if ((nsPtr == NULL) || (tail == NULL)) {
+	TclGetNamespaceForQualName(interp, cmdName, NULL,
+		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+	if ((nsPtr == NULL) || (tail == NULL)) {
 	    return (Tcl_Command) NULL;
 	}
     } else {
@@ -1769,45 +2021,54 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
 	tail = cmdName;
     }
 
-    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
-    if (!new) {
-	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+    TclInvalidateNsPath(nsPtr);
+    if (!isNew) {
+	cmdPtr = Tcl_GetHashValue(hPtr);
 
 	/*
 	 * Command already exists. If its object-based Tcl_ObjCmdProc is
 	 * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
-	 * argument "proc". Otherwise, we delete the old command. 
+	 * argument "proc". Otherwise, we delete the old command.
 	 */
 
 	if (cmdPtr->objProc == TclInvokeStringCommand) {
 	    cmdPtr->objProc = proc;
 	    cmdPtr->objClientData = clientData;
-            cmdPtr->deleteProc = deleteProc;
-            cmdPtr->deleteData = clientData;
+	    cmdPtr->deleteProc = deleteProc;
+	    cmdPtr->deleteData = clientData;
 	    return (Tcl_Command) cmdPtr;
 	}
 
 	/*
-	 * Otherwise, we delete the old command.  Be careful to preserve
-	 * any existing import links so we can restore them down below.
-	 * That way, you can redefine a command and its import status
-	 * will remain intact.
+	 * Otherwise, we delete the old command. Be careful to preserve any
+	 * existing import links so we can restore them down below. That way,
+	 * you can redefine a command and its import status will remain
+	 * intact.
 	 */
 
 	oldRefPtr = cmdPtr->importRefPtr;
 	cmdPtr->importRefPtr = NULL;
 
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
-	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
-	if (!new) {
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+	if (!isNew) {
 	    /*
-	     * If the deletion callback recreated the command, just throw
-	     * away the new command (if we try to delete it again, we
-	     * could get stuck in an infinite loop).
+	     * If the deletion callback recreated the command, just throw away
+	     * the new command (if we try to delete it again, we could get
+	     * stuck in an infinite loop).
 	     */
 
-	     ckfree((char *) Tcl_GetHashValue(hPtr));
+	     ckfree(Tcl_GetHashValue(hPtr));
 	}
+    } else {
+	/*
+	 * The list of command exported from the namespace might have changed.
+	 * However, we do not need to recompute this just yet; next time we
+	 * need the info will be soon enough.
+	 */
+
+	TclInvalidateNsCmdLookup(nsPtr);
     }
     cmdPtr = (Command *) ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
@@ -1815,11 +2076,11 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->nsPtr = nsPtr;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
-    cmdPtr->compileProc = (CompileProc *) NULL;
+    cmdPtr->compileProc = NULL;
     cmdPtr->objProc = proc;
     cmdPtr->objClientData = clientData;
     cmdPtr->proc = TclInvokeObjectCommand;
-    cmdPtr->clientData = (ClientData) cmdPtr;
+    cmdPtr->clientData = cmdPtr;
     cmdPtr->deleteProc = deleteProc;
     cmdPtr->deleteData = clientData;
     cmdPtr->flags = 0;
@@ -1827,27 +2088,27 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->tracePtr = NULL;
 
     /*
-     * Plug in any existing import references found above.  Be sure
-     * to update all of these references to point to the new command.
+     * Plug in any existing import references found above. Be sure to update
+     * all of these references to point to the new command.
      */
 
     if (oldRefPtr != NULL) {
 	cmdPtr->importRefPtr = oldRefPtr;
 	while (oldRefPtr != NULL) {
 	    refCmdPtr = oldRefPtr->importedCmdPtr;
-	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
+	    dataPtr = refCmdPtr->objClientData;
 	    dataPtr->realCmdPtr = cmdPtr;
 	    oldRefPtr = oldRefPtr->nextPtr;
 	}
     }
-    
+
     /*
      * We just created a command, so in its namespace and all of its parent
      * namespaces, it may shadow global commands with the same name. If any
      * shadowed commands are found, invalidate all cached command references
      * in the affected namespaces.
      */
-    
+
     TclResetShadowedCmdRefs(interp, cmdPtr);
     return (Tcl_Command) cmdPtr;
 }
@@ -1858,10 +2119,10 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
  * TclInvokeStringCommand --
  *
  *	"Wrapper" Tcl_ObjCmdProc used to call an existing string-based
- *	Tcl_CmdProc if no object-based procedure exists for a command. A
- *	pointer to this procedure is stored as the Tcl_ObjCmdProc in a
- *	Command structure. It simply turns around and calls the string
- *	Tcl_CmdProc in the Command structure.
+ *	Tcl_CmdProc if no object-based function exists for a command. A
+ *	pointer to this function is stored as the Tcl_ObjCmdProc in a Command
+ *	structure. It simply turns around and calls the string Tcl_CmdProc in
+ *	the Command structure.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -1874,35 +2135,16 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
  */
 
 int
-TclInvokeStringCommand(clientData, interp, objc, objv)
-    ClientData clientData;	/* Points to command's Command structure. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    register int objc;		/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TclInvokeStringCommand(
+    ClientData clientData,	/* Points to command's Command structure. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    register int objc,		/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register Command *cmdPtr = (Command *) clientData;
-    register int i;
-    int result;
-
-    /*
-     * This procedure generates an argv array for the string arguments. It
-     * starts out with stack-allocated space but uses dynamically-allocated
-     * storage if needed.
-     */
-
-#define NUM_ARGS 20
-    CONST char *(argStorage[NUM_ARGS]);
-    CONST char **argv = argStorage;
-
-    /*
-     * Create the string argument array "argv". Make sure argv is large
-     * enough to hold the objc arguments plus 1 extra for the zero
-     * end-of-argv word.
-     */
-
-    if ((objc + 1) > NUM_ARGS) {
-	argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
-    }
+    Command *cmdPtr = clientData;
+    int i, result;
+    const char **argv = (const char **)
+	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
 
     for (i = 0;  i < objc;  i++) {
 	argv[i] = Tcl_GetString(objv[i]);
@@ -1915,15 +2157,8 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
 
     result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
 
-    /*
-     * Free the argv array if malloc'ed storage was used.
-     */
-
-    if (argv != argStorage) {
-	ckfree((char *) argv);
-    }
+    TclStackFree(interp, (void *) argv);
     return result;
-#undef NUM_ARGS
 }
 
 /*
@@ -1932,10 +2167,10 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
  * TclInvokeObjectCommand --
  *
  *	"Wrapper" Tcl_CmdProc used to call an existing object-based
- *	Tcl_ObjCmdProc if no string-based procedure exists for a command.
- *	A pointer to this procedure is stored as the Tcl_CmdProc in a
- *	Command structure. It simply turns around and calls the object
- *	Tcl_ObjCmdProc in the Command structure.
+ *	Tcl_ObjCmdProc if no string-based function exists for a command. A
+ *	pointer to this function is stored as the Tcl_CmdProc in a Command
+ *	structure. It simply turns around and calls the object Tcl_ObjCmdProc
+ *	in the Command structure.
  *
  * Results:
  *	A standard Tcl string result value.
@@ -1948,42 +2183,21 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
  */
 
 int
-TclInvokeObjectCommand(clientData, interp, argc, argv)
-    ClientData clientData;	/* Points to command's Command structure. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int argc;			/* Number of arguments. */
-    register CONST char **argv;	/* Argument strings. */
+TclInvokeObjectCommand(
+    ClientData clientData,	/* Points to command's Command structure. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    register const char **argv)	/* Argument strings. */
 {
     Command *cmdPtr = (Command *) clientData;
-    register Tcl_Obj *objPtr;
-    register int i;
-    int length, result;
-
-    /*
-     * This procedure generates an objv array for object arguments that hold
-     * the argv strings. It starts out with stack-allocated space but uses
-     * dynamically-allocated storage if needed.
-     */
-
-#define NUM_ARGS 20
-    Tcl_Obj *(argStorage[NUM_ARGS]);
-    register Tcl_Obj **objv = argStorage;
-
-    /*
-     * Create the object argument array "objv". Make sure objv is large
-     * enough to hold the objc arguments plus 1 extra for the zero
-     * end-of-objv word.
-     */
-
-    if (argc > NUM_ARGS) {
-	objv = (Tcl_Obj **)
-	    ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
-    }
+    Tcl_Obj *objPtr;
+    int i, length, result;
+    Tcl_Obj **objv = (Tcl_Obj **)
+	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
 
     for (i = 0;  i < argc;  i++) {
 	length = strlen(argv[i]);
-	TclNewObj(objPtr);
-	TclInitStringRep(objPtr, argv[i], length);
+	TclNewStringObj(objPtr, argv[i], length);
 	Tcl_IncrRefCount(objPtr);
 	objv[i] = objPtr;
     }
@@ -1995,27 +2209,23 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
     result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
 
     /*
-     * Move the interpreter's object result to the string result, 
-     * then reset the object result.
+     * Move the interpreter's object result to the string result, then reset
+     * the object result.
      */
 
-    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	    TCL_VOLATILE);
-    
+    (void) Tcl_GetStringResult(interp);
+
     /*
-     * Decrement the ref counts for the argument objects created above,
-     * then free the objv array if malloc'ed storage was used.
+     * Decrement the ref counts for the argument objects created above, then
+     * free the objv array if malloc'ed storage was used.
      */
 
     for (i = 0;  i < argc;  i++) {
 	objPtr = objv[i];
 	Tcl_DecrRefCount(objPtr);
     }
-    if (objv != argStorage) {
-	ckfree((char *) objv);
-    }
+    TclStackFree(interp, objv);
     return result;
-#undef NUM_ARGS
 }
 
 /*
@@ -2023,65 +2233,64 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
  *
  * TclRenameCommand --
  *
- *      Called to give an existing Tcl command a different name. Both the
- *      old command name and the new command name can have "::" namespace
- *      qualifiers. If the new command has a different namespace context,
- *      the command will be moved to that namespace and will execute in
- *	the context of that new namespace.
+ *	Called to give an existing Tcl command a different name. Both the old
+ *	command name and the new command name can have "::" namespace
+ *	qualifiers. If the new command has a different namespace context, the
+ *	command will be moved to that namespace and will execute in the
+ *	context of that new namespace.
  *
- *      If the new command name is NULL or the null string, the command is
- *      deleted.
+ *	If the new command name is NULL or the null string, the command is
+ *	deleted.
  *
  * Results:
- *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *      If anything goes wrong, an error message is returned in the
- *      interpreter's result object.
+ *	If anything goes wrong, an error message is returned in the
+ *	interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclRenameCommand(interp, oldName, newName)
-    Tcl_Interp *interp;                 /* Current interpreter. */
-    char *oldName;                      /* Existing command name. */
-    char *newName;                      /* New command name. */
+TclRenameCommand(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    const char *oldName,	/* Existing command name. */
+    const char *newName)	/* New command name. */
 {
     Interp *iPtr = (Interp *) interp;
-    CONST char *newTail;
+    const char *newTail;
     Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
     Tcl_Command cmd;
     Command *cmdPtr;
     Tcl_HashEntry *hPtr, *oldHPtr;
-    int new, result;
-    Tcl_Obj* oldFullName;
+    int isNew, result;
+    Tcl_Obj *oldFullName;
     Tcl_DString newFullName;
 
     /*
-     * Find the existing command. An error is returned if cmdName can't
-     * be found.
+     * Find the existing command. An error is returned if cmdName can't be
+     * found.
      */
 
-    cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
-	/*flags*/ 0);
+    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
     cmdPtr = (Command *) cmd;
     if (cmdPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ",
-                ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
-                " \"", oldName, "\": command doesn't exist", (char *) NULL);
+	Tcl_AppendResult(interp, "can't ",
+		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
+		" \"", oldName, "\": command doesn't exist", NULL);
 	return TCL_ERROR;
     }
     cmdNsPtr = cmdPtr->nsPtr;
     oldFullName = Tcl_NewObj();
-    Tcl_IncrRefCount( oldFullName );
-    Tcl_GetCommandFullName( interp, cmd, oldFullName );
+    Tcl_IncrRefCount(oldFullName);
+    Tcl_GetCommandFullName(interp, cmd, oldFullName);
 
     /*
      * If the new command name is NULL or empty, delete the command. Do this
      * with Tcl_DeleteCommandFromToken, since we already have the command.
      */
-    
+
     if ((newName == NULL) || (*newName == '\0')) {
 	Tcl_DeleteCommandFromToken(interp, cmd);
 	result = TCL_OK;
@@ -2089,101 +2298,106 @@ TclRenameCommand(interp, oldName, newName)
     }
 
     /*
-     * Make sure that the destination command does not already exist.
-     * The rename operation is like creating a command, so we should
-     * automatically create the containing namespaces just like
-     * Tcl_CreateCommand would.
+     * Make sure that the destination command does not already exist. The
+     * rename operation is like creating a command, so we should automatically
+     * create the containing namespaces just like Tcl_CreateCommand would.
      */
 
-    TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
-       CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
+    TclGetNamespaceForQualName(interp, newName, NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
 
     if ((newNsPtr == NULL) || (newTail == NULL)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		 "can't rename to \"", newName, "\": bad command name",
-    	    	 (char *) NULL);
+	Tcl_AppendResult(interp, "can't rename to \"", newName,
+		"\": bad command name", NULL);
 	result = TCL_ERROR;
 	goto done;
     }
     if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		 "can't rename to \"", newName,
-		 "\": command already exists", (char *) NULL);
+	Tcl_AppendResult(interp, "can't rename to \"", newName,
+		 "\": command already exists", NULL);
 	result = TCL_ERROR;
 	goto done;
     }
 
     /*
-     * Warning: any changes done in the code here are likely
-     * to be needed in Tcl_HideCommand() code too.
-     * (until the common parts are extracted out)     --dl
+     * Warning: any changes done in the code here are likely to be needed in
+     * Tcl_HideCommand() code too (until the common parts are extracted out).
+     * - dl
      */
 
     /*
-     * Put the command in the new namespace so we can check for an alias
-     * loop. Since we are adding a new command to a namespace, we must
-     * handle any shadowing of the global commands that this might create.
+     * Put the command in the new namespace so we can check for an alias loop.
+     * Since we are adding a new command to a namespace, we must handle any
+     * shadowing of the global commands that this might create.
      */
-    
+
     oldHPtr = cmdPtr->hPtr;
-    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
-    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
+    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &isNew);
+    Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = newNsPtr;
     TclResetShadowedCmdRefs(interp, cmdPtr);
 
     /*
-     * Now check for an alias loop. If we detect one, put everything back
-     * the way it was and report the error.
+     * Now check for an alias loop. If we detect one, put everything back the
+     * way it was and report the error.
      */
 
     result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
     if (result != TCL_OK) {
-        Tcl_DeleteHashEntry(cmdPtr->hPtr);
-        cmdPtr->hPtr = oldHPtr;
-        cmdPtr->nsPtr = cmdNsPtr;
+	Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	cmdPtr->hPtr = oldHPtr;
+	cmdPtr->nsPtr = cmdNsPtr;
 	goto done;
     }
 
     /*
-     * Script for rename traces can delete the command "oldName".
-     * Therefore increment the reference count for cmdPtr so that
-     * it's Command structure is freed only towards the end of this
-     * function by calling TclCleanupCommand.
+     * The list of command exported from the namespace might have changed.
+     * However, we do not need to recompute this just yet; next time we need
+     * the info will be soon enough. These might refer to the same variable,
+     * but that's no big deal.
+     */
+
+    TclInvalidateNsCmdLookup(cmdNsPtr);
+    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
+    /*
+     * Script for rename traces can delete the command "oldName". Therefore
+     * increment the reference count for cmdPtr so that it's Command structure
+     * is freed only towards the end of this function by calling
+     * TclCleanupCommand.
      *
-     * The trace procedure needs to get a fully qualified name for
-     * old and new commands [Tcl bug #651271], or else there's no way
-     * for the trace procedure to get the namespace from which the old
-     * command is being renamed!
+     * The trace function needs to get a fully qualified name for old and new
+     * commands [Tcl bug #651271], or else there's no way for the trace
+     * function to get the namespace from which the old command is being
+     * renamed!
      */
 
-    Tcl_DStringInit( &newFullName );
-    Tcl_DStringAppend( &newFullName, newNsPtr->fullName, -1 );
-    if ( newNsPtr != iPtr->globalNsPtr ) {
-	Tcl_DStringAppend( &newFullName, "::", 2 );
+    Tcl_DStringInit(&newFullName);
+    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
+    if (newNsPtr != iPtr->globalNsPtr) {
+	Tcl_DStringAppend(&newFullName, "::", 2);
     }
-    Tcl_DStringAppend( &newFullName, newTail, -1 );
+    Tcl_DStringAppend(&newFullName, newTail, -1);
     cmdPtr->refCount++;
-    CallCommandTraces( iPtr, cmdPtr,
-		       Tcl_GetString( oldFullName ),
-		       Tcl_DStringValue( &newFullName ),
-		       TCL_TRACE_RENAME);
-    Tcl_DStringFree( &newFullName );
+    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
+	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
+    Tcl_DStringFree(&newFullName);
 
     /*
-     * The new command name is okay, so remove the command from its
-     * current namespace. This is like deleting the command, so bump
-     * the cmdEpoch to invalidate any cached references to the command.
+     * The new command name is okay, so remove the command from its current
+     * namespace. This is like deleting the command, so bump the cmdEpoch to
+     * invalidate any cached references to the command.
      */
-    
+
     Tcl_DeleteHashEntry(oldHPtr);
     cmdPtr->cmdEpoch++;
 
     /*
-     * If the command being renamed has a compile procedure, increment the
-     * interpreter's compileEpoch to invalidate its compiled code. This
-     * makes sure that we don't later try to execute old code compiled for
-     * the now-renamed command.
+     * If the command being renamed has a compile function, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This makes
+     * sure that we don't later try to execute old code compiled for the
+     * now-renamed command.
      */
 
     if (cmdPtr->compileProc != NULL) {
@@ -2191,14 +2405,15 @@ TclRenameCommand(interp, oldName, newName)
     }
 
     /*
-     * Now free the Command structure, if the "oldName" command has
-     * been deleted by invocation of rename traces.
+     * Now free the Command structure, if the "oldName" command has been
+     * deleted by invocation of rename traces.
      */
-    TclCleanupCommand(cmdPtr);
+
+    TclCleanupCommandMacro(cmdPtr);
     result = TCL_OK;
 
-    done:
-    TclDecrRefCount( oldFullName );
+  done:
+    TclDecrRefCount(oldFullName);
     return result;
 }
 
@@ -2207,16 +2422,15 @@ TclRenameCommand(interp, oldName, newName)
  *
  * Tcl_SetCommandInfo --
  *
- *	Modifies various information about a Tcl command. Note that
- *	this procedure will not change a command's namespace; use
- *	Tcl_RenameCommand to do that. Also, the isNativeObjectProc
- *	member of *infoPtr is ignored.
+ *	Modifies various information about a Tcl command. Note that this
+ *	function will not change a command's namespace; use TclRenameCommand
+ *	to do that. Also, the isNativeObjectProc member of *infoPtr is
+ *	ignored.
  *
  * Results:
- *	If cmdName exists in interp, then the information at *infoPtr
- *	is stored with the command in place of the current information
- *	and 1 is returned. If the command doesn't exist then 0 is
- *	returned. 
+ *	If cmdName exists in interp, then the information at *infoPtr is
+ *	stored with the command in place of the current information and 1 is
+ *	returned. If the command doesn't exist then 0 is returned.
  *
  * Side effects:
  *	None.
@@ -2225,20 +2439,17 @@ TclRenameCommand(interp, oldName, newName)
  */
 
 int
-Tcl_SetCommandInfo(interp, cmdName, infoPtr)
-    Tcl_Interp *interp;			/* Interpreter in which to look
-					 * for command. */
-    CONST char *cmdName;		/* Name of desired command. */
-    CONST Tcl_CmdInfo *infoPtr;		/* Where to find information
-					 * to store in the command. */
+Tcl_SetCommandInfo(
+    Tcl_Interp *interp,		/* Interpreter in which to look for
+				 * command. */
+    const char *cmdName,	/* Name of desired command. */
+    const Tcl_CmdInfo *infoPtr)	/* Where to find information to store in the
+				 * command. */
 {
     Tcl_Command cmd;
 
-    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
-            /*flags*/ 0);
-
-    return Tcl_SetCommandInfoFromToken( cmd, infoPtr );
-
+    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
+    return Tcl_SetCommandInfoFromToken(cmd, infoPtr);
 }
 
 /*
@@ -2246,16 +2457,15 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
  *
  * Tcl_SetCommandInfoFromToken --
  *
- *	Modifies various information about a Tcl command. Note that
- *	this procedure will not change a command's namespace; use
- *	Tcl_RenameCommand to do that. Also, the isNativeObjectProc
- *	member of *infoPtr is ignored.
+ *	Modifies various information about a Tcl command. Note that this
+ *	function will not change a command's namespace; use TclRenameCommand
+ *	to do that. Also, the isNativeObjectProc member of *infoPtr is
+ *	ignored.
  *
  * Results:
- *	If cmdName exists in interp, then the information at *infoPtr
- *	is stored with the command in place of the current information
- *	and 1 is returned. If the command doesn't exist then 0 is
- *	returned. 
+ *	If cmdName exists in interp, then the information at *infoPtr is
+ *	stored with the command in place of the current information and 1 is
+ *	returned. If the command doesn't exist then 0 is returned.
  *
  * Side effects:
  *	None.
@@ -2264,11 +2474,11 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
  */
 
 int
-Tcl_SetCommandInfoFromToken( cmd, infoPtr )
-    Tcl_Command cmd;
-    CONST Tcl_CmdInfo* infoPtr;
+Tcl_SetCommandInfoFromToken(
+    Tcl_Command cmd,
+    const Tcl_CmdInfo *infoPtr)
 {
-    Command* cmdPtr;		/* Internal representation of the command */
+    Command *cmdPtr;		/* Internal representation of the command */
 
     if (cmd == (Tcl_Command) NULL) {
 	return 0;
@@ -2277,13 +2487,13 @@ Tcl_SetCommandInfoFromToken( cmd, infoPtr )
     /*
      * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
      */
-    
+
     cmdPtr = (Command *) cmd;
     cmdPtr->proc = infoPtr->proc;
     cmdPtr->clientData = infoPtr->clientData;
-    if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
+    if (infoPtr->objProc == NULL) {
 	cmdPtr->objProc = TclInvokeStringCommand;
-	cmdPtr->objClientData = (ClientData) cmdPtr;
+	cmdPtr->objClientData = cmdPtr;
     } else {
 	cmdPtr->objProc = infoPtr->objProc;
 	cmdPtr->objClientData = infoPtr->objClientData;
@@ -2301,10 +2511,9 @@ Tcl_SetCommandInfoFromToken( cmd, infoPtr )
  *	Returns various information about a Tcl command.
  *
  * Results:
- *	If cmdName exists in interp, then *infoPtr is modified to
- *	hold information about cmdName and 1 is returned.  If the
- *	command doesn't exist then 0 is returned and *infoPtr isn't
- *	modified.
+ *	If cmdName exists in interp, then *infoPtr is modified to hold
+ *	information about cmdName and 1 is returned. If the command doesn't
+ *	exist then 0 is returned and *infoPtr isn't modified.
  *
  * Side effects:
  *	None.
@@ -2313,20 +2522,17 @@ Tcl_SetCommandInfoFromToken( cmd, infoPtr )
  */
 
 int
-Tcl_GetCommandInfo(interp, cmdName, infoPtr)
-    Tcl_Interp *interp;			/* Interpreter in which to look
-					 * for command. */
-    CONST char *cmdName;		/* Name of desired command. */
-    Tcl_CmdInfo *infoPtr;		/* Where to store information about
-					 * command. */
+Tcl_GetCommandInfo(
+    Tcl_Interp *interp,		/* Interpreter in which to look for
+				 * command. */
+    const char *cmdName,	/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr)	/* Where to store information about
+				 * command. */
 {
     Tcl_Command cmd;
 
-    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
-            /*flags*/ 0);
-
-    return Tcl_GetCommandInfoFromToken( cmd, infoPtr );
-
+    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
+    return Tcl_GetCommandInfoFromToken(cmd, infoPtr);
 }
 
 /*
@@ -2337,9 +2543,9 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
  *	Returns various information about a Tcl command.
  *
  * Results:
- *	Copies information from the command identified by 'cmd' into
- *	a caller-supplied structure and returns 1.  If the 'cmd' is
- *	NULL, leaves the structure untouched and returns 0.
+ *	Copies information from the command identified by 'cmd' into a
+ *	caller-supplied structure and returns 1. If the 'cmd' is NULL, leaves
+ *	the structure untouched and returns 0.
  *
  * Side effects:
  *	None.
@@ -2348,14 +2554,13 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
  */
 
 int
-Tcl_GetCommandInfoFromToken( cmd, infoPtr )
-    Tcl_Command cmd;
-    Tcl_CmdInfo* infoPtr;
+Tcl_GetCommandInfoFromToken(
+    Tcl_Command cmd,
+    Tcl_CmdInfo *infoPtr)
 {
+    Command *cmdPtr;		/* Internal representation of the command */
 
-    Command* cmdPtr;		/* Internal representation of the command */
-
-    if ( cmd == (Tcl_Command) NULL ) {
+    if (cmd == (Tcl_Command) NULL) {
 	return 0;
     }
 
@@ -2376,7 +2581,6 @@ Tcl_GetCommandInfoFromToken( cmd, infoPtr )
     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
 
     return 1;
-
 }
 
 /*
@@ -2384,9 +2588,8 @@ Tcl_GetCommandInfoFromToken( cmd, infoPtr )
  *
  * Tcl_GetCommandName --
  *
- *	Given a token returned by Tcl_CreateCommand, this procedure
- *	returns the current name of the command (which may have changed
- *	due to renaming).
+ *	Given a token returned by Tcl_CreateCommand, this function returns the
+ *	current name of the command (which may have changed due to renaming).
  *
  * Results:
  *	The return value is the name of the given command.
@@ -2397,25 +2600,25 @@ Tcl_GetCommandInfoFromToken( cmd, infoPtr )
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetCommandName(interp, command)
-    Tcl_Interp *interp;		/* Interpreter containing the command. */
-    Tcl_Command command;	/* Token for command returned by a previous
-				 * call to Tcl_CreateCommand. The command
-				 * must not have been deleted. */
+const char *
+Tcl_GetCommandName(
+    Tcl_Interp *interp,		/* Interpreter containing the command. */
+    Tcl_Command command)	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command must
+				 * not have been deleted. */
 {
     Command *cmdPtr = (Command *) command;
 
     if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
-
 	/*
 	 * This should only happen if command was "created" after the
-	 * interpreter began to be deleted, so there isn't really any
-	 * command. Just return an empty string.
+	 * interpreter began to be deleted, so there isn't really any command.
+	 * Just return an empty string.
 	 */
 
 	return "";
     }
+
     return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
 }
 
@@ -2424,28 +2627,28 @@ Tcl_GetCommandName(interp, command)
  *
  * Tcl_GetCommandFullName --
  *
- *	Given a token returned by, e.g., Tcl_CreateCommand or
- *	Tcl_FindCommand, this procedure appends to an object the command's
- *	full name, qualified by a sequence of parent namespace names. The
- *	command's fully-qualified name may have changed due to renaming.
+ *	Given a token returned by, e.g., Tcl_CreateCommand or Tcl_FindCommand,
+ *	this function appends to an object the command's full name, qualified
+ *	by a sequence of parent namespace names. The command's fully-qualified
+ *	name may have changed due to renaming.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	The command's fully-qualified name is appended to the string
- *	representation of objPtr. 
+ *	representation of objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_GetCommandFullName(interp, command, objPtr)
-    Tcl_Interp *interp;		/* Interpreter containing the command. */
-    Tcl_Command command;	/* Token for command returned by a previous
-				 * call to Tcl_CreateCommand. The command
-				 * must not have been deleted. */
-    Tcl_Obj *objPtr;		/* Points to the object onto which the
+Tcl_GetCommandFullName(
+    Tcl_Interp *interp,		/* Interpreter containing the command. */
+    Tcl_Command command,	/* Token for command returned by a previous
+				 * call to Tcl_CreateCommand. The command must
+				 * not have been deleted. */
+    Tcl_Obj *objPtr)		/* Points to the object onto which the
 				 * command's full name is appended. */
 
 {
@@ -2468,7 +2671,7 @@ Tcl_GetCommandFullName(interp, command, objPtr)
 	if (cmdPtr->hPtr != NULL) {
 	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
 	    Tcl_AppendToObj(objPtr, name, -1);
-	} 
+	}
     }
 }
 
@@ -2480,30 +2683,28 @@ Tcl_GetCommandFullName(interp, command, objPtr)
  *	Remove the given command from the given interpreter.
  *
  * Results:
- *	0 is returned if the command was deleted successfully.
- *	-1 is returned if there didn't exist a command by that name.
+ *	0 is returned if the command was deleted successfully. -1 is returned
+ *	if there didn't exist a command by that name.
  *
  * Side effects:
- *	cmdName will no longer be recognized as a valid command for
- *	interp.
+ *	cmdName will no longer be recognized as a valid command for interp.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_DeleteCommand(interp, cmdName)
-    Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by a previous Tcl_CreateInterp call). */
-    CONST char *cmdName;	/* Name of command to remove. */
+Tcl_DeleteCommand(
+    Tcl_Interp *interp,		/* Token for command interpreter (returned by
+				 * a previous Tcl_CreateInterp call). */
+    const char *cmdName)	/* Name of command to remove. */
 {
     Tcl_Command cmd;
 
     /*
-     *  Find the desired command and delete it.
+     * Find the desired command and delete it.
      */
 
-    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
-            /*flags*/ 0);
+    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
     if (cmd == (Tcl_Command) NULL) {
 	return -1;
     }
@@ -2515,26 +2716,26 @@ Tcl_DeleteCommand(interp, cmdName)
  *
  * Tcl_DeleteCommandFromToken --
  *
- *	Removes the given command from the given interpreter. This procedure
- *	resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead
- *	of a command name for efficiency.
+ *	Removes the given command from the given interpreter. This function
+ *	resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead of
+ *	a command name for efficiency.
  *
  * Results:
- *	0 is returned if the command was deleted successfully.
- *	-1 is returned if there didn't exist a command by that name.
+ *	0 is returned if the command was deleted successfully. -1 is returned
+ *	if there didn't exist a command by that name.
  *
  * Side effects:
- *	The command specified by "cmd" will no longer be recognized as a
- *	valid command for "interp".
+ *	The command specified by "cmd" will no longer be recognized as a valid
+ *	command for "interp".
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_DeleteCommandFromToken(interp, cmd)
-    Tcl_Interp *interp;		/* Token for command interpreter returned by
-				 * a previous call to Tcl_CreateInterp. */
-    Tcl_Command cmd;            /* Token for command to delete. */
+Tcl_DeleteCommandFromToken(
+    Tcl_Interp *interp,		/* Token for command interpreter returned by a
+				 * previous call to Tcl_CreateInterp. */
+    Tcl_Command cmd)		/* Token for command to delete. */
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr = (Command *) cmd;
@@ -2542,73 +2743,90 @@ Tcl_DeleteCommandFromToken(interp, cmd)
     Tcl_Command importCmd;
 
     /*
-     * The code here is tricky.  We can't delete the hash table entry
-     * before invoking the deletion callback because there are cases
-     * where the deletion callback needs to invoke the command (e.g.
-     * object systems such as OTcl). However, this means that the
-     * callback could try to delete or rename the command. The deleted
-     * flag allows us to detect these cases and skip nested deletes.
+     * Bump the command epoch counter. This will invalidate all cached
+     * references that point to this command.
+     */
+
+    cmdPtr->cmdEpoch++;
+
+    /*
+     * The code here is tricky. We can't delete the hash table entry before
+     * invoking the deletion callback because there are cases where the
+     * deletion callback needs to invoke the command (e.g. object systems such
+     * as OTcl). However, this means that the callback could try to delete or
+     * rename the command. The deleted flag allows us to detect these cases
+     * and skip nested deletes.
      */
 
     if (cmdPtr->flags & CMD_IS_DELETED) {
 	/*
-	 * Another deletion is already in progress.  Remove the hash
-	 * table entry now, but don't invoke a callback or free the
-	 * command structure.
+	 * Another deletion is already in progress. Remove the hash table
+	 * entry now, but don't invoke a callback or free the command
+	 * structure. Take care to only remove the hash entry if it has not
+	 * already been removed; otherwise if we manage to hit this function
+	 * three times, everything goes up in smoke. [Bug 1220058]
 	 */
 
-        Tcl_DeleteHashEntry(cmdPtr->hPtr);
-	cmdPtr->hPtr = NULL;
+	if (cmdPtr->hPtr != NULL) {
+	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	    cmdPtr->hPtr = NULL;
+	}
 	return 0;
     }
 
-    /* 
-     * We must delete this command, even though both traces and
-     * delete procs may try to avoid this (renaming the command etc).
-     * Also traces and delete procs may try to delete the command
-     * themsevles.  This flag declares that a delete is in progress
-     * and that recursive deletes should be ignored.
-     */
-    cmdPtr->flags |= CMD_IS_DELETED;
-
     /*
-     * Bump the command epoch counter. This will invalidate all cached
-     * references that point to this command.
+     * We must delete this command, even though both traces and delete procs
+     * may try to avoid this (renaming the command etc). Also traces and
+     * delete procs may try to delete the command themsevles. This flag
+     * declares that a delete is in progress and that recursive deletes should
+     * be ignored.
      */
-    
-    cmdPtr->cmdEpoch++;
+
+    cmdPtr->flags |= CMD_IS_DELETED;
 
     /*
-     * Call trace procedures for the command being deleted. Then delete
-     * its traces. 
+     * Call trace functions for the command being deleted. Then delete its
+     * traces.
      */
 
     if (cmdPtr->tracePtr != NULL) {
 	CommandTrace *tracePtr;
 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
-	/* Now delete these traces */
+
+	/*
+	 * Now delete these traces.
+	 */
+
 	tracePtr = cmdPtr->tracePtr;
 	while (tracePtr != NULL) {
 	    CommandTrace *nextPtr = tracePtr->nextPtr;
 	    if ((--tracePtr->refCount) <= 0) {
-		ckfree((char*)tracePtr);
+		ckfree((char *) tracePtr);
 	    }
 	    tracePtr = nextPtr;
 	}
 	cmdPtr->tracePtr = NULL;
     }
-    
+
     /*
-     * If the command being deleted has a compile procedure, increment the
-     * interpreter's compileEpoch to invalidate its compiled code. This
-     * makes sure that we don't later try to execute old code compiled with
-     * command-specific (i.e., inline) bytecodes for the now-deleted
-     * command. This field is checked in Tcl_EvalObj and ObjInterpProc, and
-     * code whose compilation epoch doesn't match is recompiled.
+     * The list of command exported from the namespace might have changed.
+     * However, we do not need to recompute this just yet; next time we need
+     * the info will be soon enough.
+     */
+
+    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
+    /*
+     * If the command being deleted has a compile function, increment the
+     * interpreter's compileEpoch to invalidate its compiled code. This makes
+     * sure that we don't later try to execute old code compiled with
+     * command-specific (i.e., inline) bytecodes for the now-deleted command.
+     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
+     * compilation epoch doesn't match is recompiled.
      */
 
     if (cmdPtr->compileProc != NULL) {
-        iPtr->compileEpoch++;
+	iPtr->compileEpoch++;
     }
 
     if (cmdPtr->deleteProc != NULL) {
@@ -2618,15 +2836,15 @@ Tcl_DeleteCommandFromToken(interp, cmd)
 	 * data will be a pointer to a ImportedCmdData structure describing
 	 * the "real" command that this imported command refers to.
 	 */
-	
+
 	/*
 	 * If you are getting a crash during the call to deleteProc and
-	 * cmdPtr->deleteProc is a pointer to the function free(), the
-	 * most likely cause is that your extension allocated memory
-	 * for the clientData argument to Tcl_CreateObjCommand() with
-	 * the ckalloc() macro and you are now trying to deallocate
-	 * this memory with free() instead of ckfree(). You should
-	 * pass a pointer to your own method that calls ckfree().
+	 * cmdPtr->deleteProc is a pointer to the function free(), the most
+	 * likely cause is that your extension allocated memory for the
+	 * clientData argument to Tcl_CreateObjCommand() with the ckalloc()
+	 * macro and you are now trying to deallocate this memory with free()
+	 * instead of ckfree(). You should pass a pointer to your own method
+	 * that calls ckfree().
 	 */
 
 	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
@@ -2639,78 +2857,77 @@ Tcl_DeleteCommandFromToken(interp, cmd)
      */
 
     for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
-            refPtr = nextRefPtr) {
+	    refPtr = nextRefPtr) {
 	nextRefPtr = refPtr->nextPtr;
 	importCmd = (Tcl_Command) refPtr->importedCmdPtr;
-        Tcl_DeleteCommandFromToken(interp, importCmd);
+	Tcl_DeleteCommandFromToken(interp, importCmd);
     }
 
     /*
-     * Don't use hPtr to delete the hash entry here, because it's
-     * possible that the deletion callback renamed the command.
-     * Instead, use cmdPtr->hptr, and make sure that no-one else
-     * has already deleted the hash entry.
+     * Don't use hPtr to delete the hash entry here, because it's possible
+     * that the deletion callback renamed the command. Instead, use
+     * cmdPtr->hptr, and make sure that no-one else has already deleted the
+     * hash entry.
      */
 
     if (cmdPtr->hPtr != NULL) {
 	Tcl_DeleteHashEntry(cmdPtr->hPtr);
+	cmdPtr->hPtr = NULL;
     }
 
     /*
      * Mark the Command structure as no longer valid. This allows
      * TclExecuteByteCode to recognize when a Command has logically been
      * deleted and a pointer to this Command structure cached in a CmdName
-     * object is invalid. TclExecuteByteCode will look up the command again
-     * in the interpreter's command hashtable.
+     * object is invalid. TclExecuteByteCode will look up the command again in
+     * the interpreter's command hashtable.
      */
 
     cmdPtr->objProc = NULL;
 
     /*
-     * Now free the Command structure, unless there is another reference to
-     * it from a CmdName Tcl object in some ByteCode code sequence. In that
-     * case, delay the cleanup until all references are either discarded
-     * (when a ByteCode is freed) or replaced by a new reference (when a
-     * cached CmdName Command reference is found to be invalid and
-     * TclExecuteByteCode looks up the command in the command hashtable).
+     * Now free the Command structure, unless there is another reference to it
+     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
+     * delay the cleanup until all references are either discarded (when a
+     * ByteCode is freed) or replaced by a new reference (when a cached
+     * CmdName Command reference is found to be invalid and TclExecuteByteCode
+     * looks up the command in the command hashtable).
      */
-    
-    TclCleanupCommand(cmdPtr);
+
+    TclCleanupCommandMacro(cmdPtr);
     return 0;
 }
 
 static char *
-CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
-    Interp *iPtr;		/* Interpreter containing command. */
-    Command *cmdPtr;		/* Command whose traces are to be
-				 * invoked. */
-    CONST char *oldName;        /* Command's old name, or NULL if we
-                                 * must get the name from cmdPtr */
-    CONST char *newName;        /* Command's new name, or NULL if
-                                 * the command is not being renamed */
-    int flags;			/* Flags indicating the type of traces
-				 * to trigger, either TCL_TRACE_DELETE
-				 * or TCL_TRACE_RENAME. */
+CallCommandTraces(
+    Interp *iPtr,		/* Interpreter containing command. */
+    Command *cmdPtr,		/* Command whose traces are to be invoked. */
+    const char *oldName,	/* Command's old name, or NULL if we must get
+				 * the name from cmdPtr */
+    const char *newName,	/* Command's new name, or NULL if the command
+				 * is not being renamed */
+    int flags)			/* Flags indicating the type of traces to
+				 * trigger, either TCL_TRACE_DELETE or
+				 * TCL_TRACE_RENAME. */
 {
     register CommandTrace *tracePtr;
     ActiveCommandTrace active;
     char *result;
     Tcl_Obj *oldNamePtr = NULL;
-    int mask = (TCL_TRACE_DELETE | TCL_TRACE_RENAME);	/* Safety */
-
-    flags &= mask;
+    Tcl_InterpState state = NULL;
 
     if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
-	/* 
-	 * While a rename trace is active, we will not process any more
-	 * rename traces; while a delete trace is active we will never
-	 * reach here -- because Tcl_DeleteCommandFromToken checks for the
-	 * condition (cmdPtr->flags & CMD_IS_DELETED) and returns immediately
-	 * when a command deletion is in progress.  For all other traces,
-	 * delete traces will not be invoked but a call to TraceCommandProc
-	 * will ensure that tracePtr->clientData is freed whenever the
-	 * command "oldName" is deleted.
+	/*
+	 * While a rename trace is active, we will not process any more rename
+	 * traces; while a delete trace is active we will never reach here -
+	 * because Tcl_DeleteCommandFromToken checks for the condition
+	 * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
+	 * command deletion is in progress. For all other traces, delete
+	 * traces will not be invoked but a call to TraceCommandProc will
+	 * ensure that tracePtr->clientData is freed whenever the command
+	 * "oldName" is deleted.
 	 */
+
 	if (cmdPtr->flags & TCL_TRACE_RENAME) {
 	    flags &= ~TCL_TRACE_RENAME;
 	}
@@ -2720,7 +2937,7 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
     }
     cmdPtr->flags |= CMD_TRACE_ACTIVE;
     cmdPtr->refCount++;
-    
+
     result = NULL;
     active.nextPtr = iPtr->activeCmdTracePtr;
     active.reverseScan = 0;
@@ -2730,37 +2947,41 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
 	flags |= TCL_TRACE_DESTROYED;
     }
     active.cmdPtr = cmdPtr;
-    
-    Tcl_Preserve((ClientData) iPtr);
-    
-    for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
-	 tracePtr = active.nextTracePtr) {
-	int traceFlags = (tracePtr->flags & mask);
 
+    Tcl_Preserve(iPtr);
+
+    for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
+	    tracePtr = active.nextTracePtr) {
 	active.nextTracePtr = tracePtr->nextPtr;
-	if (!(traceFlags & flags)) {
+	if (!(tracePtr->flags & flags)) {
 	    continue;
 	}
-	cmdPtr->flags |= traceFlags;
+	cmdPtr->flags |= tracePtr->flags;
 	if (oldName == NULL) {
 	    TclNewObj(oldNamePtr);
 	    Tcl_IncrRefCount(oldNamePtr);
-	    Tcl_GetCommandFullName((Tcl_Interp *) iPtr, 
-	            (Tcl_Command) cmdPtr, oldNamePtr);
+	    Tcl_GetCommandFullName((Tcl_Interp *) iPtr,
+		    (Tcl_Command) cmdPtr, oldNamePtr);
 	    oldName = TclGetString(oldNamePtr);
 	}
 	tracePtr->refCount++;
+	if (state == NULL) {
+	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
+	}
 	(*tracePtr->traceProc)(tracePtr->clientData,
 		(Tcl_Interp *) iPtr, oldName, newName, flags);
-	cmdPtr->flags &= ~traceFlags;
+	cmdPtr->flags &= ~tracePtr->flags;
 	if ((--tracePtr->refCount) <= 0) {
-	    ckfree((char*)tracePtr);
+	    ckfree((char *) tracePtr);
 	}
     }
 
+    if (state) {
+	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
+    }
+
     /*
-     * If a new object was created to hold the full oldName,
-     * free it now.
+     * If a new object was created to hold the full oldName, free it now.
      */
 
     if (oldNamePtr != NULL) {
@@ -2768,26 +2989,55 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
     }
 
     /*
-     * Restore the variable's flags, remove the record of our active
-     * traces, and then return.
+     * Restore the variable's flags, remove the record of our active traces,
+     * and then return.
      */
 
     cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
     cmdPtr->refCount--;
     iPtr->activeCmdTracePtr = active.nextPtr;
-    Tcl_Release((ClientData) iPtr);
+    Tcl_Release(iPtr);
     return result;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCommandSource --
+ *
+ *	This function returns a Tcl_Obj with the full source string for the
+ *	command. This insures that traces get a correct NUL-terminated command
+ *	string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetCommandSource(
+    Interp *iPtr,
+    const char *command,
+    int numChars,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (!command) {
+	return Tcl_NewListObj(objc, objv);
+    }
+    if (command == (char *) -1) {
+	command = TclGetSrcInfoForCmd(iPtr, &numChars);
+    }
+    return Tcl_NewStringObj(command, numChars);
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclCleanupCommand --
  *
- *	This procedure frees up a Command structure unless it is still
+ *	This function frees up a Command structure unless it is still
  *	referenced from an interpreter's command hashtable or from a CmdName
  *	Tcl object representing the name of a command in a ByteCode
- *	instruction sequence. 
+ *	instruction sequence.
  *
  * Results:
  *	None.
@@ -2801,8 +3051,8 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
  */
 
 void
-TclCleanupCommand(cmdPtr)
-    register Command *cmdPtr;	/* Points to the Command structure to
+TclCleanupCommand(
+    register Command *cmdPtr)	/* Points to the Command structure to
 				 * be freed. */
 {
     cmdPtr->refCount--;
@@ -2816,18 +3066,17 @@ TclCleanupCommand(cmdPtr)
  *
  * Tcl_CreateMathFunc --
  *
- *	Creates a new math function for expressions in a given
- *	interpreter.
+ *	Creates a new math function for expressions in a given interpreter.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The function defined by "name" is created or redefined. If the
- *	function already exists then its definition is replaced; this
- *	includes the builtin functions. Redefining a builtin function forces
- *	all existing code to be invalidated since that code may be compiled
- *	using an instruction specific to the replaced function. In addition,
+ *	The Tcl function defined by "name" is created or redefined. If the
+ *	function already exists then its definition is replaced; this includes
+ *	the builtin functions. Redefining a builtin function forces all
+ *	existing code to be invalidated since that code may be compiled using
+ *	an instruction specific to the replaced function. In addition,
  *	redefioning a non-builtin function will force existing code to be
  *	invalidated if the number of arguments has changed.
  *
@@ -2835,65 +3084,205 @@ TclCleanupCommand(cmdPtr)
  */
 
 void
-Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
-    Tcl_Interp *interp;			/* Interpreter in which function is
-					 * to be available. */
-    CONST 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. */
+Tcl_CreateMathFunc(
+    Tcl_Interp *interp,		/* Interpreter in which function is to be
+				 * available. */
+    const 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,		/* C function 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;
+    Tcl_DString bigName;
+    OldMathFuncData *data = (OldMathFuncData *)
+	    ckalloc(sizeof(OldMathFuncData));
+
+    data->proc = proc;
+    data->numArgs = numArgs;
+    data->argTypes = (Tcl_ValueType *)
+	    ckalloc(numArgs * sizeof(Tcl_ValueType));
+    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
+    data->clientData = clientData;
+
+    Tcl_DStringInit(&bigName);
+    Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
+    Tcl_DStringAppend(&bigName, name, -1);
+
+    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
+	    OldMathFuncProc, data, OldMathFuncDeleteProc);
+    Tcl_DStringFree(&bigName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OldMathFuncProc --
+ *
+ *	Dispatch to a math function created with Tcl_CreateMathFunc
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Whatever the math function does.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
-    if (new) {
-	Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
+static int
+OldMathFuncProc(
+    ClientData clientData,	/* Ponter to OldMathFuncData describing the
+				 * function being called */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Actual parameter count */
+    Tcl_Obj *const *objv)	/* Parameter vector */
+{
+    Tcl_Obj *valuePtr;
+    OldMathFuncData *dataPtr = clientData;
+    Tcl_Value funcResult, *args;
+    int result;
+    int j, k;
+    double d;
+
+    /*
+     * Check argument count.
+     */
+
+    if (objc != dataPtr->numArgs + 1) {
+	MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
+	return TCL_ERROR;
     }
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-    if (!new) {	
-	if (mathFuncPtr->builtinFuncIndex >= 0) {
-	    /*
-	     * We are redefining a builtin math function. Invalidate the
-             * interpreter's existing code by incrementing its
-             * compileEpoch member. This field is checked in Tcl_EvalObj
-             * and ObjInterpProc, and code whose compilation epoch doesn't
-             * match is recompiled. Newly compiled code will no longer
-             * treat the function as builtin.
-	     */
+    /*
+     * Convert arguments from Tcl_Obj's to Tcl_Value's.
+     */
 
-	    iPtr->compileEpoch++;
-	} else {
+    args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
+    for (j = 1, k = 0; j < objc; ++j, ++k) {
+
+	/* TODO: Convert to TclGetNumberFromObj() ? */
+	valuePtr = objv[j];
+	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
+#ifdef ACCEPT_NAN
+	if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
+	    d = valuePtr->internalRep.doubleValue;
+	    result = TCL_OK;
+	}
+#endif
+	if (result != TCL_OK) {
 	    /*
-	     * A non-builtin function is being redefined. We must invalidate
-             * existing code if the number of arguments has changed. This
-	     * is because existing code was compiled assuming that number.
+	     * We have a non-numeric argument.
 	     */
 
-	    if (numArgs != mathFuncPtr->numArgs) {
-		iPtr->compileEpoch++;
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "argument to math function didn't have numeric value",-1));
+	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
+	    ckfree((char *)args);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Copy the object's numeric value to the argument record, converting
+	 * it if necessary.
+	 *
+	 * NOTE: no bignum support; use the new mathfunc interface for that.
+	 */
+
+	args[k].type = dataPtr->argTypes[k];
+	switch (args[k].type) {
+	case TCL_EITHER:
+	    if (Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue))
+		    == TCL_OK) {
+		args[k].type = TCL_INT;
+		break;
+	    }
+	    if (Tcl_GetWideIntFromObj(interp, valuePtr, &(args[k].wideValue))
+		    == TCL_OK) {
+		args[k].type = TCL_WIDE_INT;
+		break;
+	    }
+	    args[k].type = TCL_DOUBLE;
+	    /* FALLTHROUGH */
+
+	case TCL_DOUBLE:
+	    args[k].doubleValue = d;
+	    break;
+	case TCL_INT:
+	    if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
+		ckfree((char *)args);
+		return TCL_ERROR;
+	    }
+	    valuePtr = Tcl_GetObjResult(interp);
+	    Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue));
+	    Tcl_ResetResult(interp);
+	    break;
+	case TCL_WIDE_INT:
+	    if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
+		ckfree((char *)args);
+		return TCL_ERROR;
 	    }
+	    valuePtr = Tcl_GetObjResult(interp);
+	    Tcl_GetWideIntFromObj(NULL, valuePtr, &(args[k].wideValue));
+	    Tcl_ResetResult(interp);
+	    break;
 	}
     }
-    
-    mathFuncPtr->builtinFuncIndex = -1;	/* can't be a builtin function */
-    if (numArgs > MAX_MATH_ARGS) {
-	numArgs = MAX_MATH_ARGS;
+
+    /*
+     * Call the function.
+     */
+
+    errno = 0;
+    result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
+    ckfree((char *)args);
+    if (result != TCL_OK) {
+	return result;
     }
-    mathFuncPtr->numArgs = numArgs;
-    for (i = 0;  i < numArgs;  i++) {
-	mathFuncPtr->argTypes[i] = argTypes[i];
+
+    /*
+     * Return the result of the call.
+     */
+
+    if (funcResult.type == TCL_INT) {
+	TclNewLongObj(valuePtr, funcResult.intValue);
+    } else if (funcResult.type == TCL_WIDE_INT) {
+	valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
+    } else {
+	return CheckDoubleResult(interp, funcResult.doubleValue);
     }
-    mathFuncPtr->proc = proc;
-    mathFuncPtr->clientData = clientData;
+    Tcl_SetObjResult(interp, valuePtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OldMathFuncDeleteProc --
+ *
+ *	Cleans up after deleting a math function registered with
+ *	Tcl_CreateMathFunc
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees allocated memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+OldMathFuncDeleteProc(
+     ClientData clientData)
+{
+    OldMathFuncData *dataPtr = clientData;
+
+    ckfree((void *) dataPtr->argTypes);
+    ckfree((void *) dataPtr);
 }
 
 /*
@@ -2905,64 +3294,80 @@ Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
  *	interpreter.
  *
  * Results:
- *	TCL_OK if it succeeds, TCL_ERROR else (leaving an error message
- *	in the interpreter result if that happens.)
+ *	TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
+ *	interpreter result if that happens.)
  *
  * Side effects:
- *	If this function succeeds, the variables pointed to by the
- *	numArgsPtr and argTypePtr arguments will be updated to detail the
- *	arguments allowed by the function.  The variable pointed to by the
- *	procPtr argument will be set to NULL if the function is a builtin
- *	function, and will be set to the address of the C function used to
- *	implement the math function otherwise (in which case the variable
- *	pointed to by the clientDataPtr argument will also be updated.)
+ *	If this function succeeds, the variables pointed to by the numArgsPtr
+ *	and argTypePtr arguments will be updated to detail the arguments
+ *	allowed by the function. The variable pointed to by the procPtr
+ *	argument will be set to NULL if the function is a builtin function,
+ *	and will be set to the address of the C function used to implement the
+ *	math function otherwise (in which case the variable pointed to by the
+ *	clientDataPtr argument will also be updated.)
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
-		    clientDataPtr)
-    Tcl_Interp *interp;
-    CONST char *name;
-    int *numArgsPtr;
-    Tcl_ValueType **argTypesPtr;
-    Tcl_MathProc **procPtr;
-    ClientData *clientDataPtr;
+Tcl_GetMathFuncInfo(
+    Tcl_Interp *interp,
+    const char *name,
+    int *numArgsPtr,
+    Tcl_ValueType **argTypesPtr,
+    Tcl_MathProc **procPtr,
+    ClientData *clientDataPtr)
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-    MathFunc *mathFuncPtr;
-    Tcl_ValueType *argTypes;
-    int i,numArgs;
+    Tcl_Obj *cmdNameObj;
+    Command *cmdPtr;
 
-    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, name);
-    if (hPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "math function \"", name, "\" not known in this interpreter",
-		(char *) NULL);
+    /*
+     * Get the command that implements the math function.
+     */
+
+    TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
+    Tcl_AppendToObj(cmdNameObj, name, -1);
+    Tcl_IncrRefCount(cmdNameObj);
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
+    Tcl_DecrRefCount(cmdNameObj);
+
+    /*
+     * Report unknown functions.
+     */
+
+    if (cmdPtr == NULL) {
+	Tcl_Obj *message;
+
+	TclNewLiteralStringObj(message, "unknown math function \"");
+	Tcl_AppendToObj(message, name, -1);
+	Tcl_AppendToObj(message, "\"", 1);
+	Tcl_SetObjResult(interp, message);
+	*numArgsPtr = -1;
+	*argTypesPtr = NULL;
+	*procPtr = NULL;
+	*clientDataPtr = NULL;
 	return TCL_ERROR;
     }
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-    *numArgsPtr = numArgs = mathFuncPtr->numArgs;
-    if (numArgs == 0) {
-	/* Avoid doing zero-sized allocs... */
-	numArgs = 1;
-    }
-    *argTypesPtr = argTypes =
-	(Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
-    for (i = 0; i < mathFuncPtr->numArgs; i++) {
-	argTypes[i] = mathFuncPtr->argTypes[i];
-    }
+    /*
+     * Retrieve function info for user defined functions; return dummy
+     * information for builtins.
+     */
+
+    if (cmdPtr->objProc == &OldMathFuncProc) {
+	OldMathFuncData *dataPtr = cmdPtr->clientData;
 
-    if (mathFuncPtr->builtinFuncIndex == -1) {
-	*procPtr = (Tcl_MathProc *) NULL;
+	*procPtr = dataPtr->proc;
+	*numArgsPtr = dataPtr->numArgs;
+	*argTypesPtr = dataPtr->argTypes;
+	*clientDataPtr = dataPtr->clientData;
     } else {
-	*procPtr = mathFuncPtr->proc;
-	*clientDataPtr = mathFuncPtr->clientData;
+	*procPtr = NULL;
+	*numArgsPtr = -1;
+	*argTypesPtr = NULL;
+	*procPtr = NULL;
+	*clientDataPtr = NULL;
     }
-
     return TCL_OK;
 }
 
@@ -2975,9 +3380,9 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
  *	interpreter.
  *
  * Results:
- *	A pointer to a Tcl_Obj structure with a reference count of zero,
- *	or NULL in the case of an error (in which case a suitable error
- *	message will be left in the interpreter result.)
+ *	A pointer to a Tcl_Obj structure with a reference count of zero, or
+ *	NULL in the case of an error (in which case a suitable error message
+ *	will be left in the interpreter result.)
  *
  * Side effects:
  *	None.
@@ -2986,28 +3391,33 @@ Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
  */
 
 Tcl_Obj *
-Tcl_ListMathFuncs(interp, pattern)
-    Tcl_Interp *interp;
-    CONST char *pattern;
+Tcl_ListMathFuncs(
+    Tcl_Interp *interp,
+    const char *pattern)
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *resultList = Tcl_NewObj();
-    register Tcl_HashEntry *hPtr;
-    Tcl_HashSearch hSearch;
-    CONST char *name;
-
-    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &hSearch);
-	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-        name = Tcl_GetHashKey(&iPtr->mathFuncTable, hPtr);
-	if ((pattern == NULL || Tcl_StringMatch(name, pattern)) &&
-	    /* I don't expect this to fail, but... */
-	    Tcl_ListObjAppendElement(interp, resultList,
-				     Tcl_NewStringObj(name,-1)) != TCL_OK) {
-	    Tcl_DecrRefCount(resultList);
-	    return NULL;
-	}
+    Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
+    Tcl_Obj *result;
+    Tcl_InterpState state;
+
+    if (pattern) {
+	Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
+	Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
+
+	Tcl_AppendObjToObj(script, arg);
+	Tcl_DecrRefCount(arg);	/* Should tear down patternObj too */
     }
-    return resultList;
+
+    state = Tcl_SaveInterpState(interp, TCL_OK);
+    Tcl_IncrRefCount(script);
+    if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
+	result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
+    } else {
+	result = Tcl_NewObj();
+    }
+    Tcl_DecrRefCount(script);
+    Tcl_RestoreInterpState(interp, state);
+
+    return result;
 }
 
 /*
@@ -3015,13 +3425,12 @@ Tcl_ListMathFuncs(interp, pattern)
  *
  * TclInterpReady --
  *
- *	Check if an interpreter is ready to eval commands or scripts, 
- *      i.e., if it was not deleted and if the nesting level is not 
- *      too high.
+ *	Check if an interpreter is ready to eval commands or scripts, i.e., if
+ *	it was not deleted and if the nesting level is not too high.
  *
  * Results:
- *	The return value is TCL_OK if it the interpreter is ready, 
- *      TCL_ERROR otherwise.
+ *	The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
+ *	otherwise.
  *
  * Side effects:
  *	The interpreters object and string results are cleared.
@@ -3029,15 +3438,18 @@ Tcl_ListMathFuncs(interp, pattern)
  *----------------------------------------------------------------------
  */
 
-int 
-TclInterpReady(interp)
-    Tcl_Interp *interp;
+int
+TclInterpReady(
+    Tcl_Interp *interp)
 {
+#if !defined(TCL_NO_STACK_CHECK)
+    int localInt; /* used for checking the stack */
+#endif
     register Interp *iPtr = (Interp *) interp;
 
     /*
-     * Reset both the interpreter's string and object results and clear 
-     * out any previous error information. 
+     * Reset both the interpreter's string and object results and clear out
+     * any previous error information.
      */
 
     Tcl_ResetResult(interp);
@@ -3045,46 +3457,53 @@ TclInterpReady(interp)
     /*
      * If the interpreter has been deleted, return an error.
      */
-    
+
     if (iPtr->flags & DELETED) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "attempt to call eval in deleted interpreter", -1);
-	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
-	        "attempt to call eval in deleted interpreter",
-		(char *) NULL);
+	Tcl_AppendResult(interp,
+		"attempt to call eval in deleted interpreter", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "IDELETE",
+		"attempt to call eval in deleted interpreter", NULL);
 	return TCL_ERROR;
     }
 
     /*
-     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
-     * it's probably because of an infinite loop somewhere.
+     * Check depth of nested calls to Tcl_Eval: if this gets too large, it's
+     * probably because of an infinite loop somewhere.
      */
 
-    if (((iPtr->numLevels) > iPtr->maxNestingDepth) 
-	    || (TclpCheckStackSpace() == 0)) {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"too many nested evaluations (infinite loop?)", -1); 
-	return TCL_ERROR;
+    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)
+	    && CheckCStack(iPtr, &localInt)) {
+	return TCL_OK;
     }
 
-    return TCL_OK;
+    if (!CheckCStack(iPtr, &localInt)) {
+	Tcl_AppendResult(interp,
+		"out of stack space (infinite loop?)", NULL);
+    } else {
+	Tcl_AppendResult(interp,
+		"too many nested evaluations (infinite loop?)", NULL);
+    }
+    return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclEvalObjvInternal --
+ * TclEvalObjvInternal
+ *
+ *	This function evaluates a Tcl command that has already been parsed
+ *	into words, with one Tcl_Obj holding each word. The caller is
+ *	responsible for managing the iPtr->numLevels.
  *
- *	This procedure evaluates a Tcl command that has already been
- *	parsed into words, with one Tcl_Obj holding each word. The caller
- *      is responsible for managing the iPtr->numLevels.
+ *      TclEvalObjvInternal is the backend for Tcl_EvalObjv, the bytecode
+ *      engine also calls it directly.
  *
  * Results:
- *	The return value is a standard Tcl completion code such as
- *	TCL_OK or TCL_ERROR.  A result or error message is left in
- *	interp's result.  If an error occurs, this procedure does
- *	NOT add any information to the errorInfo variable.
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR. A result or error message is left in interp's result. If an
+ *	error occurs, this function does NOT add any information to the
+ *	errorInfo variable.
  *
  * Side effects:
  *	Depends on the command.
@@ -3093,39 +3512,39 @@ TclInterpReady(interp)
  */
 
 int
-TclEvalObjvInternal(interp, objc, objv, command, length, flags)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate the
-				 * command.  Also used for error
-				 * reporting. */
-    int objc;			/* Number of words in command. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to objects that are
+TclEvalObjvInternal(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * command. Also used for error reporting. */
+    int objc,			/* Number of words in command. */
+    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
 				 * the words that make up the command. */
-    CONST char *command;	/* Points to the beginning of the string
-				 * representation of the command; this
-				 * is used for traces.  If the string
-				 * representation of the command is
-				 * unknown, an empty string should be
-				 * supplied. If it is NULL, no traces will
-				 * be called. */
-    int length;			/* Number of bytes in command; if -1, all
+    const char *command,	/* Points to the beginning of the string
+				 * representation of the command; this is used
+				 * for traces. NULL if the string
+				 * representation of the command is unknown is
+				 * to be generated from (objc,objv), -1 if it
+				 * is to be generated from bytecode
+				 * source. This is only needed the traces. */
+    int length,			/* Number of bytes in command; if -1, all
 				 * characters up to the first null byte are
 				 * used. */
-    int flags;			/* Collection of OR-ed bits that control
-				 * the evaluation of the script.  Only
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
 				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
 				 * currently supported. */
-
 {
     Command *cmdPtr;
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj **newObjv;
     int i;
-    CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
-					 * in case TCL_EVAL_GLOBAL was set. */
+    CallFrame *savedVarFramePtr = NULL;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
     int code = TCL_OK;
     int traceCode = TCL_OK;
-    int checkTraces = 1;
+    int checkTraces = 1, traced;
     Namespace *savedNsPtr = NULL;
+    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
+    Tcl_Obj *commandPtr = NULL;
 
     if (TclInterpReady(interp) == TCL_ERROR) {
 	return TCL_ERROR;
@@ -3135,93 +3554,107 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 	return TCL_OK;
     }
 
+    /*
+     * If any execution traces rename or delete the current command, we may
+     * need (at most) two passes here.
+     */
+
+  reparseBecauseOfTraces:
 
     /*
-     * If any execution traces rename or delete the current command,
-     * we may need (at most) two passes here.
+     * Configure evaluation context to match the requested flags.
      */
 
-    savedVarFramePtr = iPtr->varFramePtr;
-    while (1) {
-    
-	/* Configure evaluation context to match the requested flags */
-	if (flags & TCL_EVAL_GLOBAL) {
-	    iPtr->varFramePtr = NULL;
-	} else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) {
-	    savedNsPtr = iPtr->varFramePtr->nsPtr;
-	    iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
-	}
-	
-        /*
-         * Find the procedure to execute this command. If there isn't one,
-         * then see if there is a command "unknown".  If so, create a new
-         * word array with "unknown" as the first word and the original
-         * command words as arguments.  Then call ourselves recursively
-         * to execute it.
-         */
-        cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
-        if (cmdPtr == NULL) {
-	    newObjv = (Tcl_Obj **) ckalloc((unsigned)
-		((objc + 1) * sizeof (Tcl_Obj *)));
-	    for (i = objc-1; i >= 0; i--) {
-	        newObjv[i+1] = objv[i];
-	    }
-	    newObjv[0] = Tcl_NewStringObj("::unknown", -1);
-	    Tcl_IncrRefCount(newObjv[0]);
-	    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
-	    if (cmdPtr == NULL) {
-	        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "invalid command name \"", Tcl_GetString(objv[0]), "\"",
-		    (char *) NULL);
-	        code = TCL_ERROR;
+    if (flags) {
+	if (flags & TCL_EVAL_INVOKE) {
+	    savedNsPtr = varFramePtr->nsPtr;
+	    if (lookupNsPtr) {
+		varFramePtr->nsPtr = lookupNsPtr;
+		iPtr->lookupNsPtr = NULL;
 	    } else {
-	        iPtr->numLevels++;
-	        code = TclEvalObjvInternal(interp, objc+1, newObjv,
-			command, length, 0);
-	        iPtr->numLevels--;
+		varFramePtr->nsPtr = iPtr->globalNsPtr;
 	    }
-	    Tcl_DecrRefCount(newObjv[0]);
-	    ckfree((char *) newObjv);
-	    if (savedNsPtr) {
-		iPtr->varFramePtr->nsPtr = savedNsPtr;
+	} else if ((flags & TCL_EVAL_GLOBAL)
+		&& (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
+	    varFramePtr = iPtr->rootFramePtr;
+	    savedVarFramePtr = iPtr->varFramePtr;
+	    iPtr->varFramePtr = varFramePtr;
+	}
+    }
+
+    /*
+     * Find the function to execute this command. If there isn't one, then see
+     * if there is an unknown command handler registered for this namespace.
+     * If so, create a new word array with the handler as the first words and
+     * the original command words as arguments. Then call ourselves
+     * recursively to execute it.
+     */
+
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+    if (!cmdPtr) {
+	goto notFound;
+    }
+
+    if (savedNsPtr) {
+	varFramePtr->nsPtr = savedNsPtr;
+    } else if (iPtr->ensembleRewrite.sourceObjs) {
+	/*
+	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
+	 */
+
+	iPtr->ensembleRewrite.sourceObjs = NULL;
+    }
+
+    /*
+     * Call trace functions if needed.
+     */
+
+    traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
+    if (traced && checkTraces) {
+	int cmdEpoch = cmdPtr->cmdEpoch;
+	int newEpoch;
+
+	/*
+	 * Insure that we have a correct nul-terminated command string for the
+	 * trace code.
+	 */
+
+	commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
+	command = TclGetStringFromObj(commandPtr, &length);
+
+	/*
+	 * Execute any command or execution traces. Note that we bump up the
+	 * command's reference count for the duration of the calling of the
+	 * traces so that the structure doesn't go away underneath our feet.
+	 */
+
+	cmdPtr->refCount++;
+	if (iPtr->tracePtr && (traceCode == TCL_OK)) {
+	    traceCode = TclCheckInterpTraces(interp, command, length,
+		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
+	}
+	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+	    traceCode = TclCheckExecutionTraces(interp, command, length,
+		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
+	}
+	newEpoch = cmdPtr->cmdEpoch;
+	TclCleanupCommandMacro(cmdPtr);
+
+	/*
+	 * If the traces modified/deleted the command or any existing traces,
+	 * they will update the command's epoch. When that happens, set
+	 * checkTraces is set to 0 to prevent the re-calling of traces (and
+	 * any possible infinite loop) and we go back to re-find the command
+	 * implementation.
+	 */
+
+	if (cmdEpoch != newEpoch) {
+	    checkTraces = 0;
+	    if (commandPtr) {
+		Tcl_DecrRefCount(commandPtr);
 	    }
-	    goto done;
-        }
-	if (savedNsPtr) {
-	    iPtr->varFramePtr->nsPtr = savedNsPtr;
+	    goto reparseBecauseOfTraces;
 	}
-    
-        /*
-         * Call trace procedures if needed.
-         */
-        if ((checkTraces) && (command != NULL)) {
-            int cmdEpoch = cmdPtr->cmdEpoch;
-	    int newEpoch;
-	    
-	    cmdPtr->refCount++;
-            /* 
-             * If the first set of traces modifies/deletes the command or
-             * any existing traces, then the set checkTraces to 0 and
-             * go through this while loop one more time.
-             */
-            if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
-                traceCode = TclCheckInterpTraces(interp, command, length,
-                               cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
-            }
-            if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) 
-		    && (traceCode == TCL_OK)) {
-                traceCode = TclCheckExecutionTraces(interp, command, length,
-                               cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
-            }
-	    newEpoch = cmdPtr->cmdEpoch;
-	    TclCleanupCommand(cmdPtr);
-            if (cmdEpoch != newEpoch) {
-                /* The command has been modified in some way */
-                checkTraces = 0;
-                continue;
-            }
-        }
-        break;
     }
 
 #ifdef USE_DTRACE
@@ -3235,14 +3668,24 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
 		a[8], a[9]);
     }
+    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
+	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+	char *a[4]; int i[2];
+
+	TclDTraceInfo(info, a, i);
+	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+	TclDecrRefCount(info);
+    }
 #endif /* USE_DTRACE */
 
     /*
      * Finally, invoke the command's Tcl_ObjCmdProc.
      */
+
     cmdPtr->refCount++;
     iPtr->cmdCount++;
-    if ( code == TCL_OK && traceCode == TCL_OK) {
+    if (code == TCL_OK && traceCode == TCL_OK
+	    && !TclLimitExceeded(iPtr->limit)) {
 	if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
 	    TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
 		    (Tcl_Obj **)(objv + 1));
@@ -3252,48 +3695,58 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
 	}
     }
-    if (Tcl_AsyncReady()) {
+
+    if (TclAsyncReady(iPtr)) {
 	code = Tcl_AsyncInvoke(interp, code);
     }
+    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
+	code = Tcl_LimitCheck(interp);
+    }
 
     /*
      * Call 'leave' command traces
      */
-    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	int saveErrFlags = iPtr->flags 
-		& (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
-        if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-            traceCode = TclCheckExecutionTraces (interp, command, length,
-                   cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
-        }
-        if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
-            traceCode = TclCheckInterpTraces(interp, command, length,
-                   cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
-        }
-	if (traceCode == TCL_OK) {
-	    iPtr->flags |= saveErrFlags;
+
+    if (traced) {
+	if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+	    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
+		traceCode = TclCheckExecutionTraces(interp, command, length,
+			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	    }
+	    if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+		traceCode = TclCheckInterpTraces(interp, command, length,
+			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	    }
+	}
+
+	/*
+	 * If one of the trace invocation resulted in error, then change the
+	 * result code accordingly. Note, that the interp->result should
+	 * already be set correctly by the call to TraceExecutionProc.
+	 */
+
+	if (traceCode != TCL_OK) {
+	    code = traceCode;
+	}
+	if (commandPtr) {
+	    Tcl_DecrRefCount(commandPtr);
 	}
     }
-    TclCleanupCommand(cmdPtr);
 
     /*
-     * If one of the trace invocation resulted in error, then 
-     * change the result code accordingly. Note, that the
-     * interp->result should already be set correctly by the
-     * call to TraceExecutionProc.  
+     * Decrement the reference count of cmdPtr and deallocate it if it has
+     * dropped to zero.
      */
 
-    if (traceCode != TCL_OK) {
-	code = traceCode;
-    }
-    
+    TclCleanupCommandMacro(cmdPtr);
+
     /*
-     * If the interpreter has a non-empty string result, the result
-     * object is either empty or stale because some procedure set
-     * interp->result directly. If so, move the string result to the
-     * result object, then reset the string result.
+     * If the interpreter has a non-empty string result, the result object is
+     * either empty or stale because some function set interp->result
+     * directly. If so, move the string result to the result object, then
+     * reset the string result.
      */
-    
+
     if (*(iPtr->result) != 0) {
 	(void) Tcl_GetObjResult(interp);
     }
@@ -3303,532 +3756,213 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 	Tcl_Obj *r;
 
 	r = Tcl_GetObjResult(interp);
-	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r), r);
+	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
     }
 #endif /* USE_DTRACE */
 
-    done:
-    iPtr->varFramePtr = savedVarFramePtr;
+  done:
+    if (savedVarFramePtr) {
+	iPtr->varFramePtr = savedVarFramePtr;
+    }
     return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObjv --
- *
- *	This procedure evaluates a Tcl command that has already been
- *	parsed into words, with one Tcl_Obj holding each word.
- *
- * Results:
- *	The return value is a standard Tcl completion code such as
- *	TCL_OK or TCL_ERROR.  A result or error message is left in
- *	interp's result.
- *
- * Side effects:
- *	Depends on the command.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalObjv(interp, objc, objv, flags)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate the
-				 * command.  Also used for error
-				 * reporting. */
-    int objc;			/* Number of words in command. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to objects that are
-				 * the words that make up the command. */
-    int flags;			/* Collection of OR-ed bits that control
-				 * the evaluation of the script.  Only
-				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE
-				 * are  currently supported. */
-{
-    Interp *iPtr = (Interp *)interp;
-    Trace *tracePtr;
-    Tcl_DString cmdBuf;
-    char *cmdString = "";	/* A command string is only necessary for
-				 * command traces or error logs; it will be
-				 * generated to replace this default value if
-				 * necessary. */
-    int cmdLen = 0;		/* a non-zero value indicates that a command
-				 * string was generated. */
-    int code = TCL_OK;
-    int i;
-    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
 
-    for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
-	if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) {
-	    /*
-	     * The command may be needed for an execution trace.  Generate a
-	     * command string.
-	     */
-	    
-	    Tcl_DStringInit(&cmdBuf);
-	    for (i = 0; i < objc; i++) {
-		Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
+  notFound:
+    {
+	Namespace *currNsPtr = NULL;	/* Used to check for and invoke any
+					 * registered unknown command handler
+					 * for the current namespace (TIP
+					 * 181). */
+	int newObjc, handlerObjc;
+	Tcl_Obj **handlerObjv;
+
+	currNsPtr = varFramePtr->nsPtr;
+	if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+	    currNsPtr = iPtr->globalNsPtr;
+	    if (currNsPtr == NULL) {
+		Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
 	    }
-	    cmdString = Tcl_DStringValue(&cmdBuf);
-	    cmdLen = Tcl_DStringLength(&cmdBuf);
-	    break;
 	}
-    }
 
-    iPtr->numLevels++;
-    code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
-    iPtr->numLevels--;
+	/*
+	 * Check to see if the resolution namespace has lost its unknown
+	 * handler. If so, reset it to "::unknown".
+	 */
 
-    /*
-     * If we are again at the top level, process any unusual 
-     * return code returned by the evaluated code. 
-     */
-	
-    if (iPtr->numLevels == 0) {
-	if (code == TCL_RETURN) {
-	    code = TclUpdateReturnInfo(iPtr);
+	if (currNsPtr->unknownHandlerPtr == NULL) {
+	    TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+	    Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
 	}
-	if ((code != TCL_OK) && (code != TCL_ERROR) 
-	    && !allowExceptions) {
-	    ProcessUnexpectedResult(interp, code);
-	    code = TCL_ERROR;
+
+	/*
+	 * Get the list of words for the unknown handler and allocate enough
+	 * space to hold both the handler prefix and all words of the command
+	 * invokation itself.
+	 */
+
+	Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+		&handlerObjc, &handlerObjv);
+	newObjc = objc + handlerObjc;
+	newObjv = (Tcl_Obj **) TclStackAlloc(interp,
+		(int) sizeof(Tcl_Obj *) * newObjc);
+
+	/*
+	 * Copy command prefix from unknown handler and add on the real
+	 * command's full argument list. Note that we only use memcpy() once
+	 * because we have to increment the reference count of all the handler
+	 * arguments anyway.
+	 */
+
+	for (i = 0; i < handlerObjc; ++i) {
+	    newObjv[i] = handlerObjv[i];
+	    Tcl_IncrRefCount(newObjv[i]);
 	}
-    }
-	    
-    if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+	memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
 
-	/* 
-	 * If there was an error, a command string will be needed for the 
-	 * error log: generate it now if it was not done previously.
+	/*
+	 * Look up and invoke the handler (by recursive call to this
+	 * function). If there is no handler at all, instead of doing the
+	 * recursive call we just generate a generic error message; it would
+	 * be an infinite-recursion nightmare otherwise.
 	 */
 
-	if (cmdLen == 0) {
-	    Tcl_DStringInit(&cmdBuf);
-	    for (i = 0; i < objc; i++) {
-		Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
-	    }
-	    cmdString = Tcl_DStringValue(&cmdBuf);
-	    cmdLen = Tcl_DStringLength(&cmdBuf);
+	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+	if (cmdPtr == NULL) {
+	    Tcl_AppendResult(interp, "invalid command name \"",
+		    TclGetString(objv[0]), "\"", NULL);
+	    code = TCL_ERROR;
+	} else {
+	    iPtr->numLevels++;
+	    code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
+		    length, 0);
+	    iPtr->numLevels--;
 	}
-	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
-    }
 
-    if (cmdLen != 0) {
-	Tcl_DStringFree(&cmdBuf);
+	/*
+	 * Release any resources we locked and allocated during the handler
+	 * call.
+	 */
+
+	for (i = 0; i < handlerObjc; ++i) {
+	    Tcl_DecrRefCount(newObjv[i]);
+	}
+	TclStackFree(interp, newObjv);
+	if (savedNsPtr) {
+	    varFramePtr->nsPtr = savedNsPtr;
+	}
+	goto done;
     }
-    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LogCommandInfo --
+ * Tcl_EvalObjv --
  *
- *	This procedure is invoked after an error occurs in an interpreter.
- *	It adds information to the "errorInfo" variable to describe the
- *	command that was being executed when the error occurred.
+ *	This function evaluates a Tcl command that has already been parsed
+ *	into words, with one Tcl_Obj holding each word.
  *
  * Results:
- *	None.
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR. A result or error message is left in interp's result.
  *
  * Side effects:
- *	Information about the command is added to errorInfo and the
- *	line number stored internally in the interpreter is set.  If this
- *	is the first call to this procedure or Tcl_AddObjErrorInfo since
- *	an error occurred, then old information in errorInfo is
- *	deleted.
+ *	Depends on the command.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_LogCommandInfo(interp, script, command, length)
-    Tcl_Interp *interp;		/* Interpreter in which to log information. */
-    CONST char *script;		/* First character in script containing
-				 * command (must be <= command). */
-    CONST char *command;	/* First character in command that
-				 * generated the error. */
-    int length;			/* Number of bytes in command (-1 means
-				 * use all bytes up to first null byte). */
+int
+Tcl_EvalObjv(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * command. Also used for error reporting. */
+    int objc,			/* Number of words in command. */
+    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
+				 * the words that make up the command. */
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
+				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
+				 * currently supported. */
 {
-    char buffer[200];
-    register CONST char *p;
-    char *ellipsis = "";
     Interp *iPtr = (Interp *) interp;
+    int code = TCL_OK;
+    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+
+    iPtr->numLevels++;
+    code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
+    iPtr->numLevels--;
+
+    if (code == TCL_OK) {
+	return code;
+    } else {
 
-    if (iPtr->flags & ERR_ALREADY_LOGGED) {
 	/*
-	 * Someone else has already logged error information for this
-	 * command; we shouldn't add anything more.
+	 * If we are again at the top level, process any unusual return code
+	 * returned by the evaluated code.
 	 */
 
-	return;
-    }
+	if (iPtr->numLevels == 0) {
+	    if (code == TCL_RETURN) {
+		code = TclUpdateReturnInfo(iPtr);
+	    }
+	    if ((code != TCL_ERROR) && !allowExceptions) {
+		ProcessUnexpectedResult(interp, code);
+		code = TCL_ERROR;
+	    }
+	}
 
-    /*
-     * Compute the line number where the error occurred.
-     */
+	if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+	    /*
+	     * If there was an error, a command string will be needed for the
+	     * error log: generate it now. Do not worry too much about doing
+	     * it expensively.
+	     */
 
-    iPtr->errorLine = 1;
-    for (p = script; p != command; p++) {
-	if (*p == '\n') {
-	    iPtr->errorLine++;
-	}
-    }
+	    Tcl_Obj *listPtr;
+	    char *cmdString;
+	    int cmdLen;
 
-    /*
-     * Create an error message to add to errorInfo, including up to a
-     * maximum number of characters of the command.
-     */
+	    listPtr = Tcl_NewListObj(objc, objv);
+	    cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+	    Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+	    Tcl_DecrRefCount(listPtr);
+	}
 
-    if (length < 0) {
-	length = strlen(command);
-    }
-    if (length > 150) {
-	length = 150;
-	ellipsis = "...";
-    }
-    while ( (command[length] & 0xC0) == 0x80 ) {
-	/*
-	 * Back up truncation point so that we don't truncate in the
-	 * middle of a multi-byte character (in UTF-8)
-	 */
-	length--;
-	ellipsis = "...";
-    }
-    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
-	sprintf(buffer, "\n    while executing\n\"%.*s%s\"",
-		length, command, ellipsis);
-    } else {
-	sprintf(buffer, "\n    invoked from within\n\"%.*s%s\"",
-		length, command, ellipsis);
+	return code;
     }
-    Tcl_AddObjErrorInfo(interp, buffer, -1);
-    iPtr->flags &= ~ERR_ALREADY_LOGGED;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalTokensStandard, EvalTokensStandard --
+ * Tcl_EvalTokensStandard --
+ *
+ *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
+ *	that make up a word or the index for an array variable) this function
+ *	evaluates the tokens and concatenates their values to form a single
+ *	result value.
  *
- *	Given an array of tokens parsed from a Tcl command (e.g., the
- *	tokens that make up a word or the index for an array variable)
- *	this procedure evaluates the tokens and concatenates their
- *	values to form a single result value.
- * 
  * Results:
- *	The return value is a standard Tcl completion code such as
- *	TCL_OK or TCL_ERROR.  A result or error message is left in
- *	interp's result.
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR. A result or error message is left in interp's result.
  *
  * Side effects:
  *	Depends on the array of tokens being evaled.
  *
- * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_EvalTokensStandard(interp, tokenPtr, count)
-    Tcl_Interp *interp;		/* Interpreter in which to lookup
-				 * variables, execute nested commands,
-				 * and report errors. */
-    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
-				 * to evaluate and concatenate. */
-    int count;			/* Number of tokens to consider at tokenPtr.
+Tcl_EvalTokensStandard(
+    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
+				 * execute nested commands, and report
+				 * errors. */
+    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
+				 * evaluate and concatenate. */
+    int count)			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
 {
-#ifdef TCL_TIP280
-  return EvalTokensStandard (interp, tokenPtr, count, 1, NULL, NULL);
-}
-
-static int
-EvalTokensStandard(interp, tokenPtr, count, line, clNextOuter, outerScript)
-    Tcl_Interp *interp;		/* Interpreter in which to lookup
-				 * variables, execute nested commands,
-				 * and report errors. */
-    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
-				 * to evaluate and concatenate. */
-    int count;			/* Number of tokens to consider at tokenPtr.
-				 * Must be at least 1. */
-    int line;                   /* The line the script starts on. */
-    int*  clNextOuter;       /* Information about an outer context for */
-    CONST char* outerScript; /* continuation line data. This is set by
-			      * EvalEx() to properly handle [...]-nested
-			      * commands. The 'outerScript' refers to the
-			      * most-outer script containing the embedded
-			      * command, which is refered to by 'script'. The
-			      * 'clNextOuter' refers to the current entry in
-			      * the table of continuation lines in this
-			      * "master script", and the character offsets are
-			      * relative to the 'outerScript' as well.
-			      *
-			      * If outerScript == script, then this call is for
-			      * words in the outer-most script/command. See
-			      * Tcl_EvalEx() and TclEvalObjEx() for the places
-			      * generating arguments for which this is true.
-			      */
-{
-#endif
-    Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
-    char buffer[TCL_UTF_MAX];
-#ifdef TCL_MEM_DEBUG
-#   define  MAX_VAR_CHARS 5
-#else
-#   define  MAX_VAR_CHARS 30
-#endif
-    char nameBuffer[MAX_VAR_CHARS+1];
-    char *varName, *index;
-    CONST char *p = NULL;	/* Initialized to avoid compiler warning. */
-    int length, code;
-#ifdef TCL_TIP280
-#define NUM_STATIC_POS 20
-    int isLiteral, maxNumCL, numCL, i, adjust;
-    int* clPosition = NULL;
-    Interp* iPtr = (Interp*) interp;
-    int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
-#endif
-
-    /*
-     * The only tricky thing about this procedure is that it attempts to
-     * avoid object creation and string copying whenever possible.  For
-     * example, if the value is just a nested command, then use the
-     * command's result object directly.
-     */
-
-    code = TCL_OK;
-    resultPtr = NULL;
-    Tcl_ResetResult(interp);
-#ifdef TCL_TIP280
-    /*
-     * For the handling of continuation lines in literals we first check if
-     * this is actually a literal. For if not we can forego the additional
-     * processing. Otherwise we pre-allocate a small table to store the
-     * locations of all continuation lines we find in this literal, if
-     * any. The table is extended if needed.
-     */
-
-    numCL     = 0;
-    maxNumCL  = 0;
-    isLiteral = 1;
-    for (i=0 ; i < count; i++) {
-	if ((tokenPtr[i].type != TCL_TOKEN_TEXT) &&
-	    (tokenPtr[i].type != TCL_TOKEN_BS)) {
-	    isLiteral = 0;
-	    break;
-	}
-    }
-
-    if (isLiteral) {
-	maxNumCL   = NUM_STATIC_POS;
-	clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
-    }
-    adjust = 0;
-#endif
-    for ( ; count > 0; count--, tokenPtr++) {
-	valuePtr = NULL;
-
-	/*
-	 * The switch statement below computes the next value to be
-	 * concat to the result, as either a range of text or an
-	 * object.
-	 */
-
-	switch (tokenPtr->type) {
-	    case TCL_TOKEN_TEXT:
-		p = tokenPtr->start;
-		length = tokenPtr->size;
-		break;
-
-	    case TCL_TOKEN_BS:
-		length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
-			(int *) NULL, buffer);
-		p = buffer;
-#ifdef TCL_TIP280
-		/*
-		 * If the backslash sequence we found is in a literal, and
-		 * represented a continuation line, we compute and store its
-		 * location (as char offset to the beginning of the _result_
-		 * script). We may have to extend the table of locations.
-		 *
-		 * Note that the continuation line information is relevant
-		 * even if the word we are processing is not a literal, as it
-		 * can affect nested commands. See the branch for
-		 * TCL_TOKEN_COMMAND below, where the adjustment we are
-		 * tracking here is taken into account. The good thing is that
-		 * we do not need a table of everything, just the number of
-		 * lines we have to add as correction.
-		 */
-
-		if ((length == 1) && (buffer[0] == ' ') &&
-		    (tokenPtr->start[1] == '\n')) {
-		    if (isLiteral) {
-			int clPos;
-			if (resultPtr == 0) {
-			    clPos = 0;
-			} else {
-			    Tcl_GetStringFromObj(resultPtr, &clPos);
-			}
-
-			if (numCL >= maxNumCL) {
-			    maxNumCL *= 2;
-			    clPosition = (int*) ckrealloc ((char*)clPosition,
-							   maxNumCL*sizeof(int));
-			}
-			clPosition[numCL] = clPos;
-			numCL ++;
-		    }
-		    adjust ++;
-		}
-#endif
-		break;
-
-	    case TCL_TOKEN_COMMAND: {
-		Interp *iPtr = (Interp *) interp;
-		iPtr->numLevels++;
-		code = TclInterpReady(interp);
-		if (code == TCL_OK) {
-#ifndef TCL_TIP280
-		    code = Tcl_EvalEx(interp,
-			    tokenPtr->start+1, tokenPtr->size-2, 0);
-#else
-		    /* TIP #280: Transfer line information to nested command */
-		    TclAdvanceContinuations (&line, &clNextOuter,
-					     tokenPtr->start - outerScript);
-		    code = EvalEx(interp,
-				  tokenPtr->start+1, tokenPtr->size-2, 0,
-				  line + adjust, clNextOuter, outerScript);
-
-		    /*
-		     * Restore flag reset by the nested eval for future
-		     * bracketed commands and their CmdFrame setup
-		     */
-		    if (inFile) {
-			iPtr->evalFlags |= TCL_EVAL_FILE;
-		    }
-#endif
-		}
-		iPtr->numLevels--;
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		valuePtr = Tcl_GetObjResult(interp);
-		break;
-	    }
-
-	    case TCL_TOKEN_VARIABLE:
-		if (tokenPtr->numComponents == 1) {
-		    indexPtr = NULL;
-		    index = NULL;
-		} else {
-#ifndef TCL_TIP280
-		    code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
-			    tokenPtr->numComponents - 1);
-#else
-		    /* TIP #280: Transfer line information to nested command */
-		    code = EvalTokensStandard(interp, tokenPtr+2,
-			    tokenPtr->numComponents - 1, line, NULL, NULL);
-#endif
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    indexPtr = Tcl_GetObjResult(interp);
-		    Tcl_IncrRefCount(indexPtr);
-		    index = Tcl_GetString(indexPtr);
-		}
-
-		/*
-		 * We have to make a copy of the variable name in order
-		 * to have a null-terminated string.  We can't make a
-		 * temporary modification to the script to null-terminate
-		 * the name, because a trace callback might potentially
-		 * reuse the script and be affected by the null character.
-		 */
-
-		if (tokenPtr[1].size <= MAX_VAR_CHARS) {
-		    varName = nameBuffer;
-		} else {
-		    varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
-		}
-		strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
-		varName[tokenPtr[1].size] = 0;
-		valuePtr = Tcl_GetVar2Ex(interp, varName, index,
-			TCL_LEAVE_ERR_MSG);
-		if (varName != nameBuffer) {
-		    ckfree(varName);
-		}
-		if (indexPtr != NULL) {
-		    Tcl_DecrRefCount(indexPtr);
-		}
-		if (valuePtr == NULL) {
-		    code = TCL_ERROR;
-		    goto done;
-		}
-		count -= tokenPtr->numComponents;
-		tokenPtr += tokenPtr->numComponents;
-		break;
-
-	    default:
-		panic("unexpected token type in Tcl_EvalTokensStandard");
-	}
-
-	/*
-	 * If valuePtr isn't NULL, the next piece of text comes from that
-	 * object; otherwise, take length bytes starting at p.
-	 */
-
-	if (resultPtr == NULL) {
-	    if (valuePtr != NULL) {
-		resultPtr = valuePtr;
-	    } else {
-		resultPtr = Tcl_NewStringObj(p, length);
-	    }
-	    Tcl_IncrRefCount(resultPtr);
-	} else {
-	    if (Tcl_IsShared(resultPtr)) {
-		Tcl_DecrRefCount(resultPtr);
-		resultPtr = Tcl_DuplicateObj(resultPtr);
-		Tcl_IncrRefCount(resultPtr);
-	    }
-	    if (valuePtr != NULL) {
-		p = Tcl_GetStringFromObj(valuePtr, &length);
-	    }
-	    Tcl_AppendToObj(resultPtr, p, length);
-	}
-    }
-    if (resultPtr != NULL) {
-	Tcl_SetObjResult(interp, resultPtr);
-#ifdef TCL_TIP280
-	/*
-	 * If the code found continuation lines (which implies that this word
-	 * is a literal), then we store the accumulated table of locations in
-	 * the thread-global data structure for the bytecode compiler to find
-	 * later, assuming that the literal is a script which will be
-	 * compiled.
-	 */
-
-	if (numCL) {
-	    TclContinuationsEnter(resultPtr, numCL, clPosition);
-	}
-
-	/*
-	 * Release the temp table we used to collect the locations of
-	 * continuation lines, if any.
-	 */
-
-	if (maxNumCL) {
-	    ckfree ((char*) clPosition);
-	}
-#endif
-    } else {
-	code = TCL_ERROR;
-    }
-
-    done:
-    if (resultPtr != NULL) {
-	Tcl_DecrRefCount(resultPtr);
-    }
-    return code;
+    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
+			  NULL, NULL);
 }
 
 /*
@@ -3836,67 +3970,62 @@ EvalTokensStandard(interp, tokenPtr, count, line, clNextOuter, outerScript)
  *
  * Tcl_EvalTokens --
  *
- *	Given an array of tokens parsed from a Tcl command (e.g., the
- *	tokens that make up a word or the index for an array variable)
- *	this procedure evaluates the tokens and concatenates their
- *	values to form a single result value.
+ *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
+ *	that make up a word or the index for an array variable) this function
+ *	evaluates the tokens and concatenates their values to form a single
+ *	result value.
  *
  * Results:
- *	The return value is a pointer to a newly allocated Tcl_Obj
- *	containing the value of the array of tokens.  The reference
- *	count of the returned object has been incremented.  If an error
- *	occurs in evaluating the tokens then a NULL value is returned
- *	and an error message is left in interp's result.
+ *	The return value is a pointer to a newly allocated Tcl_Obj containing
+ *	the value of the array of tokens. The reference count of the returned
+ *	object has been incremented. If an error occurs in evaluating the
+ *	tokens then a NULL value is returned and an error message is left in
+ *	interp's result.
  *
  * Side effects:
  *	A new object is allocated to hold the result.
  *
  *----------------------------------------------------------------------
  *
- * This uses a non-standard return convention; its use is now deprecated.
- * It is a wrapper for the new function Tcl_EvalTokensStandard, and is not 
- * used in the core any longer. It is only kept for backward compatibility.
+ * This uses a non-standard return convention; its use is now deprecated. It
+ * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
+ * in the core any longer. It is only kept for backward compatibility.
  */
 
 Tcl_Obj *
-Tcl_EvalTokens(interp, tokenPtr, count)
-    Tcl_Interp *interp;		/* Interpreter in which to lookup
-				 * variables, execute nested commands,
-				 * and report errors. */
-    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
-				 * to evaluate and concatenate. */
-    int count;			/* Number of tokens to consider at tokenPtr.
+Tcl_EvalTokens(
+    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
+				 * execute nested commands, and report
+				 * errors. */
+    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
+				 * evaluate and concatenate. */
+    int count)			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
 {
-    int code;
     Tcl_Obj *resPtr;
-    
-    code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
-    if (code == TCL_OK) {
-	resPtr = Tcl_GetObjResult(interp);
-	Tcl_IncrRefCount(resPtr);
-	Tcl_ResetResult(interp);
-	return resPtr;
-    } else {
+
+    if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
 	return NULL;
     }
+    resPtr = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(resPtr);
+    Tcl_ResetResult(interp);
+    return resPtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalEx, EvalEx --
+ * Tcl_EvalEx, TclEvalEx --
  *
- *	This procedure evaluates a Tcl script without using the compiler
- *	or byte-code interpreter.  It just parses the script, creates
- *	values for each word of each command, then calls EvalObjv
- *	to execute each command.
+ *	This function evaluates a Tcl script without using the compiler or
+ *	byte-code interpreter. It just parses the script, creates values for
+ *	each word of each command, then calls EvalObjv to execute each
+ *	command.
  *
  * Results:
- *	The return value is a standard Tcl completion code such as
- *	TCL_OK or TCL_ERROR.  A result or error message is left in
- *	interp's result.
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR. A result or error message is left in interp's result.
  *
  * Side effects:
  *	Depends on the script.
@@ -3906,38 +4035,35 @@ Tcl_EvalTokens(interp, tokenPtr, count)
  */
 
 int
-Tcl_EvalEx(interp, script, numBytes, flags)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate the
-				 * script.  Also used for error reporting. */
-    CONST char *script;		/* First character of script to evaluate. */
-    int numBytes;		/* Number of bytes in script.  If < 0, the
+Tcl_EvalEx(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * script. Also used for error reporting. */
+    const char *script,		/* First character of script to evaluate. */
+    int numBytes,		/* Number of bytes in script. If < 0, the
 				 * script consists of all bytes up to the
 				 * first null character. */
-    int flags;			/* Collection of OR-ed bits that control
-				 * the evaluation of the script.  Only
-				 * TCL_EVAL_GLOBAL is currently
-				 * supported. */
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
+				 * TCL_EVAL_GLOBAL is currently supported. */
 {
-#ifdef TCL_TIP280
-  return EvalEx (interp, script, numBytes, flags, 1, NULL, script);
+  return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
 }
 
-static int
-EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate the
-				 * script.  Also used for error reporting. */
-    CONST char *script;		/* First character of script to evaluate. */
-    int numBytes;		/* Number of bytes in script.  If < 0, the
+int
+TclEvalEx(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
+				 * script. Also used for error reporting. */
+    const char *script,		/* First character of script to evaluate. */
+    int numBytes,		/* Number of bytes in script. If < 0, the
 				 * script consists of all bytes up to the
-				 * first null character. */
-    int flags;			/* Collection of OR-ed bits that control
-				 * the evaluation of the script.  Only
-				 * TCL_EVAL_GLOBAL is currently
-				 * supported. */
-    int line;                   /* The line the script starts on. */
-    int*  clNextOuter;       /* Information about an outer context for */
-    CONST char* outerScript; /* continuation line data. This is set only in
-			      * EvalTokensStandard(), to properly handle
+				 * first NUL character. */
+    int flags,			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Only
+				 * TCL_EVAL_GLOBAL is currently supported. */
+    int line,			/* The line the script starts on. */
+    int*  clNextOuter,       /* Information about an outer context for */
+    CONST char* outerScript) /* continuation line data. This is set only in
+			      * TclSubstTokens(), to properly handle
 			      * [...]-nested commands. The 'outerScript'
 			      * refers to the most-outer script containing the
 			      * embedded command, which is refered to by
@@ -3953,31 +4079,32 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 			      * generating arguments for which this is true.
 			      */
 {
-#endif
     Interp *iPtr = (Interp *) interp;
-    CONST char *p, *next;
-    Tcl_Parse parse;
-#define NUM_STATIC_OBJS 20
-    Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
+    const char *p, *next;
+    const unsigned int minObjs = 20;
+    Tcl_Obj **objv, **objvSpace;
+    int *expand, *lines, *lineSpace;
     Tcl_Token *tokenPtr;
-    int code = TCL_OK;
-    int i, commandLength, bytesLeft, nested;
-    CallFrame *savedVarFramePtr;   /* Saves old copy of iPtr->varFramePtr
-				    * in case TCL_EVAL_GLOBAL was set. */
+    int commandLength, bytesLeft, expandRequested, code = TCL_OK;
+    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
+				 * TCL_EVAL_GLOBAL was set. */
     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-    
-    /*
-     * The variables below keep track of how much state has been
-     * allocated while evaluating the script, so that it can be freed
-     * properly if an error occurs.
-     */
-
-    int gotParse = 0, objectsUsed = 0;
-
-#ifdef TCL_TIP280
-    /* TIP #280 Structures for tracking of command locations. */
-    CmdFrame eeFrame;
-
+    int gotParse = 0;
+    unsigned int i, objectsUsed = 0;
+				/* These variables keep track of how much
+				 * state has been allocated while evaluating
+				 * the script, so that it can be freed
+				 * properly if an error occurs. */
+    Tcl_Parse *parsePtr = (Tcl_Parse *)
+	    TclStackAlloc(interp, sizeof(Tcl_Parse));
+    CmdFrame *eeFramePtr = (CmdFrame *)
+	    TclStackAlloc(interp, sizeof(CmdFrame));
+    Tcl_Obj **stackObjArray = (Tcl_Obj **)
+	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
+    int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
+    int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
+				/* TIP #280 Structures for tracking of command
+				 * locations. */
     /*
      * Pointer for the tracking of invisible continuation lines. Initialized
      * only if the caller gave us a table of locations to track, via
@@ -3995,7 +4122,6 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 	    clNext = &iPtr->scriptCLLocPtr->loc[0];
 	}
     }
-#endif
 
     if (numBytes < 0) {
 	numBytes = strlen(script);
@@ -4004,112 +4130,102 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 
     savedVarFramePtr = iPtr->varFramePtr;
     if (flags & TCL_EVAL_GLOBAL) {
-	iPtr->varFramePtr = NULL;
+	iPtr->varFramePtr = iPtr->rootFramePtr;
     }
 
     /*
-     * Each iteration through the following loop parses the next
-     * command from the script and then executes it.
+     * Each iteration through the following loop parses the next command from
+     * the script and then executes it.
      */
 
-    objv = staticObjArray;
+    objv = objvSpace = stackObjArray;
+    lines = lineSpace = linesStack;
+    expand = expandStack;
     p = script;
     bytesLeft = numBytes;
-    if (iPtr->evalFlags & TCL_BRACKET_TERM) {
-	nested = 1;
-    } else {
-	nested = 0;
-    }
 
-#ifdef TCL_TIP280
-    /* TIP #280 Initialize tracking. Do not push on the frame stack yet. */
     /*
-     * We may cont. counting based on a specific context (CTX), or open a new
-     * context, either for a sourced script, or 'eval'. For sourced files we
-     * always have a path object, even if nothing was specified in the interp
-     * itself. That makes code using it simpler as NULL checks can be left
-     * out. Sourced file without path in the 'scriptFile' is possible during
-     * Tcl initialization.
+     * TIP #280 Initialize tracking. Do not push on the frame stack yet.
+     *
+     * We may continue counting based on a specific context (CTX), or open a
+     * new context, either for a sourced script, or 'eval'. For sourced files
+     * we always have a path object, even if nothing was specified in the
+     * interp itself. That makes code using it simpler as NULL checks can be
+     * left out. Sourced file without path in the 'scriptFile' is possible
+     * during Tcl initialization.
      */
 
     if (iPtr->evalFlags & TCL_EVAL_CTX) {
-        /* Path information comes out of the context. */
+	/*
+	 * Path information comes out of the context.
+	 */
 
-        eeFrame.type           = TCL_LOCATION_SOURCE;
-	eeFrame.data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
-	Tcl_IncrRefCount (eeFrame.data.eval.path);
+	eeFramePtr->type = TCL_LOCATION_SOURCE;
+	eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
+	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
     } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
-	/* Set up for a sourced file */
+	/*
+	 * Set up for a sourced file.
+	 */
 
-        eeFrame.type = TCL_LOCATION_SOURCE;
+	eeFramePtr->type = TCL_LOCATION_SOURCE;
 
 	if (iPtr->scriptFile) {
-	    /* Normalization here, to have the correct pwd. Should have
+	    /*
+	     * Normalization here, to have the correct pwd. Should have
 	     * negligible impact on performance, as the norm should have been
 	     * done already by the 'source' invoking us, and it caches the
-	     * result
+	     * result.
 	     */
 
-	    Tcl_Obj* norm = Tcl_FSGetNormalizedPath (interp, iPtr->scriptFile);
-	    if (!norm) {
-		/* Error message in the interp result */
-		return TCL_ERROR;
+	    Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
+
+	    if (norm == NULL) {
+		/*
+		 * Error message in the interp result.
+		 */
+		code = TCL_ERROR;
+		goto error;
 	    }
-	    eeFrame.data.eval.path = norm;
+	    eeFramePtr->data.eval.path = norm;
 	} else {
-	    eeFrame.data.eval.path = Tcl_NewStringObj ("",-1);
+	    TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
 	}
-	Tcl_IncrRefCount (eeFrame.data.eval.path);
+	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
     } else {
-	/* Set up for plain eval */
+	/*
+	 * Set up for plain eval.
+	 */
 
-	eeFrame.type           = TCL_LOCATION_EVAL;
-	eeFrame.data.eval.path = NULL;
+	eeFramePtr->type = TCL_LOCATION_EVAL;
+	eeFramePtr->data.eval.path = NULL;
     }
 
-    eeFrame.level     = (iPtr->cmdFramePtr == NULL
-			 ? 1
-			 : iPtr->cmdFramePtr->level + 1);
-    eeFrame.framePtr  = iPtr->framePtr;
-    eeFrame.nextPtr   = iPtr->cmdFramePtr;
-    eeFrame.nline     = 0;
-    eeFrame.line      = NULL;
-#endif
+    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
+    eeFramePtr->framePtr = iPtr->framePtr;
+    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
+    eeFramePtr->nline = 0;
+    eeFramePtr->line = NULL;
 
     iPtr->evalFlags = 0;
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
-	        != TCL_OK) {
+	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
 	    code = TCL_ERROR;
 	    goto error;
 	}
-	gotParse = 1; 
-
-	if (nested && parse.term == (script + numBytes)) {
-	    /*
-	     * A nested script can only terminate in ']'. If
-	     * the parsing got terminated at the end of the script,
-	     * there was no closing ']'.  Report the syntax error.
-	     */
 
-	    code = TCL_ERROR;
-	    goto error;
-	}
-
-#ifdef TCL_TIP280
 	/*
 	 * TIP #280 Track lines. The parser may have skipped text till it
-	 * found the command we are now at. We have count the lines in this
+	 * found the command we are now at. We have to count the lines in this
 	 * block, and do not forget invisible continuation lines.
 	 */
 
-	TclAdvanceLines         (&line, p, parse.commandStart);
+	TclAdvanceLines(&line, p, parsePtr->commandStart);
 	TclAdvanceContinuations (&line, &clNext,
-				 parse.commandStart - outerScript);
-#endif
+				 parsePtr->commandStart - outerScript);
 
-	if (parse.numWords > 0) {
-#ifdef TCL_TIP280
+	gotParse = 1;
+	if (parsePtr->numWords > 0) {
 	    /*
 	     * TIP #280. Track lines within the words of the current
 	     * command. We use a separate pointer into the table of
@@ -4117,77 +4233,138 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 	     * per-command parsing.
 	     */
 
-	    int         wordLine   = line;
-	    CONST char* wordStart  = parse.commandStart;
+	    int wordLine  = line;
+	    const char *wordStart = parsePtr->commandStart;
 	    int*        wordCLNext = clNext;
-#endif
 
 	    /*
 	     * Generate an array of objects for the words of the command.
 	     */
-    
-	    if (parse.numWords <= NUM_STATIC_OBJS) {
-		objv = staticObjArray;
-	    } else {
-		objv = (Tcl_Obj **) ckalloc((unsigned)
-		    (parse.numWords * sizeof (Tcl_Obj *)));
-	    }
 
-#ifdef TCL_TIP280
-	    eeFrame.nline = parse.numWords;
-	    eeFrame.line  = (int*) ckalloc((unsigned)
-		  (parse.numWords * sizeof (int)));
-#endif
+	    unsigned int objectsNeeded = 0;
+	    unsigned int numWords = parsePtr->numWords;
 
-	    for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
-		 objectsUsed < parse.numWords;
-		 objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
-#ifndef TCL_TIP280
-		code = Tcl_EvalTokensStandard(interp, tokenPtr+1, 
-		            tokenPtr->numComponents);
-#else
-	        /*
-		 * TIP #280. Track lines to current word. Save the
-		 * information on a per-word basis, signaling dynamic words as
-		 * needed. Make the information available to the recursively
-		 * called evaluator as well, including the type of context
-		 * (source vs. eval).
+	    if (numWords > minObjs) {
+		expand = (int *) ckalloc(numWords * sizeof(int));
+		objvSpace = (Tcl_Obj **)
+			ckalloc(numWords * sizeof(Tcl_Obj *));
+		lineSpace = (int *) ckalloc(numWords * sizeof(int));
+	    }
+	    expandRequested = 0;
+	    objv = objvSpace;
+	    lines = lineSpace;
+
+	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
+		    objectsUsed < numWords;
+		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
+		/*
+		 * TIP #280. Track lines to current word. Save the information
+		 * on a per-word basis, signaling dynamic words as needed.
+		 * Make the information available to the recursively called
+		 * evaluator as well, including the type of context (source
+		 * vs. eval).
 		 */
 
-		TclAdvanceLines         (&wordLine, wordStart, tokenPtr->start);
+		TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
 		TclAdvanceContinuations (&wordLine, &wordCLNext,
 					 tokenPtr->start - outerScript);
 		wordStart = tokenPtr->start;
 
-		eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr)
-					      ? wordLine
-					      : -1);
+		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
+			? wordLine : -1;
 
-	        if (eeFrame.type == TCL_LOCATION_SOURCE) {
+		if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
 		    iPtr->evalFlags |= TCL_EVAL_FILE;
 		}
 
-		code = EvalTokensStandard(interp, tokenPtr+1, 
-		            tokenPtr->numComponents, wordLine,
-			    wordCLNext, outerScript);
+		code = TclSubstTokens(interp, tokenPtr+1,
+			tokenPtr->numComponents, NULL, wordLine,
+		        wordCLNext, outerScript);
 
 		iPtr->evalFlags = 0;
-#endif
 
-		if (code == TCL_OK) {
-		    objv[objectsUsed] = Tcl_GetObjResult(interp);
-		    Tcl_IncrRefCount(objv[objectsUsed]);
-#ifdef TCL_TIP280
-		    if (wordCLNext) {
-			TclContinuationsEnterDerived (objv[objectsUsed],
-				      wordStart - outerScript, wordCLNext);
+		if (code != TCL_OK) {
+		    goto error;
+		}
+		objv[objectsUsed] = Tcl_GetObjResult(interp);
+		Tcl_IncrRefCount(objv[objectsUsed]);
+		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		    int numElements;
+
+		    code = TclListObjLength(interp, objv[objectsUsed],
+			    &numElements);
+		    if (code == TCL_ERROR) {
+			/*
+			 * Attempt to expand a non-list.
+			 */
+
+			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+				"\n    (expanding word %d)", objectsUsed));
+			Tcl_DecrRefCount(objv[objectsUsed]);
+			goto error;
 		    }
-#endif
+		    expandRequested = 1;
+		    expand[objectsUsed] = 1;
+
+		    objectsNeeded += (numElements ? numElements : 1);
 		} else {
-		    goto error;
+		    expand[objectsUsed] = 0;
+		    objectsNeeded++;
+		}
+
+		if (wordCLNext) {
+		    TclContinuationsEnterDerived (objv[objectsUsed],
+				  wordStart - outerScript, wordCLNext);
+		}
+	    } /* for loop */
+	    if (expandRequested) {
+		/*
+		 * Some word expansion was requested. Check for objv resize.
+		 */
+
+		Tcl_Obj **copy = objvSpace;
+		int *lcopy = lineSpace;
+		int wordIdx = numWords;
+		int objIdx = objectsNeeded - 1;
+
+		if ((numWords > minObjs) || (objectsNeeded >  minObjs)) {
+		    objv = objvSpace = (Tcl_Obj **)
+			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
+		    lines = lineSpace = (int *)
+			    ckalloc(objectsNeeded * sizeof(int));
+		}
+
+		objectsUsed = 0;
+		while (wordIdx--) {
+		    if (expand[wordIdx]) {
+			int numElements;
+			Tcl_Obj **elements, *temp = copy[wordIdx];
+
+			Tcl_ListObjGetElements(NULL, temp, &numElements,
+				&elements);
+			objectsUsed += numElements;
+			while (numElements--) {
+			    lines[objIdx] = -1;
+			    objv[objIdx--] = elements[numElements];
+			    Tcl_IncrRefCount(elements[numElements]);
+			}
+			Tcl_DecrRefCount(temp);
+		    } else {
+			lines[objIdx] = lcopy[wordIdx];
+			objv[objIdx--] = copy[wordIdx];
+			objectsUsed++;
+		    }
+		}
+		objv += objIdx+1;
+
+		if (copy != stackObjArray) {
+		    ckfree((char *) copy);
+		}
+		if (lcopy != linesStack) {
+		    ckfree((char *) lcopy);
 		}
 	    }
-    
+
 	    /*
 	     * Execute the command and free the objects for its words.
 	     *
@@ -4198,29 +4375,28 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 	     * have been executed.
 	     */
 
-#ifdef TCL_TIP280
-	    eeFrame.cmd.str.cmd = parse.commandStart;
-	    eeFrame.cmd.str.len = parse.commandSize;
+	    eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
+	    eeFramePtr->cmd.str.len = parsePtr->commandSize;
 
-	    if (parse.term == parse.commandStart + parse.commandSize - 1) {
-		eeFrame.cmd.str.len --;
+	    if (parsePtr->term ==
+		    parsePtr->commandStart + parsePtr->commandSize - 1) {
+		eeFramePtr->cmd.str.len--;
 	    }
 
-	    TclArgumentEnter (interp, objv, objectsUsed, &eeFrame);
-	    iPtr->cmdFramePtr = &eeFrame;
-#endif
-	    iPtr->numLevels++;    
-	    code = TclEvalObjvInternal(interp, objectsUsed, objv, 
-	            parse.commandStart, parse.commandSize, 0);
+	    eeFramePtr->nline = objectsUsed;
+	    eeFramePtr->line = lines;
+
+	    TclArgumentEnter (interp, objv, objectsUsed, eeFramePtr);
+	    iPtr->cmdFramePtr = eeFramePtr;
+	    iPtr->numLevels++;
+	    code = TclEvalObjvInternal(interp, objectsUsed, objv,
+		    parsePtr->commandStart, parsePtr->commandSize, 0);
 	    iPtr->numLevels--;
-#ifdef TCL_TIP280
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 	    TclArgumentRelease (interp, objv, objectsUsed);
 
-	    ckfree ((char*) eeFrame.line);
-	    eeFrame.line  = NULL;
-	    eeFrame.nline = 0;
-#endif
+	    eeFramePtr->line = NULL;
+	    eeFramePtr->nline = 0;
 
 	    if (code != TCL_OK) {
 		goto error;
@@ -4229,9 +4405,21 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 		Tcl_DecrRefCount(objv[i]);
 	    }
 	    objectsUsed = 0;
-	    if (objv != staticObjArray) {
-		ckfree((char *) objv);
-		objv = staticObjArray;
+	    if (objvSpace != stackObjArray) {
+		ckfree((char *) objvSpace);
+		objvSpace = stackObjArray;
+		ckfree((char *) lineSpace);
+		lineSpace = linesStack;
+	    }
+
+	    /*
+	     * Free expand separately since objvSpace could have been
+	     * reallocated above.
+	     */
+
+	    if (expand != expandStack) {
+		ckfree((char *) expand);
+		expand = expandStack;
 	    }
 	}
 
@@ -4242,214 +4430,91 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
 	 * executed command.
 	 */
 
-	next = parse.commandStart + parse.commandSize;
+	next = parsePtr->commandStart + parsePtr->commandSize;
 	bytesLeft -= next - p;
 	p = next;
-#ifdef TCL_TIP280
-	TclAdvanceLines (&line, parse.commandStart, p);
-#endif
-	Tcl_FreeParse(&parse);
+	TclAdvanceLines(&line, parsePtr->commandStart, p);
+	Tcl_FreeParse(parsePtr);
 	gotParse = 0;
-	if (nested && (*parse.term == ']')) {
-	    /*
-	     * We get here in the special case where the TCL_BRACKET_TERM
-	     * flag was set in the interpreter and the latest parsed command
-	     * was terminated by the matching close-bracket we seek.
-	     * Return immediately.
-	     */
-
-	    iPtr->termOffset = (p - 1) - script;
-	    iPtr->varFramePtr = savedVarFramePtr;
-#ifndef TCL_TIP280
-	    return TCL_OK;
-#else
-	    code = TCL_OK;
-	    goto cleanup_return;
-#endif
-	}
     } while (bytesLeft > 0);
-
-    if (nested) {
-	/*
-	 * This nested script did not terminate in ']', it is an error.
-	 */
-	
-	code = TCL_ERROR;
-	goto error;
-    }
-    
-    iPtr->termOffset = p - script;
     iPtr->varFramePtr = savedVarFramePtr;
-#ifndef TCL_TIP280
-    return TCL_OK;
-#else
     code = TCL_OK;
     goto cleanup_return;
-#endif
 
-    error:
+  error:
     /*
-     * Generate various pieces of error information, such as the line
-     * number where the error occurred and information to add to the
-     * errorInfo variable.  Then free resources that had been allocated
-     * to the command.
+     * Generate and log various pieces of error information.
      */
 
     if (iPtr->numLevels == 0) {
 	if (code == TCL_RETURN) {
 	    code = TclUpdateReturnInfo(iPtr);
 	}
-	if ((code != TCL_OK) && (code != TCL_ERROR) 
-		&& !allowExceptions) {
+	if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) {
 	    ProcessUnexpectedResult(interp, code);
 	    code = TCL_ERROR;
 	}
     }
-    if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { 
-	commandLength = parse.commandSize;
-	if (parse.term == parse.commandStart + commandLength - 1) {
+    if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	commandLength = parsePtr->commandSize;
+	if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
 	    /*
 	     * The terminator character (such as ; or ]) of the command where
 	     * the error occurred is the last character in the parsed command.
 	     * Reduce the length by one so that the error message doesn't
 	     * include the terminator character.
 	     */
-	    
+
 	    commandLength -= 1;
 	}
-	Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+		commandLength);
     }
-    
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+    /*
+     * Then free resources that had been allocated to the command.
+     */
+
     for (i = 0; i < objectsUsed; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
     if (gotParse) {
-	Tcl_FreeParse(&parse);
+	Tcl_FreeParse(parsePtr);
     }
-    if (objv != staticObjArray) {
-	ckfree((char *) objv);
+    if (objvSpace != stackObjArray) {
+	ckfree((char *) objvSpace);
+	ckfree((char *) lineSpace);
     }
-    iPtr->varFramePtr = savedVarFramePtr;
-
-    /*
-     * All that's left to do before returning is to set iPtr->termOffset
-     * to point past the end of the script we just evaluated.
-     */
-
-    next = parse.commandStart + parse.commandSize;
-    bytesLeft -= next - p;
-    p = next;
-
-    if (!nested) {
-	iPtr->termOffset = p - script;
-#ifndef TCL_TIP280
-	return code;
-#else
-	goto cleanup_return;
-#endif
+    if (expand != expandStack) {
+	ckfree((char *) expand);
     }
+    iPtr->varFramePtr = savedVarFramePtr;
 
+ cleanup_return:
     /*
-     * When we are nested (the TCL_BRACKET_TERM flag was set in the
-     * interpreter), we must find the matching close-bracket to
-     * end the script we are evaluating.
-     *
-     * When our return code is TCL_CONTINUE or TCL_RETURN, we want
-     * to correctly set iPtr->termOffset to point to that matching
-     * close-bracket so our caller can move to the part of the
-     * string beyond the script we were asked to evaluate.
-     * So we try to parse past the rest of the commands.
+     * TIP #280. Release the local CmdFrame, and its contents.
      */
 
-    next = NULL;
-    while (bytesLeft && (*parse.term != ']')) {
-	if (TCL_OK != Tcl_ParseCommand(NULL, p, bytesLeft, 1, &parse)) {
-	    /*
-	     * Syntax error.  Set the termOffset to the beginning of
-	     * the last command parsed.
-	     */
-
-	    if (next == NULL) {
-	        iPtr->termOffset = (parse.commandStart - 1) - script;
-	    } else {
-	        iPtr->termOffset = (next - 1) - script;
-	    }
-#ifndef TCL_TIP280
-	    return code;
-#else
-	    goto cleanup_return;
-#endif
-	}
-	next = parse.commandStart + parse.commandSize;
-	bytesLeft -= next - p;
-	p = next;
-	next = parse.commandStart;
-	Tcl_FreeParse(&parse);
-    }
-
-    if (bytesLeft) {
-	/* 
-	 * parse.term points to the close-bracket.
-	 */
-
-	iPtr->termOffset = parse.term - script;
-    } else if (parse.term == script + numBytes) {
-	/*
-	 * There was no close-bracket.  Syntax error.
-	 */
-
-	iPtr->termOffset = parse.term - script;
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("missing close-bracket", -1));
-#ifndef TCL_TIP280
-	return TCL_ERROR;
-#else
-	code = TCL_ERROR;
-	goto cleanup_return;
-#endif
-    } else if (*parse.term != ']') {
-	/*
-	 * There was no close-bracket.  Syntax error.
-	 */
-
-	iPtr->termOffset = (parse.term + 1) - script;
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("missing close-bracket", -1));
-#ifndef TCL_TIP280
-	return TCL_ERROR;
-#else
-	code = TCL_ERROR;
-	goto cleanup_return;
-#endif
-    } else {
-	/* 
-	 * parse.term points to the close-bracket.
-	 */
-	iPtr->termOffset = parse.term - script;
+    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
+	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
     }
+    TclStackFree(interp, linesStack);
+    TclStackFree(interp, expandStack);
+    TclStackFree(interp, stackObjArray);
+    TclStackFree(interp, eeFramePtr);
+    TclStackFree(interp, parsePtr);
 
-#ifdef TCL_TIP280
- cleanup_return:
-    /* TIP #280. Release the local CmdFrame, and its contents. */
-
-    if (eeFrame.line != NULL) {
-        ckfree ((char*) eeFrame.line);
-    }
-    if (eeFrame.type == TCL_LOCATION_SOURCE) {
-        Tcl_DecrRefCount (eeFrame.data.eval.path);
-    }
-#endif
     return code;
 }
 
-#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  *
  * TclAdvanceLines --
  *
- *	This procedure is a helper which counts the number of lines
- *	in a block of text and advances an external counter.
+ *	This function is a helper which counts the number of lines in a block
+ *	of text and advances an external counter.
  *
  * Results:
  *	None.
@@ -4462,15 +4527,16 @@ EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
  */
 
 void
-TclAdvanceLines (line,start,end)
-     int*        line;
-     CONST char* start;
-     CONST char* end;
+TclAdvanceLines(
+    int *line,
+    const char *start,
+    const char *end)
 {
-    CONST char* p;
+    register const char *p;
+
     for (p = start; p < end; p++) {
-        if (*p == '\n') {
-	  (*line) ++;
+	if (*p == '\n') {
+	    (*line)++;
 	}
     }
 }
@@ -4504,11 +4570,11 @@ TclAdvanceContinuations (line,clNextPtrPtr,loc)
     /*
      * Track the invisible continuation lines embedded in a script, if
      * any. Here they are just spaces (already). They were removed by
-     * EvalTokensStandard() via TclParseBackslash().
+     * TclSubstTokens() via TclParseBackslash().
      *
-     * *clNextPtrPtr             <=> We have continuation lines to track.
-     * **clNextPtrPtr >= 0       <=> We are not beyond the last possible location.
-     * loc >= **clNextPtrPtr     <=> We stepped beyond the current cont. line.
+     * *clNextPtrPtr         <=> We have continuation lines to track.
+     * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
+     * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
      */
 
     while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {
@@ -4647,7 +4713,7 @@ TclArgumentRelease(interp,objv,objc)
  *
  *	This procedure is a helper for the TIP #280 uplevel extension.
  *	It enters location references for the literal arguments of commands
- *	in bytecode about to be executed. Only the first entry has the actual
+ *	in bytecode about to be invoked. Only the first entry has the actual
  *	data, further entries simply count the usage up.
  *
  * Results:
@@ -4661,7 +4727,7 @@ TclArgumentRelease(interp,objv,objc)
  */
 
 void
-TclArgumentBCEnter(interp, objv, objc, codePtr, cfPtr, pc)
+TclArgumentBCEnter(interp,objv,objc,codePtr,cfPtr,pc)
      Tcl_Interp* interp;
      Tcl_Obj*    objv[];
      int         objc;
@@ -4674,12 +4740,12 @@ TclArgumentBCEnter(interp, objv, objc, codePtr, cfPtr, pc)
 
     if (hePtr) {
 	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
-	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
+	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
 
 	if (hePtr) {
-	    int  word;
-	    int  cmd  = (int) Tcl_GetHashValue(hePtr);
+	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
 	    ECL* ePtr = &eclPtr->loc[cmd];
+	    int word;
 
 	    /*
 	     * A few truths ...
@@ -4691,6 +4757,10 @@ TclArgumentBCEnter(interp, objv, objc, codePtr, cfPtr, pc)
 	     * have to save them at compile time.
 	     */
 
+	    if (ePtr->nline != objc) {
+		Tcl_Panic ("TIP 280 data structure inconsistency");
+	    }
+
 	    for (word = 1; word < objc; word++) {
 		if (ePtr->line[word] >= 0) {
 		    int isnew;
@@ -4747,7 +4817,7 @@ TclArgumentBCEnter(interp, objv, objc, codePtr, cfPtr, pc)
  */
 
 void
-TclArgumentBCRelease(interp, objv, objc, codePtr, pc)
+TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
      Tcl_Interp* interp;
      Tcl_Obj*    objv[];
      int         objc;
@@ -4759,10 +4829,10 @@ TclArgumentBCRelease(interp, objv, objc, codePtr, pc)
 
     if (hePtr) {
 	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
-	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
+	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
 
 	if (hePtr) {
-	    int  cmd  = (int) Tcl_GetHashValue(hePtr);
+	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
 	    ECL* ePtr = &eclPtr->loc[cmd];
 	    int word;
 
@@ -4776,7 +4846,7 @@ TclArgumentBCRelease(interp, objv, objc, codePtr, pc)
 						    (char *) objv[word]);
 		    if (hPtr) {
 			CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
- 
+
 			if (cfwPtr->prevPtr) {
 			    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
 			} else {
@@ -4821,16 +4891,16 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
     CmdFrame*      framePtr;
 
     /*
-     * An object which either has no string rep guaranteed to have been
-     * generated dynamically: bail out, this cannot have a usable absolute
-     * location. _Do not touch_ the information the set up by the caller. It
-     * knows better than us.
+     * An object which either has no string rep or else is a canonical list is
+     * guaranteed to have been generated dynamically: bail out, this cannot
+     * have a usable absolute location. _Do not touch_ the information the set
+     * up by the caller. It knows better than us.
      */
 
-    if (!obj->bytes) {
+    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
 	return;
     }
-    
+
     /*
      * First look for location information recorded in the argument
      * stack. That is nearest.
@@ -4850,36 +4920,34 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
      */
 
     hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj);
+
     if (hPtr) {
 	CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
 
 	framePtr = cfwPtr->framePtr;
-	framePtr->data.tebc.pc = (char*) ((ByteCode*)
-		  framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc;
+	framePtr->data.tebc.pc = (char *) (((ByteCode*)
+		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
 	*cfPtrPtr = cfwPtr->framePtr;
 	*wordPtr  = cfwPtr->word;
 	return;
     }
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_Eval --
  *
- *	Execute a Tcl command in a string.  This procedure executes the
- *	script directly, rather than compiling it to bytecodes.  Before
- *	the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was
- *	the main procedure used for executing Tcl commands, but nowadays
- *	it isn't used much.
+ *	Execute a Tcl command in a string. This function executes the script
+ *	directly, rather than compiling it to bytecodes. Before the arrival of
+ *	the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used
+ *	for executing Tcl commands, but nowadays it isn't used much.
  *
  * Results:
- *	The return value is one of the return codes defined in tcl.h
- *	(such as TCL_OK), and interp's result contains a value
- *	to supplement the return code. The value of the result
- *	will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
- *	you must copy it or lose it!
+ *	The return value is one of the return codes defined in tcl.h (such as
+ *	TCL_OK), and interp's result contains a value to supplement the return
+ *	code. The value of the result will persist only until the next call to
+ *	Tcl_Eval or Tcl_EvalObj: you must copy it or lose it!
  *
  * Side effects:
  *	Can be almost arbitrary, depending on the commands in the script.
@@ -4888,21 +4956,20 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
  */
 
 int
-Tcl_Eval(interp, string)
-    Tcl_Interp *interp;		/* Token for command interpreter (returned
-				 * by previous call to Tcl_CreateInterp). */
-    CONST char *string;		/* Pointer to TCL command to execute. */
+Tcl_Eval(
+    Tcl_Interp *interp,		/* Token for command interpreter (returned by
+				 * previous call to Tcl_CreateInterp). */
+    const char *script)		/* Pointer to TCL command to execute. */
 {
-    int code = Tcl_EvalEx(interp, string, -1, 0);
+    int code = Tcl_EvalEx(interp, script, -1, 0);
 
     /*
-     * For backwards compatibility with old C code that predates the
-     * object system in Tcl 8.0, we have to mirror the object result
-     * back into the string result (some callers may expect it there).
+     * For backwards compatibility with old C code that predates the object
+     * system in Tcl 8.0, we have to mirror the object result back into the
+     * string result (some callers may expect it there).
      */
 
-    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	    TCL_VOLATILE);
+    (void) Tcl_GetStringResult(interp);
     return code;
 }
 
@@ -4924,17 +4991,17 @@ Tcl_Eval(interp, string)
  */
 
 int
-Tcl_EvalObj(interp, objPtr)
-    Tcl_Interp * interp;
-    Tcl_Obj * objPtr;
+Tcl_EvalObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
 {
     return Tcl_EvalObjEx(interp, objPtr, 0);
 }
 
 int
-Tcl_GlobalEvalObj(interp, objPtr)
-    Tcl_Interp * interp;
-    Tcl_Obj * objPtr;
+Tcl_GlobalEvalObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
 {
     return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
 }
@@ -4945,322 +5012,272 @@ Tcl_GlobalEvalObj(interp, objPtr)
  * Tcl_EvalObjEx, TclEvalObjEx --
  *
  *	Execute Tcl commands stored in a Tcl object. These commands are
- *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT
- *	is specified.
+ *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
+ *	specified.
  *
  * Results:
- *	The return value is one of the return codes defined in tcl.h
- *	(such as TCL_OK), and the interpreter's result contains a value
- *	to supplement the return code.
+ *	The return value is one of the return codes defined in tcl.h (such as
+ *	TCL_OK), and the interpreter's result contains a value to supplement
+ *	the return code.
  *
  * Side effects:
- *	The object is converted, if necessary, to a ByteCode object that
- *	holds the bytecode instructions for the commands. Executing the
- *	commands will almost certainly have side effects that depend
- *	on those commands.
- *
- *	Just as in Tcl_Eval, interp->termOffset is set to the offset of the
- *	last character executed in the objPtr's string.
+ *	The object is converted, if necessary, to a ByteCode object that holds
+ *	the bytecode instructions for the commands. Executing the commands
+ *	will almost certainly have side effects that depend on those commands.
  *
  * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_EvalObjEx(interp, objPtr, flags)
-    Tcl_Interp *interp;			/* Token for command interpreter
-					 * (returned by a previous call to
-					 * Tcl_CreateInterp). */
-    register Tcl_Obj *objPtr;		/* Pointer to object containing
-					 * commands to execute. */
-    int flags;				/* Collection of OR-ed bits that
-					 * control the evaluation of the
-					 * script.  Supported values are
-					 * TCL_EVAL_GLOBAL and
-					 * TCL_EVAL_DIRECT. */
+Tcl_EvalObjEx(
+    Tcl_Interp *interp,		/* Token for command interpreter (returned by
+				 * a previous call to Tcl_CreateInterp). */
+    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
+				 * execute. */
+    int flags)			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Supported values
+				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
 {
-#ifdef TCL_TIP280
-  return TclEvalObjEx (interp, objPtr, flags, NULL, 0);
+    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
 }
 
 int
-TclEvalObjEx(interp, objPtr, flags, invoker, word)
-    Tcl_Interp *interp;			/* Token for command interpreter
-					 * (returned by a previous call to
-					 * Tcl_CreateInterp). */
-    register Tcl_Obj *objPtr;		/* Pointer to object containing
-					 * commands to execute. */
-    int flags;				/* Collection of OR-ed bits that
-					 * control the evaluation of the
-					 * script.  Supported values are
-					 * TCL_EVAL_GLOBAL and
-					 * TCL_EVAL_DIRECT. */
-    CONST CmdFrame* invoker; /* Frame of the command doing the eval  */
-    int             word;    /* Index of the word which is in objPtr */
+TclEvalObjEx(
+    Tcl_Interp *interp,		/* Token for command interpreter (returned by
+				 * a previous call to Tcl_CreateInterp). */
+    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
+				 * execute. */
+    int flags,			/* Collection of OR-ed bits that control the
+				 * evaluation of the script. Supported values
+				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
+    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
+    int word)			/* Index of the word which is in objPtr. */
 {
-#endif
     register Interp *iPtr = (Interp *) interp;
     char *script;
     int numSrcBytes;
     int result;
-    CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
-					 * in case TCL_EVAL_GLOBAL was set. */
-    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
+				 * TCL_EVAL_GLOBAL was set. */
 
     Tcl_IncrRefCount(objPtr);
 
-    if ((iPtr->flags & USE_EVAL_DIRECT) || (flags & TCL_EVAL_DIRECT)) {
+    /* Pure List Optimization (no string representation). In this case, we can
+     * safely use Tcl_EvalObjv instead and get an appreciable improvement in
+     * execution speed. This is because it allows us to avoid a setFromAny
+     * step that would just pack everything into a string and back out again.
+     *
+     * This also preserves any associations between list elements and location
+     * information for such elements.
+     *
+     * This restriction has been relaxed a bit by storing in lists whether
+     * they are "canonical" or not (a canonical list being one that is either
+     * pure or that has its string rep derived by UpdateStringOfList from the
+     * internal rep).
+     */
+
+    if (TclListObjIsCanonical(objPtr)) {
+	/*
+	 * TIP #280 Structures for tracking lines. As we know that this is
+	 * dynamic execution we ignore the invoker, even if known.
+	 */
+
+	int nelements;
+	Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
+	CmdFrame *eoFramePtr = (CmdFrame *)
+		TclStackAlloc(interp, sizeof(CmdFrame));
+
+	eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
+	eoFramePtr->level = (iPtr->cmdFramePtr == NULL?  1 
+		: iPtr->cmdFramePtr->level + 1);
+	eoFramePtr->framePtr = iPtr->framePtr;
+	eoFramePtr->nextPtr = iPtr->cmdFramePtr;
+
+	eoFramePtr->nline = 0;
+	eoFramePtr->line = NULL;
+
+	eoFramePtr->cmd.listPtr  = objPtr;
+	Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
+	eoFramePtr->data.eval.path = NULL;
+
+	/*
+	 * TIP #280 We do _not_ compute all the line numbers for the words
+	 * in the command. For the eval of a pure list the most sensible
+	 * choice is to put all words on line 1. Given that we neither
+	 * need memory for them nor compute anything.  'line' is left
+	 * NULL. The two places using this information (TclInfoFrame, and
+	 * TclInitCompileEnv), are special-cased to use the proper line
+	 * number directly instead of accessing the 'line' array.
+	 */
+
+	Tcl_ListObjGetElements(NULL, copyPtr, &nelements, &elements);
+
+	iPtr->cmdFramePtr = eoFramePtr;
+	result = Tcl_EvalObjv(interp, nelements, elements, flags);
+
+	Tcl_DecrRefCount(copyPtr);
+	iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+	Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
+	TclStackFree(interp, eoFramePtr);
+    } else if (flags & TCL_EVAL_DIRECT) {
 	/*
 	 * We're not supposed to use the compiler or byte-code interpreter.
-	 * Let Tcl_EvalEx evaluate the command directly (and probably
-	 * more slowly).
+	 * Let Tcl_EvalEx evaluate the command directly (and probably more
+	 * slowly).
+	 */
+
+	/*
+	 * TIP #280. Propagate context as much as we can. Especially if the
+	 * script to evaluate is a single literal it makes sense to look if
+	 * our context is one with absolute line numbers we can then track
+	 * into the literal itself too.
+	 *
+	 * See also tclCompile.c, TclInitCompileEnv, for the equivalent code
+	 * in the bytecode compiler.
+	 */
+
+	/*
+	 * Now we check if we have data about invisible continuation lines for
+	 * the script, and make it available to the direct script parser and
+	 * evaluator we are about to call, if so.
 	 *
-	 * Pure List Optimization (no string representation).  In this
-	 * case, we can safely use Tcl_EvalObjv instead and get an
-	 * appreciable improvement in execution speed.  This is because it
-	 * allows us to avoid a setFromAny step that would just pack
-	 * everything into a string and back out again.
+	 * It may be possible that the script Tcl_Obj* can be free'd while the
+	 * evaluator is using it, leading to the release of the associated
+	 * ContLineLoc structure as well. To ensure that the latter doesn't
+	 * happen we set a lock on it. We release this lock later in this
+	 * function, after the evaluator is done.  The relevant "lineCLPtr"
+	 * hashtable is managed in the file "tclObj.c".
 	 *
-	 * USE_EVAL_DIRECT is a special flag used for testing purpose only
-	 * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
+	 * Another important action is to save (and later restore) the
+	 * continuation line information of the caller, in case we are
+	 * executing nested commands in the eval/direct path.
 	 */
-	if (!(iPtr->flags & USE_EVAL_DIRECT) &&
-		(objPtr->typePtr == &tclListType) && /* is a list... */
-		(objPtr->bytes == NULL) /* ...without a string rep */) {
-	    register List *listRepPtr =
-		(List *) objPtr->internalRep.twoPtrValue.ptr1;
-	    int i, objc = listRepPtr->elemCount;
-
-#define TEOE_PREALLOC 10
-	    Tcl_Obj *staticObjv[TEOE_PREALLOC], **objv = staticObjv;
-
-#ifdef TCL_TIP280
-	    /* TIP #280 Structures for tracking lines.
-	     * As we know that this is dynamic execution we ignore the
-	     * invoker, even if known.
-	     */
-	    CmdFrame eoFrame;
-
-	    eoFrame.type     = TCL_LOCATION_EVAL_LIST;
-	    eoFrame.level    = (iPtr->cmdFramePtr == NULL ?
-				1 :
-				iPtr->cmdFramePtr->level + 1);
-	    eoFrame.framePtr = iPtr->framePtr;
-	    eoFrame.nextPtr  = iPtr->cmdFramePtr;
-	    eoFrame.nline    = 0;
-	    eoFrame.line     = NULL;
-
-	    /* NOTE: Getting the string rep of the list to eval to fill the
-	     * command information required by 'info frame' implies that
-	     * further calls for the same list would not be optimized, as it
-	     * would not be 'pure' anymore. It would also be a waste of time
-	     * as most of the time this information is not needed at all. What
-	     * we do instead is to keep the list obj itself around and have
-	     * 'info frame' sort it out.
-	     */
 
-	    eoFrame.cmd.listPtr  = objPtr;
-	    Tcl_IncrRefCount (eoFrame.cmd.listPtr);
-	    eoFrame.data.eval.path = NULL;
-#endif
-	    if (objc > TEOE_PREALLOC) {
-		objv = (Tcl_Obj **) ckalloc(objc*sizeof(Tcl_Obj *));
-	    }
-#undef TEOE_PREALLOC
-	    /*
-	     * Copy the list elements here, to avoid a segfault if
-	     * objPtr loses its List internal rep [Bug 1119369].
-	     *
-	     * TIP #280 We do _not_ compute all the line numbers for the words
-	     * in the command. For the eval of a pure list the most sensible
-	     * choice is to put all words on line 1. Given that we neither
-	     * need memory for them nor compute anything. 'line' is left
-	     * NULL. The two places using this information (TclInfoFrame, and
-	     * TclInitCompileEnv), are special-cased to use the proper line
-	     * number directly instead of accessing the 'line' array.
-	     */
+	ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
+	ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);
 
-	    for (i=0; i < objc; i++) {
-		objv[i] = listRepPtr->elements[i];
-		Tcl_IncrRefCount(objv[i]);
-	    }
+	if (clLocPtr) {
+	    iPtr->scriptCLLocPtr = clLocPtr;
+	    Tcl_Preserve (iPtr->scriptCLLocPtr);
+	} else {
+	    iPtr->scriptCLLocPtr = NULL;
+	}
 
-#ifdef TCL_TIP280
-	    iPtr->cmdFramePtr = &eoFrame;
-#endif
-	    result = Tcl_EvalObjv(interp, objc, objv, flags);
-#ifdef TCL_TIP280
-	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-	    Tcl_DecrRefCount (eoFrame.cmd.listPtr);
-#endif
+	if (invoker == NULL) {
+	    /*
+	     * No context, force opening of our own.
+	     */
 
-	    for (i=0; i < objc; i++) {
-		TclDecrRefCount(objv[i]);
-	    }
-	    if (objv != staticObjv) {
-		ckfree((char *) objv);
-	    }
-#ifdef TCL_TIP280
-	    ckfree ((char*) eoFrame.line);
-	    eoFrame.line  = NULL;
-	    eoFrame.nline = 0;
-#endif
-	} else {
-#ifndef TCL_TIP280
 	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-#else
+	} else {
 	    /*
-	     * TIP #280. Propagate context as much as we can. Especially if
-	     * the script to evaluate is a single literal it makes sense to
-	     * look if our context is one with absolute line numbers we can
-	     * then track into the literal itself too.
+	     * We have an invoker, describing the command asking for the
+	     * evaluation of a subordinate script. This script may originate
+	     * in a literal word, or from a variable, etc. Using the line
+	     * array we now check if we have good line information for the
+	     * relevant word. The type of context is relevant as well. In a
+	     * non-'source' context we don't have to try tracking lines.
 	     *
-	     * See also tclCompile.c, TclInitCompileEnv, for the equivalent
-	     * code in the bytecode compiler.
+	     * First see if the word exists and is a literal. If not we go
+	     * through the easy dynamic branch. No need to perform more
+	     * complex invokations.
 	     */
 
-	    /*
-	     * Now we check if we have data about invisible continuation lines
-	     * for the script, and make it available to the direct script
-	     * parser and evaluator we are about to call, if so.
-	     *
-	     * It may be possible that the script Tcl_Obj* can be free'd while
-	     * the evaluator is using it, leading to the release of the
-	     * associated ContLineLoc structure as well. To ensure that the
-	     * latter doesn't happen we set a lock on it. We release this lock
-	     * later in this function, after the evaluator is done.  The
-	     * relevant "lineCLPtr" hashtable is managed in the file
-	     * "tclObj.c".
-	     *
-	     * Another important action is to save (and later restore) the
-	     * continuation line information of the caller, in case we are
-	     * executing nested commands in the eval/direct path.
-	     */
+	    int pc = 0;
+	    CmdFrame *ctxPtr = (CmdFrame *)
+		TclStackAlloc(interp, sizeof(CmdFrame));
 
-	    ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
-	    ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);
+	    *ctxPtr = *invoker;
+	    if (invoker->type == TCL_LOCATION_BC) {
+		/*
+		 * Note: Type BC => ctxPtr->data.eval.path is not used.
+		 * ctxPtr->data.tebc.codePtr is used instead.
+		 */
 
-	    if (clLocPtr) {
-		iPtr->scriptCLLocPtr = clLocPtr;
-		Tcl_Preserve (iPtr->scriptCLLocPtr);
-	    } else {
-		iPtr->scriptCLLocPtr = NULL;
+		TclGetSrcInfoForPc(ctxPtr);
+		pc = 1;
 	    }
 
-	    if (invoker == NULL) {
-	        /* No context, force opening of our own */
-	        script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-	    } else {
-		/* We have an invoker, describing the command asking for the
-		 * evaluation of a subordinate script. This script may
-		 * originate in a literal word, or from a variable, etc. Using
-		 * the line array we now check if we have good line
-		 * information for the relevant word. The type of context is
-		 * relevant as well. In a non-'source' context we don't have
-		 * to try tracking lines.
-		 *
-		 * First see if the word exists and is a literal. If not we go
-		 * through the easy dynamic branch. No need to perform more
-		 * complex invokations.
-		 */
+	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 
-		CmdFrame ctx = *invoker;
-		int pc       = 0;
+	    if ((ctxPtr->nline <= word) ||
+		(ctxPtr->line[word] < 0) ||
+		(ctxPtr->type != TCL_LOCATION_SOURCE)) {
+		/*
+		 * Dynamic script, or dynamic context, force our own
+		 * context.
+		 */
 
-		if (invoker->type == TCL_LOCATION_BC) {
-		    /* Note: Type BC => ctx.data.eval.path    is not used.
-		     *                  ctx.data.tebc.codePtr is used instead.
-		     */
-		    TclGetSrcInfoForPc (&ctx);
-		    pc = 1;
-		}
+		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
 
-                script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	    } else {
+		/*
+		 * Absolute context to reuse.
+		 */
 
-		if ((ctx.nline <= word) ||
-		    (ctx.line[word] < 0) ||
-		    (ctx.type != TCL_LOCATION_SOURCE)) {
-		    /* Dynamic script, or dynamic context, force our own
-		     * context */
+		iPtr->invokeCmdFramePtr = ctxPtr;
+		iPtr->evalFlags |= TCL_EVAL_CTX;
 
-		    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-		} else {
-		    /* Absolute context available to reuse. */
+		result = TclEvalEx(interp, script, numSrcBytes, flags,
+				   ctxPtr->line[word], NULL, script);
+	    }
 
-		    iPtr->invokeCmdFramePtr = &ctx;
-		    iPtr->evalFlags |= TCL_EVAL_CTX;
+	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
+		/*
+		 * Death of SrcInfo reference.
+		 */
 
-		    result = EvalEx(interp, script, numSrcBytes, flags,
-				    ctx.line [word], NULL, script);
-		}
-		if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
-		    /* Death of SrcInfo reference. */
-		    Tcl_DecrRefCount(ctx.data.eval.path);
-		}
+		Tcl_DecrRefCount(ctxPtr->data.eval.path);
 	    }
+	    TclStackFree(interp, ctxPtr);
+	}
 
-	    /*
-	     * Now release the lock on the continuation line information, if
-	     * any, and restore the caller's settings.
-	     */
+	/*
+	 * Now release the lock on the continuation line information, if
+	 * any, and restore the caller's settings.
+	 */
 
-	    if (iPtr->scriptCLLocPtr) {
-		Tcl_Release (iPtr->scriptCLLocPtr);
-	    }
-	    iPtr->scriptCLLocPtr = saveCLLocPtr;
-#endif
+	if (iPtr->scriptCLLocPtr) {
+	    Tcl_Release (iPtr->scriptCLLocPtr);
 	}
+	iPtr->scriptCLLocPtr = saveCLLocPtr;
     } else {
 	/*
 	 * Let the compiler/engine subsystem do the evaluation.
 	 *
-	 * TIP #280 The invoker provides us with the context for the
-	 * script. We transfer this to the byte code compiler.
+	 * TIP #280 The invoker provides us with the context for the script.
+	 * We transfer this to the byte code compiler.
 	 */
+	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
 
 	savedVarFramePtr = iPtr->varFramePtr;
 	if (flags & TCL_EVAL_GLOBAL) {
-	    iPtr->varFramePtr = NULL;
+	    iPtr->varFramePtr = iPtr->rootFramePtr;
 	}
 
-#ifndef TCL_TIP280
-	result = TclCompEvalObj(interp, objPtr);
-#else
 	result = TclCompEvalObj(interp, objPtr, invoker, word);
-#endif
 
 	/*
-	 * If we are again at the top level, process any unusual 
-	 * return code returned by the evaluated code. 
+	 * If we are again at the top level, process any unusual return code
+	 * returned by the evaluated code.
 	 */
-	
+
 	if (iPtr->numLevels == 0) {
 	    if (result == TCL_RETURN) {
 		result = TclUpdateReturnInfo(iPtr);
 	    }
-	    if ((result != TCL_OK) && (result != TCL_ERROR) 
-	        && !allowExceptions) {
+	    if ((result != TCL_OK) && (result != TCL_ERROR)
+		    && !allowExceptions) {
 		ProcessUnexpectedResult(interp, result);
 		result = TCL_ERROR;
-
-		/*
-		 * If an error was created here, record information about 
-		 * what was being executed when the error occurred. Remove
-		 * the extra \n added by tclMain.c in the command sent to
-		 * Tcl_LogCommandInfo [Bug 833150].
-		 */
-
-		if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
-		    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-		    Tcl_LogCommandInfo(interp, script, script, --numSrcBytes);
-		    iPtr->flags &= ~ERR_ALREADY_LOGGED;
-		}
+		script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+		Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
 	    }
 	}
 	iPtr->evalFlags = 0;
-	iPtr->varFramePtr = savedVarFramePtr; 
+	iPtr->varFramePtr = savedVarFramePtr;
     }
 
     TclDecrRefCount(objPtr);
@@ -5272,39 +5289,37 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word)
  *
  * ProcessUnexpectedResult --
  *
- *	Procedure called by Tcl_EvalObj to set the interpreter's result
- *	value to an appropriate error message when the code it evaluates
- *	returns an unexpected result code (not TCL_OK and not TCL_ERROR) to
- *	the topmost evaluation level.
+ *	Function called by Tcl_EvalObj to set the interpreter's result value
+ *	to an appropriate error message when the code it evaluates returns an
+ *	unexpected result code (not TCL_OK and not TCL_ERROR) to the topmost
+ *	evaluation level.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The interpreter result is set to an error message appropriate to
- *	the result code.
+ *	The interpreter result is set to an error message appropriate to the
+ *	result code.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-ProcessUnexpectedResult(interp, returnCode)
-    Tcl_Interp *interp;		/* The interpreter in which the unexpected
+ProcessUnexpectedResult(
+    Tcl_Interp *interp,		/* The interpreter in which the unexpected
 				 * result code was returned. */
-    int returnCode;		/* The unexpected result code. */
+    int returnCode)		/* The unexpected result code. */
 {
     Tcl_ResetResult(interp);
     if (returnCode == TCL_BREAK) {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "invoked \"break\" outside of a loop", -1);
+	Tcl_AppendResult(interp,
+		"invoked \"break\" outside of a loop", NULL);
     } else if (returnCode == TCL_CONTINUE) {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"invoked \"continue\" outside of a loop", -1);
+	Tcl_AppendResult(interp,
+		"invoked \"continue\" outside of a loop", NULL);
     } else {
-        char buf[30 + TCL_INTEGER_SPACE];
-
-	sprintf(buf, "command returned bad code: %d", returnCode);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"command returned bad code: %d", returnCode));
     }
 }
 
@@ -5313,15 +5328,15 @@ ProcessUnexpectedResult(interp, returnCode)
  *
  * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
  *
- *	Procedures to evaluate an expression and return its value in a
+ *	Functions 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 the interp's result.
- *	Otherwise the value of the expression, in the appropriate form,
- *	is stored at *ptr. If the expression had a result that was
- *	incompatible with the desired form then an error is returned.
+ *	Each of the functions below returns a standard Tcl result. If an error
+ *	occurs then an error message is left in the interp's result. Otherwise
+ *	the value of the expression, in the appropriate form, is stored at
+ *	*ptr. If the expression had a result that was incompatible with the
+ *	desired form then an error is returned.
  *
  * Side effects:
  *	None.
@@ -5330,197 +5345,92 @@ ProcessUnexpectedResult(interp, returnCode)
  */
 
 int
-Tcl_ExprLong(interp, string, ptr)
-    Tcl_Interp *interp;		/* Context in which to evaluate the
+Tcl_ExprLong(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
 				 * expression. */
-    CONST char *string;		/* Expression to evaluate. */
-    long *ptr;			/* Where to store result. */
+    const char *exprstring,	/* Expression to evaluate. */
+    long *ptr)			/* Where to store result. */
 {
     register Tcl_Obj *exprPtr;
-    Tcl_Obj *resultPtr;
-    int length = strlen(string);
     int result = TCL_OK;
-
-    if (length > 0) {
-	exprPtr = Tcl_NewStringObj(string, length);
-	Tcl_IncrRefCount(exprPtr);
-	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
-	if (result == TCL_OK) {
-	    /*
-	     * Store an integer based on the expression result.
-	     */
-
-	    if (resultPtr->typePtr == &tclIntType) {
-		*ptr = resultPtr->internalRep.longValue;
-	    } else if (resultPtr->typePtr == &tclDoubleType) {
-		*ptr = (long) resultPtr->internalRep.doubleValue;
-	    } else if (resultPtr->typePtr == &tclWideIntType) {
-#ifndef TCL_WIDE_INT_IS_LONG
-		/*
-		 * See Tcl_GetIntFromObj for conversion comments.
-		 */
-		Tcl_WideInt w = resultPtr->internalRep.wideValue;
-		if ((w >= -(Tcl_WideInt)(ULONG_MAX))
-			&& (w <= (Tcl_WideInt)(ULONG_MAX))) {
-		    *ptr = Tcl_WideAsLong(w);
-		} else {
-		    Tcl_SetResult(interp,
-			    "integer value too large to represent as non-long integer",
-			    TCL_STATIC);
-		    result = TCL_ERROR;
-		}
-#else
-		*ptr = resultPtr->internalRep.longValue;
-#endif
-	    } else {
-		Tcl_SetResult(interp,
-		        "expression didn't have numeric value", TCL_STATIC);
-		result = TCL_ERROR;
-	    }
-	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
-	} else {
-	    /*
-	     * Move the interpreter's object result to the string result, 
-	     * then reset the object result.
-	     */
-
-	    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	            TCL_VOLATILE);
-	}
-	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */	
-    } else {
+    if (*exprstring == '\0') {
 	/*
-	 * An empty string. Just set the result integer to 0.
+	 * Legacy compatibility - return 0 for the zero-length string.
 	 */
-	
+
 	*ptr = 0;
+    } else {
+	exprPtr = Tcl_NewStringObj(exprstring, -1);
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
+	Tcl_DecrRefCount(exprPtr);
+	if (result != TCL_OK) {
+	    (void) Tcl_GetStringResult(interp);
+	}
     }
     return result;
 }
 
 int
-Tcl_ExprDouble(interp, string, ptr)
-    Tcl_Interp *interp;		/* Context in which to evaluate the
+Tcl_ExprDouble(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
 				 * expression. */
-    CONST char *string;		/* Expression to evaluate. */
-    double *ptr;		/* Where to store result. */
+    const char *exprstring,	/* Expression to evaluate. */
+    double *ptr)		/* Where to store result. */
 {
     register Tcl_Obj *exprPtr;
-    Tcl_Obj *resultPtr;
-    int length = strlen(string);
     int result = TCL_OK;
 
-    if (length > 0) {
-	exprPtr = Tcl_NewStringObj(string, length);
-	Tcl_IncrRefCount(exprPtr);
-	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
-	if (result == TCL_OK) {
-	    /*
-	     * Store a double  based on the expression result.
-	     */
-
-	    if (resultPtr->typePtr == &tclIntType) {
-		*ptr = (double) resultPtr->internalRep.longValue;
-	    } else if (resultPtr->typePtr == &tclDoubleType) {
-		*ptr = resultPtr->internalRep.doubleValue;
-	    } else if (resultPtr->typePtr == &tclWideIntType) {
-#ifndef TCL_WIDE_INT_IS_LONG
-		/*
-		 * See Tcl_GetIntFromObj for conversion comments.
-		 */
-		Tcl_WideInt w = resultPtr->internalRep.wideValue;
-		if ((w >= -(Tcl_WideInt)(ULONG_MAX))
-			&& (w <= (Tcl_WideInt)(ULONG_MAX))) {
-		    *ptr = (double) Tcl_WideAsLong(w);
-		} else {
-		    Tcl_SetResult(interp,
-			    "integer value too large to represent as non-long integer",
-			    TCL_STATIC);
-		    result = TCL_ERROR;
-		}
-#else
-		*ptr = (double) resultPtr->internalRep.longValue;
-#endif
-	    } else {
-		Tcl_SetResult(interp,
-		        "expression didn't have numeric value", TCL_STATIC);
-		result = TCL_ERROR;
-	    }
-	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
-	} else {
-	    /*
-	     * Move the interpreter's object result to the string result, 
-	     * then reset the object result.
-	     */
-
-	    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	            TCL_VOLATILE);
-	}
-	Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
-    } else {
+    if (*exprstring == '\0') {
 	/*
-	 * An empty string. Just set the result double to 0.0.
+	 * Legacy compatibility - return 0 for the zero-length string.
 	 */
-	
+
 	*ptr = 0.0;
+    } else {
+	exprPtr = Tcl_NewStringObj(exprstring, -1);
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
+	Tcl_DecrRefCount(exprPtr);
+				/* Discard the expression object. */
+	if (result != TCL_OK) {
+	    (void) Tcl_GetStringResult(interp);
+	}
     }
     return result;
 }
 
 int
-Tcl_ExprBoolean(interp, string, ptr)
-    Tcl_Interp *interp;		/* Context in which to evaluate the
-			         * expression. */
-    CONST char *string;		/* Expression to evaluate. */
-    int *ptr;			/* Where to store 0/1 result. */
+Tcl_ExprBoolean(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
+				 * expression. */
+    const char *exprstring,	/* Expression to evaluate. */
+    int *ptr)			/* Where to store 0/1 result. */
 {
-    register Tcl_Obj *exprPtr;
-    Tcl_Obj *resultPtr;
-    int length = strlen(string);
-    int result = TCL_OK;
+    if (*exprstring == '\0') {
+	/*
+	 * An empty string. Just set the result boolean to 0 (false).
+	 */
 
-    if (length > 0) {
-	exprPtr = Tcl_NewStringObj(string, length);
-	Tcl_IncrRefCount(exprPtr);
-	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
-	if (result == TCL_OK) {
-	    /*
-	     * Store a boolean based on the expression result.
-	     */
+	*ptr = 0;
+	return TCL_OK;
+    } else {
+	int result;
+	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);
 
-	    if (resultPtr->typePtr == &tclIntType) {
-		*ptr = (resultPtr->internalRep.longValue != 0);
-	    } else if (resultPtr->typePtr == &tclDoubleType) {
-		*ptr = (resultPtr->internalRep.doubleValue != 0.0);
-	    } else if (resultPtr->typePtr == &tclWideIntType) {
-#ifndef TCL_WIDE_INT_IS_LONG
-		*ptr = (resultPtr->internalRep.wideValue != 0);
-#else
-		*ptr = (resultPtr->internalRep.longValue != 0);
-#endif
-	    } else {
-		result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
-	    }
-	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
-	}
+	Tcl_IncrRefCount(exprPtr);
+	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
+	Tcl_DecrRefCount(exprPtr);
 	if (result != TCL_OK) {
 	    /*
-	     * Move the interpreter's object result to the string result, 
-	     * then reset the object result.
+	     * Move the interpreter's object result to the string result, then
+	     * reset the object result.
 	     */
 
-	    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	            TCL_VOLATILE);
+	    (void) Tcl_GetStringResult(interp);
 	}
-	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
-    } else {
-	/*
-	 * An empty string. Just set the result boolean to 0 (false).
-	 */
-	
-	*ptr = 0;
+	return result;
     }
-    return result;
 }
 
 /*
@@ -5528,16 +5438,15 @@ Tcl_ExprBoolean(interp, string, ptr)
  *
  * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
  *
- *	Procedures to evaluate an expression in an object and return its
- *	value in a particular form.
+ *	Functions to evaluate an expression in an object and return its value
+ *	in a particular form.
  *
  * Results:
- *	Each of the procedures below returns a standard Tcl result
- *	object. If an error occurs then an error message is left in the
- *	interpreter's result. Otherwise the value of the expression, in the
- *	appropriate form, is stored at *ptr. If the expression had a result
- *	that was incompatible with the desired form then an error is
- *	returned.
+ *	Each of the functions below returns a standard Tcl result object. If
+ *	an error occurs then an error message is left in the interpreter's
+ *	result. Otherwise the value of the expression, in the appropriate
+ *	form, is stored at *ptr. If the expression had a result that was
+ *	incompatible with the desired form then an error is returned.
  *
  * Side effects:
  *	None.
@@ -5546,230 +5455,117 @@ Tcl_ExprBoolean(interp, string, ptr)
  */
 
 int
-Tcl_ExprLongObj(interp, objPtr, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
-    long *ptr;				/* Where to store long result. */
+Tcl_ExprLongObj(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
+				 * expression. */
+    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
+    long *ptr)			/* Where to store long result. */
 {
     Tcl_Obj *resultPtr;
-    int result;
+    int result, type;
+    double d;
+    ClientData internalPtr;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
-    if (result == TCL_OK) {
-	if (resultPtr->typePtr == &tclIntType) {
-	    *ptr = resultPtr->internalRep.longValue;
-	} else if (resultPtr->typePtr == &tclDoubleType) {
-	    *ptr = (long) resultPtr->internalRep.doubleValue;
-	} else {
-	    result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
-	    if (result != TCL_OK) {
-		return result;
-	    }
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK){
+	return TCL_ERROR;
+    }
+
+    switch (type) {
+    case TCL_NUMBER_DOUBLE: {
+	mp_int big;
+
+	d = *((const double *) internalPtr);
+	Tcl_DecrRefCount(resultPtr);
+	if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
+	resultPtr = Tcl_NewBignumObj(&big);
+	/* FALLTHROUGH */
     }
+    case TCL_NUMBER_LONG:
+    case TCL_NUMBER_WIDE:
+    case TCL_NUMBER_BIG:
+	result = TclGetLongFromObj(interp, resultPtr, ptr);
+	break;
+
+    case TCL_NUMBER_NAN:
+	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
+	result = TCL_ERROR;
+    }
+
+    Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
     return result;
 }
 
 int
-Tcl_ExprDoubleObj(interp, objPtr, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
-    double *ptr;			/* Where to store double result. */
+Tcl_ExprDoubleObj(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
+				 * expression. */
+    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
+    double *ptr)		/* Where to store double result. */
 {
     Tcl_Obj *resultPtr;
-    int result;
+    int result, type;
+    ClientData internalPtr;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
     if (result == TCL_OK) {
-	if (resultPtr->typePtr == &tclIntType) {
-	    *ptr = (double) resultPtr->internalRep.longValue;
-	} else if (resultPtr->typePtr == &tclDoubleType) {
-	    *ptr = resultPtr->internalRep.doubleValue;
-	} else {
+	switch (type) {
+	case TCL_NUMBER_NAN:
+#ifndef ACCEPT_NAN
+	    result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
+	    break;
+#endif
+	case TCL_NUMBER_DOUBLE:
+	    *ptr = *((const double *) internalPtr);
+	    result = TCL_OK;
+	    break;
+	default:
 	    result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
-	    if (result != TCL_OK) {
-		return result;
-	    }
 	}
-	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
     }
+    Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
     return result;
 }
 
 int
-Tcl_ExprBooleanObj(interp, objPtr, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    register Tcl_Obj *objPtr;		/* Expression to evaluate. */
-    int *ptr;				/* Where to store 0/1 result. */
+Tcl_ExprBooleanObj(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
+				 * expression. */
+    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
+    int *ptr)			/* Where to store 0/1 result. */
 {
     Tcl_Obj *resultPtr;
     int result;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
     if (result == TCL_OK) {
-	if (resultPtr->typePtr == &tclIntType) {
-	    *ptr = (resultPtr->internalRep.longValue != 0);
-	} else if (resultPtr->typePtr == &tclDoubleType) {
-	    *ptr = (resultPtr->internalRep.doubleValue != 0.0);
-	} else {
-	    result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
-	}
-	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInvoke --
- *
- *	Invokes a Tcl command, given an argv/argc, from either the
- *	exposed or the hidden sets of commands in the given interpreter.
- *	NOTE: The command is invoked in the current stack frame of
- *	the interpreter, thus it can modify local variables.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Whatever the command does.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclInvoke(interp, argc, argv, flags)
-    Tcl_Interp *interp;		/* Where to invoke the command. */
-    int argc;			/* Count of args. */
-    register CONST char **argv;	/* The arg strings; argv[0] is the name of
-                                 * the command to invoke. */
-    int flags;			/* Combination of flags controlling the
-				 * call: TCL_INVOKE_HIDDEN and
-				 * TCL_INVOKE_NO_UNKNOWN. */
-{
-    register Tcl_Obj *objPtr;
-    register int i;
-    int length, result;
-
-    /*
-     * This procedure generates an objv array for object arguments that hold
-     * the argv strings. It starts out with stack-allocated space but uses
-     * dynamically-allocated storage if needed.
-     */
-
-#define NUM_ARGS 20
-    Tcl_Obj *(objStorage[NUM_ARGS]);
-    register Tcl_Obj **objv = objStorage;
-
-    /*
-     * Create the object argument array "objv". Make sure objv is large
-     * enough to hold the objc arguments plus 1 extra for the zero
-     * end-of-objv word.
-     */
-
-    if ((argc + 1) > NUM_ARGS) {
-	objv = (Tcl_Obj **)
-	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
-    }
-
-    for (i = 0;  i < argc;  i++) {
-	length = strlen(argv[i]);
-	objv[i] = Tcl_NewStringObj(argv[i], length);
-	Tcl_IncrRefCount(objv[i]);
-    }
-    objv[argc] = 0;
-
-    /*
-     * Use TclObjInterpProc to actually invoke the command.
-     */
-
-    result = TclObjInvoke(interp, argc, objv, flags);
-
-    /*
-     * Move the interpreter's object result to the string result, 
-     * then reset the object result.
-     */
-    
-    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	    TCL_VOLATILE);
-
-    /*
-     * Decrement the ref counts on the objv elements since we are done
-     * with them.
-     */
-
-    for (i = 0;  i < argc;  i++) {
-	objPtr = objv[i];
-	Tcl_DecrRefCount(objPtr);
-    }
-    
-    /*
-     * Free the objv array if malloc'ed storage was used.
-     */
-
-    if (objv != objStorage) {
-	ckfree((char *) objv);
+	result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
+	Tcl_DecrRefCount(resultPtr);
+				/* Discard the result object. */
     }
     return result;
-#undef NUM_ARGS
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGlobalInvoke --
- *
- *	Invokes a Tcl command, given an argv/argc, from either the
- *	exposed or hidden sets of commands in the given interpreter.
- *	NOTE: The command is invoked in the global stack frame of
- *	the interpreter, thus it cannot see any current state on
- *	the stack for that interpreter.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Whatever the command does.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGlobalInvoke(interp, argc, argv, flags)
-    Tcl_Interp *interp;		/* Where to invoke the command. */
-    int argc;			/* Count of args. */
-    register CONST char **argv;	/* The arg strings; argv[0] is the name of
-                                 * the command to invoke. */
-    int flags;			/* Combination of flags controlling the
-				 * call: TCL_INVOKE_HIDDEN and
-				 * TCL_INVOKE_NO_UNKNOWN. */
-{
-    register Interp *iPtr = (Interp *) interp;
-    int result;
-    CallFrame *savedVarFramePtr;
-
-    savedVarFramePtr = iPtr->varFramePtr;
-    iPtr->varFramePtr = NULL;
-    result = TclInvoke(interp, argc, argv, flags);
-    iPtr->varFramePtr = savedVarFramePtr;
-    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjInvokeGlobal --
+ * TclObjInvokeNamespace --
  *
- *	Object version: Invokes a Tcl command, given an objv/objc, from
- *	either the exposed or hidden set of commands in the given
- *	interpreter.
+ *	Object version: Invokes a Tcl command, given an objv/objc, from either
+ *	the exposed or hidden set of commands in the given interpreter.
  *	NOTE: The command is invoked in the global stack frame of the
- *	interpreter, thus it cannot see any current state on the
+ *	interpreter or namespace, thus it cannot see any current state on the
  *	stack of that interpreter.
  *
  * Results:
@@ -5782,25 +5578,33 @@ TclGlobalInvoke(interp, argc, argv, flags)
  */
 
 int
-TclObjInvokeGlobal(interp, objc, objv, flags)
-    Tcl_Interp *interp;		/* Interpreter in which command is to be
+TclObjInvokeNamespace(
+    Tcl_Interp *interp,		/* Interpreter in which command is to be
 				 * invoked. */
-    int objc;			/* Count of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects; objv[0] points to the
+    int objc,			/* Count of arguments. */
+    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
 				 * name of the command to invoke. */
-    int flags;			/* Combination of flags controlling the
-				 * call: TCL_INVOKE_HIDDEN,
-				 * TCL_INVOKE_NO_UNKNOWN, or
-				 * TCL_INVOKE_NO_TRACEBACK. */
+    Tcl_Namespace *nsPtr,	/* The namespace to use. */
+    int flags)			/* Combination of flags controlling the call:
+				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
+				 * or TCL_INVOKE_NO_TRACEBACK. */
 {
-    register Interp *iPtr = (Interp *) interp;
     int result;
-    CallFrame *savedVarFramePtr;
+    Tcl_CallFrame *framePtr;
+
+    /*
+     * Make the specified namespace the current namespace and invoke the
+     * command.
+     */
+
+    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
 
-    savedVarFramePtr = iPtr->varFramePtr;
-    iPtr->varFramePtr = NULL;
     result = TclObjInvoke(interp, objc, objv, flags);
-    iPtr->varFramePtr = savedVarFramePtr;
+
+    TclPopStackFrame(interp);
     return result;
 }
 
@@ -5809,8 +5613,8 @@ TclObjInvokeGlobal(interp, objc, objv, flags)
  *
  * TclObjInvoke --
  *
- *	Invokes a Tcl command, given an objv/objc, from either the
- *	exposed or the hidden sets of commands in the given interpreter.
+ *	Invokes a Tcl command, given an objv/objc, from either the exposed or
+ *	the hidden sets of commands in the given interpreter.
  *
  * Results:
  *	A standard Tcl object result.
@@ -5822,165 +5626,77 @@ TclObjInvokeGlobal(interp, objc, objv, flags)
  */
 
 int
-TclObjInvoke(interp, objc, objv, flags)
-    Tcl_Interp *interp;		/* Interpreter in which command is to be
+TclObjInvoke(
+    Tcl_Interp *interp,		/* Interpreter in which command is to be
 				 * invoked. */
-    int objc;			/* Count of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects; objv[0] points to the
+    int objc,			/* Count of arguments. */
+    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
 				 * name of the command to invoke. */
-    int flags;			/* Combination of flags controlling the
-				 * call: TCL_INVOKE_HIDDEN,
-				 * TCL_INVOKE_NO_UNKNOWN, or
-				 * TCL_INVOKE_NO_TRACEBACK. */
+    int flags)			/* Combination of flags controlling the call:
+				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
+				 * or TCL_INVOKE_NO_TRACEBACK. */
 {
     register Interp *iPtr = (Interp *) interp;
     Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
     char *cmdName;		/* Name of the command from objv[0]. */
-    register Tcl_HashEntry *hPtr;
-    Tcl_Command cmd;
+    Tcl_HashEntry *hPtr = NULL;
     Command *cmdPtr;
-    int localObjc;		/* Used to invoke "unknown" if the */
-    Tcl_Obj **localObjv = NULL;	/* command is not found. */
-    register int i;
     int result;
 
-    if (interp == (Tcl_Interp *) NULL) {
-        return TCL_ERROR;
+    if (interp == NULL) {
+	return TCL_ERROR;
+    }
+
+    if ((objc < 1) || (objv == NULL)) {
+	Tcl_AppendResult(interp, "illegal argument vector", NULL);
+	return TCL_ERROR;
     }
 
-    if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
-        Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "illegal argument vector", -1);
-        return TCL_ERROR;
+    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
+	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
     }
 
-    cmdName = Tcl_GetString(objv[0]);
-    if (flags & TCL_INVOKE_HIDDEN) {
-        /*
-         * We never invoke "unknown" for hidden commands.
-         */
-        
-	hPtr = NULL;
-        hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr;
-        if (hTblPtr != NULL) {
-	    hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
-	}
-	if (hPtr == NULL) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		     "invalid hidden command name \"", cmdName, "\"",
-		     (char *) NULL);
-            return TCL_ERROR;
-        }
-	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-    } else {
-	cmdPtr = NULL;
-	cmd = Tcl_FindCommand(interp, cmdName,
-	        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
-        if (cmd != (Tcl_Command) NULL) {
-	    cmdPtr = (Command *) cmd;
-        }
-	if (cmdPtr == NULL) {
-            if (!(flags & TCL_INVOKE_NO_UNKNOWN)) {
-		cmd = Tcl_FindCommand(interp, "unknown",
-                        (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
-		if (cmd != (Tcl_Command) NULL) {
-	            cmdPtr = (Command *) cmd;
-                }
-                if (cmdPtr != NULL) {
-                    localObjc = (objc + 1);
-                    localObjv = (Tcl_Obj **)
-			ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc));
-		    localObjv[0] = Tcl_NewStringObj("unknown", -1);
-		    Tcl_IncrRefCount(localObjv[0]);
-                    for (i = 0;  i < objc;  i++) {
-                        localObjv[i+1] = objv[i];
-                    }
-                    objc = localObjc;
-                    objv = localObjv;
-                }
-            }
-
-            /*
-             * Check again if we found the command. If not, "unknown" is
-             * not present and we cannot help, or the caller said not to
-             * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
-             */
-
-            if (cmdPtr == NULL) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"invalid command name \"",  cmdName, "\"", 
-			 (char *) NULL);
-                return TCL_ERROR;
-            }
-        }
-    }
-
-    /*
-     * Invoke the command procedure. First reset the interpreter's string
-     * and object results to their default empty values since they could
-     * have gotten changed by earlier invocations.
+    if (TclInterpReady(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+    cmdName = TclGetString(objv[0]);
+    hTblPtr = iPtr->hiddenCmdTablePtr;
+    if (hTblPtr != NULL) {
+	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
+    }
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "invalid hidden command name \"",
+		cmdName, "\"", NULL);
+	return TCL_ERROR;
+    }
+    cmdPtr = Tcl_GetHashValue(hPtr);
+
+    /*
+     * Invoke the command function.
      */
 
-    Tcl_ResetResult(interp);
     iPtr->cmdCount++;
-    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+    result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
 
     /*
-     * If an error occurred, record information about what was being
-     * executed when the error occurred.
+     * If an error occurred, record information about what was being executed
+     * when the error occurred.
      */
 
     if ((result == TCL_ERROR)
 	    && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
 	    && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
-	Tcl_Obj *msg;
-        
-        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
-            msg = Tcl_NewStringObj("\n    while invoking\n\"", -1);
-        } else {
-            msg = Tcl_NewStringObj("\n    invoked from within\n\"", -1);
-        }
-	Tcl_IncrRefCount(msg);
-        for (i = 0;  i < objc;  i++) {
-	    CONST char *bytes;
-	    int length;
-
-	    Tcl_AppendObjToObj(msg, objv[i]);
-	    bytes = Tcl_GetStringFromObj(msg, &length);
-	    if (length > 100) {
-		/*
-		 * Back up truncation point so that we don't truncate
-		 * in the middle of a multi-byte character.
-		 */
-		length = 100;
-		while ( (bytes[length] & 0xC0) == 0x80 ) {
-		    length--;
-		}
-		Tcl_SetObjLength(msg, length);
-		Tcl_AppendToObj(msg, "...", -1);
-		break;
-	    }
-	    if (i != (objc - 1)) {
-		Tcl_AppendToObj(msg, " ", -1);
-	    }
-        }
-
-	Tcl_AppendToObj(msg, "\"", -1);
-        Tcl_AddObjErrorInfo(interp, Tcl_GetString(msg), -1);
-	Tcl_DecrRefCount(msg);
+	int length;
+	Tcl_Obj *command = Tcl_NewListObj(objc, objv);
+	const char *cmdString;
+
+	Tcl_IncrRefCount(command);
+	cmdString = Tcl_GetStringFromObj(command, &length);
+	Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
+	Tcl_DecrRefCount(command);
 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
     }
-
-    /*
-     * Free any locally allocated storage used to call "unknown".
-     */
-
-    if (localObjv != (Tcl_Obj **) NULL) {
-	Tcl_DecrRefCount(localObjv[0]);
-        ckfree((char *) localObjv);
-    }
     return result;
 }
 
@@ -5994,413 +5710,81 @@ TclObjInvoke(interp, objc, objv, flags)
  *
  * Results:
  *	A standard Tcl result. If the result is TCL_OK, then the interp's
- *	result is set to the string value of the expression. If the result
- *	is TCL_ERROR, then the interp's result contains an error message.
+ *	result is set to the string value of the expression. If the result is
+ *	TCL_ERROR, then the interp's result contains an error message.
  *
  * Side effects:
  *	A Tcl object is allocated to hold a copy of the expression string.
- *	This expression object is passed to Tcl_ExprObj and then
- *	deallocated.
+ *	This expression object is passed to Tcl_ExprObj and then deallocated.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_ExprString(interp, string)
-    Tcl_Interp *interp;		/* Context in which to evaluate the
+Tcl_ExprString(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
 				 * expression. */
-    CONST char *string;		/* Expression to evaluate. */
+    const char *expr)		/* Expression to evaluate. */
 {
-    register Tcl_Obj *exprPtr;
-    Tcl_Obj *resultPtr;
-    int length = strlen(string);
-    char buf[TCL_DOUBLE_SPACE];
-    int result = TCL_OK;
-
-    if (length > 0) {
-	TclNewObj(exprPtr);
-	TclInitStringRep(exprPtr, string, length);
-	Tcl_IncrRefCount(exprPtr);
+    int code = TCL_OK;
 
-	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
-	if (result == TCL_OK) {
-	    /*
-	     * Set the interpreter's string result from the result object.
-	     */
-	    
-	    if (resultPtr->typePtr == &tclIntType) {
-		sprintf(buf, "%ld", resultPtr->internalRep.longValue);
-		Tcl_SetResult(interp, buf, TCL_VOLATILE);
-	    } else if (resultPtr->typePtr == &tclDoubleType) {
-		Tcl_PrintDouble((Tcl_Interp *) NULL,
-		        resultPtr->internalRep.doubleValue, buf);
-		Tcl_SetResult(interp, buf, TCL_VOLATILE);
-	    } else {
-		/*
-		 * Set interpreter's string result from the result object.
-		 */
-	    
-		Tcl_SetResult(interp, TclGetString(resultPtr),
-		        TCL_VOLATILE);
-	    }
-	    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
-	} else {
-	    /*
-	     * Move the interpreter's object result to the string result, 
-	     * then reset the object result.
-	     */
-	    
-	    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	            TCL_VOLATILE);
-	}
-	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
-    } else {
+    if (expr[0] == '\0') {
 	/*
 	 * An empty string. Just set the interpreter's result to 0.
 	 */
-	
-	Tcl_SetResult(interp, "0", TCL_VOLATILE);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateObjTrace --
- *
- *	Arrange for a procedure to be called to trace command execution.
- *
- * Results:
- *	The return value is a token for the trace, which may be passed
- *	to Tcl_DeleteTrace to eliminate the trace.
- *
- * Side effects:
- *	From now on, proc will be called just before a command procedure
- *	is called to execute a Tcl command.  Calls to proc will have the
- *	following form:
- *
- *      void proc( ClientData     clientData,
- *                 Tcl_Interp*    interp,
- *                 int            level,
- *                 CONST char*    command,
- *                 Tcl_Command    commandInfo,
- *                 int            objc,
- *                 Tcl_Obj *CONST objv[] );
- *
- *      The 'clientData' and 'interp' arguments to 'proc' will be the
- *      same as the arguments to Tcl_CreateObjTrace.  The 'level'
- *	argument gives the nesting depth of command interpretation within
- *	the interpreter.  The 'command' argument is the ASCII text of
- *	the command being evaluated -- before any substitutions are
- *	performed.  The 'commandInfo' argument gives a handle to the
- *	command procedure that will be evaluated.  The 'objc' and 'objv'
- *	parameters give the parameter vector that will be passed to the
- *	command procedure.  proc does not return a value.
- *
- *      It is permissible for 'proc' to call Tcl_SetCommandTokenInfo
- *      to change the command procedure or client data for the command
- *      being evaluated, and these changes will take effect with the
- *      current evaluation.
- *
- * The 'level' argument specifies the maximum nesting level of calls
- * to be traced.  If the execution depth of the interpreter exceeds
- * 'level', the trace callback is not executed.
- *
- * The 'flags' argument is either zero or the value,
- * TCL_ALLOW_INLINE_COMPILATION.  If the TCL_ALLOW_INLINE_COMPILATION
- * flag is not present, the bytecode compiler will not generate inline
- * code for Tcl's built-in commands.  This behavior will have a significant
- * impact on performance, but will ensure that all command evaluations are
- * traced.  If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
- * bytecode compiler will have its normal behavior of compiling in-line
- * code for some of Tcl's built-in commands.  In this case, the tracing
- * will be imprecise -- in-line code will not be traced -- but run-time
- * performance will be improved.  The latter behavior is desired for
- * many applications such as profiling of run time.
- *
- * When the trace is deleted, the 'delProc' procedure will be invoked,
- * passing it the original client data.  
- *
- *----------------------------------------------------------------------
- */
 
-Tcl_Trace
-Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    int level;			/* Maximum nesting level */
-    int flags;			/* Flags, see above */
-    Tcl_CmdObjTraceProc* proc;	/* Trace callback */
-    ClientData clientData;	/* Client data for the callback */
-    Tcl_CmdObjTraceDeleteProc* delProc;
-				/* Procedure to call when trace is deleted */
-{
-    register Trace *tracePtr;
-    register Interp *iPtr = (Interp *) interp;
-
-    /* Test if this trace allows inline compilation of commands */
-
-    if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
-	if (iPtr->tracesForbiddingInline == 0) {
-
-	    /*
-	     * When the first trace forbidding inline compilation is
-	     * created, invalidate existing compiled code for this
-	     * interpreter and arrange (by setting the
-	     * DONT_COMPILE_CMDS_INLINE flag) that when compiling new
-	     * code, no commands will be compiled inline (i.e., into
-	     * an inline sequence of instructions). We do this because
-	     * commands that were compiled inline will never result in
-	     * a command trace being called.
-	     */
-
-	    iPtr->compileEpoch++;
-	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+	Tcl_SetResult(interp, "0", TCL_VOLATILE);
+    } else {
+	Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);
+
+	Tcl_IncrRefCount(exprObj);
+	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
+	Tcl_DecrRefCount(exprObj);
+	if (code == TCL_OK) {
+	    Tcl_SetObjResult(interp, resultPtr);
+	    Tcl_DecrRefCount(resultPtr);
 	}
-	iPtr->tracesForbiddingInline++;
-    }
-    
-    tracePtr = (Trace *) ckalloc(sizeof(Trace));
-    tracePtr->level		= level;
-    tracePtr->proc		= proc;
-    tracePtr->clientData	= clientData;
-    tracePtr->delProc           = delProc;
-    tracePtr->nextPtr		= iPtr->tracePtr;
-    tracePtr->flags		= flags;
-    iPtr->tracePtr		= tracePtr;
-
-    return (Tcl_Trace) tracePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateTrace --
- *
- *	Arrange for a procedure to be called to trace command execution.
- *
- * Results:
- *	The return value is a token for the trace, which may be passed
- *	to Tcl_DeleteTrace to eliminate the trace.
- *
- * Side effects:
- *	From now on, proc will be called just before a command procedure
- *	is called to execute a Tcl command.  Calls to proc will have the
- *	following form:
- *
- *	void
- *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
- *		argc, argv)
- *	    ClientData clientData;
- *	    Tcl_Interp *interp;
- *	    int level;
- *	    char *command;
- *	    int (*cmdProc)();
- *	    ClientData cmdClientData;
- *	    int argc;
- *	    char **argv;
- *	{
- *	}
- *
- *	The clientData and interp arguments to proc will be the same
- *	as the corresponding arguments to this procedure.  Level gives
- *	the nesting level of command interpretation for this interpreter
- *	(0 corresponds to top level).  Command gives the ASCII text of
- *	the raw command, cmdProc and cmdClientData give the procedure that
- *	will be called to process the command and the ClientData value it
- *	will receive, and argc and argv give the arguments to the
- *	command, after any argument parsing and substitution.  Proc
- *	does not return a value.
- *
- *----------------------------------------------------------------------
- */
 
-Tcl_Trace
-Tcl_CreateTrace(interp, level, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which to create trace. */
-    int level;			/* Only call proc for commands at nesting
-				 * level<=argument level (1=>top level). */
-    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
-				 * command. */
-    ClientData clientData;	/* Arbitrary value word to pass to proc. */
-{
-    StringTraceData* data;
-    data = (StringTraceData*) ckalloc( sizeof( *data ));
-    data->clientData = clientData;
-    data->proc = proc;
-    return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
-			       (ClientData) data, StringTraceDeleteProc );
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringTraceProc --
- *
- *	Invoke a string-based trace procedure from an object-based
- *	callback.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Whatever the string-based trace procedure does.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
-    ClientData clientData;
-    Tcl_Interp* interp;
-    int level;
-    CONST char* command;
-    Tcl_Command commandInfo;
-    int objc;
-    Tcl_Obj *CONST *objv;
-{
-    StringTraceData* data = (StringTraceData*) clientData;
-    Command* cmdPtr = (Command*) commandInfo;
-
-    CONST char** argv;		/* Args to pass to string trace proc */
-
-    int i;
+	/*
+	 * Force the string rep of the interp result.
+	 */
 
-    /*
-     * This is a bit messy because we have to emulate the old trace
-     * interface, which uses strings for everything.
-     */
-	    
-    argv = (CONST char **) ckalloc((unsigned) ( (objc + 1)
-						* sizeof(CONST char *) ));
-    for (i = 0; i < objc; i++) {
-	argv[i] = Tcl_GetString(objv[i]);
+	(void) Tcl_GetStringResult(interp);
     }
-    argv[objc] = 0;
-
-    /*
-     * Invoke the command procedure.  Note that we cast away const-ness
-     * on two parameters for compatibility with legacy code; the code
-     * MUST NOT modify either command or argv.
-     */
-          
-    ( data->proc )( data->clientData, interp, level,
-		    (char*) command, cmdPtr->proc, cmdPtr->clientData,
-		    objc, argv );
-    ckfree( (char*) argv );
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringTraceDeleteProc --
- *
- *	Clean up memory when a string-based trace is deleted.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocated memory is returned to the system.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StringTraceDeleteProc( clientData )
-    ClientData clientData;
-{
-    ckfree( (char*) clientData );
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_DeleteTrace --
+ * Tcl_AppendObjToErrorInfo --
  *
- *	Remove a trace.
+ *	Add a Tcl_Obj value to the errorInfo field that describes the current
+ *	error.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	From now on there will be no more calls to the procedure given
- *	in trace.
+ *	The value of the Tcl_obj is appended to the errorInfo field. If we are
+ *	just starting to log an error, errorInfo is initialized from the error
+ *	message in the interpreter's result.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteTrace(interp, trace)
-    Tcl_Interp *interp;		/* Interpreter that contains trace. */
-    Tcl_Trace trace;		/* Token for trace (returned previously by
-				 * Tcl_CreateTrace). */
+Tcl_AppendObjToErrorInfo(
+    Tcl_Interp *interp,		/* Interpreter to which error information
+				 * pertains. */
+    Tcl_Obj *objPtr)		/* Message to record. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Trace *prevPtr, *tracePtr = (Trace *) trace;
-    register Trace **tracePtr2 = &(iPtr->tracePtr);
-    ActiveInterpTrace *activePtr;
-
-    /*
-     * Locate the trace entry in the interpreter's trace list,
-     * and remove it from the list.
-     */
-
-    prevPtr = NULL;
-    while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
-	prevPtr = *tracePtr2;
-	tracePtr2 = &((*tracePtr2)->nextPtr);
-    }
-    if (*tracePtr2 == NULL) {
-	return;
-    }
-    (*tracePtr2) = (*tracePtr2)->nextPtr;
+    int length;
+    const char *message = TclGetStringFromObj(objPtr, &length);
 
-    /*
-     * The code below makes it possible to delete traces while traces
-     * are active: it makes sure that the deleted trace won't be
-     * processed by TclCheckInterpTraces.
-     */
-
-    for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
-	    activePtr = activePtr->nextPtr) {
-	if (activePtr->nextTracePtr == tracePtr) {
-	    if (activePtr->reverseScan) {
-		activePtr->nextTracePtr = prevPtr;
-	    } else {
-		activePtr->nextTracePtr = tracePtr->nextPtr;
-	    }
-	}
-    }
-
-    /*
-     * If the trace forbids bytecode compilation, change the interpreter's
-     * state.  If bytecode compilation is now permitted, flag the fact and
-     * advance the compilation epoch so that procs will be recompiled to
-     * take advantage of it.
-     */
-
-    if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) {
-	iPtr->tracesForbiddingInline--;
-	if (iPtr->tracesForbiddingInline == 0) {
-	    iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
-	    iPtr->compileEpoch++;
-	}
-    }
-
-    /*
-     * Execute any delete callback.
-     */
-
-    if (tracePtr->delProc != NULL) {
-	(tracePtr->delProc)(tracePtr->clientData);
-    }
-
-    /* Delete the trace object */
-
-    Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
+    Tcl_IncrRefCount(objPtr);
+    Tcl_AddObjErrorInfo(interp, message, length);
+    Tcl_DecrRefCount(objPtr);
 }
 
 /*
@@ -6408,27 +5792,25 @@ Tcl_DeleteTrace(interp, trace)
  *
  * Tcl_AddErrorInfo --
  *
- *	Add information to the "errorInfo" variable that describes the
- *	current error.
+ *	Add information to the errorInfo field that describes the current
+ *	error.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The contents of message are added to the "errorInfo" variable.
- *	If Tcl_Eval has been called since the current value of errorInfo
- *	was set, errorInfo is cleared before adding the new message.
- *	If we are just starting to log an error, errorInfo is initialized
- *	from the error message in the interpreter's result.
+ *	The contents of message are appended to the errorInfo field. If we are
+ *	just starting to log an error, errorInfo is initialized from the error
+ *	message in the interpreter's result.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AddErrorInfo(interp, message)
-    Tcl_Interp *interp;		/* Interpreter to which error information
+Tcl_AddErrorInfo(
+    Tcl_Interp *interp,		/* Interpreter to which error information
 				 * pertains. */
-    CONST char *message;	/* Message to record. */
+    const char *message)	/* Message to record. */
 {
     Tcl_AddObjErrorInfo(interp, message, -1);
 }
@@ -6438,67 +5820,56 @@ Tcl_AddErrorInfo(interp, message)
  *
  * Tcl_AddObjErrorInfo --
  *
- *	Add information to the "errorInfo" variable that describes the
- *	current error. This routine differs from Tcl_AddErrorInfo by
- *	taking a byte pointer and length.
+ *	Add information to the errorInfo field that describes the current
+ *	error. This routine differs from Tcl_AddErrorInfo by taking a byte
+ *	pointer and length.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	"length" bytes from "message" are added to the "errorInfo" variable.
- *	If "length" is negative, use bytes up to the first NULL byte.
- *	If Tcl_EvalObj has been called since the current value of errorInfo
- *	was set, errorInfo is cleared before adding the new message.
- *	If we are just starting to log an error, errorInfo is initialized
- *	from the error message in the interpreter's result.
+ *	"length" bytes from "message" are appended to the errorInfo field. If
+ *	"length" is negative, use bytes up to the first NULL byte. If we are
+ *	just starting to log an error, errorInfo is initialized from the error
+ *	message in the interpreter's result.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AddObjErrorInfo(interp, message, length)
-    Tcl_Interp *interp;		/* Interpreter to which error information
+Tcl_AddObjErrorInfo(
+    Tcl_Interp *interp,		/* Interpreter to which error information
 				 * pertains. */
-    CONST char *message;	/* Points to the first byte of an array of
+    const char *message,	/* Points to the first byte of an array of
 				 * bytes of the message. */
-    int length;			/* The number of bytes in the message.
-				 * If < 0, then append all bytes up to a
-				 * NULL byte. */
+    int length)			/* The number of bytes in the message. If < 0,
+				 * then append all bytes up to a NULL byte. */
 {
     register Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *objPtr;
-    
+
     /*
-     * If we are just starting to log an error, errorInfo is initialized
-     * from the error message in the interpreter's result.
+     * If we are just starting to log an error, errorInfo is initialized from
+     * the error message in the interpreter's result.
      */
 
-    if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
-	iPtr->flags |= ERR_IN_PROGRESS;
+    iPtr->flags |= ERR_LEGACY_COPY;
+    if (iPtr->errorInfo == NULL) {
+	if (iPtr->result[0] != 0) {
+	    /*
+	     * The interp's string result is set, apparently by some extension
+	     * making a deprecated direct write to it. That extension may
+	     * expect interp->result to continue to be set, so we'll take
+	     * special pains to avoid clearing it, until we drop support for
+	     * interp->result completely.
+	     */
 
-	if (iPtr->result[0] == 0) {
-	    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
-	            iPtr->objResultPtr, TCL_GLOBAL_ONLY);
-	} else {		/* use the string result */
-	    objPtr = Tcl_NewStringObj(interp->result, -1);
-	    Tcl_IncrRefCount(objPtr);
-	    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
-	            objPtr, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(objPtr);
+	    iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
+	} else {
+	    iPtr->errorInfo = iPtr->objResultPtr;
 	}
-
-	/*
-	 * If the errorCode variable wasn't set by the code that generated
-	 * the error, set it to "NONE".
-	 */
-
-	if (!(iPtr->flags & ERROR_CODE_SET)) {
-	    objPtr = Tcl_NewStringObj("NONE", -1);
-	    Tcl_IncrRefCount(objPtr);
-	    Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, 
-	            objPtr, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(objPtr);
+	Tcl_IncrRefCount(iPtr->errorInfo);
+	if (!iPtr->errorCode) {
+	    Tcl_SetErrorCode(interp, "NONE", NULL);
 	}
     }
 
@@ -6507,11 +5878,12 @@ Tcl_AddObjErrorInfo(interp, message, length)
      */
 
     if (length != 0) {
-	objPtr = Tcl_NewStringObj(message, length);
-	Tcl_IncrRefCount(objPtr);
-	Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
-	        objPtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
-	Tcl_DecrRefCount(objPtr); /* free msg object appended above */
+	if (Tcl_IsShared(iPtr->errorInfo)) {
+	    Tcl_DecrRefCount(iPtr->errorInfo);
+	    iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
+	    Tcl_IncrRefCount(iPtr->errorInfo);
+	}
+	Tcl_AppendToObj(iPtr->errorInfo, message, length);
     }
 }
 
@@ -6520,12 +5892,12 @@ Tcl_AddObjErrorInfo(interp, message, length)
  *
  * Tcl_VarEvalVA --
  *
- *	Given a variable number of string arguments, concatenate them
- *	all together and execute the result as a Tcl command.
+ *	Given a variable number of string arguments, concatenate them all
+ *	together and execute the result as a Tcl command.
  *
  * Results:
- *	A standard Tcl return result.  An error message or other result may
- *	be left in the interp's result.
+ *	A standard Tcl return result. An error message or other result may be
+ *	left in the interp's result.
  *
  * Side effects:
  *	Depends on what was done by the command.
@@ -6534,19 +5906,18 @@ Tcl_AddObjErrorInfo(interp, message, length)
  */
 
 int
-Tcl_VarEvalVA (interp, argList)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
-    va_list argList;		/* Variable argument list. */
+Tcl_VarEvalVA(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
+    va_list argList)		/* Variable argument list. */
 {
     Tcl_DString buf;
     char *string;
     int result;
 
     /*
-     * Copy the strings one after the other into a single larger
-     * string.  Use stack-allocated space for small commands, but if
-     * the command gets too large than call ckalloc to create the
-     * space.
+     * Copy the strings one after the other into a single larger string. Use
+     * stack-allocated space for small commands, but if the command gets too
+     * large than call ckalloc to create the space.
      */
 
     Tcl_DStringInit(&buf);
@@ -6568,27 +5939,28 @@ Tcl_VarEvalVA (interp, argList)
  *
  * Tcl_VarEval --
  *
- *	Given a variable number of string arguments, concatenate them
- *	all together and execute the result as a Tcl command.
+ *	Given a variable number of string arguments, concatenate them all
+ *	together and execute the result as a Tcl command.
  *
  * Results:
- *	A standard Tcl return result.  An error message or other
- *	result may be left in interp->result.
+ *	A standard Tcl return result. An error message or other result may be
+ *	left in interp->result.
  *
  * Side effects:
  *	Depends on what was done by the command.
  *
  *----------------------------------------------------------------------
  */
-	/* VARARGS2 */ /* ARGSUSED */
+	/* ARGSUSED */
 int
-Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_VarEval(
+    Tcl_Interp *interp,
+    ...)
 {
-    Tcl_Interp *interp;
     va_list argList;
     int result;
 
-    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    va_start(argList, interp);
     result = Tcl_VarEvalVA(interp, argList);
     va_end(argList);
 
@@ -6596,36 +5968,35 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 }
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * Tcl_GlobalEval --
  *
  *	Evaluate a command at global level in an interpreter.
  *
  * Results:
- *	A standard Tcl result is returned, and the interp's result is
- *	modified accordingly.
+ *	A standard Tcl result is returned, and the interp's result is modified
+ *	accordingly.
  *
  * Side effects:
- *	The command string is executed in interp, and the execution
- *	is carried out in the variable context of global level (no
- *	procedures active), just as if an "uplevel #0" command were
- *	being executed.
+ *	The command string is executed in interp, and the execution is carried
+ *	out in the variable context of global level (no functions active),
+ *	just as if an "uplevel #0" command were being executed.
  *
- ---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 int
-Tcl_GlobalEval(interp, command)
-    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
-    CONST char *command;	/* Command to evaluate. */
+Tcl_GlobalEval(
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
+    const char *command)	/* Command to evaluate. */
 {
     register Interp *iPtr = (Interp *) interp;
     int result;
     CallFrame *savedVarFramePtr;
 
     savedVarFramePtr = iPtr->varFramePtr;
-    iPtr->varFramePtr = NULL;
+    iPtr->varFramePtr = iPtr->rootFramePtr;
     result = Tcl_Eval(interp, command);
     iPtr->varFramePtr = savedVarFramePtr;
     return result;
@@ -6636,8 +6007,8 @@ Tcl_GlobalEval(interp, command)
  *
  * Tcl_SetRecursionLimit --
  *
- *	Set the maximum number of recursive calls that may be active
- *	for an interpreter at once.
+ *	Set the maximum number of recursive calls that may be active for an
+ *	interpreter at once.
  *
  * Results:
  *	The return value is the old limit on nesting for interp.
@@ -6649,10 +6020,10 @@ Tcl_GlobalEval(interp, command)
  */
 
 int
-Tcl_SetRecursionLimit(interp, depth)
-    Tcl_Interp *interp;			/* Interpreter whose nesting limit
-					 * is to be set. */
-    int depth;				/* New value for maximimum depth. */
+Tcl_SetRecursionLimit(
+    Tcl_Interp *interp,		/* Interpreter whose nesting limit is to be
+				 * set. */
+    int depth)			/* New value for maximimum depth. */
 {
     Interp *iPtr = (Interp *) interp;
     int old;
@@ -6669,39 +6040,36 @@ Tcl_SetRecursionLimit(interp, depth)
  *
  * Tcl_AllowExceptions --
  *
- *	Sets a flag in an interpreter so that exceptions can occur
- *	in the next call to Tcl_Eval without them being turned into
- *	errors.
+ *	Sets a flag in an interpreter so that exceptions can occur in the next
+ *	call to Tcl_Eval without them being turned into errors.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's
- *	evalFlags structure.  See the reference documentation for
- *	more details.
+ *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's evalFlags
+ *	structure. See the reference documentation for more details.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AllowExceptions(interp)
-    Tcl_Interp *interp;		/* Interpreter in which to set flag. */
+Tcl_AllowExceptions(
+    Tcl_Interp *interp)		/* Interpreter in which to set flag. */
 {
     Interp *iPtr = (Interp *) interp;
 
     iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetVersion
+ * Tcl_GetVersion --
  *
- *	Get the Tcl major, minor, and patchlevel version numbers and
- *      the release type.  A patch is a release type TCL_FINAL_RELEASE
- *      with a patchLevel > 0.
+ *	Get the Tcl major, minor, and patchlevel version numbers and the
+ *	release type. A patch is a release type TCL_FINAL_RELEASE with a
+ *	patchLevel > 0.
  *
  * Results:
  *	None.
@@ -6713,24 +6081,898 @@ Tcl_AllowExceptions(interp)
  */
 
 void
-Tcl_GetVersion(majorV, minorV, patchLevelV, type)
-    int *majorV;
-    int *minorV;
-    int *patchLevelV;
-    int *type;
+Tcl_GetVersion(
+    int *majorV,
+    int *minorV,
+    int *patchLevelV,
+    int *type)
 {
     if (majorV != NULL) {
-        *majorV = TCL_MAJOR_VERSION;
+	*majorV = TCL_MAJOR_VERSION;
     }
     if (minorV != NULL) {
-        *minorV = TCL_MINOR_VERSION;
+	*minorV = TCL_MINOR_VERSION;
     }
     if (patchLevelV != NULL) {
-        *patchLevelV = TCL_RELEASE_SERIAL;
+	*patchLevelV = TCL_RELEASE_SERIAL;
     }
     if (type != NULL) {
-        *type = TCL_RELEASE_LEVEL;
+	*type = TCL_RELEASE_LEVEL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Math Functions --
+ *
+ *	This page contains the functions that implement all of the built-in
+ *	math functions for expressions.
+ *
+ * Results:
+ *	Each function returns TCL_OK if it succeeds and pushes an Tcl object
+ *	holding the result. If it fails it returns TCL_ERROR and leaves an
+ *	error message in the interpreter's result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprCeilFunc(
+    ClientData clientData,	/* Ignored */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter list. */
+{
+    int code;
+    double d;
+    mp_int big;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclCeil(&big)));
+	mp_clear(&big);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d)));
+    }
+    return TCL_OK;
+}
+
+static int
+ExprFloorFunc(
+    ClientData clientData,	/* Ignored */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter list. */
+{
+    int code;
+    double d;
+    mp_int big;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclFloor(&big)));
+	mp_clear(&big);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d)));
+    }
+    return TCL_OK;
+}
+
+static int
+ExprIsqrtFunc(
+    ClientData clientData,	/* Ignored */
+    Tcl_Interp *interp,		/* The interpreter in which to execute. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter list. */
+{
+    ClientData ptr;
+    int type;
+    double d;
+    Tcl_WideInt w;
+    mp_int big;
+    int exact = 0;		/* Flag == 1 if the argument can be
+				 * represented in a double as an exact
+				 * integer. */
+
+    /*
+     * Check syntax.
+     */
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the arg is a number.
+     */
+
+    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch (type) {
+    case TCL_NUMBER_NAN:
+	Tcl_GetDoubleFromObj(interp, objv[1], &d);
+	return TCL_ERROR;
+    case TCL_NUMBER_DOUBLE:
+	d = *((const double *) ptr);
+	if (d < 0) {
+	    goto negarg;
+	}
+#ifdef IEEE_FLOATING_POINT
+	if (d <= MAX_EXACT) {
+	    exact = 1;
+	}
+#endif
+	if (!exact) {
+	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	break;
+    case TCL_NUMBER_BIG:
+	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (SIGN(&big) == MP_NEG) {
+	    mp_clear(&big);
+	    goto negarg;
+	}
+	break;
+    default:
+	if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (w < 0) {
+	    goto negarg;
+	}
+	d = (double) w;
+#ifdef IEEE_FLOATING_POINT
+	if (d < MAX_EXACT) {
+	    exact = 1;
+	}
+#endif
+	if (!exact) {
+	    Tcl_GetBignumFromObj(interp, objv[1], &big);
+	}
+	break;
+    }
+
+    if (exact) {
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
+    } else {
+	mp_int root;
+
+	mp_init(&root);
+	mp_sqrt(&big, &root);
+	mp_clear(&big);
+	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
+    }
+
+    return TCL_OK;
+
+  negarg:
+    Tcl_SetObjResult(interp,
+	    Tcl_NewStringObj("square root of negative argument", -1));
+    return TCL_ERROR;
+}
+
+static int
+ExprSqrtFunc(
+    ClientData clientData,	/* Ignored */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter list. */
+{
+    int code;
+    double d;
+    mp_int big;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if ((d >= 0.0) && TclIsInfinite(d)
+	    && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) {
+	mp_int root;
+
+	mp_init(&root);
+	mp_sqrt(&big, &root);
+	mp_clear(&big);
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root)));
+	mp_clear(&root);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
+    }
+    return TCL_OK;
+}
+
+static int
+ExprUnaryFunc(
+    ClientData clientData,	/* Contains the address of a function that
+				 * takes one double argument and returns a
+				 * double result. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count */
+    Tcl_Obj *const *objv)	/* Actual parameter list */
+{
+    int code;
+    double d;
+    double (*func)(double) = (double (*)(double)) clientData;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	d = objv[1]->internalRep.doubleValue;
+	Tcl_ResetResult(interp);
+	code = TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    errno = 0;
+    return CheckDoubleResult(interp, (*func)(d));
+}
+
+static int
+CheckDoubleResult(
+    Tcl_Interp *interp,
+    double dResult)
+{
+#ifndef ACCEPT_NAN
+    if (TclIsNaN(dResult)) {
+	TclExprFloatError(interp, dResult);
+	return TCL_ERROR;
+    }
+#endif
+    if ((errno == ERANGE) && ((dResult == 0.0) || TclIsInfinite(dResult))) {
+	/*
+	 * When ERANGE signals under/overflow, just accept 0.0 or +/-Inf
+	 */
+    } else if (errno != 0) {
+	/*
+	 * Report other errno values as errors.
+	 */
+
+	TclExprFloatError(interp, dResult);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
+    return TCL_OK;
+}
+
+static int
+ExprBinaryFunc(
+    ClientData clientData,	/* Contains the address of a function that
+				 * takes two double arguments and returns a
+				 * double result. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Parameter vector. */
+{
+    int code;
+    double d1, d2;
+    double (*func)(double, double) = (double (*)(double, double)) clientData;
+
+    if (objc != 3) {
+	MathFuncWrongNumArgs(interp, 3, objc, objv);
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
+	d1 = objv[1]->internalRep.doubleValue;
+	Tcl_ResetResult(interp);
+	code = TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
+#ifdef ACCEPT_NAN
+    if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
+	d2 = objv[2]->internalRep.doubleValue;
+	Tcl_ResetResult(interp);
+	code = TCL_OK;
+    }
+#endif
+    if (code != TCL_OK) {
+	return TCL_ERROR;
+    }
+    errno = 0;
+    return CheckDoubleResult(interp, (*func)(d1, d2));
+}
+
+static int
+ExprAbsFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Parameter vector. */
+{
+    ClientData ptr;
+    int type;
+    mp_int big;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+
+    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (type == TCL_NUMBER_LONG) {
+	long l = *((const long *) ptr);
+
+	if (l > (long)0) {
+	    goto unChanged;
+	} else if (l == (long)0) {
+	    const char *string = objv[1]->bytes;
+	    if (string) {
+		while (*string != '0') {
+		    if (*string == '-') {
+			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+			return TCL_OK;
+		    }
+		    string++;
+		}
+	    }
+	    goto unChanged;
+	} else if (l == LONG_MIN) {
+	    TclBNInitBignumFromLong(&big, l);
+	    goto tooLarge;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
+	return TCL_OK;
+    }
+
+    if (type == TCL_NUMBER_DOUBLE) {
+	double d = *((const double *) ptr);
+	static const double poszero = 0.0;
+
+	/* We need to distinguish here between positive 0.0 and
+	 * negative -0.0, see Bug ID #2954959.
+	 */
+	if (d == -0.0) {
+		if (!memcmp(&d, &poszero, sizeof(double))) {
+	    goto unChanged;
+	    }
+	} else {
+	    if (d > -0.0) {
+		goto unChanged;
+	    }
+	}
+	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
+	return TCL_OK;
+    }
+
+#ifndef NO_WIDE_TYPE
+    if (type == TCL_NUMBER_WIDE) {
+	Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
+
+	if (w >= (Tcl_WideInt)0) {
+	    goto unChanged;
+	}
+	if (w == LLONG_MIN) {
+	    TclBNInitBignumFromWideInt(&big, w);
+	    goto tooLarge;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
+	return TCL_OK;
+    }
+#endif
+
+    if (type == TCL_NUMBER_BIG) {
+	/* TODO: const correctness ? */
+	if (mp_cmp_d((mp_int *) ptr, 0) == MP_LT) {
+	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
+	tooLarge:
+	    mp_neg(&big, &big);
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+	} else {
+	unChanged:
+	    Tcl_SetObjResult(interp, objv[1]);
+	}
+	return TCL_OK;
+    }
+
+    if (type == TCL_NUMBER_NAN) {
+#ifdef ACCEPT_NAN
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+#else
+	double d;
+	Tcl_GetDoubleFromObj(interp, objv[1], &d);
+	return TCL_ERROR;
+#endif
+    }
+    return TCL_OK;
+}
+
+static int
+ExprBoolFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    int value;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+    return TCL_OK;
+}
+
+static int
+ExprDoubleFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    double dResult;
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
+#ifdef ACCEPT_NAN
+	if (objv[1]->typePtr == &tclDoubleType) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
+#endif
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
+    return TCL_OK;
+}
+
+static int
+ExprEntierFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    double d;
+    int type;
+    ClientData ptr;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (type == TCL_NUMBER_DOUBLE) {
+	d = *((const double *) ptr);
+	if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
+	    mp_int big;
+
+	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
+		/* Infinity */
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+	    return TCL_OK;
+	} else {
+	    long result = (long) d;
+
+	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
+	    return TCL_OK;
+	}
+    }
+
+    if (type != TCL_NUMBER_NAN) {
+	/*
+	 * All integers are already of integer type.
+	 */
+
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+
+    /*
+     * Get the error message for NaN.
+     */
+
+    Tcl_GetDoubleFromObj(interp, objv[1], &d);
+    return TCL_ERROR;
+}
+
+static int
+ExprIntFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    long iResult;
+    Tcl_Obj *objPtr;
+    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+	return TCL_ERROR;
     }
+    objPtr = Tcl_GetObjResult(interp);
+    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
+	/*
+	 * Truncate the bignum; keep only bits in long range.
+	 */
+
+	mp_int big;
+
+	Tcl_GetBignumFromObj(NULL, objPtr, &big);
+	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+	objPtr = Tcl_NewBignumObj(&big);
+	Tcl_IncrRefCount(objPtr);
+	TclGetLongFromObj(NULL, objPtr, &iResult);
+	Tcl_DecrRefCount(objPtr);
+    }
+    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
+    return TCL_OK;
+}
+
+static int
+ExprWideFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    Tcl_WideInt wResult;
+    Tcl_Obj *objPtr;
+    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    objPtr = Tcl_GetObjResult(interp);
+    if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
+	/*
+	 * Truncate the bignum; keep only bits in wide int range.
+	 */
+
+	mp_int big;
+
+	Tcl_GetBignumFromObj(NULL, objPtr, &big);
+	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
+	objPtr = Tcl_NewBignumObj(&big);
+	Tcl_IncrRefCount(objPtr);
+	Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
+	Tcl_DecrRefCount(objPtr);
+    }
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
+    return TCL_OK;
+}
+
+static int
+ExprRandFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    Interp *iPtr = (Interp *) interp;
+    double dResult;
+    long tmp;			/* Algorithm assumes at least 32 bits. Only
+				 * long guarantees that. See below. */
+    Tcl_Obj *oResult;
+
+    if (objc != 1) {
+	MathFuncWrongNumArgs(interp, 1, objc, objv);
+	return TCL_ERROR;
+    }
+
+    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
+	iPtr->flags |= RAND_SEED_INITIALIZED;
+
+	/*
+	 * Take into consideration the thread this interp is running in order
+	 * to insure different seeds in different threads (bug #416643)
+	 */
+
+	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
+
+	/*
+	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
+	 */
+
+	iPtr->randSeed &= (unsigned long) 0x7fffffff;
+	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+	    iPtr->randSeed ^= 123459876;
+	}
+    }
+
+    /*
+     * Generate the random number using the linear congruential generator
+     * defined by the following recurrence:
+     *		seed = ( IA * seed ) mod IM
+     * where IA is 16807 and IM is (2^31) - 1. The recurrence maps a seed in
+     * the range [1, IM - 1] to a new seed in that same range. The recurrence
+     * maps IM to 0, and maps 0 back to 0, so those two values must not be
+     * allowed as initial values of seed.
+     *
+     * In order to avoid potential problems with integer overflow, the
+     * recurrence is implemented in terms of additional constants IQ and IR
+     * such that
+     *		IM = IA*IQ + IR
+     * None of the operations in the implementation overflows a 32-bit signed
+     * integer, and the C type long is guaranteed to be at least 32 bits wide.
+     *
+     * For more details on how this algorithm works, refer to the following
+     * papers:
+     *
+     *	S.K. Park & K.W. Miller, "Random number generators: good ones are hard
+     *	to find," Comm ACM 31(10):1192-1201, Oct 1988
+     *
+     *	W.H. Press & S.A. Teukolsky, "Portable random number generators,"
+     *	Computers in Physics 6(5):522-524, Sep/Oct 1992.
+     */
+
+#define RAND_IA		16807
+#define RAND_IM		2147483647
+#define RAND_IQ		127773
+#define RAND_IR		2836
+#define RAND_MASK	123459876
+
+    tmp = iPtr->randSeed/RAND_IQ;
+    iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
+    if (iPtr->randSeed < 0) {
+	iPtr->randSeed += RAND_IM;
+    }
+
+    /*
+     * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
+     * dividing by RAND_IM yields a double in the range (0, 1).
+     */
+
+    dResult = iPtr->randSeed * (1.0/RAND_IM);
+
+    /*
+     * Push a Tcl object with the result.
+     */
+
+    TclNewDoubleObj(oResult, dResult);
+    Tcl_SetObjResult(interp, oResult);
+    return TCL_OK;
+}
+
+static int
+ExprRoundFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Parameter vector. */
+{
+    double d;
+    ClientData ptr;
+    int type;
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+
+    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (type == TCL_NUMBER_DOUBLE) {
+	double fractPart, intPart;
+	long max = LONG_MAX, min = LONG_MIN;
+
+	fractPart = modf(*((const double *) ptr), &intPart);
+	if (fractPart <= -0.5) {
+	    min++;
+	} else if (fractPart >= 0.5) {
+	    max--;
+	}
+	if ((intPart >= (double)max) || (intPart <= (double)min)) {
+	    mp_int big;
+
+	    if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) {
+		/* Infinity */
+		return TCL_ERROR;
+	    }
+	    if (fractPart <= -0.5) {
+		mp_sub_d(&big, 1, &big);
+	    } else if (fractPart >= 0.5) {
+		mp_add_d(&big, 1, &big);
+	    }
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+	    return TCL_OK;
+	} else {
+	    long result = (long)intPart;
+
+	    if (fractPart <= -0.5) {
+		result--;
+	    } else if (fractPart >= 0.5) {
+		result++;
+	    }
+	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
+	    return TCL_OK;
+	}
+    }
+
+    if (type != TCL_NUMBER_NAN) {
+	/*
+	 * All integers are already rounded
+	 */
+
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+
+    /*
+     * Get the error message for NaN.
+     */
+
+    Tcl_GetDoubleFromObj(interp, objv[1], &d);
+    return TCL_ERROR;
+}
+
+static int
+ExprSrandFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Parameter vector. */
+{
+    Interp *iPtr = (Interp *) interp;
+    long i = 0;			/* Initialized to avoid compiler warning. */
+
+    /*
+     * Convert argument and use it to reset the seed.
+     */
+
+    if (objc != 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+
+    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
+	Tcl_Obj *objPtr;
+	mp_int big;
+
+	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
+	    /* TODO: more ::errorInfo here? or in caller? */
+	    return TCL_ERROR;
+	}
+
+	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+	objPtr = Tcl_NewBignumObj(&big);
+	Tcl_IncrRefCount(objPtr);
+	TclGetLongFromObj(NULL, objPtr, &i);
+	Tcl_DecrRefCount(objPtr);
+    }
+
+    /*
+     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
+     * ExprRandFunc() for more details.
+     */
+
+    iPtr->flags |= RAND_SEED_INITIALIZED;
+    iPtr->randSeed = i;
+    iPtr->randSeed &= (unsigned long) 0x7fffffff;
+    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+	iPtr->randSeed ^= 123459876;
+    }
+
+    /*
+     * To avoid duplicating the random number generation code we simply clean
+     * up our state and call the real random number function. That function
+     * will always succeed.
+     */
+
+    return ExprRandFunc(clientData, interp, 1, objv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MathFuncWrongNumArgs --
+ *
+ *	Generate an error message when a math function presents the wrong
+ *	number of arguments.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is stored in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MathFuncWrongNumArgs(
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int expected,		/* Formal parameter count. */
+    int found,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    const char *name = Tcl_GetString(objv[0]);
+    const char *tail = name + strlen(name);
+
+    while (tail > name+1) {
+	--tail;
+	if (*tail == ':' && tail[-1] == ':') {
+	    name = tail+1;
+	    break;
+	}
+    }
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "too %s arguments for math function \"%s\"",
+	    (found < expected ? "few" : "many"), name));
 }
 #ifdef USE_DTRACE
 
@@ -6755,7 +6997,7 @@ DTraceObjCmd(
     ClientData dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
 	char *a[10];
@@ -6769,6 +7011,60 @@ DTraceObjCmd(
     }
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDTraceInfo --
+ *
+ *	Extract information from a TIP280 dict for use by DTrace probes.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDTraceInfo(
+    Tcl_Obj *info,
+    char **args,
+    int *argsi)
+{
+    static Tcl_Obj *keys[7] = { NULL };
+    Tcl_Obj **k = keys, *val;
+    int i;
+
+    if (!*k) {
+	TclNewLiteralStringObj(keys[0], "cmd");
+	TclNewLiteralStringObj(keys[1], "type");
+	TclNewLiteralStringObj(keys[2], "proc");
+	TclNewLiteralStringObj(keys[3], "file");
+	TclNewLiteralStringObj(keys[4], "lambda");
+	TclNewLiteralStringObj(keys[5], "line");
+	TclNewLiteralStringObj(keys[6], "level");
+    }
+    for (i = 0; i < 4; i++) {
+	Tcl_DictObjGet(NULL, info, *k++, &val);
+	args[i] = val ? TclGetString(val) : NULL;
+    }
+    if (!args[2]) {
+	Tcl_DictObjGet(NULL, info, *k, &val);
+	args[2] = val ? TclGetString(val) : NULL;
+    }
+    k++;
+    for (i = 0; i < 2; i++) {
+	Tcl_DictObjGet(NULL, info, *k++, &val);
+	if (val) {
+	    TclGetIntFromObj(NULL, val, &(argsi[i]));
+	} else {
+	    argsi[i] = 0;
+	}
+    }
+}
 
 TCL_DTRACE_DEBUG_LOG()
 
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 8eb3ac3..dbb296b 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclBinary.c --
  *
  *	This file contains the implementation of the "binary" Tcl built-in
@@ -7,12 +7,13 @@
  * Copyright (c) 1997 by Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
+#include "tommath.h"
+
 #include <math.h>
 
 /*
@@ -24,21 +25,27 @@
 #define BINARY_NOCOUNT -2	/* No count was specified in format. */
 
 /*
- * The following defines the maximum number of different (integer)
- * numbers placed in the object cache by 'binary scan' before it bails
- * out and switches back to Plan A (creating a new object for each
- * value.)  Theoretically, it would be possible to keep the cache
- * about for the values that are already in it, but that makes the
- * code slower in practise when overflow happens, and makes little
- * odds the rest of the time (as measured on my machine.)  It is also
- * slower (on the sample I tried at least) to grow the cache to hold
- * all items we might want to put in it; presumably the extra cost of
- * managing the memory for the enlarged table outweighs the benefit
- * from allocating fewer objects.  This is probably because as the
- * number of objects increases, the likelihood of reuse of any
- * particular one drops, and there is very little gain from larger
- * maximum cache sizes (the value below is chosen to allow caching to
- * work in full with conversion of bytes.) - DKF
+ * The following flags may be ORed together and returned by GetFormatSpec
+ */
+
+#define BINARY_SIGNED 0		/* Field to be read as signed data */
+#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */
+
+/*
+ * The following defines the maximum number of different (integer) numbers
+ * placed in the object cache by 'binary scan' before it bails out and
+ * switches back to Plan A (creating a new object for each value.)
+ * Theoretically, it would be possible to keep the cache about for the values
+ * that are already in it, but that makes the code slower in practise when
+ * overflow happens, and makes little odds the rest of the time (as measured
+ * on my machine.) It is also slower (on the sample I tried at least) to grow
+ * the cache to hold all items we might want to put in it; presumably the
+ * extra cost of managing the memory for the enlarged table outweighs the
+ * benefit from allocating fewer objects. This is probably because as the
+ * number of objects increases, the likelihood of reuse of any particular one
+ * drops, and there is very little gain from larger maximum cache sizes (the
+ * value below is chosen to allow caching to work in full with conversion of
+ * bytes.) - DKF
  */
 
 #define BINARY_SCAN_MAX_CACHE	260
@@ -47,46 +54,46 @@
  * Prototypes for local procedures defined in this file:
  */
 
-static void		DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static int		FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
-			    Tcl_Obj *src, unsigned char **cursorPtr));
-static void		CopyNumber _ANSI_ARGS_((CONST VOID *from, VOID *to,
-			    unsigned int length));
-static void		FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int		GetFormatSpec _ANSI_ARGS_((char **formatPtr,
-			    char *cmdPtr, int *countPtr));
-static Tcl_Obj *	ScanNumber _ANSI_ARGS_((unsigned char *buffer,
-			    int type, Tcl_HashTable **numberCachePtr));
-static int		SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static void		UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
-static void		DeleteScanNumberCache _ANSI_ARGS_((
-			    Tcl_HashTable *numberCachePtr));
+static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
+static int		FormatNumber(Tcl_Interp *interp, int type,
+			    Tcl_Obj *src, unsigned char **cursorPtr);
+static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
+			    int *countPtr, int *flagsPtr);
+static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
+			    int flags, Tcl_HashTable **numberCachePtr);
+static int		SetByteArrayFromAny(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
+static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
+static int		NeedReversing(int format);
+static void		CopyNumber(const void *from, void *to,
+			    unsigned int length, int type);
 
 /*
- * The following object type represents an array of bytes.  An array of
- * bytes is not equivalent to an internationalized string.  Conceptually, a
- * string is an array of 16-bit quantities organized as a sequence of properly
- * formed UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
+ * The following object type represents an array of bytes. An array of bytes
+ * is not equivalent to an internationalized string. Conceptually, a string is
+ * an array of 16-bit quantities organized as a sequence of properly formed
+ * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
  * Accessor functions are provided to convert a ByteArray to a String or a
- * String to a ByteArray.  Two or more consecutive bytes in an array of bytes
+ * String to a ByteArray. Two or more consecutive bytes in an array of bytes
  * may look like a single UTF-8 character if the array is casually treated as
- * a string.  But obtaining the String from a ByteArray is guaranteed to
- * produced properly formed UTF-8 sequences so that there is a one-to-one
- * map between bytes and characters.
+ * a string. But obtaining the String from a ByteArray is guaranteed to
+ * produced properly formed UTF-8 sequences so that there is a one-to-one map
+ * between bytes and characters.
  *
  * Converting a ByteArray to a String proceeds by casting each byte in the
  * array to a 16-bit quantity, treating that number as a Unicode character,
- * and storing the UTF-8 version of that Unicode character in the String.
- * For ByteArrays consisting entirely of values 1..127, the corresponding
- * String representation is the same as the ByteArray representation.
+ * and storing the UTF-8 version of that Unicode character in the String. For
+ * ByteArrays consisting entirely of values 1..127, the corresponding String
+ * representation is the same as the ByteArray representation.
  *
  * Converting a String to a ByteArray proceeds by getting the Unicode
- * representation of each character in the String, casting it to a
- * byte by truncating the upper 8 bits, and then storing the byte in the
- * ByteArray.  Converting from ByteArray to String and back to ByteArray
- * is not lossy, but converting an arbitrary String to a ByteArray may be.
+ * representation of each character in the String, casting it to a byte by
+ * truncating the upper 8 bits, and then storing the byte in the ByteArray.
+ * Converting from ByteArray to String and back to ByteArray is not lossy, but
+ * converting an arbitrary String to a ByteArray may be.
  */
 
 Tcl_ObjType tclByteArrayType = {
@@ -98,10 +105,10 @@ Tcl_ObjType tclByteArrayType = {
 };
 
 /*
- * The following structure is the internal rep for a ByteArray object.
- * Keeps track of how much memory has been used and how much has been
- * allocated for the byte array to enable growing and shrinking of the
- * ByteArray object with fewer mallocs.  
+ * The following structure is the internal rep for a ByteArray object. Keeps
+ * track of how much memory has been used and how much has been allocated for
+ * the byte array to enable growing and shrinking of the ByteArray object with
+ * fewer mallocs.
  */
 
 typedef struct ByteArray {
@@ -109,48 +116,46 @@ typedef struct ByteArray {
 				 * array. */
     int allocated;		/* The amount of space actually allocated
 				 * minus 1 byte. */
-    unsigned char bytes[4];	/* The array of bytes.  The actual size of
-				 * this field depends on the 'allocated' field
+    unsigned char bytes[4];	/* The array of bytes. The actual size of this
+				 * field depends on the 'allocated' field
 				 * above. */
 } ByteArray;
 
-#define BYTEARRAY_SIZE(len)	\
+#define BYTEARRAY_SIZE(len) \
 		((unsigned) (sizeof(ByteArray) - 4 + (len)))
 #define GET_BYTEARRAY(objPtr) \
-		((ByteArray *) (objPtr)->internalRep.otherValuePtr)
+		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_BYTEARRAY(objPtr, baPtr) \
-		(objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
+		(objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr)
 
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * Tcl_NewByteArrayObj --
  *
- *	This procedure is creates a new ByteArray object and initializes
- *	it from the given array of bytes.
+ *	This procedure is creates a new ByteArray object and initializes it
+ *	from the given array of bytes.
  *
  * Results:
- *	The newly create object is returned.  This object will have no
- *	initial string representation.  The returned object has a ref count
- *	of 0.
+ *	The newly create object is returned. This object will have no initial
+ *	string representation. The returned object has a ref count of 0.
  *
  * Side effects:
  *	Memory allocated for new object and copy of byte array argument.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
 #undef Tcl_NewByteArrayObj
 
-
 Tcl_Obj *
-Tcl_NewByteArrayObj(bytes, length)
-    CONST unsigned char *bytes;	/* The array of bytes used to initialize
-				 * the new object. */
-    int length;			/* Length of the array of bytes, which must
-				 * be >= 0. */
+Tcl_NewByteArrayObj(
+    const unsigned char *bytes,	/* The array of bytes used to initialize the
+				 * new object. */
+    int length)			/* Length of the array of bytes, which must be
+				 * >= 0. */
 {
     return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
 }
@@ -158,11 +163,11 @@ Tcl_NewByteArrayObj(bytes, length)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewByteArrayObj(bytes, length)
-    CONST unsigned char *bytes;	/* The array of bytes used to initialize
-				 * the new object. */
-    int length;			/* Length of the array of bytes, which must
-				 * be >= 0. */
+Tcl_NewByteArrayObj(
+    const unsigned char *bytes,	/* The array of bytes used to initialize the
+				 * new object. */
+    int length)			/* Length of the array of bytes, which must be
+				 * >= 0. */
 {
     Tcl_Obj *objPtr;
 
@@ -173,7 +178,7 @@ Tcl_NewByteArrayObj(bytes, length)
 #endif /* TCL_MEM_DEBUG */
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * Tcl_DbNewByteArrayObj --
  *
@@ -188,28 +193,27 @@ Tcl_NewByteArrayObj(bytes, length)
  *	result of calling Tcl_NewByteArrayObj.
  *
  * Results:
- *	The newly create object is returned.  This object will have no
- *	initial string representation.  The returned object has a ref count
- *	of 0.
+ *	The newly create object is returned. This object will have no initial
+ *	string representation. The returned object has a ref count of 0.
  *
  * Side effects:
  *	Memory allocated for new object and copy of byte array argument.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewByteArrayObj(bytes, length, file, line)
-    CONST unsigned char *bytes;	/* The array of bytes used to initialize
-				 * the new object. */
-    int length;			/* Length of the array of bytes, which must
-				 * be >= 0. */
-    CONST char *file;		/* The name of the source file calling this
+Tcl_DbNewByteArrayObj(
+    const unsigned char *bytes,	/* The array of bytes used to initialize the
+				 * new object. */
+    int length,			/* Length of the array of bytes, which must be
+				 * >= 0. */
+    const char *file,		/* The name of the source file calling this
 				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     Tcl_Obj *objPtr;
 
@@ -221,15 +225,15 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewByteArrayObj(bytes, length, file, line)
-    CONST unsigned char *bytes;	/* The array of bytes used to initialize
-				 * the new object. */
-    int length;			/* Length of the array of bytes, which must
-				 * be >= 0. */
-    CONST char *file;		/* The name of the source file calling this
+Tcl_DbNewByteArrayObj(
+    const unsigned char *bytes,	/* The array of bytes used to initialize the
+				 * new object. */
+    int length,			/* Length of the array of bytes, which must be
+				 * >= 0. */
+    const char *file,		/* The name of the source file calling this
 				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewByteArrayObj(bytes, length);
 }
@@ -247,37 +251,38 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
  *	None.
  *
  * Side effects:
- *	The object's old string rep and internal rep is freed.
- *	Memory allocated for copy of byte array argument.
+ *	The object's old string rep and internal rep is freed. Memory
+ *	allocated for copy of byte array argument.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetByteArrayObj(objPtr, bytes, length)
-    Tcl_Obj *objPtr;		/* Object to initialize as a ByteArray. */
-    CONST unsigned char *bytes;	/* The array of bytes to use as the new
+Tcl_SetByteArrayObj(
+    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
+    const unsigned char *bytes,	/* The array of bytes to use as the new
 				 * value. */
-    int length;			/* Length of the array of bytes, which must
-				 * be >= 0. */
+    int length)			/* Length of the array of bytes, which must be
+				 * >= 0. */
 {
-    Tcl_ObjType *typePtr;
     ByteArray *byteArrayPtr;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetByteArrayObj called with shared object");
-    }
-    typePtr = objPtr->typePtr;
-    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	(*typePtr->freeIntRepProc)(objPtr);
+	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
     }
-    Tcl_InvalidateStringRep(objPtr);
+    TclFreeIntRep(objPtr);
+    TclInvalidateStringRep(objPtr);
 
+    if (length < 0) {
+	length = 0;
+    }
     byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
     byteArrayPtr->used = length;
     byteArrayPtr->allocated = length;
-    memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
 
+    if ((bytes != NULL) && (length > 0)) {
+	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
+    }
     objPtr->typePtr = &tclByteArrayType;
     SET_BYTEARRAY(objPtr, byteArrayPtr);
 }
@@ -287,28 +292,30 @@ Tcl_SetByteArrayObj(objPtr, bytes, length)
  *
  * Tcl_GetByteArrayFromObj --
  *
- *	Attempt to get the array of bytes from the Tcl object.  If the
- *	object is not already a ByteArray object, an attempt will be
- *	made to convert it to one.
+ *	Attempt to get the array of bytes from the Tcl object. If the object
+ *	is not already a ByteArray object, an attempt will be made to convert
+ *	it to one.
  *
  * Results:
  *	Pointer to array of bytes representing the ByteArray object.
  *
  * Side effects:
- *	Frees old internal rep.  Allocates memory for new internal rep.
+ *	Frees old internal rep. Allocates memory for new internal rep.
  *
  *----------------------------------------------------------------------
  */
 
 unsigned char *
-Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
-    Tcl_Obj *objPtr;		/* The ByteArray object. */
-    int *lengthPtr;		/* If non-NULL, filled with length of the
+Tcl_GetByteArrayFromObj(
+    Tcl_Obj *objPtr,		/* The ByteArray object. */
+    int *lengthPtr)		/* If non-NULL, filled with length of the
 				 * array of bytes in the ByteArray object. */
 {
     ByteArray *baPtr;
-    
-    SetByteArrayFromAny(NULL, objPtr);
+
+    if (objPtr->typePtr != &tclByteArrayType) {
+	SetByteArrayFromAny(NULL, objPtr);
+    }
     baPtr = GET_BYTEARRAY(objPtr);
 
     if (lengthPtr != NULL) {
@@ -322,32 +329,32 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
  *
  * Tcl_SetByteArrayLength --
  *
- *	This procedure changes the length of the byte array for this
- *	object.  Once the caller has set the length of the array, it
- *	is acceptable to directly modify the bytes in the array up until
- *	Tcl_GetStringFromObj() has been called on this object.
+ *	This procedure changes the length of the byte array for this object.
+ *	Once the caller has set the length of the array, it is acceptable to
+ *	directly modify the bytes in the array up until Tcl_GetStringFromObj()
+ *	has been called on this object.
  *
  * Results:
  *	The new byte array of the specified length.
  *
  * Side effects:
- *	Allocates enough memory for an array of bytes of the requested
- *	size.  When growing the array, the old array is copied to the
- *	new array; new bytes are undefined.  When shrinking, the
- *	old array is truncated to the specified length.
+ *	Allocates enough memory for an array of bytes of the requested size.
+ *	When growing the array, the old array is copied to the new array; new
+ *	bytes are undefined. When shrinking, the old array is truncated to the
+ *	specified length.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 unsigned char *
-Tcl_SetByteArrayLength(objPtr, length)
-    Tcl_Obj *objPtr;		/* The ByteArray object. */
-    int length;			/* New length for internal byte array. */
+Tcl_SetByteArrayLength(
+    Tcl_Obj *objPtr,		/* The ByteArray object. */
+    int length)			/* New length for internal byte array. */
 {
-    ByteArray *byteArrayPtr, *newByteArrayPtr;
-    
+    ByteArray *byteArrayPtr;
+
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetObjLength called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
     }
     if (objPtr->typePtr != &tclByteArrayType) {
 	SetByteArrayFromAny(NULL, objPtr);
@@ -355,22 +362,18 @@ Tcl_SetByteArrayLength(objPtr, length)
 
     byteArrayPtr = GET_BYTEARRAY(objPtr);
     if (length > byteArrayPtr->allocated) {
-	newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
-	newByteArrayPtr->used = length;
-	newByteArrayPtr->allocated = length;
-	memcpy((VOID *) newByteArrayPtr->bytes,
-		(VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
-	ckfree((char *) byteArrayPtr);
-	byteArrayPtr = newByteArrayPtr;
+	byteArrayPtr = (ByteArray *) ckrealloc(
+		(char *) byteArrayPtr, BYTEARRAY_SIZE(length));
+	byteArrayPtr->allocated = length;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
-    Tcl_InvalidateStringRep(objPtr);
+    TclInvalidateStringRep(objPtr);
     byteArrayPtr->used = length;
     return byteArrayPtr->bytes;
 }
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * SetByteArrayFromAny --
  *
@@ -382,24 +385,22 @@ Tcl_SetByteArrayLength(objPtr, length)
  * Side effects:
  *	A ByteArray object is stored as the internal rep of objPtr.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static int
-SetByteArrayFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Not used. */
-    Tcl_Obj *objPtr;		/* The object to convert to type ByteArray. */
+SetByteArrayFromAny(
+    Tcl_Interp *interp,		/* Not used. */
+    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
 {
-    Tcl_ObjType *typePtr;
     int length;
     char *src, *srcEnd;
     unsigned char *dst;
     ByteArray *byteArrayPtr;
     Tcl_UniChar ch;
-    
-    typePtr = objPtr->typePtr;
-    if (typePtr != &tclByteArrayType) {
-	src = Tcl_GetStringFromObj(objPtr, &length);
+
+    if (objPtr->typePtr != &tclByteArrayType) {
+	src = TclGetStringFromObj(objPtr, &length);
 	srcEnd = src + length;
 
 	byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
@@ -411,9 +412,7 @@ SetByteArrayFromAny(interp, objPtr)
 	byteArrayPtr->used = dst - byteArrayPtr->bytes;
 	byteArrayPtr->allocated = length;
 
-	if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
-	    (*typePtr->freeIntRepProc)(objPtr);
-	}
+	TclFreeIntRep(objPtr);
 	objPtr->typePtr = &tclByteArrayType;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
@@ -432,26 +431,26 @@ SetByteArrayFromAny(interp, objPtr)
  *	None.
  *
  * Side effects:
- *	Frees memory. 
+ *	Frees memory.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeByteArrayInternalRep(objPtr)
-    Tcl_Obj *objPtr;		/* Object with internal rep to free. */
+FreeByteArrayInternalRep(
+    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
     ckfree((char *) GET_BYTEARRAY(objPtr));
+    objPtr->typePtr = NULL;
 }
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * DupByteArrayInternalRep --
  *
- *	Initialize the internal representation of a ByteArray Tcl_Obj
- *	to a copy of the internal representation of an existing ByteArray
- *	object. 
+ *	Initialize the internal representation of a ByteArray Tcl_Obj to a
+ *	copy of the internal representation of an existing ByteArray object.
  *
  * Results:
  *	None.
@@ -459,16 +458,16 @@ FreeByteArrayInternalRep(objPtr)
  * Side effects:
  *	Allocates memory.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static void
-DupByteArrayInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+DupByteArrayInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
     int length;
-    ByteArray *srcArrayPtr, *copyArrayPtr;    
+    ByteArray *srcArrayPtr, *copyArrayPtr;
 
     srcArrayPtr = GET_BYTEARRAY(srcPtr);
     length = srcArrayPtr->used;
@@ -476,38 +475,37 @@ DupByteArrayInternalRep(srcPtr, copyPtr)
     copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
     copyArrayPtr->used = length;
     copyArrayPtr->allocated = length;
-    memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
-	    (size_t) length);
+    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
     SET_BYTEARRAY(copyPtr, copyArrayPtr);
 
     copyPtr->typePtr = &tclByteArrayType;
 }
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * UpdateStringOfByteArray --
  *
- *	Update the string representation for a ByteArray data object.
- *	Note: This procedure does not invalidate an existing old string rep
- *	so storage will be lost if this has not already been done. 
+ *	Update the string representation for a ByteArray data object. Note:
+ *	This procedure does not invalidate an existing old string rep so
+ *	storage will be lost if this has not already been done.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's string is set to a valid string that results from
- *	the ByteArray-to-string conversion.
+ *	The object's string is set to a valid string that results from the
+ *	ByteArray-to-string conversion.
  *
- *	The object becomes a string object -- the internal rep is
- *	discarded and the typePtr becomes NULL.
+ *	The object becomes a string object -- the internal rep is discarded
+ *	and the typePtr becomes NULL.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfByteArray(objPtr)
-    Tcl_Obj *objPtr;		/* ByteArray object whose string rep to
+UpdateStringOfByteArray(
+    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
 				 * update. */
 {
     int i, length, size;
@@ -522,20 +520,23 @@ UpdateStringOfByteArray(objPtr)
     /*
      * How much space will string rep need?
      */
-     
+
     size = length;
-    for (i = 0; i < length; i++) {
+    for (i = 0; i < length && size >= 0; i++) {
 	if ((src[i] == 0) || (src[i] > 127)) {
 	    size++;
 	}
     }
+    if (size < 0) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
 
     dst = (char *) ckalloc((unsigned) (size + 1));
     objPtr->bytes = dst;
     objPtr->length = size;
 
     if (size == length) {
-	memcpy((VOID *) dst, (VOID *) src, (size_t) size);
+	memcpy(dst, src, (size_t) size);
 	dst[size] = '\0';
     } else {
 	for (i = 0; i < length; i++) {
@@ -562,11 +563,11 @@ UpdateStringOfByteArray(objPtr)
  */
 
 int
-Tcl_BinaryObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_BinaryObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int arg;			/* Index of next argument to consume. */
     int value = 0;		/* Current integer value to be packed.
@@ -574,19 +575,21 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
     char cmd;			/* Current format character. */
     int count;			/* Count associated with current format
 				 * character. */
+    int flags;			/* Format field flags */
     char *format;		/* Pointer to current position in format
 				 * string. */
-    Tcl_Obj *resultPtr;		/* Object holding result buffer. */
+    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
     unsigned char *buffer;	/* Start of result buffer. */
     unsigned char *cursor;	/* Current position within result buffer. */
     unsigned char *maxPos;	/* Greatest position within result buffer that
 				 * cursor has visited.*/
-    char *errorString, *errorValue, *str;
+    const char *errorString;
+    char *errorValue, *str;
     int offset, size, length, index;
-    static CONST char *options[] = { 
-	"format",	"scan",		NULL 
+    static const char *options[] = {
+	"format",	"scan",		NULL
     };
-    enum options { 
+    enum options {
 	BINARY_FORMAT,	BINARY_SCAN
     };
 
@@ -601,760 +604,765 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
     }
 
     switch ((enum options) index) {
-	case BINARY_FORMAT: {
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
-		return TCL_ERROR;
-	    }
+    case BINARY_FORMAT:
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
+	    return TCL_ERROR;
+	}
 
-	    /*
-	     * To avoid copying the data, we format the string in two passes.
-	     * The first pass computes the size of the output buffer.  The
-	     * second pass places the formatted data into the buffer.
-	     */
+	/*
+	 * To avoid copying the data, we format the string in two passes. The
+	 * first pass computes the size of the output buffer. The second pass
+	 * places the formatted data into the buffer.
+	 */
 
-	    format = Tcl_GetString(objv[2]);
-	    arg = 3;
-	    offset = 0;
-	    length = 0;
-	    while (*format != '\0') {
-		str = format;
-		if (!GetFormatSpec(&format, &cmd, &count)) {
-		    break;
+	format = TclGetString(objv[2]);
+	arg = 3;
+	offset = 0;
+	length = 0;
+	while (*format != '\0') {
+	    str = format;
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+		break;
+	    }
+	    switch (cmd) {
+	    case 'a':
+	    case 'A':
+	    case 'b':
+	    case 'B':
+	    case 'h':
+	    case 'H':
+		/*
+		 * For string-type specifiers, the count corresponds to the
+		 * number of bytes in a single argument.
+		 */
+
+		if (arg >= objc) {
+		    goto badIndex;
+		}
+		if (count == BINARY_ALL) {
+		    Tcl_GetByteArrayFromObj(objv[arg], &count);
+		} else if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		arg++;
+		if (cmd == 'a' || cmd == 'A') {
+		    offset += count;
+		} else if (cmd == 'b' || cmd == 'B') {
+		    offset += (count + 7) / 8;
+		} else {
+		    offset += (count + 1) / 2;
+		}
+		break;
+	    case 'c':
+		size = 1;
+		goto doNumbers;
+	    case 't':
+	    case 's':
+	    case 'S':
+		size = 2;
+		goto doNumbers;
+	    case 'n':
+	    case 'i':
+	    case 'I':
+		size = 4;
+		goto doNumbers;
+	    case 'm':
+	    case 'w':
+	    case 'W':
+		size = 8;
+		goto doNumbers;
+	    case 'r':
+	    case 'R':
+	    case 'f':
+		size = sizeof(float);
+		goto doNumbers;
+	    case 'q':
+	    case 'Q':
+	    case 'd':
+		size = sizeof(double);
+
+	    doNumbers:
+		if (arg >= objc) {
+		    goto badIndex;
 		}
-		switch (cmd) {
-		    case 'a':
-		    case 'A':
-		    case 'b':
-		    case 'B':
-		    case 'h':
-		    case 'H': {
-			/*
-			 * For string-type specifiers, the count corresponds
-			 * to the number of bytes in a single argument.
-			 */
-
-			if (arg >= objc) {
-			    goto badIndex;
-			}
-			if (count == BINARY_ALL) {
-			    Tcl_GetByteArrayFromObj(objv[arg], &count);
-			} else if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			arg++;
-			if (cmd == 'a' || cmd == 'A') {
-			    offset += count;
-			} else if (cmd == 'b' || cmd == 'B') {
-			    offset += (count + 7) / 8;
-			} else {
-			    offset += (count + 1) / 2;
-			}
-			break;
-		    }
-		    case 'c': {
-			size = 1;
-			goto doNumbers;
-		    }
-		    case 's':
-		    case 'S': {
-			size = 2;
-			goto doNumbers;
-		    }
-		    case 'i':
-		    case 'I': {
-			size = 4;
-			goto doNumbers;
-		    }
-		    case 'w':
-		    case 'W': {
-			size = 8;
-			goto doNumbers;
-		    }
-		    case 'f': {
-			size = sizeof(float);
-			goto doNumbers;
-		    }
-		    case 'd': {
-			size = sizeof(double);
-			
-			doNumbers:
-			if (arg >= objc) {
-			    goto badIndex;
-			}
 
-			/*
-			 * For number-type specifiers, the count corresponds
-			 * to the number of elements in the list stored in
-			 * a single argument.  If no count is specified, then
-			 * the argument is taken as a single non-list value.
-			 */
+		/*
+		 * For number-type specifiers, the count corresponds to the
+		 * number of elements in the list stored in a single argument.
+		 * If no count is specified, then the argument is taken as a
+		 * single non-list value.
+		 */
 
-			if (count == BINARY_NOCOUNT) {
-			    arg++;
-			    count = 1;
-			} else {
-			    int listc;
-			    Tcl_Obj **listv;
-			    if (Tcl_ListObjGetElements(interp, objv[arg++],
-				    &listc, &listv) != TCL_OK) {
-				return TCL_ERROR;
-			    }
-			    if (count == BINARY_ALL) {
-				count = listc;
-			    } else if (count > listc) {
-			        Tcl_AppendResult(interp, 
-					"number of elements in list does not match count",
-					(char *) NULL);
-				return TCL_ERROR;
-			    }
-			}
-			offset += count*size;
-			break;
-		    }
-		    case 'x': {
-			if (count == BINARY_ALL) {
-			    Tcl_AppendResult(interp, 
-				    "cannot use \"*\" in format string with \"x\"",
-				    (char *) NULL);
-			    return TCL_ERROR;
-			} else if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			offset += count;
-			break;
-		    }
-		    case 'X': {
-			if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			if ((count > offset) || (count == BINARY_ALL)) {
-			    count = offset;
-			}
-			if (offset > length) {
-			    length = offset;
-			}
-			offset -= count;
-			break;
-		    }
-		    case '@': {
-			if (offset > length) {
-			    length = offset;
-			}
-			if (count == BINARY_ALL) {
-			    offset = length;
-			} else if (count == BINARY_NOCOUNT) {
-			    goto badCount;
-			} else {
-			    offset = count;
-			}
-			break;
+		if (count == BINARY_NOCOUNT) {
+		    arg++;
+		    count = 1;
+		} else {
+		    int listc;
+		    Tcl_Obj **listv;
+
+		    /* The macro evals its args more than once: avoid arg++ */		    
+		    if (TclListObjGetElements(interp, objv[arg], &listc,
+			    &listv) != TCL_OK) {
+			return TCL_ERROR;
 		    }
-		    default: {
-			errorString = str;
-			goto badField;
+		    arg++;
+		    
+		    if (count == BINARY_ALL) {
+			count = listc;
+		    } else if (count > listc) {
+			Tcl_AppendResult(interp,
+				"number of elements in list does not match count",
+				NULL);
+			return TCL_ERROR;
 		    }
 		}
+		offset += count*size;
+		break;
+
+	    case 'x':
+		if (count == BINARY_ALL) {
+		    Tcl_AppendResult(interp,
+			    "cannot use \"*\" in format string with \"x\"",
+			    NULL);
+		    return TCL_ERROR;
+		} else if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		offset += count;
+		break;
+	    case 'X':
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		if ((count > offset) || (count == BINARY_ALL)) {
+		    count = offset;
+		}
+		if (offset > length) {
+		    length = offset;
+		}
+		offset -= count;
+		break;
+	    case '@':
+		if (offset > length) {
+		    length = offset;
+		}
+		if (count == BINARY_ALL) {
+		    offset = length;
+		} else if (count == BINARY_NOCOUNT) {
+		    goto badCount;
+		} else {
+		    offset = count;
+		}
+		break;
+	    default:
+		errorString = str;
+		goto badField;
 	    }
-	    if (offset > length) {
-		length = offset;
-	    }
-	    if (length == 0) {
-		return TCL_OK;
-	    }
+	}
+	if (offset > length) {
+	    length = offset;
+	}
+	if (length == 0) {
+	    return TCL_OK;
+	}
 
-	    /*
-	     * Prepare the result object by preallocating the caclulated
-	     * number of bytes and filling with nulls.
-	     */
+	/*
+	 * Prepare the result object by preallocating the caclulated number of
+	 * bytes and filling with nulls.
+	 */
 
-	    resultPtr = Tcl_GetObjResult(interp);
-	    if (Tcl_IsShared(resultPtr)) {
-		TclNewObj(resultPtr);
-		Tcl_SetObjResult(interp, resultPtr);
-	    }
-	    buffer = Tcl_SetByteArrayLength(resultPtr, length);
-	    memset((VOID *) buffer, 0, (size_t) length);
+	resultPtr = Tcl_NewObj();
+	buffer = Tcl_SetByteArrayLength(resultPtr, length);
+	memset(buffer, 0, (size_t) length);
 
-	    /*
-	     * Pack the data into the result object.  Note that we can skip
-	     * the error checking during this pass, since we have already
-	     * parsed the string once.
-	     */
+	/*
+	 * Pack the data into the result object. Note that we can skip the
+	 * error checking during this pass, since we have already parsed the
+	 * string once.
+	 */
 
-	    arg = 3;
-	    format = Tcl_GetString(objv[2]);
-	    cursor = buffer;
-	    maxPos = cursor;
-	    while (*format != 0) {
-		if (!GetFormatSpec(&format, &cmd, &count)) {
-		    break;
+	arg = 3;
+	format = TclGetString(objv[2]);
+	cursor = buffer;
+	maxPos = cursor;
+	while (*format != 0) {
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+		break;
+	    }
+	    if ((count == 0) && (cmd != '@')) {
+		if (cmd != 'x') {
+		    arg++;
 		}
-		if ((count == 0) && (cmd != '@')) {
-		    if (cmd != 'x') {
-			arg++;
-		    }
-		    continue;
+		continue;
+	    }
+	    switch (cmd) {
+	    case 'a':
+	    case 'A': {
+		char pad = (char) (cmd == 'a' ? '\0' : ' ');
+		unsigned char *bytes;
+
+		bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
+
+		if (count == BINARY_ALL) {
+		    count = length;
+		} else if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		if (length >= count) {
+		    memcpy(cursor, bytes, (size_t) count);
+		} else {
+		    memcpy(cursor, bytes, (size_t) length);
+		    memset(cursor + length, pad, (size_t) (count - length));
 		}
-		switch (cmd) {
-		    case 'a':
-		    case 'A': {
-			char pad = (char) (cmd == 'a' ? '\0' : ' ');
-			unsigned char *bytes;
-
-			bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
-
-			if (count == BINARY_ALL) {
-			    count = length;
-			} else if (count == BINARY_NOCOUNT) {
-			    count = 1;
+		cursor += count;
+		break;
+	    }
+	    case 'b':
+	    case 'B': {
+		unsigned char *last;
+
+		str = TclGetStringFromObj(objv[arg], &length);
+		arg++;
+		if (count == BINARY_ALL) {
+		    count = length;
+		} else if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		last = cursor + ((count + 7) / 8);
+		if (count > length) {
+		    count = length;
+		}
+		value = 0;
+		errorString = "binary";
+		if (cmd == 'B') {
+		    for (offset = 0; offset < count; offset++) {
+			value <<= 1;
+			if (str[offset] == '1') {
+			    value |= 1;
+			} else if (str[offset] != '0') {
+			    errorValue = str;
+			    Tcl_DecrRefCount(resultPtr);
+			    goto badValue;
 			}
-			if (length >= count) {
-			    memcpy((VOID *) cursor, (VOID *) bytes,
-				    (size_t) count);
-			} else {
-			    memcpy((VOID *) cursor, (VOID *) bytes,
-				    (size_t) length);
-			    memset((VOID *) (cursor + length), pad,
-			            (size_t) (count - length));
+			if (((offset + 1) % 8) == 0) {
+			    *cursor++ = (unsigned char) value;
+			    value = 0;
 			}
-			cursor += count;
-			break;
 		    }
-		    case 'b':
-		    case 'B': {
-			unsigned char *last;
-			
-			str = Tcl_GetStringFromObj(objv[arg++], &length);
-			if (count == BINARY_ALL) {
-			    count = length;
-			} else if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			last = cursor + ((count + 7) / 8);
-			if (count > length) {
-			    count = length;
-			}
-			value = 0;
-			errorString = "binary";
-			if (cmd == 'B') {
-			    for (offset = 0; offset < count; offset++) {
-				value <<= 1;
-				if (str[offset] == '1') {
-				    value |= 1;
-				} else if (str[offset] != '0') {
-				    errorValue = str;
-				    goto badValue;
-				}
-				if (((offset + 1) % 8) == 0) {
-				    *cursor++ = (unsigned char) value;
-				    value = 0;
-				}
-			    }
-			} else {
-			    for (offset = 0; offset < count; offset++) {
-				value >>= 1;
-				if (str[offset] == '1') {
-				    value |= 128;
-				} else if (str[offset] != '0') {
-				    errorValue = str;
-				    goto badValue;
-				}
-				if (!((offset + 1) % 8)) {
-				    *cursor++ = (unsigned char) value;
-				    value = 0;
-				}
-			    }
+		} else {
+		    for (offset = 0; offset < count; offset++) {
+			value >>= 1;
+			if (str[offset] == '1') {
+			    value |= 128;
+			} else if (str[offset] != '0') {
+			    errorValue = str;
+			    Tcl_DecrRefCount(resultPtr);
+			    goto badValue;
 			}
-			if ((offset % 8) != 0) {
-			    if (cmd == 'B') {
-				value <<= 8 - (offset % 8);
-			    } else {
-				value >>= 8 - (offset % 8);
-			    }
+			if (!((offset + 1) % 8)) {
 			    *cursor++ = (unsigned char) value;
+			    value = 0;
 			}
-			while (cursor < last) {
-			    *cursor++ = '\0';
-			}
-			break;
 		    }
-		    case 'h':
-		    case 'H': {
-			unsigned char *last;
-			int c;
-			
-			str = Tcl_GetStringFromObj(objv[arg++], &length);
-			if (count == BINARY_ALL) {
-			    count = length;
-			} else if (count == BINARY_NOCOUNT) {
-			    count = 1;
+		}
+		if ((offset % 8) != 0) {
+		    if (cmd == 'B') {
+			value <<= 8 - (offset % 8);
+		    } else {
+			value >>= 8 - (offset % 8);
+		    }
+		    *cursor++ = (unsigned char) value;
+		}
+		while (cursor < last) {
+		    *cursor++ = '\0';
+		}
+		break;
+	    }
+	    case 'h':
+	    case 'H': {
+		unsigned char *last;
+		int c;
+
+		str = TclGetStringFromObj(objv[arg], &length);
+		arg++;
+		if (count == BINARY_ALL) {
+		    count = length;
+		} else if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		last = cursor + ((count + 1) / 2);
+		if (count > length) {
+		    count = length;
+		}
+		value = 0;
+		errorString = "hexadecimal";
+		if (cmd == 'H') {
+		    for (offset = 0; offset < count; offset++) {
+			value <<= 4;
+			if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
+			    errorValue = str;
+			    Tcl_DecrRefCount(resultPtr);
+			    goto badValue;
 			}
-			last = cursor + ((count + 1) / 2);
-			if (count > length) {
-			    count = length;
+			c = str[offset] - '0';
+			if (c > 9) {
+			    c += ('0' - 'A') + 10;
 			}
-			value = 0;
-			errorString = "hexadecimal";
-			if (cmd == 'H') {
-			    for (offset = 0; offset < count; offset++) {
-				value <<= 4;
-				if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
-				    errorValue = str;
-				    goto badValue;
-				}
-				c = str[offset] - '0';
-				if (c > 9) {
-				    c += ('0' - 'A') + 10;
-				}
-				if (c > 16) {
-				    c += ('A' - 'a');
-				}
-				value |= (c & 0xf);
-				if (offset % 2) {
-				    *cursor++ = (char) value;
-				    value = 0;
-				}
-			    }
-			} else {
-			    for (offset = 0; offset < count; offset++) {
-				value >>= 4;
-
-				if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
-				    errorValue = str;
-				    goto badValue;
-				}
-				c = str[offset] - '0';
-				if (c > 9) {
-				    c += ('0' - 'A') + 10;
-				}
-				if (c > 16) {
-				    c += ('A' - 'a');
-				}
-				value |= ((c << 4) & 0xf0);
-				if (offset % 2) {
-				    *cursor++ = (unsigned char)(value & 0xff);
-				    value = 0;
-				}
-			    }
+			if (c > 16) {
+			    c += ('A' - 'a');
 			}
+			value |= (c & 0xf);
 			if (offset % 2) {
-			    if (cmd == 'H') {
-				value <<= 4;
-			    } else {
-				value >>= 4;
-			    }
-			    *cursor++ = (unsigned char) value;
+			    *cursor++ = (char) value;
+			    value = 0;
 			}
+		    }
+		} else {
+		    for (offset = 0; offset < count; offset++) {
+			value >>= 4;
 
-			while (cursor < last) {
-			    *cursor++ = '\0';
+			if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
+			    errorValue = str;
+			    Tcl_DecrRefCount(resultPtr);
+			    goto badValue;
 			}
-			break;
-		    }
-		    case 'c':
-		    case 's':
-		    case 'S':
-		    case 'i':
-		    case 'I':
-		    case 'w':
-		    case 'W':
-		    case 'd':
-		    case 'f': {
-			int listc, i;
-			Tcl_Obj **listv;
-
-			if (count == BINARY_NOCOUNT) {
-			    /*
-			     * Note that we are casting away the const-ness of
-			     * objv, but this is safe since we aren't going to
-			     * modify the array.
-			     */
-
-			    listv = (Tcl_Obj**)(objv + arg);
-			    listc = 1;
-			    count = 1;
-			} else {
-			    Tcl_ListObjGetElements(interp, objv[arg],
-				    &listc, &listv);
-			    if (count == BINARY_ALL) {
-				count = listc;
-			    }
+			c = str[offset] - '0';
+			if (c > 9) {
+			    c += ('0' - 'A') + 10;
 			}
-			arg++;
-			for (i = 0; i < count; i++) {
-			    if (FormatNumber(interp, cmd, listv[i], &cursor)
-				    != TCL_OK) {
-				return TCL_ERROR;
-			    }
+			if (c > 16) {
+			    c += ('A' - 'a');
 			}
-			break;
-		    }
-		    case 'x': {
-			if (count == BINARY_NOCOUNT) {
-			    count = 1;
+			value |= ((c << 4) & 0xf0);
+			if (offset % 2) {
+			    *cursor++ = (unsigned char)(value & 0xff);
+			    value = 0;
 			}
-			memset(cursor, 0, (size_t) count);
-			cursor += count;
-			break;
 		    }
-		    case 'X': {
-			if (cursor > maxPos) {
-			    maxPos = cursor;
-			}
-			if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			if ((count == BINARY_ALL)
-				|| (count > (cursor - buffer))) {
-			    cursor = buffer;
-			} else {
-			    cursor -= count;
-			}
-			break;
+		}
+		if (offset % 2) {
+		    if (cmd == 'H') {
+			value <<= 4;
+		    } else {
+			value >>= 4;
 		    }
-		    case '@': {
-			if (cursor > maxPos) {
-			    maxPos = cursor;
-			}
-			if (count == BINARY_ALL) {
-			    cursor = maxPos;
-			} else {
-			    cursor = buffer + count;
-			}
-			break;
+		    *cursor++ = (unsigned char) value;
+		}
+
+		while (cursor < last) {
+		    *cursor++ = '\0';
+		}
+		break;
+	    }
+	    case 'c':
+	    case 't':
+	    case 's':
+	    case 'S':
+	    case 'n':
+	    case 'i':
+	    case 'I':
+	    case 'm':
+	    case 'w':
+	    case 'W':
+	    case 'r':
+	    case 'R':
+	    case 'd':
+	    case 'q':
+	    case 'Q':
+	    case 'f': {
+		int listc, i;
+		Tcl_Obj **listv;
+
+		if (count == BINARY_NOCOUNT) {
+		    /*
+		     * Note that we are casting away the const-ness of objv,
+		     * but this is safe since we aren't going to modify the
+		     * array.
+		     */
+
+		    listv = (Tcl_Obj**)(objv + arg);
+		    listc = 1;
+		    count = 1;
+		} else {
+		    TclListObjGetElements(interp, objv[arg], &listc, &listv);
+		    if (count == BINARY_ALL) {
+			count = listc;
 		    }
 		}
+		arg++;
+		for (i = 0; i < count; i++) {
+		    if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
+			Tcl_DecrRefCount(resultPtr);
+			return TCL_ERROR;
+		    }
+		}
+		break;
+	    }
+	    case 'x':
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		memset(cursor, 0, (size_t) count);
+		cursor += count;
+		break;
+	    case 'X':
+		if (cursor > maxPos) {
+		    maxPos = cursor;
+		}
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		if ((count == BINARY_ALL) || (count > (cursor - buffer))) {
+		    cursor = buffer;
+		} else {
+		    cursor -= count;
+		}
+		break;
+	    case '@':
+		if (cursor > maxPos) {
+		    maxPos = cursor;
+		}
+		if (count == BINARY_ALL) {
+		    cursor = maxPos;
+		} else {
+		    cursor = buffer + count;
+		}
+		break;
 	    }
-	    break;
 	}
-	case BINARY_SCAN: {
-	    int i;
-	    Tcl_Obj *valuePtr, *elementPtr;
-	    Tcl_HashTable numberCacheHash;
-	    Tcl_HashTable *numberCachePtr;
-
-	    if (objc < 4) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"value formatString ?varName varName ...?");
-		return TCL_ERROR;
+	Tcl_SetObjResult(interp, resultPtr);
+	break;
+    case BINARY_SCAN: {
+	int i;
+	Tcl_Obj *valuePtr, *elementPtr;
+	Tcl_HashTable numberCacheHash;
+	Tcl_HashTable *numberCachePtr;
+
+	if (objc < 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "value formatString ?varName varName ...?");
+	    return TCL_ERROR;
+	}
+	numberCachePtr = &numberCacheHash;
+	Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
+	buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
+	format = TclGetString(objv[3]);
+	cursor = buffer;
+	arg = 4;
+	offset = 0;
+	while (*format != '\0') {
+	    str = format;
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
+		goto done;
 	    }
-	    numberCachePtr = &numberCacheHash;
-	    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
-	    buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
-	    format = Tcl_GetString(objv[3]);
-	    cursor = buffer;
-	    arg = 4;
-	    offset = 0;
-	    while (*format != '\0') {
-		str = format;
-		if (!GetFormatSpec(&format, &cmd, &count)) {
-		    goto done;
+	    switch (cmd) {
+	    case 'a':
+	    case 'A': {
+		unsigned char *src;
+
+		if (arg >= objc) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    goto badIndex;
+		}
+		if (count == BINARY_ALL) {
+		    count = length - offset;
+		} else {
+		    if (count == BINARY_NOCOUNT) {
+			count = 1;
+		    }
+		    if (count > (length - offset)) {
+			goto done;
+		    }
 		}
-		switch (cmd) {
-		    case 'a':
-		    case 'A': {
-			unsigned char *src;
-
-			if (arg >= objc) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    goto badIndex;
-			}
-			if (count == BINARY_ALL) {
-			    count = length - offset;
-			} else {
-			    if (count == BINARY_NOCOUNT) {
-				count = 1;
-			    }
-			    if (count > (length - offset)) {
-				goto done;
-			    }
-			}
 
-			src = buffer + offset;
-			size = count;
+		src = buffer + offset;
+		size = count;
 
-			/*
-			 * Trim trailing nulls and spaces, if necessary.
-			 */
+		/*
+		 * Trim trailing nulls and spaces, if necessary.
+		 */
 
-			if (cmd == 'A') {
-			    while (size > 0) {
-				if (src[size-1] != '\0' && src[size-1] != ' ') {
-				    break;
-				}
-				size--;
-			    }
+		if (cmd == 'A') {
+		    while (size > 0) {
+			if (src[size-1] != '\0' && src[size-1] != ' ') {
+			    break;
 			}
-			valuePtr = Tcl_NewByteArrayObj(src, size);
-			Tcl_IncrRefCount(valuePtr);
-			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
-			Tcl_DecrRefCount(valuePtr);
-			arg++;
-			if (resultPtr == NULL) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    return TCL_ERROR;
-			}
-			offset += count;
-			break;
+			size--;
 		    }
-		    case 'b':
-		    case 'B': {
-			unsigned char *src;
-			char *dest;
-
-			if (arg >= objc) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    goto badIndex;
-			}
-			if (count == BINARY_ALL) {
-			    count = (length - offset) * 8;
-			} else {
-			    if (count == BINARY_NOCOUNT) {
-				count = 1;
-			    }
-			    if (count > (length - offset) * 8) {
-				goto done;
-			    }
-			}
-			src = buffer + offset;
-			valuePtr = Tcl_NewObj();
-			Tcl_SetObjLength(valuePtr, count);
-			dest = Tcl_GetString(valuePtr);
-
-			if (cmd == 'b') {
-			    for (i = 0; i < count; i++) {
-				if (i % 8) {
-				    value >>= 1;
-				} else {
-				    value = *src++;
-				}
-				*dest++ = (char) ((value & 1) ? '1' : '0');
-			    }
-			} else {
-			    for (i = 0; i < count; i++) {
-				if (i % 8) {
-				    value <<= 1;
-				} else {
-				    value = *src++;
-				}
-				*dest++ = (char) ((value & 0x80) ? '1' : '0');
-			    }
-			}
+		}
 
-			Tcl_IncrRefCount(valuePtr);			
-			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
-			Tcl_DecrRefCount(valuePtr);
-			arg++;
-			if (resultPtr == NULL) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    return TCL_ERROR;
-			}
-			offset += (count + 7 ) / 8;
-			break;
+		/*
+		 * Have to do this #ifdef-fery because (as part of defining
+		 * Tcl_NewByteArrayObj) we removed the #def that hides this
+		 * stuff normally. If this code ever gets copied to another
+		 * file, it should be changed back to the simpler version.
+		 */
+
+#ifdef TCL_MEM_DEBUG
+		valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__);
+#else
+		valuePtr = Tcl_NewByteArrayObj(src, size);
+#endif /* TCL_MEM_DEBUG */
+
+		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+			TCL_LEAVE_ERR_MSG);
+		arg++;
+		if (resultPtr == NULL) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    return TCL_ERROR;
+		}
+		offset += count;
+		break;
+	    }
+	    case 'b':
+	    case 'B': {
+		unsigned char *src;
+		char *dest;
+
+		if (arg >= objc) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    goto badIndex;
+		}
+		if (count == BINARY_ALL) {
+		    count = (length - offset) * 8;
+		} else {
+		    if (count == BINARY_NOCOUNT) {
+			count = 1;
 		    }
-		    case 'h':
-		    case 'H': {
-			char *dest;
-			unsigned char *src;
-			int i;
-			static CONST char hexdigit[] = "0123456789abcdef";
-
-			if (arg >= objc) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    goto badIndex;
-			}
-			if (count == BINARY_ALL) {
-			    count = (length - offset)*2;
+		    if (count > (length - offset) * 8) {
+			goto done;
+		    }
+		}
+		src = buffer + offset;
+		valuePtr = Tcl_NewObj();
+		Tcl_SetObjLength(valuePtr, count);
+		dest = TclGetString(valuePtr);
+
+		if (cmd == 'b') {
+		    for (i = 0; i < count; i++) {
+			if (i % 8) {
+			    value >>= 1;
 			} else {
-			    if (count == BINARY_NOCOUNT) {
-				count = 1;
-			    }
-			    if (count > (length - offset)*2) {
-				goto done;
-			    }
+			    value = *src++;
 			}
-			src = buffer + offset;
-			valuePtr = Tcl_NewObj();
-			Tcl_SetObjLength(valuePtr, count);
-			dest = Tcl_GetString(valuePtr);
-
-			if (cmd == 'h') {
-			    for (i = 0; i < count; i++) {
-				if (i % 2) {
-				    value >>= 4;
-				} else {
-				    value = *src++;
-				}
-				*dest++ = hexdigit[value & 0xf];
-			    }
+			*dest++ = (char) ((value & 1) ? '1' : '0');
+		    }
+		} else {
+		    for (i = 0; i < count; i++) {
+			if (i % 8) {
+			    value <<= 1;
 			} else {
-			    for (i = 0; i < count; i++) {
-				if (i % 2) {
-				    value <<= 4;
-				} else {
-				    value = *src++;
-				}
-				*dest++ = hexdigit[(value >> 4) & 0xf];
-			    }
-			}
-			
-			Tcl_IncrRefCount(valuePtr);
-			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
-			Tcl_DecrRefCount(valuePtr);
-			arg++;
-			if (resultPtr == NULL) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    return TCL_ERROR;
+			    value = *src++;
 			}
-			offset += (count + 1) / 2;
-			break;
-		    }
-		    case 'c': {
-			size = 1;
-			goto scanNumber;
+			*dest++ = (char) ((value & 0x80) ? '1' : '0');
 		    }
-		    case 's':
-		    case 'S': {
-			size = 2;
-			goto scanNumber;
-		    }
-		    case 'i':
-		    case 'I': {
-			size = 4;
-			goto scanNumber;
-		    }
-		    case 'w':
-		    case 'W': {
-			size = 8;
-			goto scanNumber;
+		}
+
+		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+			TCL_LEAVE_ERR_MSG);
+		arg++;
+		if (resultPtr == NULL) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    return TCL_ERROR;
+		}
+		offset += (count + 7) / 8;
+		break;
+	    }
+	    case 'h':
+	    case 'H': {
+		char *dest;
+		unsigned char *src;
+		int i;
+		static const char hexdigit[] = "0123456789abcdef";
+
+		if (arg >= objc) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    goto badIndex;
+		}
+		if (count == BINARY_ALL) {
+		    count = (length - offset)*2;
+		} else {
+		    if (count == BINARY_NOCOUNT) {
+			count = 1;
 		    }
-		    case 'f': {
-			size = sizeof(float);
-			goto scanNumber;
+		    if (count > (length - offset)*2) {
+			goto done;
 		    }
-		    case 'd': {
-			unsigned char *src;
-
-			size = sizeof(double);
-			/* fall through */
-			
-			scanNumber:
-			if (arg >= objc) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    goto badIndex;
-			}
-			if (count == BINARY_NOCOUNT) {
-			    if ((length - offset) < size) {
-				goto done;
-			    }
-			    valuePtr = ScanNumber(buffer+offset, cmd,
-				    &numberCachePtr);
-			    offset += size;
+		}
+		src = buffer + offset;
+		valuePtr = Tcl_NewObj();
+		Tcl_SetObjLength(valuePtr, count);
+		dest = TclGetString(valuePtr);
+
+		if (cmd == 'h') {
+		    for (i = 0; i < count; i++) {
+			if (i % 2) {
+			    value >>= 4;
 			} else {
-			    if (count == BINARY_ALL) {
-				count = (length - offset) / size;
-			    }
-			    if ((length - offset) < (count * size)) {
-				goto done;
-			    }
-			    valuePtr = Tcl_NewObj();
-			    src = buffer+offset;
-			    for (i = 0; i < count; i++) {
-				elementPtr = ScanNumber(src, cmd,
-					&numberCachePtr);
-				src += size;
-				Tcl_ListObjAppendElement(NULL, valuePtr,
-					elementPtr);
-			    }
-			    offset += count*size;
+			    value = *src++;
 			}
-
-			Tcl_IncrRefCount(valuePtr); 
-			resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
-			Tcl_DecrRefCount(valuePtr);
-			arg++;
-			if (resultPtr == NULL) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    return TCL_ERROR;
-			}
-			break;
+			*dest++ = hexdigit[value & 0xf];
 		    }
-		    case 'x': {
-			if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			if ((count == BINARY_ALL)
-				|| (count > (length - offset))) {
-			    offset = length;
+		} else {
+		    for (i = 0; i < count; i++) {
+			if (i % 2) {
+			    value <<= 4;
 			} else {
-			    offset += count;
+			    value = *src++;
 			}
-			break;
+			*dest++ = hexdigit[(value >> 4) & 0xf];
 		    }
-		    case 'X': {
-			if (count == BINARY_NOCOUNT) {
-			    count = 1;
-			}
-			if ((count == BINARY_ALL) || (count > offset)) {
-			    offset = 0;
-			} else {
-			    offset -= count;
-			}
-			break;
+		}
+
+		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+			TCL_LEAVE_ERR_MSG);
+		arg++;
+		if (resultPtr == NULL) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    return TCL_ERROR;
+		}
+		offset += (count + 1) / 2;
+		break;
+	    }
+	    case 'c':
+		size = 1;
+		goto scanNumber;
+	    case 't':
+	    case 's':
+	    case 'S':
+		size = 2;
+		goto scanNumber;
+	    case 'n':
+	    case 'i':
+	    case 'I':
+		size = 4;
+		goto scanNumber;
+	    case 'm':
+	    case 'w':
+	    case 'W':
+		size = 8;
+		goto scanNumber;
+	    case 'r':
+	    case 'R':
+	    case 'f':
+		size = sizeof(float);
+		goto scanNumber;
+	    case 'q':
+	    case 'Q':
+	    case 'd': {
+		unsigned char *src;
+
+		size = sizeof(double);
+		/* fall through */
+
+	    scanNumber:
+		if (arg >= objc) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    goto badIndex;
+		}
+		if (count == BINARY_NOCOUNT) {
+		    if ((length - offset) < size) {
+			goto done;
 		    }
-		    case '@': {
-			if (count == BINARY_NOCOUNT) {
-			    DeleteScanNumberCache(numberCachePtr);
-			    goto badCount;
-			}
-			if ((count == BINARY_ALL) || (count > length)) {
-			    offset = length;
-			} else {
-			    offset = count;
-			}
-			break;
+		    valuePtr = ScanNumber(buffer+offset, cmd, flags,
+			    &numberCachePtr);
+		    offset += size;
+		} else {
+		    if (count == BINARY_ALL) {
+			count = (length - offset) / size;
+		    }
+		    if ((length - offset) < (count * size)) {
+			goto done;
 		    }
-		    default: {
-			DeleteScanNumberCache(numberCachePtr);
-			errorString = str;
-			goto badField;
+		    valuePtr = Tcl_NewObj();
+		    src = buffer+offset;
+		    for (i = 0; i < count; i++) {
+			elementPtr = ScanNumber(src, cmd, flags,
+				&numberCachePtr);
+			src += size;
+			Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
 		    }
+		    offset += count*size;
 		}
+
+		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+			TCL_LEAVE_ERR_MSG);
+		arg++;
+		if (resultPtr == NULL) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    return TCL_ERROR;
+		}
+		break;
 	    }
+	    case 'x':
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		if ((count == BINARY_ALL) || (count > (length - offset))) {
+		    offset = length;
+		} else {
+		    offset += count;
+		}
+		break;
+	    case 'X':
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
+		}
+		if ((count == BINARY_ALL) || (count > offset)) {
+		    offset = 0;
+		} else {
+		    offset -= count;
+		}
+		break;
+	    case '@':
+		if (count == BINARY_NOCOUNT) {
+		    DeleteScanNumberCache(numberCachePtr);
+		    goto badCount;
+		}
+		if ((count == BINARY_ALL) || (count > length)) {
+		    offset = length;
+		} else {
+		    offset = count;
+		}
+		break;
+	    default:
+		DeleteScanNumberCache(numberCachePtr);
+		errorString = str;
+		goto badField;
+	    }
+	}
 
-	    /*
-	     * Set the result to the last position of the cursor.
-	     */
+	/*
+	 * Set the result to the last position of the cursor.
+	 */
 
-	    done:
-	    Tcl_ResetResult(interp);
-	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
-	    DeleteScanNumberCache(numberCachePtr);
-	    break;
-	}
+    done:
+	Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
+	DeleteScanNumberCache(numberCachePtr);
+	break;
+    }
     }
     return TCL_OK;
 
-    badValue:
+  badValue:
     Tcl_ResetResult(interp);
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
+    Tcl_AppendResult(interp, "expected ", errorString,
 	    " string but got \"", errorValue, "\" instead", NULL);
     return TCL_ERROR;
 
-    badCount:
+  badCount:
     errorString = "missing count for \"@\" field specifier";
     goto error;
 
-    badIndex:
+  badIndex:
     errorString = "not enough arguments for all format specifiers";
     goto error;
 
-    badField:
+  badField:
     {
 	Tcl_UniChar ch;
 	char buf[TCL_UTF_MAX + 1];
@@ -1365,7 +1373,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    error:
+  error:
     Tcl_AppendResult(interp, errorString, NULL);
     return TCL_ERROR;
 }
@@ -1375,15 +1383,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
  *
  * GetFormatSpec --
  *
- *	This function parses the format strings used in the binary
- *	format and scan commands.
+ *	This function parses the format strings used in the binary format and
+ *	scan commands.
  *
  * Results:
- *	Moves the formatPtr to the start of the next command. Returns
- *	the current command character and count in cmdPtr and countPtr.
- *	The count is set to BINARY_ALL if the count character was '*'
- *	or BINARY_NOCOUNT if no count was specified.  Returns 1 on
- *	success, or 0 if the string did not have a format specifier.
+ *	Moves the formatPtr to the start of the next command. Returns the
+ *	current command character and count in cmdPtr and countPtr. The count
+ *	is set to BINARY_ALL if the count character was '*' or BINARY_NOCOUNT
+ *	if no count was specified. Returns 1 on success, or 0 if the string
+ *	did not have a format specifier.
  *
  * Side effects:
  *	None.
@@ -1392,10 +1400,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
  */
 
 static int
-GetFormatSpec(formatPtr, cmdPtr, countPtr)
-    char **formatPtr;		/* Pointer to format string. */
-    char *cmdPtr;		/* Pointer to location of command char. */
-    int *countPtr;		/* Pointer to repeat count value. */
+GetFormatSpec(
+    char **formatPtr,		/* Pointer to format string. */
+    char *cmdPtr,		/* Pointer to location of command char. */
+    int *countPtr,		/* Pointer to repeat count value. */
+    int *flagsPtr)		/* Pointer to field flags */
 {
     /*
      * Skip any leading blanks.
@@ -1419,6 +1428,10 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
 
     *cmdPtr = **formatPtr;
     (*formatPtr)++;
+    if (**formatPtr == 'u') {
+	(*formatPtr)++;
+	(*flagsPtr) |= BINARY_UNSIGNED;
+    }
     if (**formatPtr == '*') {
 	(*formatPtr)++;
 	(*countPtr) = BINARY_ALL;
@@ -1433,13 +1446,193 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * NeedReversing --
+ *
+ *	This routine determines, if bytes of a number need to be re-ordered,
+ *	and returns a numeric code indicating the re-ordering to be done.
+ *	This depends on the endiannes of the machine and the desired format.
+ *	It is in effect a table (whose contents depend on the endianness of
+ *	the system) describing whether a value needs reversing or not. Anyone
+ *	porting the code to a big-endian platform should take care to make
+ *	sure that they define WORDS_BIGENDIAN though this is already done by
+ *	configure for the Unix build; little-endian platforms (including
+ *	Windows) don't need to do anything.
+ *
+ * Results:
+ *	0	No re-ordering needed.
+ *	1	Reverse the bytes:	01234567 <-> 76543210 (little to big)
+ *	2	Apply this re-ordering: 01234567 <-> 45670123 (Nokia to little)
+ *	3	Apply this re-ordering: 01234567 <-> 32107654 (Nokia to big)
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NeedReversing(
+    int format)
+{
+    switch (format) {
+	/* native floats and doubles: never reverse */
+    case 'd':
+    case 'f':
+	/* big endian ints: never reverse */
+    case 'I':
+    case 'S':
+    case 'W':
+#ifdef WORDS_BIGENDIAN
+	/* native ints: reverse if we're little-endian */
+    case 'n':
+    case 't':
+    case 'm':
+	/* f: reverse if we're little-endian */
+    case 'Q':
+    case 'R':
+#else /* !WORDS_BIGENDIAN */
+	/* small endian floats: reverse if we're big-endian */
+    case 'r':
+#endif /* WORDS_BIGENDIAN */
+	return 0;
+
+#ifdef WORDS_BIGENDIAN
+	/* small endian floats: reverse if we're big-endian */
+    case 'q':
+    case 'r':
+#else /* !WORDS_BIGENDIAN */
+	/* native ints: reverse if we're little-endian */
+    case 'n':
+    case 't':
+    case 'm':
+	/* f: reverse if we're little-endian */
+    case 'R':
+#endif /* WORDS_BIGENDIAN */
+	/* small endian ints: always reverse */
+    case 'i':
+    case 's':
+    case 'w':
+	return 1;
+
+#ifndef WORDS_BIGENDIAN
+    /*
+     * The Q and q formats need special handling to account for the unusual
+     * byte ordering of 8-byte floats on Nokia 770 systems, which claim to be
+     * little-endian, but also reverse word order.
+     */
+
+    case 'Q':
+	if (TclNokia770Doubles()) {
+	    return 3;
+	}
+	return 1;
+    case 'q':
+	if (TclNokia770Doubles()) {
+	    return 2;
+	}
+	return 0;
+#endif
+    }
+
+    Tcl_Panic("unexpected fallthrough");
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyNumber --
+ *
+ *	This routine is called by FormatNumber and ScanNumber to copy a
+ *	floating-point number. If required, bytes are reversed while copying.
+ *	The behaviour is only fully defined when used with IEEE float and
+ *	double values (guaranteed to be 4 and 8 bytes long, respectively.)
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Copies length bytes
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CopyNumber(
+    const void *from,		/* source */
+    void *to,			/* destination */
+    unsigned int length,	/* Number of bytes to copy */
+    int type)			/* What type of thing are we copying? */
+{
+    switch (NeedReversing(type)) {
+    case 0: 
+	memcpy(to, from, length);
+	break;
+    case 1: {
+	const unsigned char *fromPtr = from;
+	unsigned char *toPtr = to;
+
+	switch (length) {
+	case 4:
+	    toPtr[0] = fromPtr[3];
+	    toPtr[1] = fromPtr[2];
+	    toPtr[2] = fromPtr[1];
+	    toPtr[3] = fromPtr[0];
+	    break;
+	case 8:
+	    toPtr[0] = fromPtr[7];
+	    toPtr[1] = fromPtr[6];
+	    toPtr[2] = fromPtr[5];
+	    toPtr[3] = fromPtr[4];
+	    toPtr[4] = fromPtr[3];
+	    toPtr[5] = fromPtr[2];
+	    toPtr[6] = fromPtr[1];
+	    toPtr[7] = fromPtr[0];
+	    break;
+	}
+	break;
+    }
+    case 2: {
+	const unsigned char *fromPtr = from;
+	unsigned char *toPtr = to;
+
+	toPtr[0] = fromPtr[4];
+	toPtr[1] = fromPtr[5];
+	toPtr[2] = fromPtr[6];
+	toPtr[3] = fromPtr[7];
+	toPtr[4] = fromPtr[0];
+	toPtr[5] = fromPtr[1];
+	toPtr[6] = fromPtr[2];
+	toPtr[7] = fromPtr[3];
+	break;
+    }
+    case 3: {
+	const unsigned char *fromPtr = from;
+	unsigned char *toPtr = to;
+
+	toPtr[0] = fromPtr[3];
+	toPtr[1] = fromPtr[2];
+	toPtr[2] = fromPtr[1];
+	toPtr[3] = fromPtr[0];
+	toPtr[4] = fromPtr[7];
+	toPtr[5] = fromPtr[6];
+	toPtr[6] = fromPtr[5];
+	toPtr[7] = fromPtr[4];
+	break;
+    }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * FormatNumber --
  *
- *	This routine is called by Tcl_BinaryObjCmd to format a number
- *	into a location pointed at by cursor.
+ *	This routine is called by Tcl_BinaryObjCmd to format a number into a
+ *	location pointed at by cursor.
  *
  * Results:
- *	 A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
  *	Moves the cursor to the next location to be written into.
@@ -1448,64 +1641,79 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
  */
 
 static int
-FormatNumber(interp, type, src, cursorPtr)
-    Tcl_Interp *interp;		/* Current interpreter, used to report
+FormatNumber(
+    Tcl_Interp *interp,		/* Current interpreter, used to report
 				 * errors. */
-    int type;			/* Type of number to format. */
-    Tcl_Obj *src;		/* Number to format. */
-    unsigned char **cursorPtr;	/* Pointer to index into destination buffer. */
+    int type,			/* Type of number to format. */
+    Tcl_Obj *src,		/* Number to format. */
+    unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
 {
     long value;
     double dvalue;
     Tcl_WideInt wvalue;
+    float fvalue;
 
     switch (type) {
     case 'd':
-    case 'f':
+    case 'q':
+    case 'Q':
 	/*
-	 * For floating point types, we need to copy the data using
-	 * memcpy to avoid alignment issues.
+	 * Double-precision floating point values. Tcl_GetDoubleFromObj
+	 * returns TCL_ERROR for NaN, but we can check by comparing the
+	 * object's type pointer.
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    return TCL_ERROR;
+	    if (src->typePtr != &tclDoubleType) {
+		return TCL_ERROR;
+	    }
+	    dvalue = src->internalRep.doubleValue;
 	}
-	if (type == 'd') {
-	    /*
-	     * Can't just memcpy() here. [Bug 1116542]
-	     */
-
-	    CopyNumber(&dvalue, *cursorPtr, sizeof(double));
-	    *cursorPtr += sizeof(double);
-	} else {
-	    float fvalue;
+	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
+	*cursorPtr += sizeof(double);
+	return TCL_OK;
 
-	    /*
-	     * Because some compilers will generate floating point exceptions
-	     * on an overflow cast (e.g. Borland), we restrict the values
-	     * to the valid range for float.
-	     */
+    case 'f':
+    case 'r':
+    case 'R':
+	/*
+	 * Single-precision floating point values. Tcl_GetDoubleFromObj
+	 * returns TCL_ERROR for NaN, but we can check by comparing the
+	 * object's type pointer.
+	 */
 
-	    if (fabs(dvalue) > (double)FLT_MAX) {
-		fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
-	    } else {
-		fvalue = (float) dvalue;
+	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+	    if (src->typePtr != &tclDoubleType) {
+		return TCL_ERROR;
 	    }
-	    memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
-	    *cursorPtr += sizeof(float);
+	    dvalue = src->internalRep.doubleValue;
+	}
+
+	/*
+	 * Because some compilers will generate floating point exceptions on
+	 * an overflow cast (e.g. Borland), we restrict the values to the
+	 * valid range for float.
+	 */
+
+	if (fabs(dvalue) > (double)FLT_MAX) {
+	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
+	} else {
+	    fvalue = (float) dvalue;
 	}
+	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
+	*cursorPtr += sizeof(float);
 	return TCL_OK;
 
 	/*
-	 * Next cases separate from other integer cases because we
-	 * need a different API to get a wide.
+	 * 64-bit integer values.
 	 */
     case 'w':
     case 'W':
+    case 'm':
 	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (type == 'w') {
+	if (NeedReversing(type)) {
 	    *(*cursorPtr)++ = (unsigned char) wvalue;
 	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
 	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
@@ -1525,170 +1733,221 @@ FormatNumber(interp, type, src, cursorPtr)
 	    *(*cursorPtr)++ = (unsigned char) wvalue;
 	}
 	return TCL_OK;
-    default:
-	if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+
+	/*
+	 * 32-bit integer values.
+	 */
+    case 'i':
+    case 'I':
+    case 'n':
+	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (type == 'c') {
-	    *(*cursorPtr)++ = (unsigned char) value;
-	} else if (type == 's') {
-	    *(*cursorPtr)++ = (unsigned char) value;
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
-	} else if (type == 'S') {
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
-	    *(*cursorPtr)++ = (unsigned char) value;
-	} else if (type == 'i') {
+	if (NeedReversing(type)) {
 	    *(*cursorPtr)++ = (unsigned char) value;
 	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
 	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
 	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
-	} else if (type == 'I') {
+	} else {
 	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
 	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
 	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
 	    *(*cursorPtr)++ = (unsigned char) value;
 	}
 	return TCL_OK;
+
+	/*
+	 * 16-bit integer values.
+	 */
+    case 's':
+    case 'S':
+    case 't':
+	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (NeedReversing(type)) {
+	    *(*cursorPtr)++ = (unsigned char) value;
+	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
+	} else {
+	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
+	    *(*cursorPtr)++ = (unsigned char) value;
+	}
+	return TCL_OK;
+
+	/*
+	 * 8-bit integer values.
+	 */
+    case 'c':
+	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	*(*cursorPtr)++ = (unsigned char) value;
+	return TCL_OK;
+
+    default:
+	Tcl_Panic("unexpected fallthrough");
+	return TCL_ERROR;
     }
 }
 
-/* Ugly workaround for old and broken compiler! */
-static void
-CopyNumber(from, to, length)
-    CONST VOID *from;
-    VOID *to;
-    unsigned int length;
-{
-    memcpy(to, from, length);
-}
-
 /*
  *----------------------------------------------------------------------
  *
  * ScanNumber --
  *
- *	This routine is called by Tcl_BinaryObjCmd to scan a number
- *	out of a buffer.
+ *	This routine is called by Tcl_BinaryObjCmd to scan a number out of a
+ *	buffer.
  *
  * Results:
- *	Returns a newly created object containing the scanned number.
- *	This object has a ref count of zero.
+ *	Returns a newly created object containing the scanned number. This
+ *	object has a ref count of zero.
  *
  * Side effects:
- *	Might reuse an object in the number cache, place a new object
- *	in the cache, or delete the cache and set the reference to
- *	it (itself passed in by reference) to NULL.
+ *	Might reuse an object in the number cache, place a new object in the
+ *	cache, or delete the cache and set the reference to it (itself passed
+ *	in by reference) to NULL.
  *
  *----------------------------------------------------------------------
  */
 
 static Tcl_Obj *
-ScanNumber(buffer, type, numberCachePtrPtr)
-    unsigned char *buffer;	/* Buffer to scan number from. */
-    int type;			/* Format character from "binary scan" */
-    Tcl_HashTable **numberCachePtrPtr;
+ScanNumber(
+    unsigned char *buffer,	/* Buffer to scan number from. */
+    int type,			/* Format character from "binary scan" */
+    int flags,			/* Format field flags */
+    Tcl_HashTable **numberCachePtrPtr)
 				/* Place to look for cache of scanned
 				 * value objects, or NULL if too many
 				 * different numbers have been scanned. */
 {
     long value;
+    float fvalue;
+    double dvalue;
     Tcl_WideUInt uwvalue;
 
     /*
      * We cannot rely on the compiler to properly sign extend integer values
      * when we cast from smaller values to larger values because we don't know
-     * the exact size of the integer types.  So, we have to handle sign
+     * the exact size of the integer types. So, we have to handle sign
      * extension explicitly by checking the high bit and padding with 1's as
-     * needed.
+     * needed. This practice is disabled if the BINARY_UNSIGNED flag is set.
      */
 
     switch (type) {
-	case 'c':
-	    /*
-	     * Characters need special handling.  We want to produce a
-	     * signed result, but on some platforms (such as AIX) chars
-	     * are unsigned.  To deal with this, check for a value that
-	     * should be negative but isn't.
-	     */
+    case 'c':
+	/*
+	 * Characters need special handling. We want to produce a signed
+	 * result, but on some platforms (such as AIX) chars are unsigned. To
+	 * deal with this, check for a value that should be negative but
+	 * isn't.
+	 */
 
-	    value = buffer[0];
+	value = buffer[0];
+	if (!(flags & BINARY_UNSIGNED)) {
 	    if (value & 0x80) {
 		value |= -0x100;
 	    }
-	    goto returnNumericObject;
+	}
+	goto returnNumericObject;
+
+	/*
+	 * 16-bit numeric values. We need the sign extension trick (see above)
+	 * here as well.
+	 */
 
-	case 's':
+    case 's':
+    case 'S':
+    case 't':
+	if (NeedReversing(type)) {
 	    value = (long) (buffer[0] + (buffer[1] << 8));
-	    goto shortValue;
-	case 'S':
+	} else {
 	    value = (long) (buffer[1] + (buffer[0] << 8));
-	    shortValue:
+	}
+	if (!(flags & BINARY_UNSIGNED)) {
 	    if (value & 0x8000) {
 		value |= -0x10000;
 	    }
-	    goto returnNumericObject;
+	}
+	goto returnNumericObject;
 
-	case 'i':
-	    value = (long) (buffer[0] 
+	/*
+	 * 32-bit numeric values.
+	 */
+
+    case 'i':
+    case 'I':
+    case 'n':
+	if (NeedReversing(type)) {
+	    value = (long) (buffer[0]
 		    + (buffer[1] << 8)
 		    + (buffer[2] << 16)
-		    + (buffer[3] << 24));
-	    goto intValue;
-	case 'I':
+		    + (((long)buffer[3]) << 24));
+	} else {
 	    value = (long) (buffer[3]
 		    + (buffer[2] << 8)
 		    + (buffer[1] << 16)
-		    + (buffer[0] << 24));
-	    intValue:
-	    /*
-	     * Check to see if the value was sign extended properly on
-	     * systems where an int is more than 32-bits.
-	     */
+		    + (((long)buffer[0]) << 24));
+	}
+
+	/*
+	 * Check to see if the value was sign extended properly on systems
+	 * where an int is more than 32-bits.
+	 * We avoid caching unsigned integers as we cannot distinguish between
+	 * 32bit signed and unsigned in the hash (short and char are ok).
+	 */
+
+	if (flags & BINARY_UNSIGNED) {
+	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
+	}
+	if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+	    value -= (((unsigned int)1)<<31);
+	    value -= (((unsigned int)1)<<31);
+	}
+
+    returnNumericObject:
+	if (*numberCachePtrPtr == NULL) {
+	    return Tcl_NewLongObj(value);
+	} else {
+	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
+	    register Tcl_HashEntry *hPtr;
+	    int isNew;
 
-	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
-		value -= (((unsigned int)1)<<31);
-		value -= (((unsigned int)1)<<31);
+	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
+	    if (!isNew) {
+		return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
 	    }
-	    returnNumericObject:
-	    if (*numberCachePtrPtr == NULL) {
-		return Tcl_NewLongObj(value);
-	    } else {
-		register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
-		register Tcl_HashEntry *hPtr;
-		int isNew;
-
-		hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
-		if (!isNew) {
-		    return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-		}
-		if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
-		    /*
-		     * We've overflowed the cache!  Someone's parsing
-		     * a LOT of varied binary data in a single call!
-		     * Bail out by switching back to the old behaviour
-		     * for the rest of the scan.
-		     *
-		     * Note that anyone just using the 'c' conversion
-		     * (for bytes) cannot trigger this.
-		     */
-		    DeleteScanNumberCache(tablePtr);
-		    *numberCachePtrPtr = NULL;
-		    return Tcl_NewLongObj(value);
-		} else {
-		    register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
+	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
+		register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
 
-		    Tcl_IncrRefCount(objPtr);
-		    Tcl_SetHashValue(hPtr, (ClientData) objPtr);
-		    return objPtr;
-		}
+		Tcl_IncrRefCount(objPtr);
+		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+		return objPtr;
 	    }
 
 	    /*
-	     * Do not cache wide values; they are already too large to
-	     * use as keys.
+	     * We've overflowed the cache! Someone's parsing a LOT of varied
+	     * binary data in a single call! Bail out by switching back to the
+	     * old behaviour for the rest of the scan.
+	     *
+	     * Note that anyone just using the 'c' conversion (for bytes)
+	     * cannot trigger this.
 	     */
-	case 'w':
-	    uwvalue =  ((Tcl_WideUInt) buffer[0])
+
+	    DeleteScanNumberCache(tablePtr);
+	    *numberCachePtrPtr = NULL;
+	    return Tcl_NewLongObj(value);
+	}
+
+	/*
+	 * Do not cache wide (64-bit) values; they are already too large to
+	 * use as keys.
+	 */
+
+    case 'w':
+    case 'W':
+    case 'm':
+	if (NeedReversing(type)) {
+	    uwvalue = ((Tcl_WideUInt) buffer[0])
 		    | (((Tcl_WideUInt) buffer[1]) << 8)
 		    | (((Tcl_WideUInt) buffer[2]) << 16)
 		    | (((Tcl_WideUInt) buffer[3]) << 24)
@@ -1696,9 +1955,8 @@ ScanNumber(buffer, type, numberCachePtrPtr)
 		    | (((Tcl_WideUInt) buffer[5]) << 40)
 		    | (((Tcl_WideUInt) buffer[6]) << 48)
 		    | (((Tcl_WideUInt) buffer[7]) << 56);
-	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
-	case 'W':
-	    uwvalue =  ((Tcl_WideUInt) buffer[7])
+	} else {
+	    uwvalue = ((Tcl_WideUInt) buffer[7])
 		    | (((Tcl_WideUInt) buffer[6]) << 8)
 		    | (((Tcl_WideUInt) buffer[5]) << 16)
 		    | (((Tcl_WideUInt) buffer[4]) << 24)
@@ -1706,23 +1964,42 @@ ScanNumber(buffer, type, numberCachePtrPtr)
 		    | (((Tcl_WideUInt) buffer[2]) << 40)
 		    | (((Tcl_WideUInt) buffer[1]) << 48)
 		    | (((Tcl_WideUInt) buffer[0]) << 56);
-	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
-
-	    /*
-	     * Do not cache double values; they are already too large
-	     * to use as keys and the values stored are utterly
-	     * incompatible too.
-	     */
-	case 'f': {
-	    float fvalue;
-	    memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
-	    return Tcl_NewDoubleObj(fvalue);
 	}
-	case 'd': {
-	    double dvalue;
-	    memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
-	    return Tcl_NewDoubleObj(dvalue);
+	if (flags & BINARY_UNSIGNED) {
+	    Tcl_Obj *bigObj = NULL;
+	    mp_int big;
+
+	    TclBNInitBignumFromWideUInt(&big, uwvalue);
+	    bigObj = Tcl_NewBignumObj(&big);
+	    return bigObj;
 	}
+	return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+
+	/*
+	 * Do not cache double values; they are already too large to use as
+	 * keys and the values stored are utterly incompatible with the
+	 * integer part of the cache.
+	 */
+
+	/*
+	 * 32-bit IEEE single-precision floating point.
+	 */
+
+    case 'f':
+    case 'R':
+    case 'r':
+	CopyNumber(buffer, &fvalue, sizeof(float), type);
+	return Tcl_NewDoubleObj(fvalue);
+
+	/*
+	 * 64-bit IEEE double-precision floating point.
+	 */
+
+    case 'd':
+    case 'Q':
+    case 'q':
+	CopyNumber(buffer, &dvalue, sizeof(double), type);
+	return Tcl_NewDoubleObj(dvalue);
     }
     return NULL;
 }
@@ -1731,7 +2008,7 @@ ScanNumber(buffer, type, numberCachePtrPtr)
  *----------------------------------------------------------------------
  *
  * DeleteScanNumberCache --
- * 
+ *
  *	Deletes the hash table acting as a scan number cache.
  *
  * Results:
@@ -1744,10 +2021,11 @@ ScanNumber(buffer, type, numberCachePtrPtr)
  */
 
 static void
-DeleteScanNumberCache(numberCachePtr)
-    Tcl_HashTable *numberCachePtr;	/* Pointer to the hash table, or
-					 * NULL (when the cache has already
-					 * been deleted due to overflow.) */
+DeleteScanNumberCache(
+    Tcl_HashTable *numberCachePtr)
+				/* Pointer to the hash table, or NULL (when
+				 * the cache has already been deleted due to
+				 * overflow.) */
 {
     Tcl_HashEntry *hEntry;
     Tcl_HashSearch search;
@@ -1758,7 +2036,7 @@ DeleteScanNumberCache(numberCachePtr)
 
     hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
     while (hEntry != NULL) {
-	register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry);
+	register Tcl_Obj *value = Tcl_GetHashValue(hEntry);
 
 	if (value != NULL) {
 	    Tcl_DecrRefCount(value);
@@ -1767,3 +2045,11 @@ DeleteScanNumberCache(numberCachePtr)
     }
     Tcl_DeleteHashTable(numberCachePtr);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 6de9720..5263e82 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -1,21 +1,21 @@
 /*
  * tclCkalloc.c --
  *
- *    Interface to malloc and free that provides support for debugging problems
- *    involving overwritten, double freeing memory and loss of memory.
+ *    Interface to malloc and free that provides support for debugging
+ *    problems involving overwritten, double freeing memory and loss of
+ *    memory.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * This code contributed by Karl Lehenbauer and Mark Diekhans
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 #define FALSE	0
 #define TRUE	1
@@ -28,29 +28,29 @@
  */
 
 typedef struct MemTag {
-    int refCount;		/* Number of mem_headers referencing
-				 * this tag. */
-    char string[4];		/* Actual size of string will be as
-				 * large as needed for actual tag.  This
-				 * must be the last field in the structure. */
+    int refCount;		/* Number of mem_headers referencing this
+				 * tag. */
+    char string[4];		/* Actual size of string will be as large as
+				 * needed for actual tag. This must be the
+				 * last field in the structure. */
 } MemTag;
 
 #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
 
-static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers
-				 * (set by "memory tag" command). */
+static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
+				 * by "memory tag" command). */
 
 /*
- * One of the following structures is allocated just before each
- * dynamically allocated chunk of memory, both to record information
- * about the chunk and to help detect chunk under-runs.
+ * One of the following structures is allocated just before each dynamically
+ * allocated chunk of memory, both to record information about the chunk and
+ * to help detect chunk under-runs.
  */
 
 #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
 struct mem_header {
     struct mem_header *flink;
     struct mem_header *blink;
-    MemTag *tagPtr;		/* Tag from "memory tag" command;  may be
+    MemTag *tagPtr;		/* Tag from "memory tag" command; may be
 				 * NULL. */
     CONST char *file;
     long length;
@@ -59,9 +59,8 @@ struct mem_header {
 				/* Aligns body on 8-byte boundary, plus
 				 * provides at least 8 additional guard bytes
 				 * to detect underruns. */
-    char body[1];		/* First byte of client's space.  Actual
-				 * size of this field will be larger than
-				 * one. */
+    char body[1];		/* First byte of client's space. Actual size
+				 * of this field will be larger than one. */
 };
 
 static struct mem_header *allocHead = NULL;  /* List of allocated structures */
@@ -69,16 +68,16 @@ static struct mem_header *allocHead = NULL;  /* List of allocated structures */
 #define GUARD_VALUE  0141
 
 /*
- * The following macro determines the amount of guard space *above* each
- * chunk of memory.
+ * The following macro determines the amount of guard space *above* each chunk
+ * of memory.
  */
 
 #define HIGH_GUARD_SIZE 8
 
 /*
  * The following macro computes the offset of the "body" field within
- * mem_header.  It is used to get back to the header pointer from the
- * body pointer that's used by clients.
+ * mem_header. It is used to get back to the header pointer from the body
+ * pointer that's used by clients.
  */
 
 #define BODY_OFFSET \
@@ -86,25 +85,25 @@ static struct mem_header *allocHead = NULL;  /* List of allocated structures */
 
 static int total_mallocs = 0;
 static int total_frees = 0;
-static int current_bytes_malloced = 0;
-static int maximum_bytes_malloced = 0;
+static size_t current_bytes_malloced = 0;
+static size_t maximum_bytes_malloced = 0;
 static int current_malloc_packets = 0;
 static int maximum_malloc_packets = 0;
 static int break_on_malloc = 0;
 static int trace_on_at_malloc = 0;
-static int  alloc_tracing = FALSE;
-static int  init_malloced_bodies = TRUE;
+static int alloc_tracing = FALSE;
+static int init_malloced_bodies = TRUE;
 #ifdef MEM_VALIDATE
-    static int  validate_memory = TRUE;
+static int validate_memory = TRUE;
 #else
-    static int  validate_memory = FALSE;
+static int validate_memory = FALSE;
 #endif
 
 /*
- * The following variable indicates to TclFinalizeMemorySubsystem()
- * that it should dump out the state of memory before exiting.  If the
- * value is non-NULL, it gives the name of the file in which to
- * dump memory usage information.
+ * The following variable indicates to TclFinalizeMemorySubsystem() that it
+ * should dump out the state of memory before exiting. If the value is
+ * non-NULL, it gives the name of the file in which to dump memory usage
+ * information.
  */
 
 char *tclMemDumpFileName = NULL;
@@ -114,10 +113,11 @@ static char dumpFile[100];	/* Records where to dump memory allocation
 				 * information. */
 
 /*
- * Mutex to serialize allocations.  This is a low-level mutex that must
- * be explicitly initialized.  This is necessary because the self
- * initializing mutexes use ckalloc...
+ * Mutex to serialize allocations. This is a low-level mutex that must be
+ * explicitly initialized. This is necessary because the self initializing
+ * mutexes use ckalloc...
  */
+
 static Tcl_Mutex *ckallocMutexPtr;
 static int ckallocInit = 0;
 
@@ -125,26 +125,27 @@ static int ckallocInit = 0;
  * Prototypes for procedures defined in this file:
  */
 
-static int		CheckmemCmd _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char *argv[]));
-static int		MemoryCmd _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static void		ValidateMemory _ANSI_ARGS_((
-			    struct mem_header *memHeaderP, CONST char *file,
-			    int line, int nukeGuards));
+static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
+			    int argc, CONST char *argv[]);
+static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
+			    int argc, CONST char *argv[]);
+static void		ValidateMemory(struct mem_header *memHeaderP,
+			    CONST char *file, int line, int nukeGuards);
 
 /*
  *----------------------------------------------------------------------
  *
  * TclInitDbCkalloc --
- *	Initialize the locks used by the allocator.
- *	This is only appropriate to call in a single threaded environment,
- *	such as during TclInitSubsystems.
+ *
+ *	Initialize the locks used by the allocator. This is only appropriate
+ *	to call in a single threaded environment, such as during
+ *	TclInitSubsystems.
  *
  *----------------------------------------------------------------------
  */
+
 void
-TclInitDbCkalloc()
+TclInitDbCkalloc(void)
 {
     if (!ckallocInit) {
 	ckallocInit = 1;
@@ -160,29 +161,40 @@ TclInitDbCkalloc()
  *----------------------------------------------------------------------
  *
  * TclDumpMemoryInfo --
- *     Display the global memory management statistics.
+ *
+ *	Display the global memory management statistics.
  *
  *----------------------------------------------------------------------
  */
-void
-TclDumpMemoryInfo(outFile)
-    FILE *outFile;
+
+int
+TclDumpMemoryInfo(ClientData clientData, int flags)
 {
-    fprintf(outFile,"total mallocs             %10d\n",
-	    total_mallocs);
-    fprintf(outFile,"total frees               %10d\n",
-	    total_frees);
-    fprintf(outFile,"current packets allocated %10d\n",
-	    current_malloc_packets);
-    fprintf(outFile,"current bytes allocated   %10d\n",
-	    current_bytes_malloced);
-    fprintf(outFile,"maximum packets allocated %10d\n",
-	    maximum_malloc_packets);
-    fprintf(outFile,"maximum bytes allocated   %10d\n",
-	    maximum_bytes_malloced);
+    char buf[1024];
+
+    if (clientData == NULL) { return 0; }
+    sprintf(buf,
+	    "total mallocs             %10d\n"
+	    "total frees               %10d\n"
+	    "current packets allocated %10d\n"
+	    "current bytes allocated   %10lu\n"
+	    "maximum packets allocated %10d\n"
+	    "maximum bytes allocated   %10lu\n",
+	    total_mallocs,
+	    total_frees,
+	    current_malloc_packets,
+	    (unsigned long)current_bytes_malloced,
+	    maximum_malloc_packets,
+	    (unsigned long)maximum_bytes_malloced);
+    if (flags == 0) {
+	fprintf((FILE *)clientData, buf);
+    } else {
+	/* Assume objPtr to append to */
+	Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
+    }
+    return 1;
 }
 
-
 /*
  *----------------------------------------------------------------------
  *
@@ -201,67 +213,68 @@ TclDumpMemoryInfo(outFile)
  */
 
 static void
-ValidateMemory(memHeaderP, file, line, nukeGuards)
-    struct mem_header *memHeaderP;	/* Memory chunk to validate */
-    CONST char        *file;		/* File containing the call to
-					 * Tcl_ValidateAllMemory */
-    int                line;		/* Line number of call to
-					 * Tcl_ValidateAllMemory */
-    int                nukeGuards;	/* If non-zero, indicates that the
-					 * memory guards are to be reset to 0
-					 * after they have been printed */
+ValidateMemory(
+    struct mem_header *memHeaderP,
+				/* Memory chunk to validate */
+    CONST char *file,		/* File containing the call to
+				 * Tcl_ValidateAllMemory */
+    int line,			/* Line number of call to
+				 * Tcl_ValidateAllMemory */
+    int nukeGuards)		/* If non-zero, indicates that the memory
+				 * guards are to be reset to 0 after they have
+				 * been printed */
 {
     unsigned char *hiPtr;
-    int   idx;
-    int   guard_failed = FALSE;
+    size_t idx;
+    int guard_failed = FALSE;
     int byte;
 
     for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
-        byte = *(memHeaderP->low_guard + idx);
-        if (byte != GUARD_VALUE) {
-            guard_failed = TRUE;
-            fflush(stdout);
+	byte = *(memHeaderP->low_guard + idx);
+	if (byte != GUARD_VALUE) {
+	    guard_failed = TRUE;
+	    fflush(stdout);
 	    byte &= 0xff;
-            fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
+	    fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
 		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
-        }
+	}
     }
     if (guard_failed) {
-        TclDumpMemoryInfo (stderr);
-        fprintf(stderr, "low guard failed at %lx, %s %d\n",
-                 (long unsigned int) memHeaderP->body, file, line);
-        fflush(stderr);  /* In case name pointer is bad. */
-        fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+	TclDumpMemoryInfo((ClientData) stderr, 0);
+	fprintf(stderr, "low guard failed at %lx, %s %d\n",
+		(long unsigned int) memHeaderP->body, file, line);
+	fflush(stderr);			/* In case name pointer is bad. */
+	fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
 		memHeaderP->file, memHeaderP->line);
-        panic ("Memory validation failure");
+	Tcl_Panic("Memory validation failure");
     }
 
     hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
     for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
-        byte = *(hiPtr + idx);
-        if (byte != GUARD_VALUE) {
-            guard_failed = TRUE;
-            fflush (stdout);
+	byte = *(hiPtr + idx);
+	if (byte != GUARD_VALUE) {
+	    guard_failed = TRUE;
+	    fflush(stdout);
 	    byte &= 0xff;
-            fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
+	    fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
 		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
-        }
+	}
     }
 
     if (guard_failed) {
-        TclDumpMemoryInfo (stderr);
-        fprintf(stderr, "high guard failed at %lx, %s %d\n",
-                 (long unsigned int) memHeaderP->body, file, line);
-        fflush(stderr);  /* In case name pointer is bad. */
-        fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
+	TclDumpMemoryInfo((ClientData) stderr, 0);
+	fprintf(stderr, "high guard failed at %lx, %s %d\n",
+		(long unsigned int) memHeaderP->body, file, line);
+	fflush(stderr);			/* In case name pointer is bad. */
+	fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
 		memHeaderP->length, memHeaderP->file,
 		memHeaderP->line);
-        panic("Memory validation failure");
+	Tcl_Panic("Memory validation failure");
     }
 
     if (nukeGuards) {
-        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
-        memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE);
+	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+	memset(hiPtr, 0, HIGH_GUARD_SIZE);
     }
 
 }
@@ -281,10 +294,13 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
  *
  *----------------------------------------------------------------------
  */
+
 void
-Tcl_ValidateAllMemory (file, line)
-    CONST char  *file;	/* File from which Tcl_ValidateAllMemory was called */
-    int          line;	/* Line number of call to Tcl_ValidateAllMemory */
+Tcl_ValidateAllMemory(
+    CONST char *file,		/* File from which Tcl_ValidateAllMemory was
+				 * called. */
+    int line)			/* Line number of call to
+				 * Tcl_ValidateAllMemory */
 {
     struct mem_header *memScanP;
 
@@ -293,7 +309,7 @@ Tcl_ValidateAllMemory (file, line)
     }
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
-        ValidateMemory(memScanP, file, line, FALSE);
+	ValidateMemory(memScanP, file, line, FALSE);
     }
     Tcl_MutexUnlock(ckallocMutexPtr);
 }
@@ -307,17 +323,19 @@ Tcl_ValidateAllMemory (file, line)
  *	information will be written to stderr.
  *
  * Results:
- *	Return TCL_ERROR if an error accessing the file occurs, `errno'
- *	will have the file error number left in it.
+ *	Return TCL_ERROR if an error accessing the file occurs, `errno' will
+ *	have the file error number left in it.
+ *
  *----------------------------------------------------------------------
  */
+
 int
-Tcl_DumpActiveMemory (fileName)
-    CONST char *fileName;		/* Name of the file to write info to */
+Tcl_DumpActiveMemory(
+    CONST char *fileName)	/* Name of the file to write info to */
 {
-    FILE              *fileP;
+    FILE *fileP;
     struct mem_header *memScanP;
-    char              *address;
+    char *address;
 
     if (fileName == NULL) {
 	fileP = stderr;
@@ -330,18 +348,18 @@ Tcl_DumpActiveMemory (fileName)
 
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
-        address = &memScanP->body [0];
-        fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
+	address = &memScanP->body [0];
+	fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
 		(long unsigned int) address,
-                 (long unsigned int) address + memScanP->length - 1,
-		 memScanP->length, memScanP->file, memScanP->line,
-		 (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
+		(long unsigned int) address + memScanP->length - 1,
+		memScanP->length, memScanP->file, memScanP->line,
+		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
 	(void) fputc('\n', fileP);
     }
     Tcl_MutexUnlock(ckallocMutexPtr);
 
     if (fileP != stderr) {
-	fclose (fileP);
+	fclose(fileP);
     }
     return TCL_OK;
 }
@@ -351,53 +369,54 @@ Tcl_DumpActiveMemory (fileName)
  *
  * Tcl_DbCkalloc - debugging ckalloc
  *
- *        Allocate the requested amount of space plus some extra for
- *        guard bands at both ends of the request, plus a size, panicing
- *        if there isn't enough space, then write in the guard bands
- *        and return the address of the space in the middle that the
- *        user asked for.
+ *	Allocate the requested amount of space plus some extra for guard bands
+ *	at both ends of the request, plus a size, panicing if there isn't
+ *	enough space, then write in the guard bands and return the address of
+ *	the space in the middle that the user asked for.
  *
- *        The second and third arguments are file and line, these contain
- *        the filename and line number corresponding to the caller.
- *        These are sent by the ckalloc macro; it uses the preprocessor
- *        autodefines __FILE__ and __LINE__.
+ *	The second and third arguments are file and line, these contain the
+ *	filename and line number corresponding to the caller. These are sent
+ *	by the ckalloc macro; it uses the preprocessor autodefines __FILE__
+ *	and __LINE__.
  *
  *----------------------------------------------------------------------
  */
+
 char *
-Tcl_DbCkalloc(size, file, line)
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_DbCkalloc(
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     struct mem_header *result = NULL;
 
-    if (validate_memory)
-        Tcl_ValidateAllMemory (file, line);
-
+    if (validate_memory) {
+	Tcl_ValidateAllMemory(file, line);
+    }
 
     /* Don't let size argument to TclpAlloc overflow */
-    if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
+    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
 	result = (struct mem_header *) TclpAlloc((unsigned)size +
 		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     }
     if (result == NULL) {
-        fflush(stdout);
-        TclDumpMemoryInfo(stderr);
-        panic("unable to alloc %u bytes, %s line %d", size, file, line);
+	fflush(stdout);
+	TclDumpMemoryInfo((ClientData) stderr, 0);
+	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
     }
 
     /*
-     * Fill in guard zones and size.  Also initialize the contents of
-     * the block with bogus bytes to detect uses of initialized data.
-     * Link into allocated list.
+     * Fill in guard zones and size. Also initialize the contents of the block
+     * with bogus bytes to detect uses of initialized data. Link into
+     * allocated list.
      */
+
     if (init_malloced_bodies) {
-        memset ((VOID *) result, GUARD_VALUE,
+	memset(result, GUARD_VALUE,
 		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     } else {
-	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
-	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+	memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
     }
     if (!ckallocInit) {
 	TclInitDbCkalloc();
@@ -413,56 +432,61 @@ Tcl_DbCkalloc(size, file, line)
     result->flink = allocHead;
     result->blink = NULL;
 
-    if (allocHead != NULL)
-        allocHead->blink = result;
+    if (allocHead != NULL) {
+	allocHead->blink = result;
+    }
     allocHead = result;
 
     total_mallocs++;
     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
-        (void) fflush(stdout);
-        fprintf(stderr, "reached malloc trace enable point (%d)\n",
-                total_mallocs);
-        fflush(stderr);
-        alloc_tracing = TRUE;
-        trace_on_at_malloc = 0;
+	(void) fflush(stdout);
+	fprintf(stderr, "reached malloc trace enable point (%d)\n",
+		total_mallocs);
+	fflush(stderr);
+	alloc_tracing = TRUE;
+	trace_on_at_malloc = 0;
     }
 
-    if (alloc_tracing)
-        fprintf(stderr,"ckalloc %lx %u %s %d\n",
+    if (alloc_tracing) {
+	fprintf(stderr,"ckalloc %lx %u %s %d\n",
 		(long unsigned int) result->body, size, file, line);
+    }
 
     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
-        break_on_malloc = 0;
-        (void) fflush(stdout);
-        fprintf(stderr,"reached malloc break limit (%d)\n",
-                total_mallocs);
-        fprintf(stderr, "program will now enter C debugger\n");
-        (void) fflush(stderr);
+	break_on_malloc = 0;
+	(void) fflush(stdout);
+	fprintf(stderr,"reached malloc break limit (%d)\n",
+		total_mallocs);
+	fprintf(stderr, "program will now enter C debugger\n");
+	(void) fflush(stderr);
 	abort();
     }
 
     current_malloc_packets++;
-    if (current_malloc_packets > maximum_malloc_packets)
-        maximum_malloc_packets = current_malloc_packets;
+    if (current_malloc_packets > maximum_malloc_packets) {
+	maximum_malloc_packets = current_malloc_packets;
+    }
     current_bytes_malloced += size;
-    if (current_bytes_malloced > maximum_bytes_malloced)
-        maximum_bytes_malloced = current_bytes_malloced;
+    if (current_bytes_malloced > maximum_bytes_malloced) {
+	maximum_bytes_malloced = current_bytes_malloced;
+    }
 
     Tcl_MutexUnlock(ckallocMutexPtr);
 
     return result->body;
 }
-
+
 char *
-Tcl_AttemptDbCkalloc(size, file, line)
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_AttemptDbCkalloc(
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     struct mem_header *result = NULL;
 
-    if (validate_memory)
-        Tcl_ValidateAllMemory (file, line);
+    if (validate_memory) {
+	Tcl_ValidateAllMemory(file, line);
+    }
 
     /* Don't let size argument to TclpAlloc overflow */
     if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
@@ -470,22 +494,22 @@ Tcl_AttemptDbCkalloc(size, file, line)
 		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     }
     if (result == NULL) {
-        fflush(stdout);
-        TclDumpMemoryInfo(stderr);
+	fflush(stdout);
+	TclDumpMemoryInfo((ClientData) stderr, 0);
 	return NULL;
     }
 
     /*
-     * Fill in guard zones and size.  Also initialize the contents of
-     * the block with bogus bytes to detect uses of initialized data.
-     * Link into allocated list.
+     * Fill in guard zones and size. Also initialize the contents of the block
+     * with bogus bytes to detect uses of initialized data. Link into
+     * allocated list.
      */
     if (init_malloced_bodies) {
-        memset ((VOID *) result, GUARD_VALUE,
+	memset(result, GUARD_VALUE,
 		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     } else {
-	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
-	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+	memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
     }
     if (!ckallocInit) {
 	TclInitDbCkalloc();
@@ -501,71 +525,73 @@ Tcl_AttemptDbCkalloc(size, file, line)
     result->flink = allocHead;
     result->blink = NULL;
 
-    if (allocHead != NULL)
-        allocHead->blink = result;
+    if (allocHead != NULL) {
+	allocHead->blink = result;
+    }
     allocHead = result;
 
     total_mallocs++;
     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
-        (void) fflush(stdout);
-        fprintf(stderr, "reached malloc trace enable point (%d)\n",
-                total_mallocs);
-        fflush(stderr);
-        alloc_tracing = TRUE;
-        trace_on_at_malloc = 0;
+	(void) fflush(stdout);
+	fprintf(stderr, "reached malloc trace enable point (%d)\n",
+		total_mallocs);
+	fflush(stderr);
+	alloc_tracing = TRUE;
+	trace_on_at_malloc = 0;
     }
 
-    if (alloc_tracing)
-        fprintf(stderr,"ckalloc %lx %u %s %d\n",
+    if (alloc_tracing) {
+	fprintf(stderr,"ckalloc %lx %u %s %d\n",
 		(long unsigned int) result->body, size, file, line);
+    }
 
     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
-        break_on_malloc = 0;
-        (void) fflush(stdout);
-        fprintf(stderr,"reached malloc break limit (%d)\n",
-                total_mallocs);
-        fprintf(stderr, "program will now enter C debugger\n");
-        (void) fflush(stderr);
+	break_on_malloc = 0;
+	(void) fflush(stdout);
+	fprintf(stderr,"reached malloc break limit (%d)\n",
+		total_mallocs);
+	fprintf(stderr, "program will now enter C debugger\n");
+	(void) fflush(stderr);
 	abort();
     }
 
     current_malloc_packets++;
-    if (current_malloc_packets > maximum_malloc_packets)
-        maximum_malloc_packets = current_malloc_packets;
+    if (current_malloc_packets > maximum_malloc_packets) {
+	maximum_malloc_packets = current_malloc_packets;
+    }
     current_bytes_malloced += size;
-    if (current_bytes_malloced > maximum_bytes_malloced)
-        maximum_bytes_malloced = current_bytes_malloced;
+    if (current_bytes_malloced > maximum_bytes_malloced) {
+	maximum_bytes_malloced = current_bytes_malloced;
+    }
 
     Tcl_MutexUnlock(ckallocMutexPtr);
 
     return result->body;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_DbCkfree - debugging ckfree
  *
- *        Verify that the low and high guards are intact, and if so
- *        then free the buffer else panic.
+ *	Verify that the low and high guards are intact, and if so then free
+ *	the buffer else Tcl_Panic.
  *
- *        The guards are erased after being checked to catch duplicate
- *        frees.
+ *	The guards are erased after being checked to catch duplicate frees.
  *
- *        The second and third arguments are file and line, these contain
- *        the filename and line number corresponding to the caller.
- *        These are sent by the ckfree macro; it uses the preprocessor
- *        autodefines __FILE__ and __LINE__.
+ *	The second and third arguments are file and line, these contain the
+ *	filename and line number corresponding to the caller. These are sent
+ *	by the ckfree macro; it uses the preprocessor autodefines __FILE__ and
+ *	__LINE__.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DbCkfree(ptr, file, line)
-    char       *ptr;
-    CONST char *file;
-    int         line;
+Tcl_DbCkfree(
+    char *ptr,
+    CONST char *file,
+    int line)
 {
     struct mem_header *memp;
 
@@ -574,28 +600,28 @@ Tcl_DbCkfree(ptr, file, line)
     }
 
     /*
-     * The following cast is *very* tricky.  Must convert the pointer
-     * to an integer before doing arithmetic on it, because otherwise
-     * the arithmetic will be done differently (and incorrectly) on
-     * word-addressed machines such as Crays (will subtract only bytes,
-     * even though BODY_OFFSET is in words on these machines).
+     * The following cast is *very* tricky. Must convert the pointer to an
+     * integer before doing arithmetic on it, because otherwise the arithmetic
+     * will be done differently (and incorrectly) on word-addressed machines
+     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
+     * words on these machines).
      */
 
     memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
 
     if (alloc_tracing) {
-        fprintf(stderr, "ckfree %lx %ld %s %d\n",
+	fprintf(stderr, "ckfree %lx %ld %s %d\n",
 		(long unsigned int) memp->body, memp->length, file, line);
     }
 
     if (validate_memory) {
-        Tcl_ValidateAllMemory(file, line);
+	Tcl_ValidateAllMemory(file, line);
     }
 
     Tcl_MutexLock(ckallocMutexPtr);
     ValidateMemory(memp, file, line, TRUE);
     if (init_malloced_bodies) {
-	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
+	memset(ptr, GUARD_VALUE, (size_t) memp->length);
     }
 
     total_frees++;
@@ -612,12 +638,16 @@ Tcl_DbCkfree(ptr, file, line)
     /*
      * Delink from allocated list
      */
-    if (memp->flink != NULL)
-        memp->flink->blink = memp->blink;
-    if (memp->blink != NULL)
-        memp->blink->flink = memp->flink;
-    if (allocHead == memp)
-        allocHead = memp->flink;
+
+    if (memp->flink != NULL) {
+	memp->flink->blink = memp->blink;
+    }
+    if (memp->blink != NULL) {
+	memp->blink->flink = memp->flink;
+    }
+    if (allocHead == memp) {
+	allocHead = memp->flink;
+    }
     TclpFree((char *) memp);
     Tcl_MutexUnlock(ckallocMutexPtr);
 }
@@ -627,21 +657,22 @@ Tcl_DbCkfree(ptr, file, line)
  *
  * Tcl_DbCkrealloc - debugging ckrealloc
  *
- *	Reallocate a chunk of memory by allocating a new one of the
- *	right size, copying the old data to the new location, and then
- *	freeing the old memory space, using all the memory checking
- *	features of this package.
+ *	Reallocate a chunk of memory by allocating a new one of the right
+ *	size, copying the old data to the new location, and then freeing the
+ *	old memory space, using all the memory checking features of this
+ *	package.
  *
  *--------------------------------------------------------------------
  */
+
 char *
-Tcl_DbCkrealloc(ptr, size, file, line)
-    char        *ptr;
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_DbCkrealloc(
+    char *ptr,
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
-    char *new;
+    char *newPtr;
     unsigned int copySize;
     struct mem_header *memp;
 
@@ -650,8 +681,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
     }
 
     /*
-     * See comment from Tcl_DbCkfree before you change the following
-     * line.
+     * See comment from Tcl_DbCkfree before you change the following line.
      */
 
     memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
@@ -660,20 +690,20 @@ Tcl_DbCkrealloc(ptr, size, file, line)
     if (copySize > (unsigned int) memp->length) {
 	copySize = memp->length;
     }
-    new = Tcl_DbCkalloc(size, file, line);
-    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+    newPtr = Tcl_DbCkalloc(size, file, line);
+    memcpy(newPtr, ptr, (size_t) copySize);
     Tcl_DbCkfree(ptr, file, line);
-    return new;
+    return newPtr;
 }
-
+
 char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
-    char        *ptr;
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_AttemptDbCkrealloc(
+    char *ptr,
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
-    char *new;
+    char *newPtr;
     unsigned int copySize;
     struct mem_header *memp;
 
@@ -682,8 +712,7 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
     }
 
     /*
-     * See comment from Tcl_DbCkfree before you change the following
-     * line.
+     * See comment from Tcl_DbCkfree before you change the following line.
      */
 
     memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
@@ -692,13 +721,13 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
     if (copySize > (unsigned int) memp->length) {
 	copySize = memp->length;
     }
-    new = Tcl_AttemptDbCkalloc(size, file, line);
-    if (new == NULL) {
+    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
+    if (newPtr == NULL) {
 	return NULL;
     }
-    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+    memcpy(newPtr, ptr, (size_t) copySize);
     Tcl_DbCkfree(ptr, file, line);
-    return new;
+    return newPtr;
 }
 
 
@@ -707,8 +736,8 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
  *
  * Tcl_Alloc, et al. --
  *
- *	These functions are defined in terms of the debugging versions
- *	when TCL_MEM_DEBUG is set.
+ *	These functions are defined in terms of the debugging versions when
+ *	TCL_MEM_DEBUG is set.
  *
  * Results:
  *	Same as the debug versions.
@@ -726,37 +755,37 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
 #undef Tcl_AttemptRealloc
 
 char *
-Tcl_Alloc(size)
-    unsigned int size;
+Tcl_Alloc(
+    unsigned int size)
 {
     return Tcl_DbCkalloc(size, "unknown", 0);
 }
 
 char *
-Tcl_AttemptAlloc(size)
-    unsigned int size;
+Tcl_AttemptAlloc(
+    unsigned int size)
 {
     return Tcl_AttemptDbCkalloc(size, "unknown", 0);
 }
 
 void
-Tcl_Free(ptr)
-    char *ptr;
+Tcl_Free(
+    char *ptr)
 {
     Tcl_DbCkfree(ptr, "unknown", 0);
 }
 
 char *
-Tcl_Realloc(ptr, size)
-    char *ptr;
-    unsigned int size;
+Tcl_Realloc(
+    char *ptr,
+    unsigned int size)
 {
     return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
 }
 char *
-Tcl_AttemptRealloc(ptr, size)
-    char *ptr;
-    unsigned int size;
+Tcl_AttemptRealloc(
+    char *ptr,
+    unsigned int size)
 {
     return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
 }
@@ -765,8 +794,9 @@ Tcl_AttemptRealloc(ptr, size)
  *----------------------------------------------------------------------
  *
  * MemoryCmd --
- *	Implements the Tcl "memory" command, which provides Tcl-level
- *	control of Tcl memory debugging information.
+ *
+ *	Implements the Tcl "memory" command, which provides Tcl-level control
+ *	of Tcl memory debugging information.
  *		memory active $file
  *		memory break_on_malloc $count
  *		memory info
@@ -778,33 +808,34 @@ Tcl_AttemptRealloc(ptr, size)
  *		memory validate on|off
  *
  * Results:
- *     Standard TCL results.
+ *	Standard TCL results.
  *
  *----------------------------------------------------------------------
  */
 	/* ARGSUSED */
 static int
-MemoryCmd (clientData, interp, argc, argv)
-    ClientData  clientData;
-    Tcl_Interp *interp;
-    int         argc;
-    CONST char  **argv;
+MemoryCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int argc,
+    CONST char *argv[])
 {
     CONST char *fileName;
+    FILE *fileP;
     Tcl_DString buffer;
     int result;
     size_t len;
 
     if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option [args..]\"", (char *) NULL);
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" option [args..]\"", NULL);
 	return TCL_ERROR;
     }
 
     if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
-        if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " ", argv[1], " file\"", (char *) NULL);
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " ", argv[1], " file\"", NULL);
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -814,43 +845,61 @@ MemoryCmd (clientData, interp, argc, argv)
 	result = Tcl_DumpActiveMemory (fileName);
 	Tcl_DStringFree(&buffer);
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "error accessing ", argv[2],
-		    (char *) NULL);
+	    Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
     }
     if (strcmp(argv[1],"break_on_malloc") == 0) {
-        if (argc != 3) {
-            goto argError;
+	if (argc != 3) {
+	    goto argError;
 	}
-        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-        return TCL_OK;
+	return TCL_OK;
     }
     if (strcmp(argv[1],"info") == 0) {
-	char buf[400];
-	sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
-	    "total mallocs", total_mallocs, "total frees", total_frees,
-	    "current packets allocated", current_malloc_packets,
-	    "current bytes allocated", current_bytes_malloced,
-	    "maximum packets allocated", maximum_malloc_packets,
-	    "maximum bytes allocated", maximum_bytes_malloced);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
-        return TCL_OK;
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
+		"total mallocs", total_mallocs, "total frees", total_frees,
+		"current packets allocated", current_malloc_packets,
+		"current bytes allocated", current_bytes_malloced,
+		"maximum packets allocated", maximum_malloc_packets,
+		"maximum bytes allocated", maximum_bytes_malloced));
+	return TCL_OK;
     }
     if (strcmp(argv[1],"init") == 0) {
-        if (argc != 3) {
-            goto bad_suboption;
+	if (argc != 3) {
+	    goto bad_suboption;
+	}
+	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+	return TCL_OK;
+    }
+    if (strcmp(argv[1],"objs") == 0) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " objs file\"", NULL);
+	    return TCL_ERROR;
+	}
+	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	if (fileName == NULL) {
+	    return TCL_ERROR;
+	}
+	fileP = fopen(fileName, "w");
+	if (fileP == NULL) {
+	    Tcl_AppendResult(interp, "cannot open output file", NULL);
+	    return TCL_ERROR;
 	}
-        init_malloced_bodies = (strcmp(argv[2],"on") == 0);
-        return TCL_OK;
+	TclDbDumpActiveObjects(fileP);
+	fclose(fileP);
+	Tcl_DStringFree(&buffer);
+	return TCL_OK;
     }
     if (strcmp(argv[1],"onexit") == 0) {
-        if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"",
-		    argv[0], " onexit file\"", (char *) NULL);
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " onexit file\"", NULL);
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -865,7 +914,7 @@ MemoryCmd (clientData, interp, argc, argv)
     if (strcmp(argv[1],"tag") == 0) {
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " tag string\"", (char *) NULL);
+		    " tag string\"", NULL);
 	    return TCL_ERROR;
 	}
 	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -878,43 +927,43 @@ MemoryCmd (clientData, interp, argc, argv)
 	return TCL_OK;
     }
     if (strcmp(argv[1],"trace") == 0) {
-        if (argc != 3) {
-            goto bad_suboption;
+	if (argc != 3) {
+	    goto bad_suboption;
 	}
-        alloc_tracing = (strcmp(argv[2],"on") == 0);
-        return TCL_OK;
+	alloc_tracing = (strcmp(argv[2],"on") == 0);
+	return TCL_OK;
     }
 
     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
-        if (argc != 3) {
-            goto argError;
+	if (argc != 3) {
+	    goto argError;
 	}
-        if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+	if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
     }
     if (strcmp(argv[1],"validate") == 0) {
-        if (argc != 3) {
+	if (argc != 3) {
 	    goto bad_suboption;
 	}
-        validate_memory = (strcmp(argv[2],"on") == 0);
-        return TCL_OK;
+	validate_memory = (strcmp(argv[2],"on") == 0);
+	return TCL_OK;
     }
 
     Tcl_AppendResult(interp, "bad option \"", argv[1],
-	    "\": should be active, break_on_malloc, info, init, onexit, ",
-	    "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
+	    "\": should be active, break_on_malloc, info, init, onexit, "
+	    "tag, trace, trace_on_at_malloc, or validate", NULL);
     return TCL_ERROR;
 
-argError:
+  argError:
     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " count\"", (char *) NULL);
+	    " ", argv[1], " count\"", NULL);
     return TCL_ERROR;
 
-bad_suboption:
+  bad_suboption:
     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " on|off\"", (char *) NULL);
+	    " ", argv[1], " on|off\"", NULL);
     return TCL_ERROR;
 }
 
@@ -923,10 +972,9 @@ bad_suboption:
  *
  * CheckmemCmd --
  *
- *	This is the command procedure for the "checkmem" command, which
- *	causes the application to exit after printing information about
- *	memory usage to the file passed to this command as its first
- *	argument.
+ *	This is the command procedure for the "checkmem" command, which causes
+ *	the application to exit after printing information about memory usage
+ *	to the file passed to this command as its first argument.
  *
  * Results:
  *	Returns a standard Tcl completion code.
@@ -938,15 +986,15 @@ bad_suboption:
  */
 
 static int
-CheckmemCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Interpreter for evaluation. */
-    int argc;				/* Number of arguments. */
-    CONST char *argv[];			/* String values of arguments. */
+CheckmemCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Interpreter for evaluation. */
+    int argc,			/* Number of arguments. */
+    CONST char *argv[])		/* String values of arguments. */
 {
     if (argc != 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" fileName\"", (char *) NULL);
+		" fileName\"", NULL);
 	return TCL_ERROR;
     }
     tclMemDumpFileName = dumpFile;
@@ -959,8 +1007,7 @@ CheckmemCmd(clientData, interp, argc, argv)
  *
  * Tcl_InitMemory --
  *
- *	Create the "memory" and "checkmem" commands in the given
- *	interpreter.
+ *	Create the "memory" and "checkmem" commands in the given interpreter.
  *
  * Results:
  *	None.
@@ -972,14 +1019,13 @@ CheckmemCmd(clientData, interp, argc, argv)
  */
 
 void
-Tcl_InitMemory(interp)
-    Tcl_Interp *interp;	/* Interpreter in which commands should be added */
+Tcl_InitMemory(
+    Tcl_Interp *interp)		/* Interpreter in which commands should be
+				 * added */
 {
     TclInitDbCkalloc();
-    Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
+    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
 }
 
 
@@ -996,47 +1042,50 @@ Tcl_InitMemory(interp)
  *----------------------------------------------------------------------
  *
  * Tcl_Alloc --
- *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
- *     that memory was actually allocated.
+ *
+ *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
+ *	that memory was actually allocated.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_Alloc (size)
-    unsigned int size;
+Tcl_Alloc(
+    unsigned int size)
 {
     char *result;
 
     result = TclpAlloc(size);
+
     /*
-     * Most systems will not alloc(0), instead bumping it to one so
-     * that NULL isn't returned.  Some systems (AIX, Tru64) will alloc(0)
-     * by returning NULL, so we have to check that the NULL we get is
-     * not in response to alloc(0).
+     * Most systems will not alloc(0), instead bumping it to one so that NULL
+     * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
+     * NULL, so we have to check that the NULL we get is not in response to
+     * alloc(0).
      *
-     * The ANSI spec actually says that systems either return NULL *or*
-     * a special pointer on failure, but we only check for NULL
+     * The ANSI spec actually says that systems either return NULL *or* a
+     * special pointer on failure, but we only check for NULL
      */
+
     if ((result == NULL) && size) {
-	panic("unable to alloc %u bytes", size);
+	Tcl_Panic("unable to alloc %u bytes", size);
     }
     return result;
 }
 
 char *
-Tcl_DbCkalloc(size, file, line)
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_DbCkalloc(
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     char *result;
 
     result = (char *) TclpAlloc(size);
 
     if ((result == NULL) && size) {
-        fflush(stdout);
-        panic("unable to alloc %u bytes, %s line %d", size, file, line);
+	fflush(stdout);
+	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
     }
     return result;
 }
@@ -1045,15 +1094,16 @@ Tcl_DbCkalloc(size, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_AttemptAlloc --
- *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does not
- *     check that memory was actually allocated.
+ *
+ *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
+ *	check that memory was actually allocated.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_AttemptAlloc (size)
-    unsigned int size;
+Tcl_AttemptAlloc(
+    unsigned int size)
 {
     char *result;
 
@@ -1062,57 +1112,57 @@ Tcl_AttemptAlloc (size)
 }
 
 char *
-Tcl_AttemptDbCkalloc(size, file, line)
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_AttemptDbCkalloc(
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     char *result;
 
     result = (char *) TclpAlloc(size);
     return result;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_Realloc --
- *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does
- *     check that memory was actually allocated.
+ *
+ *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
+ *	that memory was actually allocated.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_Realloc(ptr, size)
-    char *ptr;
-    unsigned int size;
+Tcl_Realloc(
+    char *ptr,
+    unsigned int size)
 {
     char *result;
 
     result = TclpRealloc(ptr, size);
 
     if ((result == NULL) && size) {
-	panic("unable to realloc %u bytes", size);
+	Tcl_Panic("unable to realloc %u bytes", size);
     }
     return result;
 }
 
 char *
-Tcl_DbCkrealloc(ptr, size, file, line)
-    char        *ptr;
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_DbCkrealloc(
+    char *ptr,
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     char *result;
 
     result = (char *) TclpRealloc(ptr, size);
 
     if ((result == NULL) && size) {
-        fflush(stdout);
-        panic("unable to realloc %u bytes, %s line %d", size, file, line);
+	fflush(stdout);
+	Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
     }
     return result;
 }
@@ -1121,16 +1171,17 @@ Tcl_DbCkrealloc(ptr, size, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_AttemptRealloc --
- *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does
- *     not check that memory was actually allocated.
+ *
+ *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not
+ *	check that memory was actually allocated.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_AttemptRealloc(ptr, size)
-    char *ptr;
-    unsigned int size;
+Tcl_AttemptRealloc(
+    char *ptr,
+    unsigned int size)
 {
     char *result;
 
@@ -1139,11 +1190,11 @@ Tcl_AttemptRealloc(ptr, size)
 }
 
 char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
-    char        *ptr;
-    unsigned int size;
-    CONST char  *file;
-    int          line;
+Tcl_AttemptDbCkrealloc(
+    char *ptr,
+    unsigned int size,
+    CONST char *file,
+    int line)
 {
     char *result;
 
@@ -1155,25 +1206,26 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_Free --
- *     Interface to TclpFree when TCL_MEM_DEBUG is disabled.  Done here
- *     rather in the macro to keep some modules from being compiled with
- *     TCL_MEM_DEBUG enabled and some with it disabled.
+ *
+ *	Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather
+ *	in the macro to keep some modules from being compiled with
+ *	TCL_MEM_DEBUG enabled and some with it disabled.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_Free (ptr)
-    char *ptr;
+Tcl_Free(
+    char *ptr)
 {
     TclpFree(ptr);
 }
 
 void
-Tcl_DbCkfree(ptr, file, line)
-    char       *ptr;
-    CONST char *file;
-    int         line;
+Tcl_DbCkfree(
+    char *ptr,
+    CONST char *file,
+    int line)
 {
     TclpFree(ptr);
 }
@@ -1182,36 +1234,37 @@ Tcl_DbCkfree(ptr, file, line)
  *----------------------------------------------------------------------
  *
  * Tcl_InitMemory --
- *     Dummy initialization for memory command, which is only available
- *     if TCL_MEM_DEBUG is on.
+ *
+ *	Dummy initialization for memory command, which is only available if
+ *	TCL_MEM_DEBUG is on.
  *
  *----------------------------------------------------------------------
  */
 	/* ARGSUSED */
 void
-Tcl_InitMemory(interp)
-    Tcl_Interp *interp;
+Tcl_InitMemory(
+    Tcl_Interp *interp)
 {
 }
 
 int
-Tcl_DumpActiveMemory(fileName)
-    CONST char *fileName;
+Tcl_DumpActiveMemory(
+    CONST char *fileName)
 {
     return TCL_OK;
 }
 
 void
-Tcl_ValidateAllMemory(file, line)
-    CONST char *file;
-    int         line;
+Tcl_ValidateAllMemory(
+    CONST char *file,
+    int line)
 {
 }
 
-void
-TclDumpMemoryInfo(outFile)
-    FILE *outFile;
+int
+TclDumpMemoryInfo(ClientData clientData, int flags)
 {
+    return 1;
 }
 
 #endif	/* TCL_MEM_DEBUG */
@@ -1221,23 +1274,22 @@ TclDumpMemoryInfo(outFile)
  *
  * TclFinalizeMemorySubsystem --
  *
- *	This procedure is called to finalize all the structures that
- *	are used by the memory allocator on a per-process basis.
+ *	This procedure is called to finalize all the structures that are used
+ *	by the memory allocator on a per-process basis.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	This subsystem is self-initializing, since memory can be
- *	allocated before Tcl is formally initialized.  After this call,
- *	this subsystem has been reset to its initial state and is
- *	usable again.
+ *	This subsystem is self-initializing, since memory can be allocated
+ *	before Tcl is formally initialized. After this call, this subsystem
+ *	has been reset to its initial state and is usable again.
  *
  *---------------------------------------------------------------------------
  */
 
 void
-TclFinalizeMemorySubsystem()
+TclFinalizeMemorySubsystem(void)
 {
 #ifdef TCL_MEM_DEBUG
     if (tclMemDumpFileName != NULL) {
@@ -1245,12 +1297,15 @@ TclFinalizeMemorySubsystem()
     } else if (onExitMemDumpFileName != NULL) {
 	Tcl_DumpActiveMemory(onExitMemDumpFileName);
     }
+
     Tcl_MutexLock(ckallocMutexPtr);
+
     if (curTagPtr != NULL) {
 	TclpFree((char *) curTagPtr);
 	curTagPtr = NULL;
     }
     allocHead = NULL;
+
     Tcl_MutexUnlock(ckallocMutexPtr);
 #endif
 
@@ -1258,3 +1313,11 @@ TclFinalizeMemorySubsystem()
     TclFinalizeAllocSubsystem();
 #endif
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 2c00a07..5b95ae6 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1,23 +1,136 @@
-/* 
+/*
  * tclClock.c --
  *
- *	Contains the time and date related commands.  This code
- *	is derived from the time and date facilities of TclX,
- *	by Mark Diekhans and Karl Lehenbauer.
+ *	Contains the time and date related commands. This code is derived from
+ *	the time and date facilities of TclX, by Mark Diekhans and Karl
+ *	Lehenbauer.
  *
  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#include "tcl.h"
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * The date parsing stuff uses lexx and has tons o statics.
+ * Windows has mktime. The configurators do not check.
+ */
+
+#ifdef __WIN32__
+#define HAVE_MKTIME 1
+#endif
+
+/*
+ * Constants
+ */
+
+#define JULIAN_DAY_POSIX_EPOCH		2440588
+#define SECONDS_PER_DAY			86400
+#define JULIAN_SEC_POSIX_EPOCH	      (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
+					* SECONDS_PER_DAY)
+#define FOUR_CENTURIES			146097 /* days */
+#define JDAY_1_JAN_1_CE_JULIAN		1721424
+#define JDAY_1_JAN_1_CE_GREGORIAN	1721426
+#define ONE_CENTURY_GREGORIAN		36524  /* days */
+#define FOUR_YEARS			1461   /* days */
+#define ONE_YEAR			365    /* days */
+
+/*
+ * Table of the days in each month, leap and common years
+ */
+
+static const int hath[2][12] = {
+    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
+    {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
+};
+static const int daysInPriorMonths[2][13] = {
+    {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365},
+    {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}
+};
+
+/*
+ * Enumeration of the string literals used in [clock]
+ */
+
+typedef enum ClockLiteral {
+    LIT__NIL,
+    LIT__DEFAULT_FORMAT,
+    LIT_BCE,		LIT_C,			
+    LIT_CANNOT_USE_GMT_AND_TIMEZONE,
+    LIT_CE,
+    LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
+    LIT_ERA,		LIT_GMT,		LIT_GREGORIAN,
+    LIT_INTEGER_VALUE_TOO_LARGE,
+    LIT_ISO8601WEEK,	LIT_ISO8601YEAR,
+    LIT_JULIANDAY,	LIT_LOCALSECONDS,
+    LIT_MONTH,
+    LIT_SECONDS,	LIT_TZNAME,		LIT_TZOFFSET,
+    LIT_YEAR,
+    LIT__END
+} ClockLiteral;
+static const char *const literals[] = {
+    "",
+    "%a %b %d %H:%M:%S %Z %Y",
+    "BCE",		"C",			
+    "cannot use -gmt and -timezone in same call",
+    "CE",
+    "dayOfMonth",	"dayOfWeek",		"dayOfYear",
+    "era",		":GMT",			"gregorian",
+    "integer value too large to represent",
+    "iso8601Week",	"iso8601Year",
+    "julianDay",	"localSeconds",
+    "month",
+    "seconds",		"tzName",		"tzOffset",
+    "year"
+};
+
+/*
+ * Structure containing the client data for [clock]
+ */
+
+typedef struct ClockClientData {
+    int refCount;		/* Number of live references */
+    Tcl_Obj** literals;		/* Pool of object literals */
+} ClockClientData;
+
+/*
+ * Structure containing the fields used in [clock format] and [clock scan]
+ */
+
+typedef struct TclDateFields {
+    Tcl_WideInt seconds;	/* Time expressed in seconds from the Posix
+				 * epoch */
+    Tcl_WideInt localSeconds;	/* Local time expressed in nominal seconds
+				 * from the Posix epoch */
+    int tzOffset;		/* Time zone offset in seconds east of
+				 * Greenwich */
+    Tcl_Obj* tzName;		/* Time zone name */
+    int julianDay;		/* Julian Day Number in local time zone */
+    enum {BCE=1, CE=0} era;	/* Era */
+    int gregorian;		/* Flag == 1 if the date is Gregorian */
+    int year;			/* Year of the era */
+    int dayOfYear;		/* Day of the year (1 January == 1) */
+    int month;			/* Month number */
+    int dayOfMonth;		/* Day of the month */
+    int iso8601Year;		/* ISO8601 week-based year */
+    int iso8601Week;		/* ISO8601 week number */
+    int dayOfWeek;		/* Day of the week */
+} TclDateFields;
+static const char* eras[] = { "CE", "BCE", NULL };
+
+/*
+ * Thread specific data block holding a 'struct tm' for the 'gmtime' and
+ * 'localtime' library calls.
+ */
+
+static Tcl_ThreadDataKey tmKey;
+
+/*
+ * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
+ * in the date parsing code.
  */
 
 TCL_DECLARE_MUTEX(clockMutex)
@@ -26,366 +139,1914 @@ TCL_DECLARE_MUTEX(clockMutex)
  * Function prototypes for local procedures in this file:
  */
 
-static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_WideInt clockVal, int useGMT,
-			    char *format));
+static int		ConvertUTCToLocal(Tcl_Interp*,
+			    TclDateFields*, Tcl_Obj*, int);
+static int		ConvertUTCToLocalUsingTable(Tcl_Interp*,
+			    TclDateFields*, int, Tcl_Obj *const[]);
+static int		ConvertUTCToLocalUsingC(Tcl_Interp*,
+			    TclDateFields*, int);
+static int		ConvertLocalToUTC(Tcl_Interp*,
+			    TclDateFields*, Tcl_Obj*, int);
+static int		ConvertLocalToUTCUsingTable(Tcl_Interp*,
+			    TclDateFields*, int, Tcl_Obj *const[]);
+static int		ConvertLocalToUTCUsingC(Tcl_Interp*,
+			    TclDateFields*, int);
+static Tcl_Obj*		LookupLastTransition(Tcl_Interp*, Tcl_WideInt,
+			    int, Tcl_Obj *const *);
+static void		GetYearWeekDay(TclDateFields*, int);
+static void		GetGregorianEraYearDay(TclDateFields*, int);
+static void		GetMonthDay(TclDateFields*);
+static void		GetJulianDayFromEraYearWeekDay(TclDateFields*, int);
+static void		GetJulianDayFromEraYearMonthDay(TclDateFields*, int);
+static int		IsGregorianLeapYear(TclDateFields*);
+static int		WeekdayOnOrBefore(int, int);
+static int		ClockClicksObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockConvertlocaltoutcObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockGetdatefieldsObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockGetjuliandayfromerayearmonthdayObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockGetjuliandayfromerayearweekdayObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockGetenvObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockMicrosecondsObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockMillisecondsObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockParseformatargsObjCmd(
+			    ClientData clientData, Tcl_Interp* interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		ClockSecondsObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static struct tm *	ThreadSafeLocalTime(const time_t *);
+static void		TzsetIfNecessary(void);
+static void		ClockDeleteCmdProc(ClientData);
+
+/*
+ * Structure containing description of "native" clock commands to create.
+ */
+
+struct ClockCommand {
+    const char *name;		/* The tail of the command name. The full name
+				 * is "::tcl::clock::<name>". When NULL marks
+				 * the end of the table. */
+    Tcl_ObjCmdProc *objCmdProc;	/* Function that implements the command. This
+				 * will always have the ClockClientData sent
+				 * to it, but may well ignore this data. */
+};
+
+static const struct ClockCommand clockCommands[] = {
+    { "clicks",			ClockClicksObjCmd },
+    { "getenv",			ClockGetenvObjCmd },
+    { "microseconds",		ClockMicrosecondsObjCmd },
+    { "milliseconds",		ClockMillisecondsObjCmd },
+    { "seconds",		ClockSecondsObjCmd },
+    { "Oldscan",		TclClockOldscanObjCmd },
+    { "ConvertLocalToUTC",	ClockConvertlocaltoutcObjCmd },
+    { "GetDateFields",		ClockGetdatefieldsObjCmd },
+    { "GetJulianDayFromEraYearMonthDay",
+		ClockGetjuliandayfromerayearmonthdayObjCmd },
+    { "GetJulianDayFromEraYearWeekDay",
+    		ClockGetjuliandayfromerayearweekdayObjCmd },
+    { "ParseFormatArgs",	ClockParseformatargsObjCmd },
+    { NULL, NULL }
+};
 
 /*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
- * Tcl_ClockObjCmd --
+ * TclClockInit --
  *
- *	This procedure is invoked to process the "clock" Tcl command.
- *	See the user documentation for details on what it does.
+ *	Registers the 'clock' subcommands with the Tcl interpreter and
+ *	initializes its client data (which consists mostly of constant
+ *	Tcl_Obj's that it is too much trouble to keep recreating).
  *
  * Results:
- *	A standard Tcl result.
+ *	None.
  *
  * Side effects:
- *	See the user documentation.
+ *	Installs the commands and creates the client data
  *
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
+ */
+
+void
+TclClockInit(
+    Tcl_Interp *interp)		/* Tcl interpreter */
+{
+    const struct ClockCommand *clockCmdPtr;
+    char cmdName[50];		/* Buffer large enough to hold the string
+				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
+				 * plus a terminating NULL. */
+    ClockClientData *data;
+    int i;
+
+    /*
+     * Safe interps get [::clock] as alias to a master, so do not need their
+     * own copies of the support routines.
+     */
+
+    if (Tcl_IsSafe(interp)) {
+	return;
+    }
+
+    /*
+     * Create the client data, which is a refcounted literal pool.
+     */
+
+    data = (ClockClientData *) ckalloc(sizeof(ClockClientData));
+    data->refCount = 0;
+    data->literals = (Tcl_Obj**) ckalloc(LIT__END * sizeof(Tcl_Obj*));
+    for (i = 0; i < LIT__END; ++i) {
+	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
+	Tcl_IncrRefCount(data->literals[i]);
+    }
+
+    /*
+     * Install the commands.
+     */
+
+    strcpy(cmdName, "::tcl::clock::");
+#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
+    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
+	strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
+	data->refCount++;
+	Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
+		ClockDeleteCmdProc);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockConvertlocaltoutcObjCmd --
+ *
+ *	Tcl command that converts a UTC time to a local time by whatever means
+ *	is available.
+ *
+ * Usage:
+ *	::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover
+ *
+ * Parameters:
+ *	dict - Dictionary containing a 'localSeconds' entry.
+ *	tzdata - Time zone data
+ *	changeover - Julian Day of the adoption of the Gregorian calendar.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	On success, sets the interpreter result to the given dictionary
+ *	augmented with a 'seconds' field giving the UTC time. On failure,
+ *	leaves an error message in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockConvertlocaltoutcObjCmd(
+    ClientData clientData,	/* Client data  */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const *objv)	/* Parameter vector */
+{
+    ClockClientData* data = (ClockClientData*) clientData;
+    Tcl_Obj* const * literals = data->literals;
+    Tcl_Obj* secondsObj;
+    Tcl_Obj* dict;
+    int changeover;
+    TclDateFields fields;
+    int created = 0;
+    int status;
+
+    /*
+     * Check params and convert time.
+     */
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover");
+	return TCL_ERROR;
+    }
+    dict = objv[1];
+    if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
+		       &secondsObj)!= TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (secondsObj == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
+						  "found in dictionary", -1));
+	return TCL_ERROR;
+    }
+    if ((Tcl_GetWideIntFromObj(interp, secondsObj,
+			      &(fields.localSeconds)) != TCL_OK)
+	|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
+	|| ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Copy-on-write; set the 'seconds' field in the dictionary and place the
+     * modified dictionary in the interpreter result.
+     */
+
+    if (Tcl_IsShared(dict)) {
+	dict = Tcl_DuplicateObj(dict);
+	created = 1;
+	Tcl_IncrRefCount(dict);
+    }
+    status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS],
+	    Tcl_NewWideIntObj(fields.seconds));
+    if (status == TCL_OK) {
+	Tcl_SetObjResult(interp, dict);
+    }
+    if (created) {
+	Tcl_DecrRefCount(dict);
+    }
+    return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetdatefieldsObjCmd --
+ *
+ *	Tcl command that determines the values that [clock format] will use in
+ *	formatting a date, and populates a dictionary with them.
+ *
+ * Usage:
+ *	::tcl::clock::GetDateFields seconds tzdata changeover
+ *
+ * Parameters:
+ *	seconds - Time expressed in seconds from the Posix epoch.
+ *	tzdata - Time zone data of the time zone in which time is to
+ *                 be expressed.
+ *	changeover - Julian Day Number at which the current locale adopted
+ *		     the Gregorian calendar
+ *
+ * Results:
+ *	Returns a dictonary populated with the fields:
+ *		seconds - Seconds from the Posix epoch
+ *		localSeconds - Nominal seconds from the Posix epoch in
+ *			       the local time zone.
+ *		tzOffset - Time zone offset in seconds east of Greenwich
+ *		tzName - Time zone name
+ *		julianDay - Julian Day Number in the local time zone
+ *
+ *----------------------------------------------------------------------
  */
 
 int
-Tcl_ClockObjCmd (client, interp, objc, objv)
-    ClientData client;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument values. */
+ClockGetdatefieldsObjCmd(
+    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const *objv)	/* Parameter vector */
 {
-    Tcl_Obj *resultPtr;
-    int index;
-    Tcl_Obj *CONST *objPtr;
-    int useGMT = 0;
-    char *format = "%a %b %d %X %Z %Y";
-    int dummy;
-    Tcl_WideInt baseClock, clockVal;
-    long zone;
-    Tcl_Obj *baseObjPtr = NULL;
-    char *scanStr;
-    int n;
-    
-    static CONST char *switches[] =
-	{"clicks", "format", "scan", "seconds", (char *) NULL};
-    enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
-		       COMMAND_SECONDS
-    };
-    static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
-    static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
+    TclDateFields fields;
+    Tcl_Obj* dict;
+    ClockClientData* data = (ClockClientData*) clientData;
+    Tcl_Obj* const * literals = data->literals;
+    int changeover;
+
+    /*
+     * Check params.
+     */
 
-    resultPtr = Tcl_GetObjResult(interp);
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK
+	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
-	    != TCL_OK) {
+    /* 
+     * fields.seconds could be an unsigned number that overflowed.  Make
+     * sure that it isn't.
+     */
+
+    if (objv[1]->typePtr == &tclBignumType) {
+	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
 	return TCL_ERROR;
     }
-    switch ((enum command) index) {
-	case COMMAND_CLICKS:	{		/* clicks */
-	    int forceMilli = 0;
-
-	    if (objc == 3) {
-		format = Tcl_GetStringFromObj(objv[2], &n);
-		if ( ( n >= 2 ) 
-		     && ( strncmp( format, "-milliseconds",
-				   (unsigned int) n) == 0 ) ) {
-		    forceMilli = 1;
-		} else {
-		    Tcl_AppendStringsToObj(resultPtr,
-			    "bad switch \"", format,
-			    "\": must be -milliseconds", (char *) NULL);
-		    return TCL_ERROR;
-		}
-	    } else if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
-		return TCL_ERROR;
+
+    /*
+     * Convert UTC time to local.
+     */
+
+    if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Extract Julian day.
+     */
+
+    fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH)
+	    / SECONDS_PER_DAY);
+
+    /*
+     * Convert to Julian or Gregorian calendar.
+     */
+
+    GetGregorianEraYearDay(&fields, changeover);
+    GetMonthDay(&fields);
+    GetYearWeekDay(&fields, changeover);
+
+    dict = Tcl_NewDictObj();
+    Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
+	    Tcl_NewWideIntObj(fields.localSeconds));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
+	    Tcl_NewWideIntObj(fields.seconds));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
+    Tcl_DecrRefCount(fields.tzName);
+    Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
+	    Tcl_NewIntObj(fields.tzOffset));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
+	    Tcl_NewIntObj(fields.julianDay));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
+	    Tcl_NewIntObj(fields.gregorian));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
+	    literals[fields.era ? LIT_BCE : LIT_CE]);
+    Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
+	    Tcl_NewIntObj(fields.year));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
+	    Tcl_NewIntObj(fields.dayOfYear));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
+	    Tcl_NewIntObj(fields.month));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
+	    Tcl_NewIntObj(fields.dayOfMonth));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR],
+	    Tcl_NewIntObj(fields.iso8601Year));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
+	    Tcl_NewIntObj(fields.iso8601Week));
+    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
+	    Tcl_NewIntObj(fields.dayOfWeek));
+    Tcl_SetObjResult(interp, dict);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetjuliandayfromerayearmonthdayObjCmd --
+ *
+ *	Tcl command that converts a time from era-year-month-day to a Julian
+ *	Day Number.
+ *
+ * Parameters:
+ *	dict - Dictionary that contains 'era', 'year', 'month' and
+ *	       'dayOfMonth' keys.
+ *	changeover - Julian Day of changeover to the Gregorian calendar
+ *
+ * Results:
+ *	Result is either TCL_OK, with the interpreter result being the
+ *	dictionary augmented with a 'julianDay' key, or TCL_ERROR,
+ *	with the result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearmonthdayObjCmd (
+    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const *objv)	/* Parameter vector */
+{
+    TclDateFields fields;
+    Tcl_Obj* dict;
+    ClockClientData* data = (ClockClientData*) clientData;
+    Tcl_Obj* const * literals = data->literals;
+    Tcl_Obj* fieldPtr;
+    int changeover;
+    int copied = 0;
+    int status;
+    int era = 0;
+
+    /*
+     * Check params.
+     */
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+	return TCL_ERROR;
+    }
+    dict = objv[1];
+    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+		&era) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr,
+		&(fields.dayOfMonth)) != TCL_OK
+	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    fields.era = era;
+
+    /*
+     * Get Julian day.
+     */
+
+    GetJulianDayFromEraYearMonthDay(&fields, changeover);
+
+    /*
+     * Store Julian day in the dictionary - copy on write.
+     */
+
+    if (Tcl_IsShared(dict)) {
+	dict = Tcl_DuplicateObj(dict);
+	Tcl_IncrRefCount(dict);
+	copied = 1;
+    }
+    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+	    Tcl_NewIntObj(fields.julianDay));
+    if (status == TCL_OK) {
+	Tcl_SetObjResult(interp, dict);
+    }
+    if (copied) {
+	Tcl_DecrRefCount(dict);
+    }
+    return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetjuliandayfromerayearweekdayObjCmd --
+ *
+ *	Tcl command that converts a time from the ISO calendar to a Julian Day
+ *	Number.
+ *
+ * Parameters:
+ *	dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week'
+ *	       and 'dayOfWeek' keys.
+ *	changeover - Julian Day of changeover to the Gregorian calendar
+ *
+ * Results:
+ *	Result is either TCL_OK, with the interpreter result being the
+ *	dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the
+ *	result being an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockGetjuliandayfromerayearweekdayObjCmd (
+    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const *objv)	/* Parameter vector */
+{
+    TclDateFields fields;
+    Tcl_Obj* dict;
+    ClockClientData* data = (ClockClientData*) clientData;
+    Tcl_Obj* const * literals = data->literals;
+    Tcl_Obj* fieldPtr;
+    int changeover;
+    int copied = 0;
+    int status;
+    int era = 0;
+
+    /*
+     * Check params.
+     */
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
+	return TCL_ERROR;
+    }
+    dict = objv[1];
+    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
+		&era) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr,
+		&(fields.iso8601Year)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr,
+		&(fields.iso8601Week)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
+		&fieldPtr) != TCL_OK
+	    || TclGetIntFromObj(interp, fieldPtr,
+		&(fields.dayOfWeek)) != TCL_OK
+	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    fields.era = era;
+
+    /*
+     * Get Julian day.
+     */
+
+    GetJulianDayFromEraYearWeekDay(&fields, changeover);
+
+    /*
+     * Store Julian day in the dictionary - copy on write.
+     */
+
+    if (Tcl_IsShared(dict)) {
+	dict = Tcl_DuplicateObj(dict);
+	Tcl_IncrRefCount(dict);
+	copied = 1;
+    }
+    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
+	    Tcl_NewIntObj(fields.julianDay));
+    if (status == TCL_OK) {
+	Tcl_SetObjResult(interp, dict);
+    }
+    if (copied) {
+	Tcl_DecrRefCount(dict);
+    }
+    return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertLocalToUTC --
+ *
+ *	Converts a time (in a TclDateFields structure) from the local wall
+ *	clock to UTC.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Populates the 'seconds' field if successful; stores an error message
+ *	in the interpreter result on failure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertLocalToUTC(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Fields of the time */
+    Tcl_Obj* tzdata,		/* Time zone data */
+    int changeover)		/* Julian Day of the Gregorian transition */
+{
+    int rowc;			/* Number of rows in tzdata */
+    Tcl_Obj** rowv;		/* Pointers to the rows */
+
+    /*
+     * Unpack the tz data.
+     */
+
+    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Special case: If the time zone is :localtime, the tzdata will be empty.
+     * Use 'mktime' to convert the time to local
+     */
+
+    if (rowc == 0) {
+	return ConvertLocalToUTCUsingC(interp, fields, changeover);
+    } else {
+	return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertLocalToUTCUsingTable --
+ *
+ *	Converts a time (in a TclDateFields structure) from local time in a
+ *	given time zone to UTC.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Stores an error message in the interpreter if an error occurs; if
+ *	successful, stores the 'seconds' field in 'fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertLocalToUTCUsingTable(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    int rowc,			/* Number of points at which time changes */
+    Tcl_Obj *const rowv[])	/* Points at which time changes */
+{
+    Tcl_Obj* row;
+    int cellc;
+    Tcl_Obj** cellv;
+    int have[8];
+    int nHave = 0;
+    int i;
+    int found;
+
+    /*
+     * Perform an initial lookup assuming that local == UTC, and locate the
+     * last time conversion prior to that time. Get the offset from that row,
+     * and look up again. Continue until we find an offset that we found
+     * before. This definition, rather than "the same offset" ensures that we
+     * don't enter an endless loop, as would otherwise happen when trying to
+     * convert a non-existent time such as 02:30 during the US Spring Daylight
+     * Saving Time transition.
+     */
+
+    found = 0;
+    fields->tzOffset = 0;
+    fields->seconds = fields->localSeconds;
+    while (!found) {
+	row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+	if ((row == NULL)
+		|| TclListObjGetElements(interp, row, &cellc,
+		    &cellv) != TCL_OK
+		|| TclGetIntFromObj(interp, cellv[1],
+		    &(fields->tzOffset)) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	found = 0;
+	for (i = 0; !found && i < nHave; ++i) {
+	    if (have[i] == fields->tzOffset) {
+		found = 1;
+		break;
 	    }
-	    if (forceMilli) {
-		/*
-		 * We can enforce at least millisecond granularity
-		 */
-		Tcl_Time time;
-		Tcl_GetTime(&time);
-		Tcl_SetLongObj(resultPtr,
-			(long) (time.sec*1000 + time.usec/1000));
-	    } else {
-		Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
+	}
+	if (!found) {
+	    if (nHave == 8) {
+		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
 	    }
-	    return TCL_OK;
+	    have[nHave] = fields->tzOffset;
+	    ++nHave;
 	}
+	fields->seconds = fields->localSeconds - fields->tzOffset;
+    }
+    fields->tzOffset = have[i];
+    fields->seconds = fields->localSeconds - fields->tzOffset;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertLocalToUTCUsingC --
+ *
+ *	Converts a time from local wall clock to UTC when the local time zone
+ *	cannot be determined. Uses 'mktime' to do the job.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Stores an error message in the interpreter if an error occurs; if
+ *	successful, stores the 'seconds' field in 'fields.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	case COMMAND_FORMAT:			/* format */
-	    if ((objc < 3) || (objc > 7)) {
-		wrongFmtArgs:
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"clockval ?-format string? ?-gmt boolean?");
-		return TCL_ERROR;
-	    }
+static int
+ConvertLocalToUTCUsingC(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    int changeover)		/* Julian Day of the Gregorian transition */
+{
+    struct tm timeVal;
+    int localErrno;
+    int secondOfDay;
+    Tcl_WideInt jsec;
 
-	    if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal)
-		    != TCL_OK) {
-		return TCL_ERROR;
-	    }
-    
-	    objPtr = objv+3;
-	    objc -= 3;
-	    while (objc > 1) {
-		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
-			"switch", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch (index) {
-		    case 0:		/* -format */
-			format = Tcl_GetStringFromObj(objPtr[1], &dummy);
-			break;
-		    case 1:		/* -gmt */
-			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
-				&useGMT) != TCL_OK) {
-			    return TCL_ERROR;
-			}
-			break;
-		}
-		objPtr += 2;
-		objc -= 2;
-	    }
-	    if (objc != 0) {
-		goto wrongFmtArgs;
-	    }
-	    return FormatClock(interp, clockVal, useGMT,
-		    format);
-
-	case COMMAND_SCAN:			/* scan */
-	    if ((objc < 3) || (objc > 7)) {
-		wrongScanArgs:
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"dateString ?-base clockValue? ?-gmt boolean?");
-		return TCL_ERROR;
-	    }
+    /*
+     * Convert the given time to a date.
+     */
 
-	    objPtr = objv+3;
-	    objc -= 3;
-	    while (objc > 1) {
-		if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
-			"switch", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch (index) {
-		    case 0:		/* -base */
-			baseObjPtr = objPtr[1];
-			break;
-		    case 1:		/* -gmt */
-			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
-				&useGMT) != TCL_OK) {
-			    return TCL_ERROR;
-			}
-			break;
-		}
-		objPtr += 2;
-		objc -= 2;
-	    }
-	    if (objc != 0) {
-		goto wrongScanArgs;
-	    }
+    jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH;
+    fields->julianDay = (int) (jsec / SECONDS_PER_DAY);
+    secondOfDay = (int)(jsec % SECONDS_PER_DAY);
+    if (secondOfDay < 0) {
+	secondOfDay += SECONDS_PER_DAY;
+	--fields->julianDay;
+    }
+    GetGregorianEraYearDay(fields, changeover);
+    GetMonthDay(fields);
 
-	    if (baseObjPtr != NULL) {
-		if (Tcl_GetWideIntFromObj(interp, baseObjPtr,
-					  &baseClock) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-	    } else {
-		baseClock = TclpGetSeconds();
-	    }
+    /*
+     * Convert the date/time to a 'struct tm'.
+     */
 
-	    if (useGMT) {
-		zone = -50000; /* Force GMT */
-	    } else {
-		zone = TclpGetTimeZone(baseClock);
-	    }
+    timeVal.tm_year = fields->year - 1900;
+    timeVal.tm_mon = fields->month - 1;
+    timeVal.tm_mday = fields->dayOfMonth;
+    timeVal.tm_hour = (secondOfDay / 3600) % 24;
+    timeVal.tm_min = (secondOfDay / 60) % 60;
+    timeVal.tm_sec = secondOfDay % 60;
+    timeVal.tm_isdst = -1;
+    timeVal.tm_wday = -1;
+    timeVal.tm_yday = -1;
 
-	    scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
-	    Tcl_MutexLock(&clockMutex);
-	    if (TclGetDate(scanStr, baseClock, zone,
-		    &clockVal) < 0) {
-		Tcl_MutexUnlock(&clockMutex);
-		Tcl_AppendStringsToObj(resultPtr,
-			"unable to convert date-time string \"",
-			scanStr, "\"", (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_MutexUnlock(&clockMutex);
+    /*
+     * Get local time. It is rumored that mktime is not thread safe on some
+     * platforms, so seize a mutex before attempting this.
+     */
 
-	    Tcl_SetWideIntObj(resultPtr, clockVal);
-	    return TCL_OK;
+    TzsetIfNecessary();
+    Tcl_MutexLock(&clockMutex);
+    errno = 0;
+    fields->seconds = (Tcl_WideInt) mktime(&timeVal);
+    localErrno = errno;
+    Tcl_MutexUnlock(&clockMutex);
 
-	case COMMAND_SECONDS:			/* seconds */
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
-	    return TCL_OK;
-	default:
-	    return TCL_ERROR;	/* Should never be reached. */
+    /*
+     * If conversion fails, report an error.
+     */
+
+    if (localErrno != 0
+	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
+	Tcl_SetResult(interp, "time value too large/small to represent",
+		TCL_STATIC);
+	return TCL_ERROR;
     }
+    return TCL_OK;
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
- * FormatClock --
+ * ConvertUTCToLocal --
  *
- *      Formats a time value based on seconds into a human readable
- *	string.
+ *	Converts a time (in a TclDateFields structure) from UTC to local time.
  *
  * Results:
- *      Standard Tcl result.
+ *	Returns a standard Tcl result.
  *
  * Side effects:
- *      None.
+ *	Populates the 'tzName' and 'tzOffset' fields.
  *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static int
-FormatClock(interp, clockVal, useGMT, format)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    Tcl_WideInt clockVal;	       	/* Time in seconds. */
-    int useGMT;				/* Boolean */
-    char *format;			/* Format string */
+ConvertUTCToLocal(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Fields of the time */
+    Tcl_Obj* tzdata,		/* Time zone data */
+    int changeover)		/* Julian Day of the Gregorian transition */
 {
-    struct tm *timeDataPtr;
-    Tcl_DString buffer, uniBuffer;
-    int bufSize;
-    char *p;
-    int result;
-    time_t tclockVal;
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
-    TIMEZONE_t savedTimeZone = 0;	/* lint. */
-    char *savedTZEnv = NULL;		/* lint. */
-#endif
+    int rowc;			/* Number of rows in tzdata */
+    Tcl_Obj** rowv;		/* Pointers to the rows */
 
-#ifdef HAVE_TZSET
     /*
-     * Some systems forgot to call tzset in localtime, make sure its done.
+     * Unpack the tz data.
      */
-    static int  calledTzset = 0;
 
-    Tcl_MutexLock(&clockMutex);
-    if (!calledTzset) {
-        tzset();
-        calledTzset = 1;
+    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
+	return TCL_ERROR;
     }
-    Tcl_MutexUnlock(&clockMutex);
-#endif
 
     /*
-     * If the user gave us -format "", just return now
+     * Special case: If the time zone is :localtime, the tzdata will be empty.
+     * Use 'localtime' to convert the time to local
+     */
+
+    if (rowc == 0) {
+	return ConvertUTCToLocalUsingC(interp, fields, changeover);
+    } else {
+	return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertUTCToLocalUsingTable --
+ *
+ *	Converts UTC to local time, given a table of transition points
+ *
+ * Results:
+ *	Returns a standard Tcl result
+ *
+ * Side effects:
+ *	On success, fills fields->tzName, fields->tzOffset and
+ *	fields->localSeconds. On failure, places an error message in the
+ *	interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertUTCToLocalUsingTable(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Fields of the date */
+    int rowc,			/* Number of rows in the conversion table
+				 * (>= 1) */
+    Tcl_Obj *const rowv[])	/* Rows of the conversion table */
+{
+    Tcl_Obj* row;		/* Row containing the current information */
+    int cellc;			/* Count of cells in the row (must be 4) */
+    Tcl_Obj** cellv;		/* Pointers to the cells */
+
+    /*
+     * Look up the nearest transition time.
+     */
+
+    row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+    if (row == NULL ||
+	    TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
+	    TclGetIntFromObj(interp,cellv[1],&(fields->tzOffset)) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Convert the time.
+     */
+
+    fields->tzName = cellv[3];
+    Tcl_IncrRefCount(fields->tzName);
+    fields->localSeconds = fields->seconds + fields->tzOffset;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertUTCToLocalUsingC --
+ *
+ *	Converts UTC to localtime in cases where the local time zone is not
+ *	determinable, using the C 'localtime' function to do it.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	On success, fills fields->tzName, fields->tzOffset and
+ *	fields->localSeconds. On failure, places an error message in the
+ *	interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertUTCToLocalUsingC(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    int changeover)		/* Julian Day of the Gregorian transition */
+{
+    time_t tock;
+    struct tm* timeVal;		/* Time after conversion */
+    int diff;			/* Time zone diff local-Greenwich */
+    char buffer[8];		/* Buffer for time zone name */
+
+    /*
+     * Use 'localtime' to determine local year, month, day, time of day.
+     */
+
+    tock = (time_t) fields->seconds;
+    if ((Tcl_WideInt) tock != fields->seconds) {
+	Tcl_AppendResult(interp,
+		"number too large to represent as a Posix time", NULL);
+	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
+	return TCL_ERROR;
+    }
+    TzsetIfNecessary();
+    timeVal = ThreadSafeLocalTime(&tock);
+    if (timeVal == NULL) {
+	Tcl_AppendResult(interp,
+		"localtime failed (clock value may be too "
+		"large/small to represent)", NULL);
+	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Fill in the date in 'fields' and use it to derive Julian Day.
+     */
+
+    fields->era = CE;
+    fields->year = timeVal->tm_year + 1900;
+    fields->month = timeVal->tm_mon + 1;
+    fields->dayOfMonth = timeVal->tm_mday;
+    GetJulianDayFromEraYearMonthDay(fields, changeover);
+
+    /*
+     * Convert that value to seconds.
+     */
+
+    fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24
+	    + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60
+	    + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH;
+
+    /*
+     * Determine a time zone offset and name; just use +hhmm for the name.
+     */
+
+    diff = (int) (fields->localSeconds - fields->seconds);
+    fields->tzOffset = diff;
+    if (diff < 0) {
+	*buffer = '-';
+	diff = -diff;
+    } else {
+	*buffer = '+';
+    }
+    sprintf(buffer+1, "%02d", diff / 3600);
+    diff %= 3600;
+    sprintf(buffer+3, "%02d", diff / 60);
+    diff %= 60;
+    if (diff > 0) {
+	sprintf(buffer+5, "%02d", diff);
+    }
+    fields->tzName = Tcl_NewStringObj(buffer, -1);
+    Tcl_IncrRefCount(fields->tzName);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LookupLastTransition --
+ *
+ *	Given a UTC time and a tzdata array, looks up the last transition on
+ *	or before the given time.
+ *
+ * Results:
+ *	Returns a pointer to the row, or NULL if an error occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+LookupLastTransition(
+    Tcl_Interp* interp,		/* Interpreter for error messages */
+    Tcl_WideInt tick,		/* Time from the epoch */
+    int rowc,			/* Number of rows of tzdata */
+    Tcl_Obj *const *rowv)	/* Rows in tzdata */
+{
+    int l;
+    int u;
+    Tcl_Obj* compObj;
+    Tcl_WideInt compVal;
+
+    /*
+     * Examine the first row to make sure we're in bounds.
      */
-    if (*format == '\0') {
-	return TCL_OK;
+
+    if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
+	    || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
+     * anyway.
+     */
+
+    if (tick < compVal) {
+	return rowv[0];
     }
 
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
     /*
-     * This is a kludge for systems not having the timezone string in
-     * struct tm.  No matter what was specified, they use the local
-     * timezone string.  Since this kludge requires fiddling with the
-     * TZ environment variable, it will mess up if done on multiple
-     * threads at once.  Protect it with a the clock mutex.
+     * Binary-search to find the transition.
      */
 
-    Tcl_MutexLock( &clockMutex );
-    if (useGMT) {
-        CONST char *varValue;
+    l = 0;
+    u = rowc-1;
+    while (l < u) {
+	int m = (l + u + 1) / 2;
 
-        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
-        if (varValue != NULL) {
-	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
-        } else {
-            savedTZEnv = NULL;
+	if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
+		Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+	    return NULL;
+	}
+	if (tick >= compVal) {
+	    l = m;
+	} else {
+	    u = m-1;
 	}
-        Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
-        savedTimeZone = timezone;
-        timezone = 0;
-        tzset();
     }
-#endif
+    return rowv[l];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetYearWeekDay --
+ *
+ *	Given a date with Julian Calendar Day, compute the year, week, and day
+ *	in the ISO8601 calendar.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in the date
+ *	fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetYearWeekDay(
+    TclDateFields* fields,	/* Date to convert, must have 'julianDay' */
+    int changeover)		/* Julian Day Number of the Gregorian
+				 * transition */
+{
+    TclDateFields temp;
+    int dayOfFiscalYear;
 
-    tclockVal = (time_t) clockVal;
-    timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
-    
     /*
-     * Make a guess at the upper limit on the substituted string size
-     * based on the number of percents in the string.
+     * Find the given date, minus three days, plus one year. That date's
+     * iso8601 year is an upper bound on the ISO8601 year of the given date.
      */
 
-    for (bufSize = 1, p = format; *p != '\0'; p++) {
-	if (*p == '%') {
-	    bufSize += 40;
-	    if (p[1] == 'c') {
-		bufSize += 226;
-	    }
+    temp.julianDay = fields->julianDay - 3;
+    GetGregorianEraYearDay(&temp, changeover);
+    if (temp.era == BCE) {
+	temp.iso8601Year = temp.year - 1;
+    } else {
+	temp.iso8601Year = temp.year + 1;
+    }
+    temp.iso8601Week = 1;
+    temp.dayOfWeek = 1;
+    GetJulianDayFromEraYearWeekDay(&temp, changeover);
+
+    /*
+     * temp.julianDay is now the start of an ISO8601 year, either the one
+     * corresponding to the given date, or the one after. If we guessed high,
+     * move one year earlier
+     */
+
+    if (fields->julianDay < temp.julianDay) {
+	if (temp.era == BCE) {
+	    temp.iso8601Year += 1;
 	} else {
-	    bufSize++;
+	    temp.iso8601Year -= 1;
 	}
+	GetJulianDayFromEraYearWeekDay(&temp, changeover);
     }
-    Tcl_DStringInit(&uniBuffer);
-    Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
-    Tcl_DStringInit(&buffer);
-    Tcl_DStringSetLength(&buffer, bufSize);
 
-    /* If we haven't locked the clock mutex up above, lock it now. */
+    fields->iso8601Year = temp.iso8601Year;
+    dayOfFiscalYear = fields->julianDay - temp.julianDay;
+    fields->iso8601Week = (dayOfFiscalYear / 7) + 1;
+    fields->dayOfWeek = (dayOfFiscalYear + 1) % 7;
+    if (fields->dayOfWeek < 1) {
+	fields->dayOfWeek += 7;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetGregorianEraYearDay --
+ *
+ *	Given a Julian Day Number, extracts the year and day of the year and
+ *	puts them into TclDateFields, along with the era (BCE or CE) and a
+ *	flag indicating whether the date is Gregorian or Julian.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores 'era', 'gregorian', 'year', and 'dayOfYear'.
+ *
+ *----------------------------------------------------------------------
+ */
 
-#if defined(HAVE_TM_ZONE) || defined(WIN32)
-    Tcl_MutexLock(&clockMutex);
-#endif
-    result = TclpStrftime(buffer.string, (unsigned int) bufSize,
-	    Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
-#if defined(HAVE_TM_ZONE) || defined(WIN32)
-    Tcl_MutexUnlock(&clockMutex);
-#endif
-    Tcl_DStringFree(&uniBuffer);
-
-#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
-    if (useGMT) {
-        if (savedTZEnv != NULL) {
-            Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
-            ckfree(savedTZEnv);
-        } else {
-            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
-        }
-        timezone = savedTimeZone;
-        tzset();
-    }
-    Tcl_MutexUnlock( &clockMutex );
-#endif
+static void
+GetGregorianEraYearDay(
+    TclDateFields* fields,	/* Date fields containing 'julianDay' */
+    int changeover)		/* Gregorian transition date */
+{
+    int jday = fields->julianDay;
+    int day;
+    int year;
+    int n;
 
-    if (result == 0) {
+    if (jday >= changeover) {
 	/*
-	 * A zero return is the error case (can also mean the strftime
-	 * didn't get enough space to write into).  We know it doesn't
-	 * mean that we wrote zero chars because the check for an empty
-	 * format string is above.
+	 * Gregorian calendar.
 	 */
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad format string \"", format, "\"", (char *) NULL);
+
+	fields->gregorian = 1;
+	year = 1;
+
+	/*
+	 * n = Number of 400-year cycles since 1 January, 1 CE in the
+	 * proleptic Gregorian calendar. day = remaining days.
+	 */
+
+	day = jday - JDAY_1_JAN_1_CE_GREGORIAN;
+	n = day / FOUR_CENTURIES;
+	day %= FOUR_CENTURIES;
+	if (day < 0) {
+	    day += FOUR_CENTURIES;
+	    --n;
+	}
+	year += 400 * n;
+
+	/*
+	 * n = number of centuries since the start of (year);
+	 * day = remaining days
+	 */
+
+	n = day / ONE_CENTURY_GREGORIAN;
+	day %= ONE_CENTURY_GREGORIAN;
+	if (n > 3) {
+	    /*
+	     * 31 December in the last year of a 400-year cycle.
+	     */
+
+	    n = 3;
+	    day += ONE_CENTURY_GREGORIAN;
+	}
+	year += 100 * n;
+
+    } else {
+	/*
+	 * Julian calendar.
+	 */
+
+	fields->gregorian = 0;
+	year = 1;
+	day = jday - JDAY_1_JAN_1_CE_JULIAN;
+
+    }
+
+    /*
+     * n = number of 4-year cycles; days = remaining days.
+     */
+
+    n = day / FOUR_YEARS;
+    day %= FOUR_YEARS;
+    if (day < 0) {
+	day += FOUR_YEARS;
+	--n;
+    }
+    year += 4 * n;
+
+    /*
+     * n = number of years; days = remaining days.
+     */
+
+    n = day / ONE_YEAR;
+    day %= ONE_YEAR;
+    if (n > 3) {
+	/*
+	 * 31 December of a leap year.
+	 */
+
+	n = 3;
+	day += 365;
+    }
+    year += n;
+
+    /*
+     * store era/year/day back into fields.
+     */
+
+    if (year <= 0) {
+	fields->era = BCE;
+	fields->year = 1 - year;
+    } else {
+	fields->era = CE;
+	fields->year = year;
+    }
+    fields->dayOfYear = day + 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMonthDay --
+ *
+ *	Given a date as year and day-of-year, find month and day.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores 'month' and 'dayOfMonth' in the 'fields' structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMonthDay(
+    TclDateFields* fields)	/* Date to convert */
+{
+    int day = fields->dayOfYear;
+    int month;
+    const int* h = hath[IsGregorianLeapYear(fields)];
+
+    for (month = 0; month < 12 && day > h[month]; ++month) {
+	day -= h[month];
+    }
+    fields->month = month+1;
+    fields->dayOfMonth = day;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetJulianDayFromEraYearWeekDay --
+ *
+ *	Given a TclDateFields structure containing era, ISO8601 year, ISO8601
+ *	week, and day of week, computes the Julian Day Number.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores 'julianDay' in the fields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetJulianDayFromEraYearWeekDay(
+    TclDateFields* fields,	/* Date to convert */
+    int changeover)		/* Julian Day Number of the Gregorian
+				 * transition */
+{
+    int firstMonday;		/* Julian day number of week 1, day 1 in the
+				 * given year */
+
+    /*
+     * Find January 4 in the ISO8601 year, which will always be in week 1.
+     */
+
+    TclDateFields firstWeek;
+    firstWeek.era = fields->era;
+    firstWeek.year = fields->iso8601Year;
+    firstWeek.month = 1;
+    firstWeek.dayOfMonth = 4;
+    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);
+
+    /*
+     * Find Monday of week 1.
+     */
+
+    firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay);
+
+    /*
+     * Advance to the given week and day.
+     */
+
+    fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1)
+	    + fields->dayOfWeek - 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetJulianDayFromEraYearMonthDay --
+ *
+ *	Given era, year, month, and dayOfMonth (in TclDateFields), and the
+ *	Gregorian transition date, computes the Julian Day Number.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores day number in 'julianDay'
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetJulianDayFromEraYearMonthDay(
+    TclDateFields* fields,	/* Date to convert */
+    int changeover)		/* Gregorian transition date as a Julian Day */
+{
+    int year;  int ym1;
+    int month; int mm1;
+    int q; int r;
+    int ym1o4; int ym1o100; int ym1o400;
+
+    if (fields->era == BCE) {
+	year = 1 - fields->year;
+    } else {
+	year = fields->year;
+    }
+
+    /*
+     * Reduce month modulo 12.
+     */
+
+    month = fields->month;
+    mm1 = month - 1;
+    q = mm1 / 12;
+    r = (mm1 % 12);
+    if (r < 0) {
+	r += 12;
+	q -= 1;
+    }
+    year += q;
+    month = r + 1;
+    ym1 = year - 1;
+
+    /*
+     * Adjust the year after reducing the month.
+     */
+
+    fields->gregorian = 1;
+    if (year < 1) {
+	fields->era = BCE;
+	fields->year = 1-year;
+    } else {
+	fields->era = CE;
+	fields->year = year;
+    }
+
+    /*
+     * Try an initial conversion in the Gregorian calendar.
+     */
+
+    ym1o4 = ym1 / 4;
+    if (ym1 % 4 < 0) {
+	--ym1o4;
+    }
+    ym1o100 = ym1 / 100;
+    if (ym1 % 100 < 0) {
+	--ym1o100;
+    }
+    ym1o400 = ym1 / 400;
+    if (ym1 % 400 < 0) {
+	--ym1o400;
+    }
+    fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
+	    + fields->dayOfMonth
+	    + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1]
+	    + (ONE_YEAR * ym1)
+	    + ym1o4
+	    - ym1o100
+	    + ym1o400;
+
+    /*
+     * If the resulting date is before the Gregorian changeover, convert in
+     * the Julian calendar instead.
+     */
+
+    if (fields->julianDay < changeover) {
+	fields->gregorian = 0;
+	fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
+		+ fields->dayOfMonth
+		+ daysInPriorMonths[year%4 == 0][month - 1]
+		+ (ONE_YEAR * ym1)
+	        + ym1o4;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsGregorianLeapYear --
+ *
+ *	Tests whether a given year is a leap year, in either Julian or
+ *	Gregorian calendar.
+ *
+ * Results:
+ *	Returns 1 for a leap year, 0 otherwise.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsGregorianLeapYear(
+    TclDateFields* fields)	/* Date to test */
+{
+    int year;
+
+    if (fields->era == BCE) {
+	year = 1 - fields->year;
+    } else {
+	year = fields->year;
+    }
+    if (year%4 != 0) {
+	return 0;
+    } else if (!(fields->gregorian)) {
+	return 1;
+    } else if (year%400 == 0) {
+	return 1;
+    } else if (year%100 == 0) {
+	return 0;
+    } else {
+	return 1;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WeekdayOnOrBefore --
+ *
+ *	Finds the Julian Day Number of a given day of the week that falls on
+ *	or before a given date, expressed as Julian Day Number.
+ *
+ * Results:
+ *	Returns the Julian Day Number
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WeekdayOnOrBefore(
+    int dayOfWeek,		/* Day of week; Sunday == 0 or 7 */
+    int julianDay)		/* Reference date */
+{
+    int k = (dayOfWeek + 6) % 7;
+    if (k < 0) {
+	k += 7;
+    }
+    return julianDay - ((julianDay - k) % 7);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetenvObjCmd --
+ *
+ *	Tcl command that reads an environment variable from the system
+ *
+ * Usage:
+ *	::tcl::clock::getEnv NAME
+ *
+ * Parameters:
+ *	NAME - Name of the environment variable desired
+ *
+ * Results:
+ *	Returns a standard Tcl result. Returns an error if the variable does
+ *	not exist, with a message left in the interpreter. Returns TCL_OK and
+ *	the value of the variable if the variable does exist,
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockGetenvObjCmd(
+    ClientData clientData,
+    Tcl_Interp* interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char* varName;
+    const char* varValue;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
+    varName = TclGetString(objv[1]);
+    varValue = getenv(varName);
+    if (varValue == NULL) {
+	varValue = "";
+    }
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ThreadSafeLocalTime --
+ *
+ *	Wrapper around the 'localtime' library function to make it thread
+ *	safe.
+ *
+ * Results:
+ *	Returns a pointer to a 'struct tm' in thread-specific data.
+ *
+ * Side effects:
+ *	Invokes localtime or localtime_r as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
 
+static struct tm *
+ThreadSafeLocalTime(
+    const time_t *timePtr)	/* Pointer to the number of seconds since the
+				 * local system's epoch */
+{
     /*
-     * Convert the time to UTF from external encoding [Bug: 3345]
+     * Get a thread-local buffer to hold the returned time.
      */
-    Tcl_DStringInit(&uniBuffer);
-    Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
 
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
+    struct tm *tmPtr = (struct tm *)
+	    Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
+#ifdef HAVE_LOCALTIME_R
+    localtime_r(timePtr, tmPtr);
+#else
+    struct tm *sysTmPtr;
 
-    Tcl_DStringFree(&uniBuffer);
-    Tcl_DStringFree(&buffer);
+    Tcl_MutexLock(&clockMutex);
+    sysTmPtr = localtime(timePtr);
+    if (sysTmPtr == NULL) {
+	Tcl_MutexUnlock(&clockMutex);
+	return NULL;
+    } else {
+	memcpy((void *) tmPtr, (void *) localtime(timePtr), sizeof(struct tm));
+	Tcl_MutexUnlock(&clockMutex);
+    }
+#endif
+    return tmPtr;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockClicksObjCmd --
+ *
+ *	Returns a high-resolution counter.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock clicks' Tcl command. Refer to the user
+ * documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockClicksObjCmd(
+    ClientData clientData,	/* Client data is unused */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj* const* objv)	/* Parameter values */
+{
+    static const char *clicksSwitches[] = {
+	"-milliseconds", "-microseconds", NULL
+    };
+    enum ClicksSwitch {
+	CLICKS_MILLIS,   CLICKS_MICROS,   CLICKS_NATIVE
+    };
+    int index = CLICKS_NATIVE;
+    Tcl_Time now;
+
+    switch (objc) {
+    case 1:
+	break;
+    case 2:
+	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	break;
+    default:
+	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+	return TCL_ERROR;
+    }
+
+    switch (index) {
+    case CLICKS_MILLIS:
+	Tcl_GetTime(&now);
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+		now.sec * 1000 + now.usec / 1000));
+	break;
+    case CLICKS_NATIVE: {
+#ifndef TCL_WIDE_CLICKS
+	unsigned long clicks = TclpGetClicks();
+#else
+	Tcl_WideInt clicks = TclpGetWideClicks();
+#endif
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) clicks));
+	break;
+    }
+    case CLICKS_MICROS:
+	Tcl_GetTime(&now);
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+		((Tcl_WideInt) now.sec * 1000000) + now.usec));
+	break;
+    }
+
+    return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockMillisecondsObjCmd -
+ *
+ *	Returns a count of milliseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock milliseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockMillisecondsObjCmd(
+    ClientData clientData,	/* Client data is unused */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj* const* objv)	/* Parameter values */
+{
+    Tcl_Time now;
+
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+    Tcl_GetTime(&now);
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+	    now.sec * 1000 + now.usec / 1000));
     return TCL_OK;
 }
+
+/*----------------------------------------------------------------------
+ *
+ * ClockMicrosecondsObjCmd -
+ *
+ *	Returns a count of microseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock microseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
 
+int
+ClockMicrosecondsObjCmd(
+    ClientData clientData,	/* Client data is unused */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj* const* objv)	/* Parameter values */
+{
+    Tcl_Time now;
+
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+    Tcl_GetTime(&now);
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+	    ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ClockParseformatargsObjCmd --
+ *
+ *	Parses the arguments for [clock format].
+ *
+ * Results:
+ *	Returns a standard Tcl result, whose value is a four-element 
+ *	list comprising the time format, the locale, and the timezone.
+ *
+ * This function exists because the loop that parses the [clock format]
+ * options is a known performance "hot spot", and is implemented in an 
+ * effort to speed that particular code up.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ClockParseformatargsObjCmd(
+    ClientData clientData,	/* Client data containing literal pool */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const objv[]	/* Parameter vector */
+) {
+
+    ClockClientData* dataPtr = (ClockClientData*) clientData;
+    Tcl_Obj** litPtr = dataPtr->literals;
+
+    /* Format, locale and timezone */
+
+    Tcl_Obj* results[3];
+#define formatObj results[0]
+#define localeObj results[1]
+#define timezoneObj results[2]
+    int gmtFlag = 0;
+
+    /* Command line options expected */
+
+    static const char* options[] = {
+	"-format",		"-gmt",			"-locale",
+	"-timezone",		NULL };
+    enum optionInd {
+	CLOCK_FORMAT_FORMAT,	CLOCK_FORMAT_GMT,	CLOCK_FORMAT_LOCALE,
+	CLOCK_FORMAT_TIMEZONE 
+    };
+    int optionIndex;		/* Index of an option */
+    int saw = 0;		/* Flag == 1 if option was seen already */
+    Tcl_WideInt clockVal;	/* Clock value - just used to parse */
+    int i;
+
+    /* Args consist of a time followed by keyword-value pairs */
+
+    if (objc < 2 || (objc % 2) != 0) {
+	Tcl_WrongNumArgs(interp, 0, objv,
+			 "clock format clockval ?-format string? "
+			 "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
+	Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+	return TCL_ERROR;
+    }
+
+    /* Extract values for the keywords */
+
+    formatObj = litPtr[LIT__DEFAULT_FORMAT];
+    localeObj = litPtr[LIT_C];
+    timezoneObj = litPtr[LIT__NIL];
+    for (i = 2; i < objc; i+=2) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
+				&optionIndex) != TCL_OK) {
+	    Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+			     Tcl_GetString(objv[i]), NULL);
+	    return TCL_ERROR;
+	}
+	switch (optionIndex) {
+	case CLOCK_FORMAT_FORMAT:
+	    formatObj = objv[i+1];
+	    break;
+	case CLOCK_FORMAT_GMT:
+	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    break;
+	case CLOCK_FORMAT_LOCALE:
+	    localeObj = objv[i+1];
+	    break;
+	case CLOCK_FORMAT_TIMEZONE:
+	    timezoneObj = objv[i+1];
+	    break;
+	}
+	saw |= (1 << optionIndex);
+    }
+
+    /* Check options */
+
+    if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if ((saw & (1 << CLOCK_FORMAT_GMT))
+	&& (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
+	Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
+	Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
+	return TCL_ERROR;
+    }
+    if (gmtFlag) {
+	timezoneObj = litPtr[LIT_GMT];
+    }
+
+    /* Return options as a list */
+
+    Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
+    return TCL_OK;
+
+#undef timezoneObj
+#undef localeObj
+#undef formatObj
+
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockSecondsObjCmd -
+ *
+ *	Returns a count of microseconds since the epoch.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ * This function implements the 'clock seconds' Tcl command. Refer to the user
+ * documentation for details on what it does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockSecondsObjCmd(
+    ClientData clientData,	/* Client data is unused */
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj* const* objv)	/* Parameter values */
+{
+    Tcl_Time now;
+
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+    Tcl_GetTime(&now);
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TzsetIfNecessary --
+ *
+ *	Calls the tzset() library function if the contents of the TZ
+ *	environment variable has changed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls tzset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TzsetIfNecessary(void)
+{
+    static char* tzWas = NULL;	/* Previous value of TZ, protected by
+				 * clockMutex. */
+    const char* tzIsNow;	/* Current value of TZ */
+
+    Tcl_MutexLock(&clockMutex);
+    tzIsNow = getenv("TZ");
+    if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
+	tzset();
+	if (tzWas != NULL) {
+	    ckfree(tzWas);
+	}
+	tzWas = ckalloc(strlen(tzIsNow) + 1);
+	strcpy(tzWas, tzIsNow);
+    } else if (tzIsNow == NULL && tzWas != NULL) {
+	tzset();
+	ckfree(tzWas);
+	tzWas = NULL;
+    }
+    Tcl_MutexUnlock(&clockMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockDeleteCmdProc --
+ *
+ *	Remove a reference to the clock client data, and clean up memory
+ *	when it's all gone.
+ *
+ * Results:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockDeleteCmdProc(
+    ClientData clientData)	/* Opaque pointer to the client data */
+{
+    ClockClientData *data = (ClockClientData*) clientData;
+    int i;
+
+    --(data->refCount);
+    if (data->refCount == 0) {
+	for (i = 0; i < LIT__END; ++i) {
+	    Tcl_DecrRefCount(data->literals[i]);
+	}
+	ckfree((char*) (data->literals));
+	ckfree((char*) data);
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 2f7814c..44f08a3 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1,51 +1,45 @@
-/* 
+/*
  * tclCmdAH.c --
  *
- *	This file contains the top-level command routines for most of
- *	the Tcl built-in commands whose names begin with the letters
- *	A to H.
+ *	This file contains the top-level command routines for most of the Tcl
+ *	built-in commands whose names begin with the letters A to H.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#ifndef _WIN64
-/* See [Bug 3354324]: file mtime sets wrong time */
-#   define _USE_32BIT_TIME_T
-#endif
-
-#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclPort.h"
 #include <locale.h>
 
 /*
  * Prototypes for local procedures defined in this file:
  */
 
-static int		CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, int mode));
-static int		GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, Tcl_FSStatProc *statProc,
-			    Tcl_StatBuf *statPtr));
-static char *		GetTypeFromMode _ANSI_ARGS_((int mode));
-static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *varName, Tcl_StatBuf *statPtr));
+static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    int mode);
+static int		EncodingDirsObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
+static char *		GetTypeFromMode(int mode);
+static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
+			    Tcl_StatBuf *statPtr);
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_BreakObjCmd --
  *
- *	This procedure is invoked to process the "break" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "break" Tcl command. See the
+ *	user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "break" or the name
- *	to which "break" was renamed: e.g., "set z break; $z"
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "break" or the name to
+ *	which "break" was renamed: e.g., "set z break; $z"
  *
  * Results:
  *	A standard Tcl result.
@@ -58,11 +52,11 @@ static int		StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
 
 	/* ARGSUSED */
 int
-Tcl_BreakObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_BreakObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     if (objc != 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -76,8 +70,9 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_CaseObjCmd --
  *
- *	This procedure is invoked to process the "case" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "case" Tcl command. See the
+ *	user documentation for details on what it does. THIS COMMAND IS
+ *	OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
  *
  * Results:
  *	A standard Tcl object result.
@@ -90,16 +85,16 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_CaseObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_CaseObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register int i;
     int body, result, caseObjc;
-    char *string, *arg;
-    Tcl_Obj *CONST *caseObjv;
+    char *stringPtr, *arg;
+    Tcl_Obj *const *caseObjv;
     Tcl_Obj *armPtr;
 
     if (objc < 3) {
@@ -108,10 +103,10 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    string = Tcl_GetString(objv[1]);
+    stringPtr = TclGetString(objv[1]);
     body = -1;
 
-    arg = Tcl_GetString(objv[2]);
+    arg = TclGetString(objv[2]);
     if (strcmp(arg, "in") == 0) {
 	i = 3;
     } else {
@@ -121,36 +116,35 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
     caseObjv = objv + i;
 
     /*
-     * If all of the pattern/command pairs are lumped into a single
-     * argument, split them out again.
+     * If all of the pattern/command pairs are lumped into a single argument,
+     * split them out again.
      */
 
     if (caseObjc == 1) {
 	Tcl_Obj **newObjv;
-	
-	Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+
+	TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
 	caseObjv = newObjv;
     }
 
     for (i = 0;  i < caseObjc;  i += 2) {
 	int patObjc, j;
-	CONST char **patObjv;
+	const char **patObjv;
 	char *pat;
 	unsigned char *p;
 
 	if (i == (caseObjc - 1)) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	            "extra case pattern with no body", -1);
+	    Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
 	    return TCL_ERROR;
 	}
 
 	/*
-	 * Check for special case of single pattern (no list) with
-	 * no backslash sequences.
+	 * Check for special case of single pattern (no list) with no
+	 * backslash sequences.
 	 */
 
-	pat = Tcl_GetString(caseObjv[i]);
+	pat = TclGetString(caseObjv[i]);
 	for (p = (unsigned char *) pat; *p != '\0'; p++) {
 	    if (isspace(*p) || (*p == '\\')) {	/* INTL: ISO space, UCHAR */
 		break;
@@ -160,17 +154,16 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
 	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
 		body = i + 1;
 	    }
-	    if (Tcl_StringMatch(string, pat)) {
+	    if (Tcl_StringMatch(stringPtr, pat)) {
 		body = i + 1;
 		goto match;
 	    }
 	    continue;
 	}
 
-
 	/*
-	 * Break up pattern lists, then check each of the patterns
-	 * in the list.
+	 * Break up pattern lists, then check each of the patterns in the
+	 * list.
 	 */
 
 	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
@@ -178,7 +171,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
 	    return result;
 	}
 	for (j = 0; j < patObjc; j++) {
-	    if (Tcl_StringMatch(string, patObjv[j])) {
+	    if (Tcl_StringMatch(stringPtr, patObjv[j])) {
 		body = i + 1;
 		break;
 	    }
@@ -189,18 +182,14 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
 	}
     }
 
-    match:
+  match:
     if (body != -1) {
 	armPtr = caseObjv[body - 1];
 	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
 	if (result == TCL_ERROR) {
-	    char msg[100 + TCL_INTEGER_SPACE];
-	    
-	    arg = Tcl_GetString(armPtr);
-	    sprintf(msg,
-		    "\n    (\"%.50s\" arm line %d)", arg,
-	            interp->errorLine);
-	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		    "\n    (\"%.50s\" arm line %d)",
+		    TclGetString(armPtr), interp->errorLine));
 	}
 	return result;
     }
@@ -217,7 +206,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_CatchObjCmd --
  *
- *	This object-based procedure is invoked to process the "catch" Tcl 
+ *	This object-based procedure is invoked to process the "catch" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -231,53 +220,68 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_CatchObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_CatchObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *varNamePtr = NULL;
+    Tcl_Obj *optionVarNamePtr = NULL;
     int result;
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    Interp *iPtr = (Interp *) interp;
 
-    if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
+    if ((objc < 2) || (objc > 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"script ?resultVarName? ?optionVarName?");
 	return TCL_ERROR;
     }
 
-    if (objc == 3) {
+    if (objc >= 3) {
 	varNamePtr = objv[2];
     }
+    if (objc == 4) {
+	optionVarNamePtr = objv[3];
+    }
 
-#ifndef TCL_TIP280
-    result = Tcl_EvalObjEx(interp, objv[1], 0);
-#else
-    /* TIP #280. Make invoking context available to caught script */
-    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1);
-#endif
-    
-    if (objc == 3) {
-	if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
-		Tcl_GetObjResult(interp), 0) == NULL) {
+    /*
+     * TIP #280. Make invoking context available to caught script.
+     */
+
+    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+
+    /*
+     * We disable catch in interpreters where the limit has been exceeded.
+     */
+
+    if (Tcl_LimitExceeded(interp)) {
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"catch\" body line %d)", interp->errorLine));
+	return TCL_ERROR;
+    }
+
+    if (objc >= 3) {
+	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+		Tcl_GetObjResult(interp), 0)) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),  
-	            "couldn't save command result in variable", -1);
+	    Tcl_AppendResult(interp,
+		    "couldn't save command result in variable", NULL);
+	    return TCL_ERROR;
+	}
+    }
+    if (objc == 4) {
+	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
+	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
+		options, 0)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp,
+		    "couldn't save return options in variable", NULL);
 	    return TCL_ERROR;
 	}
     }
-
-    /*
-     * Set the interpreter's object result to an integer object holding the
-     * integer Tcl_EvalObj result. Note that we don't bother generating a
-     * string representation. We reset the interpreter's object result
-     * to an unshared empty object and then set it to be an integer object.
-     */
 
     Tcl_ResetResult(interp);
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
     return TCL_OK;
 }
 
@@ -286,8 +290,8 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_CdObjCmd --
  *
- *	This procedure is invoked to process the "cd" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "cd" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -300,11 +304,11 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_CdObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_CdObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *dir;
     int result;
@@ -317,7 +321,7 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
     if (objc == 2) {
 	dir = objv[1];
     } else {
-	dir = Tcl_NewStringObj("~",1);
+	TclNewLiteralStringObj(dir, "~");
 	Tcl_IncrRefCount(dir);
     }
     if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
@@ -326,7 +330,7 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
 	result = Tcl_FSChdir(dir);
 	if (result != TCL_OK) {
 	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
-		    Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
+		    TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
 	    result = TCL_ERROR;
 	}
     }
@@ -355,11 +359,11 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ConcatObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ConcatObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     if (objc >= 2) {
 	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
@@ -370,14 +374,14 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ContinueObjCmd -
+ * Tcl_ContinueObjCmd --
  *
- *	This procedure is invoked to process the "continue" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "continue" Tcl command. See
+ *	the user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "continue" or the name
- *	to which "continue" was renamed: e.g., "set z continue; $z"
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "continue" or the name to
+ *	which "continue" was renamed: e.g., "set z continue; $z"
  *
  * Results:
  *	A standard Tcl result.
@@ -390,11 +394,11 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ContinueObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_ContinueObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     if (objc != 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -420,29 +424,25 @@ Tcl_ContinueObjCmd(dummy, interp, objc, objv)
  */
 
 int
-Tcl_EncodingObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_EncodingObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int index, length;
-    Tcl_Encoding encoding;
-    char *string;
-    Tcl_DString ds;
-    Tcl_Obj *resultPtr;
+    int index;
 
-    static CONST char *optionStrings[] = {
-	"convertfrom", "convertto", "names", "system",
+    static const char *optionStrings[] = {
+	"convertfrom", "convertto", "dirs", "names", "system",
 	NULL
     };
     enum options {
-	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_NAMES, ENC_SYSTEM
+	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
     };
 
     if (objc < 2) {
-    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 	    &index) != TCL_OK) {
@@ -450,78 +450,80 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
     }
 
     switch ((enum options) index) {
-	case ENC_CONVERTTO:
-	case ENC_CONVERTFROM: {
-	    Tcl_Obj *data;
-	    if (objc == 3) {
-		encoding = Tcl_GetEncoding(interp, NULL);
-		data = objv[2];
-	    } else if (objc == 4) {
-		if (TclGetEncodingFromObj(interp, objv[2], &encoding)
-			!= TCL_OK) {
-		    return TCL_ERROR;
-		}
-		data = objv[3];
-	    } else {
-		Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
+    case ENC_CONVERTTO:
+    case ENC_CONVERTFROM: {
+	Tcl_Obj *data;
+	Tcl_DString ds;
+	Tcl_Encoding encoding;
+	int length;
+	char *stringPtr;
+
+	if (objc == 3) {
+	    encoding = Tcl_GetEncoding(interp, NULL);
+	    data = objv[2];
+	} else if (objc == 4) {
+	    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    
-	    if ((enum options) index == ENC_CONVERTFROM) {
-		/*
-		 * Treat the string as binary data.
-		 */
+	    data = objv[3];
+	} else {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
+	    return TCL_ERROR;
+	}
 
-		string = (char *) Tcl_GetByteArrayFromObj(data, &length);
-		Tcl_ExternalToUtfDString(encoding, string, length, &ds);
+	if ((enum options) index == ENC_CONVERTFROM) {
+	    /*
+	     * Treat the string as binary data.
+	     */
 
-		/*
-		 * Note that we cannot use Tcl_DStringResult here because
-		 * it will truncate the string at the first null byte.
-		 */
+	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
+	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
 
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
-		Tcl_DStringFree(&ds);
-	    } else {
-		/*
-		 * Store the result as binary data.
-		 */
+	    /*
+	     * Note that we cannot use Tcl_DStringResult here because it will
+	     * truncate the string at the first null byte.
+	     */
 
-		string = Tcl_GetStringFromObj(data, &length);
-		Tcl_UtfToExternalDString(encoding, string, length, &ds);
-		resultPtr = Tcl_GetObjResult(interp);
-		Tcl_SetByteArrayObj(resultPtr, 
-			(unsigned char *) Tcl_DStringValue(&ds),
-			Tcl_DStringLength(&ds));
-		Tcl_DStringFree(&ds);
-	    }
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
+	    Tcl_DStringFree(&ds);
+	} else {
+	    /*
+	     * Store the result as binary data.
+	     */
 
-	    Tcl_FreeEncoding(encoding);
-	    break;
+	    stringPtr = TclGetStringFromObj(data, &length);
+	    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
+	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
+		    (unsigned char *) Tcl_DStringValue(&ds),
+		    Tcl_DStringLength(&ds)));
+	    Tcl_DStringFree(&ds);
 	}
-	case ENC_NAMES: {
-	    if (objc > 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_GetEncodingNames(interp);
-	    break;
+
+	Tcl_FreeEncoding(encoding);
+	break;
+    }
+    case ENC_DIRS:
+	return EncodingDirsObjCmd(dummy, interp, objc, objv);
+    case ENC_NAMES:
+	if (objc > 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
 	}
-	case ENC_SYSTEM: {
-	    if (objc > 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
-		return TCL_ERROR;
-	    }
-	    if (objc == 2) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			Tcl_GetEncodingName(NULL), -1);
-	    } else {
-	        return Tcl_SetSystemEncoding(interp,
-			Tcl_GetStringFromObj(objv[2], NULL));
-	    }
-	    break;
+	Tcl_GetEncodingNames(interp);
+	break;
+    case ENC_SYSTEM:
+	if (objc > 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
+	    return TCL_ERROR;
 	}
+	if (objc == 2) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    Tcl_GetEncodingName(NULL), -1));
+	} else {
+	    return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
+	}
+	break;
     }
     return TCL_OK;
 }
@@ -529,10 +531,54 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * EncodingDirsObjCmd --
+ *
+ *	This command manipulates the encoding search path.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Can set the encoding search path.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+EncodingDirsObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *dirListObj;
+
+    if (objc > 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
+	return TCL_ERROR;
+    }
+    if (objc == 2) {
+	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
+	return TCL_OK;
+    }
+
+    dirListObj = objv[2];
+    if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
+	Tcl_AppendResult(interp, "expected directory list but got \"",
+		TclGetString(dirListObj), "\"", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, dirListObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ErrorObjCmd --
  *
- *	This procedure is invoked to process the "error" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "error" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -545,36 +591,35 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ErrorObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ErrorObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    char *info;
-    int infoLen;
+    Tcl_Obj *options, *optName;
 
     if ((objc < 2) || (objc > 4)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
 	return TCL_ERROR;
     }
-    
-    if (objc >= 3) {		/* process the optional info argument */
-	info = Tcl_GetStringFromObj(objv[2], &infoLen);
-	if (infoLen > 0) {
-	    Tcl_AddObjErrorInfo(interp, info, infoLen);
-	    iPtr->flags |= ERR_ALREADY_LOGGED;
-	}
+
+    TclNewLiteralStringObj(options, "-code error -level 0");
+
+    if (objc >= 3) {		/* Process the optional info argument */
+	TclNewLiteralStringObj(optName, "-errorinfo");
+	Tcl_ListObjAppendElement(NULL, options, optName);
+	Tcl_ListObjAppendElement(NULL, options, objv[2]);
     }
-    
-    if (objc == 4) {
-	Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
-	iPtr->flags |= ERROR_CODE_SET;
+
+    if (objc >= 4) {		/* Process the optional code argument */
+	TclNewLiteralStringObj(optName, "-errorcode");
+	Tcl_ListObjAppendElement(NULL, options, optName);
+	Tcl_ListObjAppendElement(NULL, options, objv[3]);
     }
-    
+
     Tcl_SetObjResult(interp, objv[1]);
-    return TCL_ERROR;
+    return Tcl_SetReturnOptions(interp, options);
 }
 
 /*
@@ -582,7 +627,7 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_EvalObjCmd --
  *
- *	This object-based procedure is invoked to process the "eval" Tcl 
+ *	This object-based procedure is invoked to process the "eval" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -596,53 +641,50 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_EvalObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_EvalObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result;
     register Tcl_Obj *objPtr;
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    Interp *iPtr = (Interp *) interp;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
-    
+
     if (objc == 2) {
-#ifndef TCL_TIP280
-	result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
-#else
-	/* TIP #280. Make argument location available to eval'd script */
+	/*
+	 * TIP #280. Make argument location available to eval'd script.
+	 */
+
 	CmdFrame* invoker = iPtr->cmdFramePtr;
 	int word          = 1;
 	TclArgumentGet (interp, objv[1], &invoker, &word);
+
 	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
-			      invoker, word);
-#endif
+		invoker, word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
-	 * between, then evaluate the result.  Tcl_EvalObjEx will delete
-	 * the object when it decrements its refcount after eval'ing it.
+	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
+	 * object when it decrements its refcount after eval'ing it.
 	 */
-    	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-#ifndef TCL_TIP280
-	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
-#else
-	/* TIP #280. Make invoking context available to eval'd script */
+
+	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+
+	/*
+	 * TIP #280. Make invoking context available to eval'd script.
+	 */
+
 	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
-#endif
     }
     if (result == TCL_ERROR) {
-	char msg[32 + TCL_INTEGER_SPACE];
-
-	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
-	Tcl_AddObjErrorInfo(interp, msg, -1);
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"eval\" body line %d)", interp->errorLine));
     }
     return result;
 }
@@ -652,8 +694,8 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_ExitObjCmd --
  *
- *	This procedure is invoked to process the "exit" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "exit" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -666,11 +708,11 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ExitObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ExitObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int value;
 
@@ -678,7 +720,7 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
 	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
 	return TCL_ERROR;
     }
-    
+
     if (objc == 1) {
 	value = 0;
     } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
@@ -686,7 +728,7 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
     }
     Tcl_Exit(value);
     /*NOTREACHED*/
-    return TCL_OK;			/* Better not ever reach this! */
+    return TCL_OK;		/* Better not ever reach this! */
 }
 
 /*
@@ -698,8 +740,8 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
  *	command. See the user documentation for details on what it does.
  *
  *	With the bytecode compiler, this procedure is called in two
- *	circumstances: 1) to execute expr commands that are too complicated
- *	or too unsafe to try compiling directly into an inline sequence of
+ *	circumstances: 1) to execute expr commands that are too complicated or
+ *	too unsafe to try compiling directly into an inline sequence of
  *	instructions, and 2) to execute commands where the command name is
  *	computed at runtime and is "expr" or the name to which "expr" was
  *	renamed (e.g., "set z expr; $z 2+3")
@@ -715,16 +757,14 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ExprObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
-{	 
-    register Tcl_Obj *objPtr;
+Tcl_ExprObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
     Tcl_Obj *resultPtr;
-    register char *bytes;
-    int length, i, result;
+    int result;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -733,42 +773,18 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
 
     if (objc == 2) {
 	result = Tcl_ExprObj(interp, objv[1], &resultPtr);
-	if (result == TCL_OK) {
-	    Tcl_SetObjResult(interp, resultPtr);
-	    Tcl_DecrRefCount(resultPtr);  /* done with the result object */
-	}
-	return result;
-    }
-
-    /*
-     * Create a new object holding the concatenated argument strings.
-     */
-
-    /*** QUESTION: Do we need to copy the slow way? ***/
-    bytes = Tcl_GetStringFromObj(objv[1], &length);
-    objPtr = Tcl_NewStringObj(bytes, length);
-    Tcl_IncrRefCount(objPtr);
-    for (i = 2;  i < objc;  i++) {
-	Tcl_AppendToObj(objPtr, " ", 1);
-	bytes = Tcl_GetStringFromObj(objv[i], &length);
-	Tcl_AppendToObj(objPtr, bytes, length);
+    } else {
+	Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	Tcl_IncrRefCount(objPtr);
+	result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+	Tcl_DecrRefCount(objPtr);
     }
 
-    /*
-     * Evaluate the concatenated string object.
-     */
-
-    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
     if (result == TCL_OK) {
 	Tcl_SetObjResult(interp, resultPtr);
-	Tcl_DecrRefCount(resultPtr);  /* done with the result object */
+	Tcl_DecrRefCount(resultPtr);	/* Done with the result object */
     }
 
-    /*
-     * Free allocated resources.
-     */
-    
-    Tcl_DecrRefCount(objPtr);
     return result;
 }
 
@@ -777,12 +793,11 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_FileObjCmd --
  *
- *	This procedure is invoked to process the "file" Tcl command.
- *	See the user documentation for details on what it does.
- *	PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH
- *	EMBEDDED NULLS, WHICH COULD THEORETICALLY HAPPEN ON A MAC.
- *      With the object-based Tcl_FS APIs, the above NOTE may no
- *      longer be true.  In any case this assertion should be tested.
+ *	This procedure is invoked to process the "file" Tcl command. See the
+ *	user documentation for details on what it does. PLEASE NOTE THAT THIS
+ *	FAILS WITH FILENAMES AND PATHS WITH EMBEDDED NULLS. With the
+ *	object-based Tcl_FS APIs, the above NOTE may no longer be true. In any
+ *	case this assertion should be tested.
  *
  * Results:
  *	A standard Tcl result.
@@ -795,607 +810,569 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_FileObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_FileObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int index;
+    int index, value;
+    Tcl_StatBuf buf;
+    struct utimbuf tval;
 
-/*
- * This list of constants should match the fileOption string array below.
- */
+    /*
+     * This list of constants should match the fileOption string array below.
+     */
 
-    static CONST char *fileOptions[] = {
+    static const char *fileOptions[] = {
 	"atime",	"attributes",	"channels",	"copy",
 	"delete",
 	"dirname",	"executable",	"exists",	"extension",
 	"isdirectory",	"isfile",	"join",		"link",
-	"lstat",        "mtime",	"mkdir",	"nativename",	
+	"lstat",	"mtime",	"mkdir",	"nativename",
 	"normalize",    "owned",
 	"pathtype",	"readable",	"readlink",	"rename",
-	"rootname",	"separator",    "size",		"split",	
-	"stat",         "system", 
+	"rootname",	"separator",    "size",		"split",
+	"stat",		"system",
 	"tail",		"type",		"volumes",	"writable",
-	(char *) NULL
+	NULL
     };
     enum options {
 	FCMD_ATIME,	FCMD_ATTRIBUTES, FCMD_CHANNELS,	FCMD_COPY,
 	FCMD_DELETE,
 	FCMD_DIRNAME,	FCMD_EXECUTABLE, FCMD_EXISTS,	FCMD_EXTENSION,
-	FCMD_ISDIRECTORY, FCMD_ISFILE,	FCMD_JOIN,	FCMD_LINK, 
-	FCMD_LSTAT,     FCMD_MTIME,	FCMD_MKDIR,	FCMD_NATIVENAME, 
-	FCMD_NORMALIZE, FCMD_OWNED,
+	FCMD_ISDIRECTORY, FCMD_ISFILE,	FCMD_JOIN,	FCMD_LINK,
+	FCMD_LSTAT,	FCMD_MTIME,	FCMD_MKDIR,	FCMD_NATIVENAME,
+	FCMD_NORMALIZE,	FCMD_OWNED,
 	FCMD_PATHTYPE,	FCMD_READABLE,	FCMD_READLINK,	FCMD_RENAME,
-	FCMD_ROOTNAME,	FCMD_SEPARATOR, FCMD_SIZE,	FCMD_SPLIT,	
-	FCMD_STAT,      FCMD_SYSTEM, 
+	FCMD_ROOTNAME,	FCMD_SEPARATOR,	FCMD_SIZE,	FCMD_SPLIT,
+	FCMD_STAT,	FCMD_SYSTEM,
 	FCMD_TAIL,	FCMD_TYPE,	FCMD_VOLUMES,	FCMD_WRITABLE
     };
 
     if (objc < 2) {
-    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
 	    &index) != TCL_OK) {
-    	return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     switch ((enum options) index) {
-    	case FCMD_ATIME: {
-	    Tcl_StatBuf buf;
-	    struct utimbuf tval;
 
-	    if ((objc < 3) || (objc > 4)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
-		return TCL_ERROR;
-	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+    case FCMD_ATIME:
+    case FCMD_MTIME:
+	if ((objc < 3) || (objc > 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+	    return TCL_ERROR;
+	}
+	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (objc == 4) {
+	    /*
+	     * Need separate variable for reading longs from an object on
+	     * 64-bit platforms. [Bug #698146]
+	     */
+
+	    long newTime;
+
+	    if (TclGetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (objc == 4) {
-		long newTime;
 
-		if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
-		    return TCL_ERROR;
-		}
+	    if (index == FCMD_ATIME) {
 		tval.actime = newTime;
 		tval.modtime = buf.st_mtime;
-		if (Tcl_FSUtime(objv[2], &tval) != 0) {
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "could not set access time for file \"",
-			    Tcl_GetString(objv[2]), "\": ",
-			    Tcl_PosixError(interp), (char *) NULL);
-		    return TCL_ERROR;
-		}
-		/*
-		 * Do another stat to ensure that the we return the
-		 * new recognized atime - hopefully the same as the
-		 * one we sent in.  However, fs's like FAT don't
-		 * even know what atime is.
-		 */
-		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		    return TCL_ERROR;
-		}
+	    } else {	/* index == FCMD_MTIME */
+		tval.actime = buf.st_atime;
+		tval.modtime = newTime;
 	    }
-	    Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
-	    return TCL_OK;
-	}
-	case FCMD_ATTRIBUTES: {
-            return TclFileAttrsCmd(interp, objc, objv);
-	}
-	case FCMD_CHANNELS: {
-	    if ((objc < 2) || (objc > 3)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+
+	    if (Tcl_FSUtime(objv[2], &tval) != 0) {
+		Tcl_AppendResult(interp, "could not set ",
+			(index == FCMD_ATIME ? "access" : "modification"),
+			" time for file \"", TclGetString(objv[2]), "\": ",
+			Tcl_PosixError(interp), NULL);
 		return TCL_ERROR;
 	    }
-	    return Tcl_GetChannelNamesEx(interp,
-		    ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
-	}
-	case FCMD_COPY: {
-	    return TclFileCopyCmd(interp, objc, objv);
-	}	    
-	case FCMD_DELETE: {
-	    return TclFileDeleteCmd(interp, objc, objv);
-	}
-    	case FCMD_DIRNAME: {
-	    Tcl_Obj *dirPtr;
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    dirPtr = TclFileDirname(interp, objv[2]);
-	    if (dirPtr == NULL) {
-	        return TCL_ERROR;
-	    } else {
-		Tcl_SetObjResult(interp, dirPtr);
-		Tcl_DecrRefCount(dirPtr);
-		return TCL_OK;
+
+	    /*
+	     * Do another stat to ensure that the we return the new recognized
+	     * atime - hopefully the same as the one we sent in. However, fs's
+	     * like FAT don't even know what atime is.
+	     */
+
+	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+		return TCL_ERROR;
 	    }
 	}
-	case FCMD_EXECUTABLE: {
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    return CheckAccess(interp, objv[2], X_OK);
+
+	Tcl_SetObjResult(interp, Tcl_NewLongObj((long)
+		(index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
+	return TCL_OK;
+    case FCMD_ATTRIBUTES:
+	return TclFileAttrsCmd(interp, objc, objv);
+    case FCMD_CHANNELS:
+	if ((objc < 2) || (objc > 3)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	    return TCL_ERROR;
 	}
-	case FCMD_EXISTS: {
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    return CheckAccess(interp, objv[2], F_OK);
+	return Tcl_GetChannelNamesEx(interp,
+		((objc == 2) ? NULL : TclGetString(objv[2])));
+    case FCMD_COPY:
+	return TclFileCopyCmd(interp, objc, objv);
+    case FCMD_DELETE:
+	return TclFileDeleteCmd(interp, objc, objv);
+    case FCMD_DIRNAME: {
+	Tcl_Obj *dirPtr;
+
+	if (objc != 3) {
+	    goto only3Args;
 	}
-	case FCMD_EXTENSION: {
-	    char *fileName, *extension;
-	    if (objc != 3) {
-	    	goto only3Args;
-	    }
-	    fileName = Tcl_GetString(objv[2]);
-	    extension = TclGetExtension(fileName);
-	    if (extension != NULL) {
-	    	Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1);
-	    }
+	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
+	if (dirPtr == NULL) {
+	    return TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, dirPtr);
+	    Tcl_DecrRefCount(dirPtr);
 	    return TCL_OK;
 	}
-    	case FCMD_ISDIRECTORY: {
-	    int value;
-	    Tcl_StatBuf buf;
-
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    value = 0;
-	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-		value = S_ISDIR(buf.st_mode);
-	    }
-	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
+    }
+    case FCMD_EXECUTABLE:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	return CheckAccess(interp, objv[2], X_OK);
+    case FCMD_EXISTS:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	return CheckAccess(interp, objv[2], F_OK);
+    case FCMD_EXTENSION: {
+	Tcl_Obj *ext;
+
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);
+	if (ext != NULL) {
+	    Tcl_SetObjResult(interp, ext);
+	    Tcl_DecrRefCount(ext);
 	    return TCL_OK;
+	} else {
+	    return TCL_ERROR;
 	}
-    	case FCMD_ISFILE: {
-	    int value;
-	    Tcl_StatBuf buf;
-	    
-    	    if (objc != 3) {
-    	    	goto only3Args;
-    	    }
-	    value = 0;
-	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-		value = S_ISREG(buf.st_mode);
-	    }
-	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
-	    return TCL_OK;
+    }
+    case FCMD_ISDIRECTORY:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	value = 0;
+	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
+	    value = S_ISDIR(buf.st_mode);
 	}
-	case FCMD_JOIN: {
-	    Tcl_Obj *resObj;
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+	return TCL_OK;
+    case FCMD_ISFILE:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	value = 0;
+	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
+	    value = S_ISREG(buf.st_mode);
+	}
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+	return TCL_OK;
+    case FCMD_OWNED:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	value = 0;
+	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
+	    /*
+	     * For Windows, there are no user ids associated with a file, so
+	     * we always return 1.
+	     */
 
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
-		return TCL_ERROR;
-	    }
-	    resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
-	    Tcl_SetObjResult(interp, resObj);
-	    return TCL_OK;
+#if defined(__WIN32__) || defined(__CYGWIN__)
+	    value = 1;
+#else
+	    value = (geteuid() == buf.st_uid);
+#endif
 	}
-	case FCMD_LINK: {
-	    Tcl_Obj *contents;
-	    int index;
-	    
-	    if (objc < 3 || objc > 5) {
-		Tcl_WrongNumArgs(interp, 2, objv, 
-				 "?-linktype? linkname ?target?");
-		return TCL_ERROR;
-	    }
-	    
-	    /* Index of the 'source' argument */
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+	return TCL_OK;
+    case FCMD_JOIN: {
+	Tcl_Obj *resObj;
+
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
+	    return TCL_ERROR;
+	}
+	resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
+	Tcl_SetObjResult(interp, resObj);
+	return TCL_OK;
+    }
+    case FCMD_LINK: {
+	Tcl_Obj *contents;
+	int index;
+
+	if (objc < 3 || objc > 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Index of the 'source' argument.
+	 */
+
+	if (objc == 5) {
+	    index = 3;
+	} else {
+	    index = 2;
+	}
+
+	if (objc > 3) {
+	    int linkAction;
 	    if (objc == 5) {
-		index = 3;
-	    } else {
-		index = 2;
-	    }
-	    
-	    if (objc > 3) {
-		int linkAction;
-		if (objc == 5) {
-		    /* We have a '-linktype' argument */
-		    static CONST char *linkTypes[] = {
-			"-symbolic", "-hard", NULL
-		    };
-		    if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, 
-				     "switch", 0, &linkAction) != TCL_OK) {
-			return TCL_ERROR;
-		    }
-		    if (linkAction == 0) {
-		        linkAction = TCL_CREATE_SYMBOLIC_LINK;
-		    } else {
-			linkAction = TCL_CREATE_HARD_LINK;
-		    }
-		} else {
-		    linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
-		}
-		if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
+		/*
+		 * We have a '-linktype' argument.
+		 */
+
+		static const char *linkTypes[] = {
+		    "-symbolic", "-hard", NULL
+		};
+		if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, "switch",
+			0, &linkAction) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		/* Create link from source to target */
-		contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
-		if (contents == NULL) {
-		    /* 
-		     * We handle two common error cases specially, and
-		     * for all other errors, we use the standard posix
-		     * error message.
-		     */
-		    if (errno == EEXIST) {
-			Tcl_AppendResult(interp, "could not create new link \"", 
-				Tcl_GetString(objv[index]), 
-				"\": that path already exists", (char *) NULL);
-		    } else if (errno == ENOENT) {
-			Tcl_AppendResult(interp, "could not create new link \"", 
-				Tcl_GetString(objv[index]), 
-				"\" since target \"", 
-				Tcl_GetString(objv[index+1]), 
-				"\" doesn't exist", 
-				(char *) NULL);
-		    } else {
-			Tcl_AppendResult(interp, "could not create new link \"", 
-				Tcl_GetString(objv[index]), "\" pointing to \"", 
-				Tcl_GetString(objv[index+1]), "\": ", 
-				Tcl_PosixError(interp), (char *) NULL);
-		    }
-		    return TCL_ERROR;
+		if (linkAction == 0) {
+		    linkAction = TCL_CREATE_SYMBOLIC_LINK;
+		} else {
+		    linkAction = TCL_CREATE_HARD_LINK;
 		}
 	    } else {
-		if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		/* Read link */
-		contents = Tcl_FSLink(objv[index], NULL, 0);
-		if (contents == NULL) {
-		    Tcl_AppendResult(interp, "could not read link \"", 
-			    Tcl_GetString(objv[index]), "\": ", 
-			    Tcl_PosixError(interp), (char *) NULL);
-		    return TCL_ERROR;
-		}
+		linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
 	    }
-	    Tcl_SetObjResult(interp, contents);
-	    if (objc == 3) {
-		/* 
-		 * If we are reading a link, we need to free this
-		 * result refCount.  If we are creating a link, this
-		 * will just be objv[index+1], and so we don't own it.
-		 */
-		Tcl_DecrRefCount(contents);
-	    }
-	    return TCL_OK;
-	}
-    	case FCMD_LSTAT: {
-	    char *varName;
-	    Tcl_StatBuf buf;
-
-    	    if (objc != 4) {
-    	    	Tcl_WrongNumArgs(interp, 2, objv, "name varName");
-    	    	return TCL_ERROR;
-    	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+	    if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    varName = Tcl_GetString(objv[3]);
-	    return StoreStatData(interp, varName, &buf);
-	}
-	case FCMD_MTIME: {
-	    Tcl_StatBuf buf;
-	    struct utimbuf tval;
 
-	    if ((objc < 3) || (objc > 4)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
-		return TCL_ERROR;
-	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (objc == 4) {
-		long newTime;
+	    /*
+	     * Create link from source to target.
+	     */
 
-		if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		tval.actime = buf.st_atime;
-		tval.modtime = newTime;
-		if (Tcl_FSUtime(objv[2], &tval) != 0) {
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "could not set modification time for file \"",
-			    Tcl_GetString(objv[2]), "\": ",
-			    Tcl_PosixError(interp), (char *) NULL);
-		    return TCL_ERROR;
-		}
+	    contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
+	    if (contents == NULL) {
 		/*
-		 * Do another stat to ensure that the we return the
-		 * new recognized atime - hopefully the same as the
-		 * one we sent in.  However, fs's like FAT don't
-		 * even know what atime is.
+		 * We handle three common error cases specially, and for all
+		 * other errors, we use the standard posix error message.
 		 */
-		if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		    return TCL_ERROR;
+
+		if (errno == EEXIST) {
+		    Tcl_AppendResult(interp, "could not create new link \"",
+			    TclGetString(objv[index]),
+			    "\": that path already exists", NULL);
+		} else if (errno == ENOENT) {
+		    /*
+		     * There are two cases here: either the target doesn't
+		     * exist, or the directory of the src doesn't exist.
+		     */
+
+		    int access;
+		    Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
+			    TCL_PATH_DIRNAME);
+
+		    if (dirPtr == NULL) {
+			return TCL_ERROR;
+		    }
+		    access = Tcl_FSAccess(dirPtr, F_OK);
+		    Tcl_DecrRefCount(dirPtr);
+		    if (access != 0) {
+			Tcl_AppendResult(interp,
+				"could not create new link \"",
+				TclGetString(objv[index]),
+				"\": no such file or directory", NULL);
+		    } else {
+			Tcl_AppendResult(interp,
+				"could not create new link \"",
+				TclGetString(objv[index]), "\": target \"",
+				TclGetString(objv[index+1]),
+				"\" doesn't exist", NULL);
+		    }
+		} else {
+		    Tcl_AppendResult(interp,
+			    "could not create new link \"",
+			    TclGetString(objv[index]), "\" pointing to \"",
+			    TclGetString(objv[index+1]), "\": ",
+			    Tcl_PosixError(interp), NULL);
 		}
-	    }
-	    Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
-	    return TCL_OK;
-	}
-	case FCMD_MKDIR: {
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
 		return TCL_ERROR;
 	    }
-	    return TclFileMakeDirsCmd(interp, objc, objv);
-	}
-	case FCMD_NATIVENAME: {
-	    CONST char *fileName;
-	    Tcl_DString ds;
-
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    fileName = Tcl_GetString(objv[2]);
-	    fileName = Tcl_TranslateFileName(interp, fileName, &ds);
-	    if (fileName == NULL) {
+	} else {
+	    if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, 
-			     Tcl_DStringLength(&ds));
-	    Tcl_DStringFree(&ds);
-	    return TCL_OK;
-	}
-	case FCMD_NORMALIZE: {
-	    Tcl_Obj *fileName;
 
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "filename");
-		return TCL_ERROR;
-	    }
+	    /*
+	     * Read link
+	     */
 
-	    fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
-	    if (fileName == NULL) {
+	    contents = Tcl_FSLink(objv[index], NULL, 0);
+	    if (contents == NULL) {
+		Tcl_AppendResult(interp, "could not read link \"",
+			TclGetString(objv[index]), "\": ",
+			Tcl_PosixError(interp), NULL);
 		return TCL_ERROR;
 	    }
-	    Tcl_SetObjResult(interp, fileName);
-	    return TCL_OK;
 	}
-	case FCMD_OWNED: {
-	    int value;
-	    Tcl_StatBuf buf;
-	    
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    value = 0;
-	    if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-		/*
-		 * For Windows there are no user ids 
-		 * associated with a file, so we always return 1.
-		 */
+	Tcl_SetObjResult(interp, contents);
+	if (objc == 3) {
+	    /*
+	     * If we are reading a link, we need to free this result refCount.
+	     * If we are creating a link, this will just be objv[index+1], and
+	     * so we don't own it.
+	     */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
-		value = 1;
-#else
-		value = (geteuid() == buf.st_uid);
-#endif
-	    }	    
-	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
-	    return TCL_OK;
+	    Tcl_DecrRefCount(contents);
 	}
-	case FCMD_PATHTYPE: {
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    switch (Tcl_FSGetPathType(objv[2])) {
-	    	case TCL_PATH_ABSOLUTE:
-	    	    Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
-		    break;
-	    	case TCL_PATH_RELATIVE:
-	    	    Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
-	    	    break;
-	    	case TCL_PATH_VOLUME_RELATIVE:
-		    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
-				     "volumerelative", -1);
-		    break;
-	    }
-	    return TCL_OK;
+	return TCL_OK;
+    }
+    case FCMD_LSTAT:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name varName");
+	    return TCL_ERROR;
 	}
-    	case FCMD_READABLE: {
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    return CheckAccess(interp, objv[2], R_OK);
+	if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	case FCMD_READLINK: {
-	    Tcl_Obj *contents;
-		
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    
-	    if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-
-	    contents = Tcl_FSLink(objv[2], NULL, 0);
+	return StoreStatData(interp, objv[3], &buf);
+    case FCMD_STAT:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name varName");
+	    return TCL_ERROR;
+	}
+	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return StoreStatData(interp, objv[3], &buf);
+    case FCMD_SIZE:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp,
+		Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
+	return TCL_OK;
+    case FCMD_TYPE:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		GetTypeFromMode((unsigned short) buf.st_mode), -1));
+	return TCL_OK;
+    case FCMD_MKDIR:
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
+	    return TCL_ERROR;
+	}
+	return TclFileMakeDirsCmd(interp, objc, objv);
+    case FCMD_NATIVENAME: {
+	const char *fileName;
+	Tcl_DString ds;
 
-	    if (contents == NULL) {
-	    	Tcl_AppendResult(interp, "could not readlink \"", 
-	    		Tcl_GetString(objv[2]), "\": ", 
-	    		Tcl_PosixError(interp), (char *) NULL);
-	    	return TCL_ERROR;
-	    }
-	    Tcl_SetObjResult(interp, contents);
-	    Tcl_DecrRefCount(contents);
-	    return TCL_OK;
+	if (objc != 3) {
+	    goto only3Args;
 	}
-	case FCMD_RENAME: {
-	    return TclFileRenameCmd(interp, objc, objv);
+	fileName = TclGetString(objv[2]);
+	fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+	if (fileName == NULL) {
+	    return TCL_ERROR;
 	}
-	case FCMD_ROOTNAME: {
-	    int length;
-	    char *fileName, *extension;
-	    
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    fileName = Tcl_GetStringFromObj(objv[2], &length);
-	    extension = TclGetExtension(fileName);
-	    if (extension == NULL) {
-	    	Tcl_SetObjResult(interp, objv[2]);
-	    } else {
-	        Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
-			(int) (length - strlen(extension)));
-	    }
-	    return TCL_OK;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName,
+		Tcl_DStringLength(&ds)));
+	Tcl_DStringFree(&ds);
+	return TCL_OK;
+    }
+    case FCMD_NORMALIZE: {
+	Tcl_Obj *fileName;
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "filename");
+	    return TCL_ERROR;
 	}
-	case FCMD_SEPARATOR: {
-	    if ((objc < 2) || (objc > 3)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?name?");
-		return TCL_ERROR;
-	    }
-	    if (objc == 2) {
-	        char *separator = NULL; /* lint */
-		switch (tclPlatform) {
-		    case TCL_PLATFORM_UNIX:
-			separator = "/";
-			break;
-		    case TCL_PLATFORM_WINDOWS:
-			separator = "\\";
-			break;
-		}
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
-	    } else {
-		Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
-		if (separatorObj != NULL) {
-		    Tcl_SetObjResult(interp, separatorObj);
-		} else {
-		    Tcl_SetObjResult(interp, 
-			    Tcl_NewStringObj("Unrecognised path",-1));
-		    return TCL_ERROR;
-		}
-	    }
-	    return TCL_OK;
+
+	fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
+	if (fileName == NULL) {
+	    return TCL_ERROR;
 	}
-	case FCMD_SIZE: {
-	    Tcl_StatBuf buf;
-	    
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
-		    (Tcl_WideInt) buf.st_size);
-	    return TCL_OK;
+	Tcl_SetObjResult(interp, fileName);
+	return TCL_OK;
+    }
+    case FCMD_PATHTYPE: {
+	Tcl_Obj *typeName;
+
+	if (objc != 3) {
+	    goto only3Args;
 	}
-	case FCMD_SPLIT: {
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));
+
+	switch (Tcl_FSGetPathType(objv[2])) {
+	case TCL_PATH_ABSOLUTE:
+	    TclNewLiteralStringObj(typeName, "absolute");
+	    break;
+	case TCL_PATH_RELATIVE:
+	    TclNewLiteralStringObj(typeName, "relative");
+	    break;
+	case TCL_PATH_VOLUME_RELATIVE:
+	    TclNewLiteralStringObj(typeName, "volumerelative");
+	    break;
+	default:
 	    return TCL_OK;
 	}
-	case FCMD_STAT: {
-	    char *varName;
-	    Tcl_StatBuf buf;
-	    
-	    if (objc != 4) {
-	    	Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
-		return TCL_ERROR;
-	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    varName = Tcl_GetString(objv[3]);
-	    return StoreStatData(interp, varName, &buf);
+	Tcl_SetObjResult(interp, typeName);
+	return TCL_OK;
+    }
+    case FCMD_READABLE:
+	if (objc != 3) {
+	    goto only3Args;
 	}
-	case FCMD_SYSTEM: {
-	    Tcl_Obj* fsInfo;
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    fsInfo = Tcl_FSFileSystemInfo(objv[2]);
-	    if (fsInfo != NULL) {
-		Tcl_SetObjResult(interp, fsInfo);
-		return TCL_OK;
-	    } else {
-		Tcl_SetObjResult(interp, 
-				 Tcl_NewStringObj("Unrecognised path",-1));
-		return TCL_ERROR;
-	    }
+	return CheckAccess(interp, objv[2], R_OK);
+    case FCMD_READLINK: {
+	Tcl_Obj *contents;
+
+	if (objc != 3) {
+	    goto only3Args;
 	}
-    	case FCMD_TAIL: {
-	    int splitElements;
-	    Tcl_Obj *splitPtr;
 
-	    if (objc != 3) {
-		goto only3Args;
-	    }
-	    /* 
-	     * The behaviour we want here is slightly different to
-	     * the standard Tcl_FSSplitPath in the handling of home
-	     * directories; Tcl_FSSplitPath preserves the "~" while 
-	     * this code computes the actual full path name, if we
-	     * had just a single component.
-	     */	    
-	    splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
-	    if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
-		Tcl_DecrRefCount(splitPtr);
-		splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
-		if (splitPtr == NULL) {
-		    return TCL_ERROR;
-		}
-		splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
-	    }
+	if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
+	    return TCL_ERROR;
+	}
 
-	    /*
-	     * Return the last component, unless it is the only component,
-	     * and it is the root of an absolute path.
-	     */
+	contents = Tcl_FSLink(objv[2], NULL, 0);
 
-	    if (splitElements > 0) {
-	    	if ((splitElements > 1)
-		  || (Tcl_FSGetPathType(objv[2]) == TCL_PATH_RELATIVE)) {
-		    
-		    Tcl_Obj *tail = NULL;
-		    Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail);
-		    Tcl_SetObjResult(interp, tail);
-	    	}
-	    }
-	    Tcl_DecrRefCount(splitPtr);
+	if (contents == NULL) {
+	    Tcl_AppendResult(interp, "could not readlink \"",
+		    TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
+		    NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, contents);
+	Tcl_DecrRefCount(contents);
+	return TCL_OK;
+    }
+    case FCMD_RENAME:
+	return TclFileRenameCmd(interp, objc, objv);
+    case FCMD_ROOTNAME: {
+	Tcl_Obj *root;
+
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);
+	if (root != NULL) {
+	    Tcl_SetObjResult(interp, root);
+	    Tcl_DecrRefCount(root);
 	    return TCL_OK;
+	} else {
+	    return TCL_ERROR;
+	}
+    }
+    case FCMD_SEPARATOR:
+	if ((objc < 2) || (objc > 3)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+	    return TCL_ERROR;
 	}
-	case FCMD_TYPE: {
-	    Tcl_StatBuf buf;
+	if (objc == 2) {
+	    char *separator = NULL; /* lint */
 
-	    if (objc != 3) {
-	    	goto only3Args;
+	    switch (tclPlatform) {
+	    case TCL_PLATFORM_UNIX:
+		separator = "/";
+		break;
+	    case TCL_PLATFORM_WINDOWS:
+		separator = "\\";
+		break;
 	    }
-	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
+	} else {
+	    Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
+
+	    if (separatorObj == NULL) {
+		Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
 		return TCL_ERROR;
 	    }
-	    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
-		    GetTypeFromMode((unsigned short) buf.st_mode), -1);
-	    return TCL_OK;
+	    Tcl_SetObjResult(interp, separatorObj);
 	}
-	case FCMD_VOLUMES: {
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_SetObjResult(interp, Tcl_FSListVolumes());
-	    return TCL_OK;
+	return TCL_OK;
+    case FCMD_SPLIT: {
+	Tcl_Obj *res;
+
+	if (objc != 3) {
+	    goto only3Args;
 	}
-	case FCMD_WRITABLE: {
-	    if (objc != 3) {
-	    	goto only3Args;
+	res = Tcl_FSSplitPath(objv[2], NULL);
+	if (res == NULL) {
+	    /* How can the interp be NULL here?! DKF */
+	    if (interp != NULL) {
+		Tcl_AppendResult(interp, "could not read \"",
+			TclGetString(objv[2]),
+			"\": no such file or directory", NULL);
 	    }
-	    return CheckAccess(interp, objv[2], W_OK);
+	    return TCL_ERROR;
 	}
+	Tcl_SetObjResult(interp, res);
+	return TCL_OK;
     }
+    case FCMD_SYSTEM: {
+	Tcl_Obj *fsInfo;
 
-    only3Args:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	fsInfo = Tcl_FSFileSystemInfo(objv[2]);
+	if (fsInfo == NULL) {
+	    Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, fsInfo);
+	return TCL_OK;
+    }
+    case FCMD_TAIL: {
+	Tcl_Obj *dirPtr;
+
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
+	if (dirPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, dirPtr);
+	Tcl_DecrRefCount(dirPtr);
+	return TCL_OK;
+    }
+    case FCMD_VOLUMES:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_FSListVolumes());
+	return TCL_OK;
+    case FCMD_WRITABLE:
+	if (objc != 3) {
+	    goto only3Args;
+	}
+	return CheckAccess(interp, objv[2], W_OK);
+    }
+
+  only3Args:
     Tcl_WrongNumArgs(interp, 2, objv, "name");
     return TCL_ERROR;
 }
@@ -1405,35 +1382,35 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
  *
  * CheckAccess --
  *
- *	Utility procedure used by Tcl_FileObjCmd() to query file
- *	attributes available through the access() system call.
+ *	Utility procedure used by Tcl_FileObjCmd() to query file attributes
+ *	available through the access() system call.
  *
  * Results:
- *	Always returns TCL_OK.  Sets interp's result to boolean true or
- *	false depending on whether the file has the specified attribute.
+ *	Always returns TCL_OK. Sets interp's result to boolean true or false
+ *	depending on whether the file has the specified attribute.
  *
  * Side effects:
  *	None.
  *
  *---------------------------------------------------------------------------
  */
-  
+
 static int
-CheckAccess(interp, objPtr, mode)
-    Tcl_Interp *interp;		/* Interp for status return.  Must not be
+CheckAccess(
+    Tcl_Interp *interp,		/* Interp for status return. Must not be
 				 * NULL. */
-    Tcl_Obj *objPtr;		/* Name of file to check. */
-    int mode;			/* Attribute to check; passed as argument to
+    Tcl_Obj *pathPtr,		/* Name of file to check. */
+    int mode)			/* Attribute to check; passed as argument to
 				 * access(). */
 {
     int value;
-    
-    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
+
+    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
 	value = 0;
     } else {
-	value = (Tcl_FSAccess(objPtr, mode) == 0);
+	value = (Tcl_FSAccess(pathPtr, mode) == 0);
     }
-    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
 
     return TCL_OK;
 }
@@ -1443,14 +1420,14 @@ CheckAccess(interp, objPtr, mode)
  *
  * GetStatBuf --
  *
- *	Utility procedure used by Tcl_FileObjCmd() to query file
- *	attributes available through the stat() or lstat() system call.
+ *	Utility procedure used by Tcl_FileObjCmd() to query file attributes
+ *	available through the stat() or lstat() system call.
  *
  * Results:
- *	The return value is TCL_OK if the specified file exists and can
- *	be stat'ed, TCL_ERROR otherwise.  If TCL_ERROR is returned, an
- *	error message is left in interp's result.  If TCL_OK is returned,
- *	*statPtr is filled with information about the specified file.
+ *	The return value is TCL_OK if the specified file exists and can be
+ *	stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error
+ *	message is left in interp's result. If TCL_OK is returned, *statPtr is
+ *	filled with information about the specified file.
  *
  * Side effects:
  *	None.
@@ -1459,27 +1436,27 @@ CheckAccess(interp, objPtr, mode)
  */
 
 static int
-GetStatBuf(interp, objPtr, statProc, statPtr)
-    Tcl_Interp *interp;		/* Interp for error return.  May be NULL. */
-    Tcl_Obj *objPtr;		/* Path name to examine. */
-    Tcl_FSStatProc *statProc;	/* Either stat() or lstat() depending on
+GetStatBuf(
+    Tcl_Interp *interp,		/* Interp for error return. May be NULL. */
+    Tcl_Obj *pathPtr,		/* Path name to examine. */
+    Tcl_FSStatProc *statProc,	/* Either stat() or lstat() depending on
 				 * desired behavior. */
-    Tcl_StatBuf *statPtr;	/* Filled with info about file obtained by
+    Tcl_StatBuf *statPtr)	/* Filled with info about file obtained by
 				 * calling (*statProc)(). */
 {
     int status;
-    
-    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
+
+    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    status = (*statProc)(objPtr, statPtr);
-    
+    status = (*statProc)(pathPtr, statPtr);
+
     if (status < 0) {
 	if (interp != NULL) {
 	    Tcl_AppendResult(interp, "could not read \"",
-		    Tcl_GetString(objPtr), "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+		    TclGetString(pathPtr), "\": ",
+		    Tcl_PosixError(interp), NULL);
 	}
 	return TCL_ERROR;
     }
@@ -1491,13 +1468,13 @@ GetStatBuf(interp, objPtr, statProc, statPtr)
  *
  * StoreStatData --
  *
- *	This is a utility procedure that breaks out the fields of a
- *	"stat" structure and stores them in textual form into the
- *	elements of an associative array.
+ *	This is a utility procedure that breaks out the fields of a "stat"
+ *	structure and stores them in textual form into the elements of an
+ *	associative array.
  *
  * Results:
- *	Returns a standard Tcl return value.  If an error occurs then
- *	a message is left in interp's result.
+ *	Returns a standard Tcl return value. If an error occurs then a message
+ *	is left in interp's result.
  *
  * Side effects:
  *	Elements of the associative array given by "varName" are modified.
@@ -1506,56 +1483,59 @@ GetStatBuf(interp, objPtr, statProc, statPtr)
  */
 
 static int
-StoreStatData(interp, varName, statPtr)
-    Tcl_Interp *interp;			/* Interpreter for error reports. */
-    char *varName;			/* Name of associative array variable
-					 * in which to store stat results. */
-    Tcl_StatBuf *statPtr;		/* Pointer to buffer containing
-					 * stat data to store in varName. */
+StoreStatData(
+    Tcl_Interp *interp,		/* Interpreter for error reports. */
+    Tcl_Obj *varName,		/* Name of associative array variable in which
+				 * to store stat results. */
+    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
+				 * store in varName. */
 {
-    Tcl_Obj *var = Tcl_NewStringObj(varName, -1);
-    Tcl_Obj *field = Tcl_NewObj();
-    Tcl_Obj *value;
+    Tcl_Obj *field, *value;
     register unsigned short mode;
 
     /*
      * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
+     *
+     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
+     * to have an object (i.e. possibly cached) array variable name but a
+     * string element name, so no API exists. Messy.
      */
+
 #define STORE_ARY(fieldName, object) \
-    Tcl_SetStringObj(field, (fieldName), -1); \
-    value = (object); \
-    if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
-	Tcl_DecrRefCount(var); \
-	Tcl_DecrRefCount(field); \
-	Tcl_DecrRefCount(value); \
-	return TCL_ERROR; \
-    }
-
-    Tcl_IncrRefCount(var);
-    Tcl_IncrRefCount(field);
-    STORE_ARY("dev",   Tcl_NewLongObj((long)statPtr->st_dev));
+    TclNewLiteralStringObj(field, fieldName);				\
+    Tcl_IncrRefCount(field);						\
+    value = (object);							\
+    if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
+	TclDecrRefCount(field);						\
+	return TCL_ERROR;						\
+    }									\
+    TclDecrRefCount(field);
+
     /*
-     * Watch out porters; the inode is meant to be an *unsigned* value,
-     * so the cast might fail when there isn't a real arithmentic 'long
-     * long' type...
+     * Watch out porters; the inode is meant to be an *unsigned* value, so the
+     * cast might fail when there isn't a real arithmentic 'long long' type...
      */
-    STORE_ARY("ino",   Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
-    STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink));
-    STORE_ARY("uid",   Tcl_NewLongObj((long)statPtr->st_uid));
-    STORE_ARY("gid",   Tcl_NewLongObj((long)statPtr->st_gid));
-    STORE_ARY("size",  Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
-#ifdef HAVE_ST_BLOCKS
-    STORE_ARY("blocks",Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
+
+    STORE_ARY("dev",	Tcl_NewLongObj((long)statPtr->st_dev));
+    STORE_ARY("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
+    STORE_ARY("nlink",	Tcl_NewLongObj((long)statPtr->st_nlink));
+    STORE_ARY("uid",	Tcl_NewLongObj((long)statPtr->st_uid));
+    STORE_ARY("gid",	Tcl_NewLongObj((long)statPtr->st_gid));
+    STORE_ARY("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+    STORE_ARY("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+    STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
 #endif
-    STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
-    STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
-    STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
+    STORE_ARY("atime",	Tcl_NewLongObj((long)statPtr->st_atime));
+    STORE_ARY("mtime",	Tcl_NewLongObj((long)statPtr->st_mtime));
+    STORE_ARY("ctime",	Tcl_NewLongObj((long)statPtr->st_ctime));
     mode = (unsigned short) statPtr->st_mode;
-    STORE_ARY("mode",  Tcl_NewIntObj(mode));
-    STORE_ARY("type",  Tcl_NewStringObj(GetTypeFromMode(mode), -1));
+    STORE_ARY("mode",	Tcl_NewIntObj(mode));
+    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
 #undef STORE_ARY
-    Tcl_DecrRefCount(var);
-    Tcl_DecrRefCount(field);
+
     return TCL_OK;
 }
 
@@ -1564,8 +1544,7 @@ StoreStatData(interp, varName, statPtr)
  *
  * GetTypeFromMode --
  *
- *	Given a mode word, returns a string identifying the type of a
- *	file.
+ *	Given a mode word, returns a string identifying the type of a file.
  *
  * Results:
  *	A static text string giving the file type from mode.
@@ -1577,8 +1556,8 @@ StoreStatData(interp, varName, statPtr)
  */
 
 static char *
-GetTypeFromMode(mode)
-    int mode;
+GetTypeFromMode(
+    int mode)
 {
     if (S_ISREG(mode)) {
 	return "file";
@@ -1607,103 +1586,98 @@ GetTypeFromMode(mode)
  *
  * Tcl_ForObjCmd --
  *
- *      This procedure is invoked to process the "for" Tcl command.
- *      See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "for" Tcl command. See the
+ *	user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "for" or the name
- *	to which "for" was renamed: e.g.,
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "for" or the name to which
+ *	"for" was renamed: e.g.,
  *	"set z for; $z {set i 0} {$i<100} {incr i} {puts $i}"
  *
  * Results:
- *      A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *      See the user documentation.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-        /* ARGSUSED */
+	/* ARGSUSED */
 int
-Tcl_ForObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;                   /* Not used. */
-    Tcl_Interp *interp;                 /* Current interpreter. */
-    int objc;                           /* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ForObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result, value;
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    Interp *iPtr = (Interp *) interp;
 
     if (objc != 5) {
-        Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
+	return TCL_ERROR;
     }
 
-#ifndef TCL_TIP280
-    result = Tcl_EvalObjEx(interp, objv[1], 0);
-#else
-    /* TIP #280. Make invoking context available to initial script */
-    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1);
-#endif
+    /*
+     * TIP #280. Make invoking context available to initial script.
+     */
+
+    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
     if (result != TCL_OK) {
-        if (result == TCL_ERROR) {
-            Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
-        }
-        return result;
+	if (result == TCL_ERROR) {
+	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
+	}
+	return result;
     }
     while (1) {
 	/*
 	 * We need to reset the result before passing it off to
-	 * Tcl_ExprBooleanObj.  Otherwise, any error message will be appended
+	 * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
 	 * to the result of the last evaluation.
 	 */
 
 	Tcl_ResetResult(interp);
-        result = Tcl_ExprBooleanObj(interp, objv[2], &value);
-        if (result != TCL_OK) {
-            return result;
-        }
-        if (!value) {
-            break;
-        }
-#ifndef TCL_TIP280
-        result = Tcl_EvalObjEx(interp, objv[4], 0);
-#else
-	/* TIP #280. Make invoking context available to loop body */
-        result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr,4);
-#endif
-        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-            if (result == TCL_ERROR) {
-                char msg[32 + TCL_INTEGER_SPACE];
-
-                sprintf(msg, "\n    (\"for\" body line %d)",interp->errorLine);
-                Tcl_AddErrorInfo(interp, msg);
-            }
-            break;
-        }
-#ifndef TCL_TIP280
-        result = Tcl_EvalObjEx(interp, objv[3], 0);
-#else
-	/* TIP #280. Make invoking context available to next script */
-        result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3);
-#endif
+	result = Tcl_ExprBooleanObj(interp, objv[2], &value);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (!value) {
+	    break;
+	}
+
+	/*
+	 * TIP #280. Make invoking context available to loop body.
+	 */
+
+	result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr, 4);
+	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+	    if (result == TCL_ERROR) {
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"for\" body line %d)", interp->errorLine));
+	    }
+	    break;
+	}
+
+	/*
+	 * TIP #280. Make invoking context available to next script.
+	 */
+
+	result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
 	if (result == TCL_BREAK) {
-            break;
-        } else if (result != TCL_OK) {
-            if (result == TCL_ERROR) {
-                Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-            }
-            return result;
-        }
+	    break;
+	} else if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
+	    }
+	    return result;
+	}
     }
     if (result == TCL_BREAK) {
-        result = TCL_OK;
+	result = TCL_OK;
     }
     if (result == TCL_OK) {
-        Tcl_ResetResult(interp);
+	Tcl_ResetResult(interp);
     }
     return result;
 }
@@ -1714,7 +1688,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
  * Tcl_ForeachObjCmd --
  *
  *	This object-based procedure is invoked to process the "foreach" Tcl
- *	command.  See the user documentation for details on what it does.
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -1727,45 +1701,27 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ForeachObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ForeachObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result = TCL_OK;
     int i;			/* i selects a value list */
     int j, maxj;		/* Number of loop iterations */
     int v;			/* v selects a loop variable */
-    int numLists;		/* Count of value lists */
+    int numLists = (objc-2)/2;	/* Count of value lists */
     Tcl_Obj *bodyPtr;
+    Interp *iPtr = (Interp *) interp;
 
-    /*
-     * We copy the argument object pointers into a local array to avoid
-     * the problem that "objv" might become invalid. It is a pointer into
-     * the evaluation stack and that stack might be grown and reallocated
-     * if the loop body requires a large amount of stack space.
-     */
-    
-#define NUM_ARGS 9
-    Tcl_Obj *(argObjStorage[NUM_ARGS]);
-    Tcl_Obj **argObjv = argObjStorage;
-    
-#define STATIC_LIST_SIZE 4
-    int indexArray[STATIC_LIST_SIZE];
-    int varcListArray[STATIC_LIST_SIZE];
-    Tcl_Obj **varvListArray[STATIC_LIST_SIZE];
-    int argcListArray[STATIC_LIST_SIZE];
-    Tcl_Obj **argvListArray[STATIC_LIST_SIZE];
-
-    int *index = indexArray;		   /* Array of value list indices */
-    int *varcList = varcListArray;	   /* # loop variables per list */
-    Tcl_Obj ***varvList = varvListArray;   /* Array of var name lists */
-    int *argcList = argcListArray;	   /* Array of value list sizes */
-    Tcl_Obj ***argvList = argvListArray;   /* Array of value lists */
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    int *index;			/* Array of value list indices */
+    int *varcList;		/* # loop variables per list */
+    Tcl_Obj ***varvList;	/* Array of var name lists */
+    Tcl_Obj **vCopyList;	/* Copies of var name list arguments */
+    int *argcList;		/* Array of value list sizes */
+    Tcl_Obj ***argvList;	/* Array of value lists */
+    Tcl_Obj **aCopyList;	/* Copies of value list arguments */
 
     if (objc < 4 || (objc%2 != 0)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1774,65 +1730,54 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Create the object argument array "argObjv". Make sure argObjv is
-     * large enough to hold the objc arguments.
+     * Manage numList parallel value lists.
+     * argvList[i] is a value list counted by argcList[i]l;
+     * varvList[i] is the list of variables associated with the value list;
+     * varcList[i] is the number of variables associated with the value list;
+     * index[i] is the current pointer into the value list argvList[i].
      */
 
-    if (objc > NUM_ARGS) {
-	argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
-    }
-    for (i = 0;  i < objc;  i++) {
-	argObjv[i] = objv[i];
-    }
+    index = (int *) TclStackAlloc(interp, 3 * numLists * sizeof(int));
+    varcList = index + numLists;
+    argcList = varcList + numLists;
+    memset(index, 0, 3 * numLists * sizeof(int));
 
-    /*
-     * Manage numList parallel value lists.
-     * argvList[i] is a value list counted by argcList[i]
-     * varvList[i] is the list of variables associated with the value list
-     * varcList[i] is the number of variables associated with the value list
-     * index[i] is the current pointer into the value list argvList[i]
-     */
+    varvList = (Tcl_Obj ***)
+	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj **));
+    argvList = varvList + numLists;
+    memset(varvList, 0, 2 * numLists * sizeof(Tcl_Obj **));
 
-    numLists = (objc-2)/2;
-    if (numLists > STATIC_LIST_SIZE) {
-	index = (int *) ckalloc(numLists * sizeof(int));
-	varcList = (int *) ckalloc(numLists * sizeof(int));
-	varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
-	argcList = (int *) ckalloc(numLists * sizeof(int));
-	argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
-    }
-    for (i = 0;  i < numLists;  i++) {
-	index[i] = 0;
-	varcList[i] = 0;
-	varvList[i] = (Tcl_Obj **) NULL;
-	argcList[i] = 0;
-	argvList[i] = (Tcl_Obj **) NULL;
-    }
+    vCopyList = (Tcl_Obj **)
+	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj *));
+    aCopyList = vCopyList + numLists;
+    memset(vCopyList, 0, 2 * numLists * sizeof(Tcl_Obj *));
 
     /*
-     * Break up the value lists and variable lists into elements
+     * Break up the value lists and variable lists into elements.
      */
 
     maxj = 0;
-    for (i = 0;  i < numLists;  i++) {
-	result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
-	        &varcList[i], &varvList[i]);
-	if (result != TCL_OK) {
+    for (i=0 ; i<numLists ; i++) {
+	
+	vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
+	if (vCopyList[i] == NULL) {
+	    result = TCL_ERROR;
 	    goto done;
 	}
+	TclListObjGetElements(NULL, vCopyList[i], &varcList[i], &varvList[i]);
 	if (varcList[i] < 1) {
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	            "foreach varlist is empty", -1);
+	    Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
 	    result = TCL_ERROR;
 	    goto done;
 	}
-	
-	result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
-	        &argcList[i], &argvList[i]);
-	if (result != TCL_OK) {
+
+	aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
+	if (aCopyList[i] == NULL) {
+	    result = TCL_ERROR;
 	    goto done;
 	}
-	
+	TclListObjGetElements(NULL, aCopyList[i], &argcList[i], &argvList[i]);
+
 	j = argcList[i] / varcList[i];
 	if ((argcList[i] % varcList[i]) != 0) {
 	    j++;
@@ -1843,64 +1788,39 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Iterate maxj times through the lists in parallel
-     * If some value lists run out of values, set loop vars to ""
+     * Iterate maxj times through the lists in parallel. If some value lists
+     * run out of values, set loop vars to ""
      */
-    
-    bodyPtr = argObjv[objc-1];
-    for (j = 0;  j < maxj;  j++) {
-	for (i = 0;  i < numLists;  i++) {
-	    /*
-	     * Refetch the list members; we assume that the sizes are
-	     * the same, but the array of elements might be different
-	     * if the internal rep of the objects has been lost and
-	     * recreated (it is too difficult to accurately tell when
-	     * this happens, which can lead to some wierd crashes,
-	     * like Bug #494348...)
-	     */
 
-	    result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
-		    &varcList[i], &varvList[i]);
-	    if (result != TCL_OK) {
-		panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
-	    }
-	    result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
-		    &argcList[i], &argvList[i]);
-	    if (result != TCL_OK) {
-		panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
-	    }
-	    
-	    for (v = 0;  v < varcList[i];  v++) {
+    bodyPtr = objv[objc-1];
+    for (j=0 ; j<maxj ; j++) {
+	for (i=0 ; i<numLists ; i++) {
+	    for (v=0 ; v<varcList[i] ; v++) {
 		int k = index[i]++;
 		Tcl_Obj *valuePtr, *varValuePtr;
-		
+
 		if (k < argcList[i]) {
 		    valuePtr = argvList[i][k];
 		} else {
-		    valuePtr = Tcl_NewObj(); /* empty string */
+		    valuePtr = Tcl_NewObj(); /* Empty string */
 		}
-		Tcl_IncrRefCount(valuePtr);
-		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
-			NULL, valuePtr, 0);
-		Tcl_DecrRefCount(valuePtr);
+		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
+			valuePtr, TCL_LEAVE_ERR_MSG);
 		if (varValuePtr == NULL) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"couldn't set loop variable: \"",
-			Tcl_GetString(varvList[i][v]), "\"", (char *) NULL);
+		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			    "\n    (setting foreach loop variable \"%s\")",
+			    TclGetString(varvList[i][v])));
 		    result = TCL_ERROR;
 		    goto done;
 		}
-
 	    }
 	}
 
-#ifndef TCL_TIP280
-	result = Tcl_EvalObjEx(interp, bodyPtr, 0);
-#else
-	/* TIP #280. Make invoking context available to loop body */
-	result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr,objc-1);
-#endif
+	/*
+	 * TIP #280. Make invoking context available to loop body.
+	 */
+
+	result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr, objc-1);
 	if (result != TCL_OK) {
 	    if (result == TCL_CONTINUE) {
 		result = TCL_OK;
@@ -1908,11 +1828,9 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
 		result = TCL_OK;
 		break;
 	    } else if (result == TCL_ERROR) {
-                char msg[32 + TCL_INTEGER_SPACE];
-
-		sprintf(msg, "\n    (\"foreach\" body line %d)",
-			interp->errorLine);
-		Tcl_AddObjErrorInfo(interp, msg, -1);
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"foreach\" body line %d)",
+			interp->errorLine));
 		break;
 	    } else {
 		break;
@@ -1923,20 +1841,19 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
 	Tcl_ResetResult(interp);
     }
 
-    done:
-    if (numLists > STATIC_LIST_SIZE) {
-	ckfree((char *) index);
-	ckfree((char *) varcList);
-	ckfree((char *) argcList);
-	ckfree((char *) varvList);
-	ckfree((char *) argvList);
-    }
-    if (argObjv != argObjStorage) {
-	ckfree((char *) argObjv);
+  done:
+    for (i=0 ; i<numLists ; i++) {
+	if (vCopyList[i]) {
+	    Tcl_DecrRefCount(vCopyList[i]);
+	}
+	if (aCopyList[i]) {
+	    Tcl_DecrRefCount(aCopyList[i]);
+	}
     }
+    TclStackFree(interp, vCopyList);	/* Tcl_Obj * arrays */
+    TclStackFree(interp, varvList);	/* Tcl_Obj ** arrays */
+    TclStackFree(interp, index);	/* int arrays */
     return result;
-#undef STATIC_LIST_SIZE
-#undef NUM_ARGS
 }
 
 /*
@@ -1944,8 +1861,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_FormatObjCmd --
  *
- *	This procedure is invoked to process the "format" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "format" Tcl command. See
+ *	the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1958,493 +1875,25 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_FormatObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;    	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_FormatObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *format;		/* Used to read characters from the format
-				 * string. */
-    int formatLen;		/* The length of the format string */
-    char *endPtr;		/* Points to the last char in format array */
-    char newFormat[43];		/* A new format specifier is generated here. */
-    int width;			/* Field width from field specifier, or 0 if
-				 * no width given. */
-    int precision;		/* Field precision from field specifier, or 0
-				 * if no precision given. */
-    int size;			/* Number of bytes needed for result of
-				 * conversion, based on type of conversion
-				 * ("e", "s", etc.), width, and precision. */
-    long intValue;		/* Used to hold value to pass to sprintf, if
-				 * it's a one-word integer or char value */
-    char *ptrValue = NULL;	/* Used to hold value to pass to sprintf, if
-				 * it's a one-word value. */
-    double doubleValue;		/* Used to hold value to pass to sprintf if
-				 * it's a double value. */
-    Tcl_WideInt wideValue;	/* Used to hold value to pass to sprintf if
-				 * it's a 'long long' value. */
-    int whichValue;		/* Indicates which of intValue, ptrValue,
-				 * or doubleValue has the value to pass to
-				 * sprintf, according to the following
-				 * definitions: */
-#   define INT_VALUE 0
-#   define CHAR_VALUE 1
-#   define PTR_VALUE 2
-#   define DOUBLE_VALUE 3
-#   define STRING_VALUE 4
-#   define WIDE_VALUE 5
-#   define MAX_FLOAT_SIZE 320
-
-    Tcl_Obj *resultPtr;  	/* Where result is stored finally. */
-    char staticBuf[MAX_FLOAT_SIZE + 1];
-				/* A static buffer to copy the format results 
-				 * into */
-    char *dst = staticBuf;      /* The buffer that sprintf writes into each
-				 * time the format processes a specifier */
-    int dstSize = MAX_FLOAT_SIZE;
-				/* The size of the dst buffer */
-    int noPercent;		/* Special case for speed:  indicates there's
-				 * no field specifier, just a string to copy.*/
-    int objIndex;		/* Index of argument to substitute next. */
-    int gotXpg = 0;		/* Non-zero means that an XPG3 %n$-style
-				 * specifier has been seen. */
-    int gotSequential = 0;	/* Non-zero means that a regular sequential
-				 * (non-XPG3) conversion specifier has been
-				 * seen. */
-    int useShort;		/* Value to be printed is short (half word). */
-    char *end;			/* Used to locate end of numerical fields. */
-    int stringLen = 0;		/* Length of string in characters rather
-				 * than bytes.  Used for %s substitution. */
-    int gotMinus;		/* Non-zero indicates that a minus flag has
-				 * been seen in the current field. */
-    int gotPrecision;		/* Non-zero indicates that a precision has
-				 * been set for the current field. */
-    int gotZero;		/* Non-zero indicates that a zero flag has
-				 * been seen in the current field. */
-    int useWide;		/* Value to be printed is Tcl_WideInt. */
-
-    /*
-     * This procedure is a bit nasty.  The goal is to use sprintf to
-     * do most of the dirty work.  There are several problems:
-     * 1. this procedure can't trust its arguments.
-     * 2. we must be able to provide a large enough result area to hold
-     *    whatever's generated.  This is hard to estimate.
-     * 3. there's no way to move the arguments from objv to the call
-     *    to sprintf in a reasonable way.  This is particularly nasty
-     *    because some of the arguments may be two-word values (doubles
-     *    and wide-ints).
-     * So, what happens here is to scan the format string one % group
-     * at a time, making many individual calls to sprintf.
-     */
+    Tcl_Obj *resultPtr;		/* Where result is stored finally. */
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
 	return TCL_ERROR;
     }
 
-    format = Tcl_GetStringFromObj(objv[1], &formatLen);
-    endPtr = format + formatLen;
-    resultPtr = Tcl_NewObj();
-    objIndex = 2;
-
-    while (format < endPtr) {
-	register char *newPtr = newFormat;
-
-	width = precision = noPercent = useShort = 0;
-	gotZero = gotMinus = gotPrecision = 0;
-	useWide = 0;
-	whichValue = PTR_VALUE;
-
-	/*
-	 * Get rid of any characters before the next field specifier.
-	 */
-	if (*format != '%') {
-	    ptrValue = format;
-	    while ((*format != '%') && (format < endPtr)) {
-		format++;
-	    }
-	    size = format - ptrValue;
-	    noPercent = 1;
-	    goto doField;
-	}
-
-	if (format[1] == '%') {
-	    ptrValue = format;
-	    size = 1;
-	    noPercent = 1;
-	    format += 2;
-	    goto doField;
-	}
-
-	/*
-	 * Parse off a field specifier, compute how many characters
-	 * will be needed to store the result, and substitute for
-	 * "*" size specifiers.
-	 */
-	*newPtr = '%';
-	newPtr++;
-	format++;
-	if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
-	    int tmp;
-
-	    /*
-	     * Check for an XPG3-style %n$ specification.  Note: there
-	     * must not be a mixture of XPG3 specs and non-XPG3 specs
-	     * in the same format string.
-	     */
-
-	    tmp = strtoul(format, &end, 10);	/* INTL: "C" locale. */
-	    if (*end != '$') {
-		goto notXpg;
-	    }
-	    format = end+1;
-	    gotXpg = 1;
-	    if (gotSequential) {
-		goto mixedXPG;
-	    }
-	    objIndex = tmp+1;
-	    if ((objIndex < 2) || (objIndex >= objc)) {
-		goto badIndex;
-	    }
-	    goto xpgCheckDone;
-	}
-
-	notXpg:
-	gotSequential = 1;
-	if (gotXpg) {
-	    goto mixedXPG;
-	}
-
-	xpgCheckDone:
-	while ((*format == '-') || (*format == '#') || (*format == '0')
-		|| (*format == ' ') || (*format == '+')) {
-	    if (*format == '-') {
-		gotMinus = 1;
-	    }
-	    if (*format == '0') {
-		/*
-		 * This will be handled by sprintf for numbers, but we
-		 * need to do the char/string ones ourselves
-		 */
-		gotZero = 1;
-	    }
-	    *newPtr = *format;
-	    newPtr++;
-	    format++;
-	}
-	if (isdigit(UCHAR(*format))) {		/* INTL: Tcl source. */
-	    width = strtoul(format, &end, 10);	/* INTL: Tcl source. */
-	    format = end;
-	} else if (*format == '*') {
-	    if (objIndex >= objc) {
-		goto badIndex;
-	    }
-	    if (Tcl_GetIntFromObj(interp,	/* INTL: Tcl source. */
-		    objv[objIndex], &width) != TCL_OK) {
-		goto fmtError;
-	    }
-	    if (width < 0) {
-		width = -width;
-		*newPtr = '-';
-		gotMinus = 1;
-		newPtr++;
-	    }
-	    objIndex++;
-	    format++;
-	}
-	if (width > 100000) {
-	    /*
-	     * Don't allow arbitrarily large widths:  could cause core
-	     * dump when we try to allocate a zillion bytes of memory
-	     * below.
-	     */
-
-	    width = 100000;
-	} else if (width < 0) {
-	    width = 0;
-	}
-	if (width != 0) {
-	    TclFormatInt(newPtr, width);	/* INTL: printf format. */
-	    while (*newPtr != 0) {
-		newPtr++;
-	    }
-	}
-	if (*format == '.') {
-	    *newPtr = '.';
-	    newPtr++;
-	    format++;
-	    gotPrecision = 1;
-	}
-	if (isdigit(UCHAR(*format))) {		/* INTL: Tcl source. */
-	    precision = strtoul(format, &end, 10);  /* INTL: "C" locale. */
-	    format = end;
-	} else if (*format == '*') {
-	    if (objIndex >= objc) {
-		goto badIndex;
-	    }
-	    if (Tcl_GetIntFromObj(interp,	/* INTL: Tcl source. */
-		    objv[objIndex], &precision) != TCL_OK) {
-		goto fmtError;
-	    }
-	    objIndex++;
-	    format++;
-	}
-	if (gotPrecision) {
-	    TclFormatInt(newPtr, precision);	/* INTL: printf format. */
-	    while (*newPtr != 0) {
-		newPtr++;
-	    }
-	}
-	if (*format == 'l') {
-	    useWide = 1;
-	    /*
-	     * Only add a 'll' modifier for integer values as it makes
-	     * some libc's go into spasm otherwise.  [Bug #702622]
-	     */
-	    switch (format[1]) {
-	    case 'i':
-	    case 'd':
-	    case 'o':
-	    case 'u':
-	    case 'x':
-	    case 'X':
-		strcpy(newPtr, TCL_LL_MODIFIER);
-		newPtr += TCL_LL_MODIFIER_SIZE;
-	    }
-	    format++;
-	} else if (*format == 'h') {
-	    useShort = 1;
-	    *newPtr = 'h';
-	    newPtr++;
-	    format++;
-	}
-	*newPtr = *format;
-	newPtr++;
-	*newPtr = 0;
-	if (objIndex >= objc) {
-	    goto badIndex;
-	}
-	switch (*format) {
-	case 'i':
-	    newPtr[-1] = 'd';
-	case 'd':
-	case 'o':
-	case 'u':
-	case 'x':
-	case 'X':
-	    if (useWide) {
-		if (Tcl_GetWideIntFromObj(interp,	/* INTL: Tcl source. */
-			objv[objIndex], &wideValue) != TCL_OK) {
-		    goto fmtError;
-		}
-		whichValue = WIDE_VALUE;
-		size = 40 + precision;
-		break;
-	    }
-	    if (Tcl_GetLongFromObj(interp,		/* INTL: Tcl source. */
-		    objv[objIndex], &intValue) != TCL_OK) {
-		if (Tcl_GetWideIntFromObj(interp,	/* INTL: Tcl source. */
-			objv[objIndex], &wideValue) != TCL_OK) {
-		    goto fmtError;
-		}
-		intValue = Tcl_WideAsLong(wideValue);
-	    }
-
-#if (LONG_MAX > INT_MAX)
-	    if (!useShort) {
-		/*
-		 * Add the 'l' for long format type because we are on an
-		 * LP64 archtecture and we are really going to pass a long
-		 * argument to sprintf.
-		 *
-		 * Do not add this if we're going to pass in a short (i.e.
-		 * if we've got an 'h' modifier already in the string); some
-		 * libc implementations of sprintf() do not like it at all.
-		 * [Bug 1154163]
-		 */
-		newPtr++;
-		*newPtr = 0;
-		newPtr[-1] = newPtr[-2];
-		newPtr[-2] = 'l';
-	    }
-#endif /* LONG_MAX > INT_MAX */
-	    whichValue = INT_VALUE;
-	    size = 40 + precision;
-	    break;
-	case 's':
-	    /*
-	     * Compute the length of the string in characters and add
-	     * any additional space required by the field width.  All
-	     * of the extra characters will be spaces, so one byte per
-	     * character is adequate.
-	     */
-
-	    whichValue = STRING_VALUE;
-	    ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
-	    stringLen = Tcl_NumUtfChars(ptrValue, size);
-	    if (gotPrecision && (precision < stringLen)) {
-		stringLen = precision;
-	    }
-	    size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
-	    if (width > stringLen) {
-		size += (width - stringLen);
-	    }
-	    break;
-	case 'c':
-	    if (Tcl_GetLongFromObj(interp,	/* INTL: Tcl source. */
-		    objv[objIndex], &intValue) != TCL_OK) {
-		goto fmtError;
-	    }
-	    whichValue = CHAR_VALUE;
-	    size = width + TCL_UTF_MAX;
-	    break;
-	case 'e':
-	case 'E':
-	case 'f':
-	case 'g':
-	case 'G':
-	    if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
-		    objv[objIndex], &doubleValue) != TCL_OK) {
-		goto fmtError;
-	    }
-	    whichValue = DOUBLE_VALUE;
-	    size = MAX_FLOAT_SIZE;
-	    if (precision > 10) {
-		size += precision;
-	    }
-	    break;
-	case 0:
-	    Tcl_SetResult(interp,
-		    "format string ended in middle of field specifier",
-		    TCL_STATIC);
-	    goto fmtError;
-	default:
-	{
-	    char buf[40];
-
-	    sprintf(buf, "bad field specifier \"%c\"", *format);
-	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
-	    goto fmtError;
-	}
-	}
-	objIndex++;
-	format++;
-
-	/*
-	 * Make sure that there's enough space to hold the formatted
-	 * result, then format it.
-	 */
-
-	doField:
-	if (width > size) {
-	    size = width;
-	}
-	if (noPercent) {
-	    Tcl_AppendToObj(resultPtr, ptrValue, size);
-	} else {
-	    if (size > dstSize) {
-	        if (dst != staticBuf) {
-		    ckfree(dst);
-		}
-		dst = (char *) ckalloc((unsigned) (size + 1));
-		dstSize = size;
-	    }
-	    switch (whichValue) {
-	    case DOUBLE_VALUE:
-		sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
-		break;
-	    case WIDE_VALUE:
-		sprintf(dst, newFormat, wideValue);
-		break;
-	    case INT_VALUE:
-		if (useShort) {
-		    sprintf(dst, newFormat, (short) intValue);
-		} else {
-		    sprintf(dst, newFormat, intValue);
-		}
-		break;
-	    case CHAR_VALUE: {
-		char *ptr;
-		char padChar = (gotZero ? '0' : ' ');
-		ptr = dst;
-		if (!gotMinus) {
-		    for ( ; --width > 0; ptr++) {
-			*ptr = padChar;
-		    }
-		}
-		ptr += Tcl_UniCharToUtf(intValue, ptr);
-		for ( ; --width > 0; ptr++) {
-		    *ptr = padChar;
-		}
-		*ptr = '\0';
-		break;
-	    }
-	    case STRING_VALUE: {
-		char *ptr;
-		char padChar = (gotZero ? '0' : ' ');
-		int pad;
-
-		ptr = dst;
-		if (width > stringLen) {
-		    pad = width - stringLen;
-		} else {
-		    pad = 0;
-		}
-
-		if (!gotMinus) {
-		    while (pad > 0) {
-			*ptr++ = padChar;
-			pad--;
-		    }
-		}
-
-		size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; 
-		if (size) {
-		    memcpy(ptr, ptrValue, (size_t) size);
-		    ptr += size;
-		}
-		while (pad > 0) {
-		    *ptr++ = padChar;
-		    pad--;
-		}
-		*ptr = '\0';
-		break;
-	    }
-	    default:
-		sprintf(dst, newFormat, ptrValue);
-		break;
-	    }
-	    Tcl_AppendToObj(resultPtr, dst, -1);
-	}
+    resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2);
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
     }
-
     Tcl_SetObjResult(interp, resultPtr);
-    if (dst != staticBuf) {
-	ckfree(dst);
-    }
     return TCL_OK;
-
-    mixedXPG:
-    Tcl_SetResult(interp, 
-	    "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
-    goto fmtError;
-
-    badIndex:
-    if (gotXpg) {
-	Tcl_SetResult(interp, 
-		"\"%n$\" argument index out of range", TCL_STATIC);
-    } else {
-	Tcl_SetResult(interp, 
-		"not enough arguments for all format specifiers", TCL_STATIC);
-    }
-
-    fmtError:
-    if (dst != staticBuf) {
-	ckfree(dst);
-    }
-    Tcl_DecrRefCount(resultPtr);
-    return TCL_ERROR;
 }
 
 /*
@@ -2454,4 +1903,3 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 21dbdc8..152e61d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1,62 +1,80 @@
-/* 
+/*
  * tclCmdIL.c --
  *
- *	This file contains the top-level command routines for most of
- *	the Tcl built-in commands whose names begin with the letters
- *	I through L.  It contains only commands in the generic core
- *	(i.e. those that don't depend much upon UNIX facilities).
+ *	This file contains the top-level command routines for most of the Tcl
+ *	built-in commands whose names begin with the letters I through L. It
+ *	contains only commands in the generic core (i.e. those that don't
+ *	depend much upon UNIX facilities).
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2005 Donal K. Fellows.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclRegexp.h"
 
 /*
- * During execution of the "lsort" command, structures of the following
- * type are used to arrange the objects being sorted into a collection
- * of linked lists.
+ * During execution of the "lsort" command, structures of the following type
+ * are used to arrange the objects being sorted into a collection of linked
+ * lists.
  */
 
 typedef struct SortElement {
-    Tcl_Obj *objPtr;			/* Object being sorted. */
-    int count;				/* number of same elements in list */
-    struct SortElement *nextPtr;        /* Next element in the list, or
-					 * NULL for end of list. */
+    union {
+	char *strValuePtr;
+	long   intValue;
+	double doubleValue;
+	Tcl_Obj *objValuePtr;
+    } index;
+    Tcl_Obj *objPtr;	        /* Object being sorted, or its index. */
+    struct SortElement *nextPtr;/* Next element in the list, or NULL for end
+				 * of list. */
 } SortElement;
 
 /*
- * The "lsort" command needs to pass certain information down to the
- * function that compares two list elements, and the comparison function
- * needs to pass success or failure information back up to the top-level
- * "lsort" command.  The following structure is used to pass this
- * information.
+ * These function pointer types are used with the "lsearch" and "lsort"
+ * commands to facilitate the "-nocase" option.
+ */
+
+typedef int (*SortStrCmpFn_t) (const char *, const char *);
+typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
+
+/*
+ * The "lsort" command needs to pass certain information down to the function
+ * that compares two list elements, and the comparison function needs to pass
+ * success or failure information back up to the top-level "lsort" command.
+ * The following structure is used to pass this information.
  */
 
 typedef struct SortInfo {
     int isIncreasing;		/* Nonzero means sort in increasing order. */
-    int sortMode;		/* The sort mode.  One of SORTMODE_*
-				 * values defined below */
-    Tcl_Obj *compareCmdPtr;     /* The Tcl comparison command when sortMode
-				 * is SORTMODE_COMMAND.  Pre-initialized to
-				 * hold base of command.*/
-    int index;			/* If the -index option was specified, this
-				 * holds the index of the list element
-				 * to extract for comparison.  If -index
-				 * wasn't specified, this is -1. */
-    Tcl_Interp *interp;		/* The interpreter in which the sortis
-				 * being done. */
-    int resultCode;		/* Completion code for the lsort command.
-				 * If an error occurs during the sort this
-				 * is changed from TCL_OK to  TCL_ERROR. */
+    int sortMode;		/* The sort mode. One of SORTMODE_* values
+				 * defined below. */
+    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
+				 * SORTMODE_COMMAND. Pre-initialized to hold
+				 * base of command. */
+    int *indexv;		/* If the -index option was specified, this
+				 * holds the indexes contained in the list
+				 * supplied as an argument to that option.
+				 * NULL if no indexes supplied, and points to
+				 * singleIndex field when only one
+				 * supplied. */
+    int indexc;			/* Number of indexes in indexv array. */
+    int singleIndex;		/* Static space for common index case. */
+    int unique;
+    int numElements;
+    Tcl_Interp *interp;		/* The interpreter in which the sort is being
+				 * done. */
+    int resultCode;		/* Completion code for the lsort command. If
+				 * an error occurs during the sort this is
+				 * changed from TCL_OK to TCL_ERROR. */
 } SortInfo;
 
 /*
@@ -64,115 +82,113 @@ typedef struct SortInfo {
  * following values.
  */
 
-#define SORTMODE_ASCII      0
-#define SORTMODE_INTEGER    1
-#define SORTMODE_REAL       2
-#define SORTMODE_COMMAND    3
-#define SORTMODE_DICTIONARY 4
+#define SORTMODE_ASCII		0
+#define SORTMODE_INTEGER	1
+#define SORTMODE_REAL		2
+#define SORTMODE_COMMAND	3
+#define SORTMODE_DICTIONARY	4
+#define SORTMODE_ASCII_NC	8
 
 /*
- * Magic values for the index field of the SortInfo structure.
- * Note that the index "end-1" will be translated to SORTIDX_END-1, etc.
+ * Magic values for the index field of the SortInfo structure. Note that the
+ * index "end-1" will be translated to SORTIDX_END-1, etc.
  */
-#define SORTIDX_NONE	-1		/* Not indexed; use whole value. */
-#define SORTIDX_END	-2		/* Indexed from end. */
+
+#define SORTIDX_NONE	-1	/* Not indexed; use whole value. */
+#define SORTIDX_END	-2	/* Indexed from end. */
 
 /*
  * Forward declarations for procedures defined in this file:
  */
 
-static void		AppendLocals _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *listPtr, CONST char *pattern,
-			    int includeLinks));
-static int		DictionaryCompare _ANSI_ARGS_((char *left,
-			    char *right));
-static int		InfoArgsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoBodyCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoCmdCountCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoCommandsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoCompleteCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-#ifdef TCL_TIP280
+static int		DictionaryCompare(char *left, char *right);
+static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 /* TIP #280 - New 'info' subcommand 'frame' */
-static int		InfoFrameCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-#endif
-static int		InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoHostnameCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoLevelCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoLibraryCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoLoadedCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoLocalsCmd _ANSI_ARGS_((ClientData dummy,
+static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoNameOfExecutableCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoNameOfExecutableCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoPatchLevelCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoProcsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoScriptCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoSharedlibCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoTclVersionCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		InfoVarsCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static SortElement *    MergeSort _ANSI_ARGS_((SortElement *headPt,
-			    SortInfo *infoPtr));
-static SortElement *    MergeLists _ANSI_ARGS_((SortElement *leftPtr,
-			    SortElement *rightPtr, SortInfo *infoPtr));
-static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
-			    Tcl_Obj *second, SortInfo *infoPtr));
+			    Tcl_Obj *const objv[]);
+static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static SortElement *    MergeLists(SortElement *leftPtr, SortElement *rightPtr,
+			    SortInfo *infoPtr);
+static int		SortCompare(SortElement *firstPtr, SortElement *second,
+			    SortInfo *infoPtr);
+static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
+			    SortInfo *infoPtr);
+
+/*
+ * Array of values describing how to implement each standard subcommand of the
+ * "info" command.
+ */
+
+static const EnsembleImplMap defaultInfoMap[] = {
+    {"args",		   InfoArgsCmd,		    NULL},
+    {"body",		   InfoBodyCmd,		    NULL},
+    {"cmdcount",	   InfoCmdCountCmd,	    NULL},
+    {"commands",	   InfoCommandsCmd,	    NULL},
+    {"complete",	   InfoCompleteCmd,	    NULL},
+    {"default",		   InfoDefaultCmd,	    NULL},
+    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd},
+    {"frame",		   InfoFrameCmd,	    NULL},
+    {"functions",	   InfoFunctionsCmd,	    NULL},
+    {"globals",		   TclInfoGlobalsCmd,	    NULL},
+    {"hostname",	   InfoHostnameCmd,	    NULL},
+    {"level",		   InfoLevelCmd,	    NULL},
+    {"library",		   InfoLibraryCmd,	    NULL},
+    {"loaded",		   InfoLoadedCmd,	    NULL},
+    {"locals",		   TclInfoLocalsCmd,	    NULL},
+    {"nameofexecutable",   InfoNameOfExecutableCmd, NULL},
+    {"patchlevel",	   InfoPatchLevelCmd,	    NULL},
+    {"procs",		   InfoProcsCmd,	    NULL},
+    {"script",		   InfoScriptCmd,	    NULL},
+    {"sharedlibextension", InfoSharedlibCmd,	    NULL},
+    {"tclversion",	   InfoTclVersionCmd,	    NULL},
+    {"vars",		   TclInfoVarsCmd,	    NULL},
+    {NULL, NULL, NULL}
+};
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_IfObjCmd --
  *
- *	This procedure is invoked to process the "if" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "if" Tcl command. See the
+ *	user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "if" or the name
- *	to which "if" was renamed: e.g., "set z if; $z 1 {puts foo}"
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "if" or the name to which
+ *	"if" was renamed: e.g., "set z if; $z 1 {puts foo}"
  *
  * Results:
  *	A standard Tcl result.
@@ -183,34 +199,32 @@ static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_IfObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_IfObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int thenScriptIndex = 0;	/* then script to be evaled after syntax check */
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    int thenScriptIndex = 0;	/* "then" script to be evaled after syntax
+				 * check. */
+    Interp *iPtr = (Interp *) interp;
     int i, result, value;
     char *clause;
+
     i = 1;
     while (1) {
 	/*
-	 * At this point in the loop, objv and objc refer to an expression
-	 * to test, either for the main expression or an expression
-	 * following an "elseif".  The arguments after the expression must
-	 * be "then" (optional) and a script to execute if the expression is
-	 * true.
+	 * At this point in the loop, objv and objc refer to an expression to
+	 * test, either for the main expression or an expression following an
+	 * "elseif". The arguments after the expression must be "then"
+	 * (optional) and a script to execute if the expression is true.
 	 */
 
 	if (i >= objc) {
-	    clause = Tcl_GetString(objv[i-1]);
-	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",
-		    clause, "\" argument", (char *) NULL);
+	    clause = TclGetString(objv[i-1]);
+	    Tcl_AppendResult(interp, "wrong # args: ",
+		    "no expression after \"", clause, "\" argument", NULL);
 	    return TCL_ERROR;
 	}
 	if (!thenScriptIndex) {
@@ -221,13 +235,13 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
 	}
 	i++;
 	if (i >= objc) {
-	    missingScript:
-	    clause = Tcl_GetString(objv[i-1]);
-	    Tcl_AppendResult(interp, "wrong # args: no script following \"",
-		    clause, "\" argument", (char *) NULL);
+	missingScript:
+	    clause = TclGetString(objv[i-1]);
+	    Tcl_AppendResult(interp, "wrong # args: ",
+		    "no script following \"", clause, "\" argument", NULL);
 	    return TCL_ERROR;
 	}
-	clause = Tcl_GetString(objv[i]);
+	clause = TclGetString(objv[i]);
 	if ((i < objc) && (strcmp(clause, "then") == 0)) {
 	    i++;
 	}
@@ -238,26 +252,25 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
 	    thenScriptIndex = i;
 	    value = 0;
 	}
-	
+
 	/*
-	 * The expression evaluated to false.  Skip the command, then
-	 * see if there is an "else" or "elseif" clause.
+	 * The expression evaluated to false. Skip the command, then see if
+	 * there is an "else" or "elseif" clause.
 	 */
 
 	i++;
 	if (i >= objc) {
 	    if (thenScriptIndex) {
-#ifndef TCL_TIP280
-		return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
-#else
-		/* TIP #280. Make invoking context available to branch */
+		/*
+		 * TIP #280. Make invoking context available to branch.
+		 */
+
 		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
-				    iPtr->cmdFramePtr,thenScriptIndex);
-#endif
+			iPtr->cmdFramePtr, thenScriptIndex);
 	    }
 	    return TCL_OK;
 	}
-	clause = Tcl_GetString(objv[i]);
+	clause = TclGetString(objv[i]);
 	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
 	    i++;
 	    continue;
@@ -266,40 +279,33 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Couldn't find a "then" or "elseif" clause to execute.  Check now
-     * for an "else" clause.  We know that there's at least one more
-     * argument when we get here.
+     * Couldn't find a "then" or "elseif" clause to execute. Check now for an
+     * "else" clause. We know that there's at least one more argument when we
+     * get here.
      */
 
     if (strcmp(clause, "else") == 0) {
 	i++;
 	if (i >= objc) {
-	    Tcl_AppendResult(interp,
-		    "wrong # args: no script following \"else\" argument",
-		    (char *) NULL);
+	    Tcl_AppendResult(interp, "wrong # args: ",
+		    "no script following \"else\" argument", NULL);
 	    return TCL_ERROR;
 	}
     }
     if (i < objc - 1) {
-	Tcl_AppendResult(interp,
-		"wrong # args: extra words after \"else\" clause in \"if\" command",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "wrong # args: ",
+		"extra words after \"else\" clause in \"if\" command", NULL);
 	return TCL_ERROR;
     }
     if (thenScriptIndex) {
-#ifndef TCL_TIP280
-	return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
-#else
-	/* TIP #280. Make invoking context available to branch/else */
+	/*
+	 * TIP #280. Make invoking context available to branch/else.
+	 */
+
 	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
-			    iPtr->cmdFramePtr,thenScriptIndex);
-#endif
+		iPtr->cmdFramePtr, thenScriptIndex);
     }
-#ifndef TCL_TIP280
-    return Tcl_EvalObjEx(interp, objv[i], 0);
-#else
-    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i);
-#endif
+    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
 }
 
 /*
@@ -307,12 +313,12 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_IncrObjCmd --
  *
- *	This procedure is invoked to process the "incr" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "incr" Tcl command. See the
+ *	user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "incr" or the name
- *	to which "incr" was renamed: e.g., "set z incr; $z i -1"
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "incr" or the name to
+ *	which "incr" was renamed: e.g., "set z incr; $z i -1"
  *
  * Results:
  *	A standard Tcl result.
@@ -323,64 +329,30 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
 int
-Tcl_IncrObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_IncrObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    long incrAmount;
-    Tcl_Obj *newValuePtr;
-    
+    Tcl_Obj *newValuePtr, *incrPtr;
+
     if ((objc != 2) && (objc != 3)) {
-        Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
 	return TCL_ERROR;
     }
 
-    /*
-     * Calculate the amount to increment by.
-     */
-    
-    if (objc == 2) {
-	incrAmount = 1;
+    if (objc == 3) {
+	incrPtr = objv[2];
     } else {
-	if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {
-	    Tcl_AddErrorInfo(interp, "\n    (reading increment)");
-	    return TCL_ERROR;
-	}
-	/*
-	 * Need to be a bit cautious to ensure that [expr]-like rules
-	 * are enforced for interpretation of wide integers, despite
-	 * the fact that the underlying API itself is a 'long' only one.
-	 */
-	if (objv[2]->typePtr == &tclIntType) {
-	    incrAmount = objv[2]->internalRep.longValue;
-	} else if (objv[2]->typePtr == &tclWideIntType) {
-	    TclGetLongFromWide(incrAmount,objv[2]);
-	} else {
-	    Tcl_WideInt wide;
-
-	    if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) {
-		Tcl_AddErrorInfo(interp, "\n    (reading increment)");
-		return TCL_ERROR;
-	    }
-	    incrAmount = Tcl_WideAsLong(wide);
-	    if ((wide <= Tcl_LongAsWide(LONG_MAX))
-		    && (wide >= Tcl_LongAsWide(LONG_MIN))) {
-		objv[2]->typePtr = &tclIntType;
-		objv[2]->internalRep.longValue = incrAmount;
-	    }
-	}
+	incrPtr = Tcl_NewIntObj(1);
     }
-    
-    /*
-     * Increment the variable's value.
-     */
+    Tcl_IncrRefCount(incrPtr);
+    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
+	    incrPtr, TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(incrPtr);
 
-    newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
-	    TCL_LEAVE_ERR_MSG);
     if (newValuePtr == NULL) {
 	return TCL_ERROR;
     }
@@ -391,141 +363,31 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
      */
 
     Tcl_SetObjResult(interp, newValuePtr);
-    return TCL_OK; 
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_InfoObjCmd --
+ * TclInitInfoCmd --
  *
- *	This procedure is invoked to process the "info" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is called to create the "info" Tcl command. See the user
+ *	documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	FIXME
  *
  * Side effects:
- *	See the user documentation.
+ *	none
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_InfoObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Arbitrary value passed to the command. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_Command
+TclInitInfoCmd(
+    Tcl_Interp *interp)		/* Current interpreter. */
 {
-    static CONST char *subCmds[] = {
-	     "args", "body", "cmdcount", "commands",
-	     "complete", "default", "exists",
-#ifdef TCL_TIP280
-	     "frame",
-#endif
-	     "functions",
-	     "globals", "hostname", "level", "library", "loaded",
-	     "locals", "nameofexecutable", "patchlevel", "procs",
-	     "script", "sharedlibextension", "tclversion", "vars",
-	     (char *) NULL};
-    enum ISubCmdIdx {
-	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
-	    ICompleteIdx, IDefaultIdx, IExistsIdx,
-#ifdef TCL_TIP280
-	    IFrameIdx,
-#endif
-	    IFunctionsIdx,
-	    IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
-	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
-	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
-    };
-    int index, result;
-
-    if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
-        return TCL_ERROR;
-    }
-    
-    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
-	    (int *) &index);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    switch (index) {
-        case IArgsIdx:
-	    result = InfoArgsCmd(clientData, interp, objc, objv);
-            break;
-	case IBodyIdx:
-	    result = InfoBodyCmd(clientData, interp, objc, objv);
-	    break;
-	case ICmdCountIdx:
-	    result = InfoCmdCountCmd(clientData, interp, objc, objv);
-	    break;
-        case ICommandsIdx:
-	    result = InfoCommandsCmd(clientData, interp, objc, objv);
-	    break;
-        case ICompleteIdx:
-	    result = InfoCompleteCmd(clientData, interp, objc, objv);
-	    break;
-	case IDefaultIdx:
-	    result = InfoDefaultCmd(clientData, interp, objc, objv);
-	    break;
-	case IExistsIdx:
-	    result = InfoExistsCmd(clientData, interp, objc, objv);
-	    break;
-#ifdef TCL_TIP280
-	case IFrameIdx:
-	    /* TIP #280 - New method 'frame' */
-	    result = InfoFrameCmd(clientData, interp, objc, objv);
-	    break;
-#endif
-	case IFunctionsIdx:
-	    result = InfoFunctionsCmd(clientData, interp, objc, objv);
-	    break;
-        case IGlobalsIdx:
-	    result = InfoGlobalsCmd(clientData, interp, objc, objv);
-	    break;
-        case IHostnameIdx:
-	    result = InfoHostnameCmd(clientData, interp, objc, objv);
-	    break;
-	case ILevelIdx:
-	    result = InfoLevelCmd(clientData, interp, objc, objv);
-	    break;
-	case ILibraryIdx:
-	    result = InfoLibraryCmd(clientData, interp, objc, objv);
-	    break;
-        case ILoadedIdx:
-	    result = InfoLoadedCmd(clientData, interp, objc, objv);
-	    break;
-        case ILocalsIdx:
-	    result = InfoLocalsCmd(clientData, interp, objc, objv);
-	    break;
-	case INameOfExecutableIdx:
-	    result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
-	    break;
-	case IPatchLevelIdx:
-	    result = InfoPatchLevelCmd(clientData, interp, objc, objv);
-	    break;
-        case IProcsIdx:
-	    result = InfoProcsCmd(clientData, interp, objc, objv);
-	    break;
-        case IScriptIdx:
-	    result = InfoScriptCmd(clientData, interp, objc, objv);
-	    break;
-	case ISharedLibExtensionIdx:
-	    result = InfoSharedlibCmd(clientData, interp, objc, objv);
-	    break;
-	case ITclVersionIdx:
-	    result = InfoTclVersionCmd(clientData, interp, objc, objv);
-	    break;
-	case IVarsIdx:
-	    result = InfoVarsCmd(clientData, interp, objc, objv);
-	    break;
-    }
-    return result;
+    return TclMakeEnsemble(interp, "info", defaultInfoMap);
 }
 
 /*
@@ -533,27 +395,27 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
  *
  * InfoArgsCmd --
  *
- *      Called to implement the "info args" command that returns the
- *      argument list for a procedure. Handles the following syntax:
+ *	Called to implement the "info args" command that returns the argument
+ *	list for a procedure. Handles the following syntax:
  *
- *          info args procName
+ *	    info args procName
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoArgsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoArgsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
     char *name;
@@ -561,30 +423,29 @@ InfoArgsCmd(dummy, interp, objc, objv)
     CompiledLocal *localPtr;
     Tcl_Obj *listObjPtr;
 
-    if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "procname");
-        return TCL_ERROR;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname");
+	return TCL_ERROR;
     }
 
-    name = Tcl_GetString(objv[2]);
+    name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "\"", name, "\" isn't a procedure", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+	return TCL_ERROR;
     }
 
     /*
      * Build a return list containing the arguments.
      */
-    
-    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+    listObjPtr = Tcl_NewListObj(0, NULL);
     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
-            localPtr = localPtr->nextPtr) {
-        if (TclIsVarArgument(localPtr)) {
-            Tcl_ListObjAppendElement(interp, listObjPtr,
+	    localPtr = localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_ListObjAppendElement(interp, listObjPtr,
 		    Tcl_NewStringObj(localPtr->name, -1));
-        }
+	}
     }
     Tcl_SetObjResult(interp, listObjPtr);
     return TCL_OK;
@@ -595,65 +456,65 @@ InfoArgsCmd(dummy, interp, objc, objv)
  *
  * InfoBodyCmd --
  *
- *      Called to implement the "info body" command that returns the body
- *      for a procedure. Handles the following syntax:
+ *	Called to implement the "info body" command that returns the body for
+ *	a procedure. Handles the following syntax:
  *
- *          info body procName
+ *	    info body procName
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoBodyCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoBodyCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
     char *name;
     Proc *procPtr;
     Tcl_Obj *bodyPtr, *resultPtr;
-    
-    if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "procname");
-        return TCL_ERROR;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname");
+	return TCL_ERROR;
     }
 
-    name = Tcl_GetString(objv[2]);
+    name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"\"", name, "\" isn't a procedure", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+	return TCL_ERROR;
     }
 
-    /* 
+    /*
      * Here we used to return procPtr->bodyPtr, except when the body was
-     * bytecompiled - in that case, the return was a copy of the body's
-     * string rep. In order to better isolate the implementation details
-     * of the compiler/engine subsystem, we now always return a copy of 
-     * the string rep. It is important to return a copy so that later 
-     * manipulations of the object do not invalidate the internal rep.
+     * bytecompiled - in that case, the return was a copy of the body's string
+     * rep. In order to better isolate the implementation details of the
+     * compiler/engine subsystem, we now always return a copy of the string
+     * rep. It is important to return a copy so that later manipulations of
+     * the object do not invalidate the internal rep.
      */
 
     bodyPtr = procPtr->bodyPtr;
     if (bodyPtr->bytes == NULL) {
 	/*
-	 * The string rep might not be valid if the procedure has
-	 * never been run before.  [Bug #545644]
+	 * The string rep might not be valid if the procedure has never been
+	 * run before. [Bug #545644]
 	 */
-	(void) Tcl_GetString(bodyPtr);
+
+	(void) TclGetString(bodyPtr);
     }
     resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-    
+
     Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
@@ -663,37 +524,37 @@ InfoBodyCmd(dummy, interp, objc, objv)
  *
  * InfoCmdCountCmd --
  *
- *      Called to implement the "info cmdcount" command that returns the
- *      number of commands that have been executed. Handles the following
- *      syntax:
+ *	Called to implement the "info cmdcount" command that returns the
+ *	number of commands that have been executed. Handles the following
+ *	syntax:
  *
- *          info cmdcount
+ *	    info cmdcount
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoCmdCountCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoCmdCountCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
 
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
     return TCL_OK;
 }
 
@@ -702,74 +563,74 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
  *
  * InfoCommandsCmd --
  *
- *	Called to implement the "info commands" command that returns the
- *	list of commands in the interpreter that match an optional pattern.
- *	The pattern, if any, consists of an optional sequence of namespace
- *	names separated by "::" qualifiers, which is followed by a
- *	glob-style pattern that restricts which commands are returned.
- *	Handles the following syntax:
+ *	Called to implement the "info commands" command that returns the list
+ *	of commands in the interpreter that match an optional pattern. The
+ *	pattern, if any, consists of an optional sequence of namespace names
+ *	separated by "::" qualifiers, which is followed by a glob-style
+ *	pattern that restricts which commands are returned. Handles the
+ *	following syntax:
  *
- *          info commands ?pattern?
+ *	    info commands ?pattern?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoCommandsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoCommandsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *cmdName, *pattern;
-    CONST char *simplePattern;
+    const char *simplePattern;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
     Namespace *nsPtr;
     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
     Tcl_Command cmd;
+    int i;
 
     /*
-     * Get the pattern and find the "effective namespace" in which to
-     * list commands.
+     * Get the pattern and find the "effective namespace" in which to list
+     * commands.
      */
 
-    if (objc == 2) {
-        simplePattern = NULL;
+    if (objc == 1) {
+	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 3) {
+    } else if (objc == 2) {
 	/*
 	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an
-	 * error was found while parsing the pattern, return it. Otherwise,
-	 * if the namespace wasn't found, just leave nsPtr NULL: we will
-	 * return an empty list since no commands there can be found.
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
+	 * was found while parsing the pattern, return it. Otherwise, if the
+	 * namespace wasn't found, just leave nsPtr NULL: we will return an
+	 * empty list since no commands there can be found.
 	 */
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
-	
 
-	pattern = Tcl_GetString(objv[2]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-           /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	pattern = TclGetString(objv[1]);
+	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
+		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
-	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
     }
 
     /*
@@ -781,20 +642,20 @@ InfoCommandsCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Scan through the effective namespace's command table and create a
-     * list with all commands that match the pattern. If a specific
-     * namespace was requested in the pattern, qualify the command names
-     * with the namespace name.
+     * Scan through the effective namespace's command table and create a list
+     * with all commands that match the pattern. If a specific namespace was
+     * requested in the pattern, qualify the command names with the namespace
+     * name.
      */
 
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    listPtr = Tcl_NewListObj(0, NULL);
 
     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
 	/*
-	 * Special case for when the pattern doesn't include any of
-	 * glob's special characters. This lets us avoid scans of any
-	 * hash tables.
+	 * Special case for when the pattern doesn't include any of glob's
+	 * special characters. This lets us avoid scans of any hash tables.
 	 */
+
 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
 	if (entryPtr != NULL) {
 	    if (specificNsInPattern) {
@@ -806,21 +667,48 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 	    }
 	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-	} else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-	    entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,
-		    simplePattern);
+	    Tcl_SetObjResult(interp, listPtr);
+	    return TCL_OK;
+	}
+	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    Tcl_HashTable *tablePtr = NULL;	/* Quell warning. */
+
+	    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+		Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
+
+		if (pathNsPtr == NULL) {
+		    continue;
+		}
+		tablePtr = &pathNsPtr->cmdTable;
+		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
+		if (entryPtr != NULL) {
+		    break;
+		}
+	    }
+	    if (entryPtr == NULL) {
+		tablePtr = &globalNsPtr->cmdTable;
+		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
+	    }
 	    if (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+		cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
 		Tcl_ListObjAppendElement(interp, listPtr,
 			Tcl_NewStringObj(cmdName, -1));
+		Tcl_SetObjResult(interp, listPtr);
+		return TCL_OK;
 	    }
 	}
-    } else {
+    } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
+	/*
+	 * The pattern is non-trivial, but either there is no explicit path or
+	 * there is an explicit namespace in the pattern. In both cases, the
+	 * old matching scheme is perfect.
+	 */
+
 	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
-	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		if (specificNsInPattern) {
 		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
 		    elemObjPtr = Tcl_NewObj();
@@ -835,19 +723,19 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 
 	/*
 	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern, then add in
-	 * all global :: commands that match the simple pattern. Of course,
-	 * we add in only those commands that aren't hidden by a command in
-	 * the effective namespace.
+	 * specific namespace wasn't requested in the pattern, then add in all
+	 * global :: commands that match the simple pattern. Of course, we add
+	 * in only those commands that aren't hidden by a command in the
+	 * effective namespace.
 	 */
-	
+
 	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
 	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
 	    while (entryPtr != NULL) {
 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
 		if ((simplePattern == NULL)
-	                || Tcl_StringMatch(cmdName, simplePattern)) {
-		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
+		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
 			Tcl_ListObjAppendElement(interp, listPtr,
 				Tcl_NewStringObj(cmdName, -1));
 		    }
@@ -855,8 +743,97 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 		entryPtr = Tcl_NextHashEntry(&search);
 	    }
 	}
+    } else {
+	/*
+	 * The pattern is non-trivial (can match more than one command name),
+	 * there is an explicit path, and there is no explicit namespace in
+	 * the pattern. This means that we have to traverse the path to
+	 * discover all the commands defined.
+	 */
+
+	Tcl_HashTable addedCommandsTable;
+	int isNew;
+	int foundGlobal = (nsPtr == globalNsPtr);
+
+	/*
+	 * We keep a hash of the objects already added to the result list.
+	 */
+
+	Tcl_InitObjHashTable(&addedCommandsTable);
+
+	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+	while (entryPtr != NULL) {
+	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+	    if ((simplePattern == NULL)
+		    || Tcl_StringMatch(cmdName, simplePattern)) {
+		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		(void) Tcl_CreateHashEntry(&addedCommandsTable,
+			(char *)elemObjPtr, &isNew);
+	    }
+	    entryPtr = Tcl_NextHashEntry(&search);
+	}
+
+	/*
+	 * Search the path next.
+	 */
+
+	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+	    Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
+
+	    if (pathNsPtr == NULL) {
+		continue;
+	    }
+	    if (pathNsPtr == globalNsPtr) {
+		foundGlobal = 1;
+	    }
+	    entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
+	    while (entryPtr != NULL) {
+		cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
+		if ((simplePattern == NULL)
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
+		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
+			    (char *) elemObjPtr, &isNew);
+		    if (isNew) {
+			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		    } else {
+			TclDecrRefCount(elemObjPtr);
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
+	    }
+	}
+
+	/*
+	 * If the effective namespace isn't the global :: namespace, and a
+	 * specific namespace wasn't requested in the pattern, then add in all
+	 * global :: commands that match the simple pattern. Of course, we add
+	 * in only those commands that aren't hidden by a command in the
+	 * effective namespace.
+	 */
+
+	if (!foundGlobal) {
+	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
+	    while (entryPtr != NULL) {
+		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+		if ((simplePattern == NULL)
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
+		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+		    if (Tcl_FindHashEntry(&addedCommandsTable,
+			    (char *) elemObjPtr) == NULL) {
+			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		    } else {
+			TclDecrRefCount(elemObjPtr);
+		    }
+		}
+		entryPtr = Tcl_NextHashEntry(&search);
+	    }
+	}
+
+	Tcl_DeleteHashTable(&addedCommandsTable);
     }
-    
+
     Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
@@ -866,40 +843,36 @@ InfoCommandsCmd(dummy, interp, objc, objv)
  *
  * InfoCompleteCmd --
  *
- *      Called to implement the "info complete" command that determines
- *      whether a string is a complete Tcl command. Handles the following
- *      syntax:
+ *	Called to implement the "info complete" command that determines
+ *	whether a string is a complete Tcl command. Handles the following
+ *	syntax:
  *
- *          info complete command
+ *	    info complete command
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoCompleteCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoCompleteCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "command");
-        return TCL_ERROR;
-    }
-
-    if (TclObjCommandComplete(objv[2])) {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
-    } else {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command");
+	return TCL_ERROR;
     }
 
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+	    TclObjCommandComplete(objv[1])));
     return TCL_OK;
 }
 
@@ -908,28 +881,27 @@ InfoCompleteCmd(dummy, interp, objc, objv)
  *
  * InfoDefaultCmd --
  *
- *      Called to implement the "info default" command that returns the
- *      default value for a procedure argument. Handles the following
- *      syntax:
+ *	Called to implement the "info default" command that returns the
+ *	default value for a procedure argument. Handles the following syntax:
  *
- *          info default procName arg varName
+ *	    info default procName arg varName
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoDefaultCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoDefaultCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
     char *procName, *argName, *varName;
@@ -937,485 +909,471 @@ InfoDefaultCmd(dummy, interp, objc, objv)
     CompiledLocal *localPtr;
     Tcl_Obj *valueObjPtr;
 
-    if (objc != 5) {
-        Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
-        return TCL_ERROR;
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
+	return TCL_ERROR;
     }
 
-    procName = Tcl_GetString(objv[2]);
-    argName = Tcl_GetString(objv[3]);
+    procName = TclGetString(objv[1]);
+    argName = TclGetString(objv[2]);
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"\"", procName, "\" isn't a procedure", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
+	return TCL_ERROR;
     }
 
     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
-            localPtr = localPtr->nextPtr) {
-        if (TclIsVarArgument(localPtr)
+	    localPtr = localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)
 		&& (strcmp(argName, localPtr->name) == 0)) {
-            if (localPtr->defValuePtr != NULL) {
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+	    if (localPtr->defValuePtr != NULL) {
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
 			localPtr->defValuePtr, 0);
-                if (valueObjPtr == NULL) {
-                    defStoreError:
-		    varName = Tcl_GetString(objv[4]);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	                    "couldn't store default value in variable \"",
-			    varName, "\"", (char *) NULL);
-                    return TCL_ERROR;
-                }
-		Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
-            } else {
-                Tcl_Obj *nullObjPtr = Tcl_NewObj();
-		Tcl_IncrRefCount(nullObjPtr);
-                valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+		if (valueObjPtr == NULL) {
+		    goto defStoreError;
+		}
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+	    } else {
+		Tcl_Obj *nullObjPtr = Tcl_NewObj();
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
 			nullObjPtr, 0);
-		Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
-                if (valueObjPtr == NULL) {
-                    goto defStoreError;
-                }
-		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
-            }
-            return TCL_OK;
-        }
-    }
-
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	    "procedure \"", procName, "\" doesn't have an argument \"",
-	    argName, "\"", (char *) NULL);
+		if (valueObjPtr == NULL) {
+		    goto defStoreError;
+		}
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	    }
+	    return TCL_OK;
+	}
+    }
+
+    Tcl_AppendResult(interp, "procedure \"", procName,
+	    "\" doesn't have an argument \"", argName, "\"", NULL);
+    return TCL_ERROR;
+
+  defStoreError:
+    varName = TclGetString(objv[3]);
+    Tcl_AppendResult(interp, "couldn't store default value in variable \"",
+	    varName, "\"", NULL);
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InfoExistsCmd --
+ * TclInfoExistsCmd --
  *
- *      Called to implement the "info exists" command that determines
- *      whether a variable exists. Handles the following syntax:
+ *	Called to implement the "info exists" command that determines whether
+ *	a variable exists. Handles the following syntax:
  *
- *          info exists varName
+ *	    info exists varName
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-InfoExistsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+int
+TclInfoExistsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *varName;
     Var *varPtr;
 
-    if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "varName");
-        return TCL_ERROR;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName");
+	return TCL_ERROR;
     }
 
-    varName = Tcl_GetString(objv[2]);
+    varName = TclGetString(objv[1]);
     varPtr = TclVarTraceExists(interp, varName);
-    if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
-        Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
-    } else {
-        Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
-    }
+
+    Tcl_SetObjResult(interp,
+	    Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr));
     return TCL_OK;
 }
 
-#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  *
  * InfoFrameCmd --
  *	TIP #280
  *
- *      Called to implement the "info frame" command that returns the
- *      location of either the currently executing command, or its caller.
- *      Handles the following syntax:
+ *	Called to implement the "info frame" command that returns the location
+ *	of either the currently executing command, or its caller. Handles the
+ *	following syntax:
  *
- *          info frame ?number?
+ *		info frame ?number?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoFrameCmd(dummy, interp, objc, objv)
-     ClientData dummy;		/* Not used. */
-     Tcl_Interp *interp;		/* Current interpreter. */
-     int objc;			/* Number of arguments. */
-     Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoFrameCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
+    int level;
+    CmdFrame *framePtr;
 
-    if (objc == 2) {
-	/* just "info frame" */
-        int levels = (iPtr->cmdFramePtr == NULL
-		      ? 0
-		      : iPtr->cmdFramePtr->level);
+    if (objc == 1) {
+	/*
+	 * Just "info frame".
+	 */
+
+	int levels =
+		(iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level);
 
 	Tcl_SetObjResult(interp, Tcl_NewIntObj (levels));
-        return TCL_OK;
-
-    } else if (objc == 3) {
-	/* "info frame level" */
-        int       level;
-	CmdFrame *framePtr;
-
-        if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
-            return TCL_ERROR;
-        }
-        if (level <= 0) {
-	    /* Relative adressing */
-
-            if (iPtr->cmdFramePtr == NULL) {
-                levelError:
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"bad level \"",
-			Tcl_GetString(objv[2]),
-			"\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            /* Convert to absolute. */
-
-            level += iPtr->cmdFramePtr->level;
-        }
-        for (framePtr = iPtr->cmdFramePtr;
-	     framePtr != NULL;
-	     framePtr = framePtr->nextPtr) {
+	return TCL_OK;
+    } else if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+	return TCL_ERROR;
+    }
 
-	    if (framePtr->level == level) {
-                break;
-            }
-        }
-        if (framePtr == NULL) {
-            goto levelError;
-        }
+    /*
+     * We've got "info frame level" and must parse the level first.
+     */
 
+    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (level <= 0) {
 	/*
-	 * Pull the information and construct the dictionary to return, as
-	 * list. Regarding use of the CmdFrame fields see tclInt.h, and its
-	 * definition.
+	 * Negative levels are adressing relative to the current frame's
+	 * depth.
 	 */
 
-	{
-	    Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */
-	    int      lc = 0;
+	if (iPtr->cmdFramePtr == NULL) {
+	levelError:
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
+		    TclGetString(objv[1]), "\"", NULL);
+	    return TCL_ERROR;
+	}
 
-	    /* This array is indexed by the TCL_LOCATION_... values, except
-	     * for _LAST.
-	     */
+	/*
+	 * Convert to absolute.
+	 */
 
-	    static CONST char* typeString [TCL_LOCATION_LAST] = {
-	       "eval", "eval", "eval", "precompiled", "source", "proc"
-	    };
+	level += iPtr->cmdFramePtr->level;
+    }
 
-	    Proc*    procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+    for (framePtr = iPtr->cmdFramePtr; framePtr != NULL;
+	    framePtr = framePtr->nextPtr) {
+	if (framePtr->level == level) {
+	    break;
+	}
+    }
+    if (framePtr == NULL) {
+	goto levelError;
+    }
 
-	    switch (framePtr->type) {
-	    case TCL_LOCATION_EVAL:
-	        /* Evaluation, dynamic script. Type, line, cmd, the latter
-		 * through str. */
+    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoFrame --
+ *
+ *	Core of InfoFrameCmd, returns TIP280 dict for a given frame.
+ *
+ * Results:
+ *	Returns TIP280 dict.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
-		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
-		lv [lc ++] = Tcl_NewStringObj ("line",-1);
-		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);
-		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
-		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,
-					       framePtr->cmd.str.len);
-		break;
+Tcl_Obj *
+TclInfoFrame(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    CmdFrame *framePtr)		/* Frame to get info for. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
+				 * the dict. */
+    int lc = 0;
+    /*
+     * This array is indexed by the TCL_LOCATION_... values, except
+     * for _LAST.
+     */
+    static const char *typeString[TCL_LOCATION_LAST] = {
+	"eval", "eval", "eval", "precompiled", "source", "proc"
+    };
+    Tcl_Obj *tmpObj;
+    Proc *procPtr =
+	framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
 
-	    case TCL_LOCATION_EVAL_LIST:
-	        /* List optimized evaluation. Type, line, cmd, the latter
-		 * through listPtr, possibly a frame. */
+   /*
+     * Pull the information and construct the dictionary to return, as list.
+     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
+     */
 
-	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
-		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
-		lv [lc ++] = Tcl_NewStringObj ("line",-1);
-		lv [lc ++] = Tcl_NewIntObj    (1);
+#define ADD_PAIR(name, value) \
+	TclNewLiteralStringObj(tmpObj, name); \
+	lv[lc++] = tmpObj; \
+	lv[lc++] = (value)
 
-		/* We put a duplicate of the command list obj into the result
-		 * to ensure that the 'pure List'-property of the command
-		 * itself is not destroyed. Otherwise the query here would
-		 * disable the list optimization path in Tcl_EvalObjEx.
-		 */
+    switch (framePtr->type) {
+    case TCL_LOCATION_EVAL:
+	/*
+	 * Evaluation, dynamic script. Type, line, cmd, the latter through
+	 * str.
+	 */
 
-		lv [lc ++] =  Tcl_NewStringObj ("cmd",-1);
-		lv [lc ++] =  Tcl_DuplicateObj (framePtr->cmd.listPtr);
-		break;
+	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
+		framePtr->cmd.str.len));
+	break;
 
-	    case TCL_LOCATION_PREBC:
-	        /* Precompiled. Result contains the type as signal, nothing
-		 * else */
+    case TCL_LOCATION_EVAL_LIST:
+	/*
+	 * List optimized evaluation. Type, line, cmd, the latter through
+	 * listPtr, possibly a frame.
+	 */
 
-	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
-		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
-		break;
+	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+	ADD_PAIR("line", Tcl_NewIntObj(1));
 
-	    case TCL_LOCATION_BC: {
-	        /* Execution of bytecode. Talk to the BC engine to fill out
-		 * the frame. */
+	/*
+	 * We put a duplicate of the command list obj into the result to
+	 * ensure that the 'pure List'-property of the command itself is not
+	 * destroyed. Otherwise the query here would disable the list
+	 * optimization path in Tcl_EvalObjEx.
+	 */
 
-	        CmdFrame f = *framePtr;
+	ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
+	break;
 
-		/* Note: Type BC => f.data.eval.path    is not used.
-		 *                  f.data.tebc.codePtr is used instead.
-		 */
+    case TCL_LOCATION_PREBC:
+	/*
+	 * Precompiled. Result contains the type as signal, nothing else.
+	 */
 
-	        TclGetSrcInfoForPc (&f);
-		/* Now filled:        cmd.str.(cmd,len), line */
-		/* Possibly modified: type, path! */
+	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+	break;
 
-	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
-		lv [lc ++] = Tcl_NewStringObj (typeString [f.type],-1);
-		lv [lc ++] = Tcl_NewStringObj ("line",-1);
-		lv [lc ++] = Tcl_NewIntObj    (f.line[0]);
+    case TCL_LOCATION_BC: {
+	/*
+	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
+	 */
 
-		if (f.type == TCL_LOCATION_SOURCE) {
-		    lv [lc ++] = Tcl_NewStringObj ("file",-1);
-		    lv [lc ++] = f.data.eval.path;
-		    /* Death of reference by TclGetSrcInfoForPc */
-		    Tcl_DecrRefCount (f.data.eval.path);
-		}
+	CmdFrame *fPtr;
 
-		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
-		lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len);
-	        break;
-	    }
+	fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+	*fPtr = *framePtr;
 
-	    case TCL_LOCATION_SOURCE:
-	        /* Evaluation of a script file */
-
-	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
-		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
-		lv [lc ++] = Tcl_NewStringObj ("line",-1);
-		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);
-		lv [lc ++] = Tcl_NewStringObj ("file",-1);
-		lv [lc ++] = framePtr->data.eval.path;
-		/* Refcount framePtr->data.eval.path goes up when lv
-		 * is converted into the result list object.
-		 */
-		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
-		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,
-					       framePtr->cmd.str.len);
-		break;
+	/*
+	 * Note:
+	 * Type BC => f.data.eval.path	  is not used.
+	 *	      f.data.tebc.codePtr is used instead.
+	 */
 
-	    case TCL_LOCATION_PROC:
-		Tcl_Panic ("TCL_LOCATION_PROC found in standard frame");
-		break;
-	    }
+	TclGetSrcInfoForPc(fPtr);
+
+	/*
+	 * Now filled: cmd.str.(cmd,len), line
+	 * Possibly modified: type, path!
+	 */
+
+	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
+	if (fPtr->line) {
+	    ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
+	}
+
+	if (fPtr->type == TCL_LOCATION_SOURCE) {
+	    ADD_PAIR("file", fPtr->data.eval.path);
 
 	    /*
-	     * 'proc'. Common to all frame types. Conditional on having an
-	     * associated Procedure CallFrame.
+	     * Death of reference by TclGetSrcInfoForPc.
 	     */
 
-	    if (procPtr != NULL) {
-		Tcl_HashEntry* namePtr = procPtr->cmdPtr->hPtr;
-		/*
-		 * ITcl seems to provide us with weird, maybe bogus Command
-		 * structures (methods?)  which may have no HashEntry pointing
-		 * to the name information, or a HashEntry without owning
-		 * HashTable. Therefore check again that our data is valid.
-		 */
-		if (namePtr && namePtr->tablePtr) {
-		    char* procName = Tcl_GetHashKey (namePtr->tablePtr, namePtr);
-		    char* nsName   = procPtr->cmdPtr->nsPtr->fullName;
+	    Tcl_DecrRefCount(fPtr->data.eval.path);
+	}
 
-		    lv [lc ++] = Tcl_NewStringObj ("proc",-1);
-		    lv [lc ++] = Tcl_NewStringObj (nsName,-1);
+	ADD_PAIR("cmd",
+		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
+	TclStackFree(interp, fPtr);
+	break;
+    }
 
-		    if (strcmp (nsName, "::") != 0) {
-			Tcl_AppendToObj (lv [lc-1], "::", -1);
-		    }
-		    Tcl_AppendToObj (lv [lc-1], procName, -1);
-		}
-	    }
+    case TCL_LOCATION_SOURCE:
+	/*
+	 * Evaluation of a script file.
+	 */
 
-	    /* 'level'. Common to all frame types. Conditional on having an
-	     * associated _visible_ CallFrame */
+	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+	ADD_PAIR("file", framePtr->data.eval.path);
 
-	    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
-	        CallFrame* current = framePtr->framePtr;
-		CallFrame* top     = iPtr->varFramePtr;
-		CallFrame* idx;
+	/*
+	 * Refcount framePtr->data.eval.path goes up when lv is converted into
+	 * the result list object.
+	 */
 
-		for (idx = top;
-		     idx != NULL;
-		     idx = idx->callerVarPtr) {
-		    if (idx == current) {
-		        int c = framePtr->framePtr->level;
-			int t = iPtr->varFramePtr->level;
+	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
+		framePtr->cmd.str.len));
+	break;
 
-			lv [lc ++] = Tcl_NewStringObj ("level",-1);
-			lv [lc ++] = Tcl_NewIntObj (t - c);
-			break;
-		    }
-		}
+    case TCL_LOCATION_PROC:
+	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
+	break;
+    }
+
+    /*
+     * 'proc'. Common to all frame types. Conditional on having an associated
+     * Procedure CallFrame.
+     */
+
+    if (procPtr != NULL) {
+	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
+
+	if (namePtr) {
+	    /*
+	     * This is a regular command.
+	     */
+
+	    char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
+	    char *nsName = procPtr->cmdPtr->nsPtr->fullName;
+
+	    ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
+
+	    if (strcmp(nsName, "::") != 0) {
+		Tcl_AppendToObj(lv[lc-1], "::", -1);
 	    }
+	    Tcl_AppendToObj(lv[lc-1], procName, -1);
+	} else if (procPtr->cmdPtr->clientData) {
+	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
+	    int i;
 
-	    Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv));
-	    return TCL_OK;
+	    /*
+	     * This is a non-standard command. Luckily, it's told us how to
+	     * render extra information about its frame.
+	     */
+
+	    for (i=0 ; i<efiPtr->length ; i++) {
+		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
+		if (efiPtr->fields[i].proc) {
+		    lv[lc++] =
+			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
+		} else {
+		    lv[lc++] = efiPtr->fields[i].clientData;
+		}
+	    }
 	}
     }
 
-    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    /*
+     * 'level'. Common to all frame types. Conditional on having an associated
+     * _visible_ CallFrame.
+     */
 
-    return TCL_ERROR;
+    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
+	CallFrame *current = framePtr->framePtr;
+	CallFrame *top = iPtr->varFramePtr;
+	CallFrame *idx;
+
+	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
+	    if (idx == current) {
+		int c = framePtr->framePtr->level;
+		int t = iPtr->varFramePtr->level;
+
+		ADD_PAIR("level", Tcl_NewIntObj(t - c));
+		break;
+	    }
+	}
+    }
+
+    return Tcl_NewListObj(lc, lv);
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * InfoFunctionsCmd --
  *
- *      Called to implement the "info functions" command that returns the
- *      list of math functions matching an optional pattern. Handles the
- *      following syntax:
+ *	Called to implement the "info functions" command that returns the list
+ *	of math functions matching an optional pattern. Handles the following
+ *	syntax:
  *
- *          info functions ?pattern?
+ *	    info functions ?pattern?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoFunctionsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoFunctionsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *pattern;
-    Tcl_Obj *listPtr;
-
-    if (objc == 2) {
-        pattern = NULL;
-    } else if (objc == 3) {
-        pattern = Tcl_GetString(objv[2]);
-    } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
-    }
+    Tcl_Obj *script;
+    int code;
 
-    listPtr = Tcl_ListMathFuncs(interp, pattern);
-    if (listPtr == NULL) {
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoGlobalsCmd --
- *
- *      Called to implement the "info globals" command that returns the list
- *      of global variables matching an optional pattern. Handles the
- *      following syntax:
- *
- *          info globals ?pattern?
- *
- * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
 
-static int
-InfoGlobalsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
-{
-    char *varName, *pattern;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Var *varPtr;
-    Tcl_Obj *listPtr;
+    script = Tcl_NewStringObj(
+"	    ::apply [::list {{pattern *}} {\n"
+"		::set cmds {}\n"
+"		::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n"
+"		    ::lappend cmds [::namespace tail $cmd]\n"
+"		}\n"
+"		::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n"
+"		    ::set cmd [::namespace tail $cmd]\n"
+"		    ::if {$cmd ni $cmds} {\n"
+"			::lappend cmds $cmd\n"
+"		    }\n"
+"		}\n"
+"		::return $cmds\n"
+"	    } [::namespace current]] ", -1);
 
     if (objc == 2) {
-        pattern = NULL;
-    } else if (objc == 3) {
-	pattern = Tcl_GetString(objv[2]);
-	/*
-	 * Strip leading global-namespace qualifiers. [Bug 1057461]
-	 */
-	if (pattern[0] == ':' && pattern[1] == ':') {
-	    while (*pattern == ':') {
-		pattern++;
-	    }
-	}
-    } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
-    }
+	Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1]));
 
-    /*
-     * Scan through the global :: namespace's variable table and create a
-     * list of all global variables that match the pattern.
-     */
-    
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
-	entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
- 	if (entryPtr != NULL) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(pattern, -1));
-	    }
-	}
-    } else {
-	for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (TclIsVarUndefined(varPtr)) {
-		continue;
-	    }
-	    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(varName, -1));
-	    }
-	}
+	Tcl_AppendObjToObj(script, arg);
+	Tcl_DecrRefCount(arg);
     }
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
+
+    Tcl_IncrRefCount(script);
+    code = Tcl_EvalObjEx(interp, script, 0);
+
+    Tcl_DecrRefCount(script);
+
+    return code;
 }
 
 /*
@@ -1423,43 +1381,42 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
  *
  * InfoHostnameCmd --
  *
- *      Called to implement the "info hostname" command that returns the
- *      host name. Handles the following syntax:
+ *	Called to implement the "info hostname" command that returns the host
+ *	name. Handles the following syntax:
  *
- *          info hostname
+ *	    info hostname
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoHostnameCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoHostnameCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    CONST char *name;
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+    const char *name;
+
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
 
     name = Tcl_GetHostName();
     if (name) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
 	return TCL_OK;
-    } else {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp),
-		"unable to determine name of host", -1);
-	return TCL_ERROR;
     }
+    Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
+    return TCL_ERROR;
 }
 
 /*
@@ -1467,71 +1424,69 @@ InfoHostnameCmd(dummy, interp, objc, objv)
  *
  * InfoLevelCmd --
  *
- *      Called to implement the "info level" command that returns
- *      information about the call stack. Handles the following syntax:
+ *	Called to implement the "info level" command that returns information
+ *	about the call stack. Handles the following syntax:
  *
- *          info level ?number?
+ *	    info level ?number?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoLevelCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoLevelCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    int level;
-    CallFrame *framePtr;
-    Tcl_Obj *listPtr;
 
-    if (objc == 2) {		/* just "info level" */
-        if (iPtr->varFramePtr == NULL) {
-            Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
-        } else {
-            Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);
-        }
-        return TCL_OK;
-    } else if (objc == 3) {
-        if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
-            return TCL_ERROR;
-        }
-        if (level <= 0) {
-            if (iPtr->varFramePtr == NULL) {
-                levelError:
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"bad level \"",
-			Tcl_GetString(objv[2]),
-			"\"", (char *) NULL);
-                return TCL_ERROR;
-            }
-            level += iPtr->varFramePtr->level;
-        }
-        for (framePtr = iPtr->varFramePtr;  framePtr != NULL;
-                framePtr = framePtr->callerVarPtr) {
-            if (framePtr->level == level) {
-                break;
-            }
-        }
-        if (framePtr == NULL) {
-            goto levelError;
-        }
-
-        listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
-        Tcl_SetObjResult(interp, listPtr);
-        return TCL_OK;
-    }
-
-    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    if (objc == 1) {		/* Just "info level" */
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
+	return TCL_OK;
+    }
+
+    if (objc == 2) {
+	int level;
+	CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
+
+	if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (level <= 0) {
+	    if (iPtr->varFramePtr == rootFramePtr) {
+		goto levelError;
+	    }
+	    level += iPtr->varFramePtr->level;
+	}
+	for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
+		framePtr=framePtr->callerVarPtr) {
+	    if (framePtr->level == level) {
+		break;
+	    }
+	}
+	if (framePtr == rootFramePtr) {
+	    goto levelError;
+	}
+
+	Tcl_SetObjResult(interp,
+		Tcl_NewListObj(framePtr->objc, framePtr->objv));
+	return TCL_OK;
+    }
+
+    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+    return TCL_ERROR;
+
+  levelError:
+    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
+	    NULL);
     return TCL_ERROR;
 }
 
@@ -1540,43 +1495,42 @@ InfoLevelCmd(dummy, interp, objc, objv)
  *
  * InfoLibraryCmd --
  *
- *      Called to implement the "info library" command that returns the
- *      library directory for the Tcl installation. Handles the following
- *      syntax:
+ *	Called to implement the "info library" command that returns the
+ *	library directory for the Tcl installation. Handles the following
+ *	syntax:
  *
- *          info library
+ *	    info library
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoLibraryCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoLibraryCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    CONST char *libDirName;
+    const char *libDirName;
 
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
 
     libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
     if (libDirName != NULL) {
-        Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
-        return TCL_OK;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
+	return TCL_OK;
     }
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
-            "no library has been specified for Tcl", -1);
+    Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
     return TCL_ERROR;
 }
 
@@ -1585,174 +1539,42 @@ InfoLibraryCmd(dummy, interp, objc, objv)
  *
  * InfoLoadedCmd --
  *
- *      Called to implement the "info loaded" command that returns the
- *      packages that have been loaded into an interpreter. Handles the
- *      following syntax:
+ *	Called to implement the "info loaded" command that returns the
+ *	packages that have been loaded into an interpreter. Handles the
+ *	following syntax:
  *
- *          info loaded ?interp?
+ *	    info loaded ?interp?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoLoadedCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoLoadedCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *interpName;
-    int result;
 
-    if ((objc != 2) && (objc != 3)) {
-        Tcl_WrongNumArgs(interp, 2, objv, "?interp?");
-        return TCL_ERROR;
+    if ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
+	return TCL_ERROR;
     }
 
-    if (objc == 2) {		/* get loaded pkgs in all interpreters */
+    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
 	interpName = NULL;
-    } else {			/* get pkgs just in specified interp */
-	interpName = Tcl_GetString(objv[2]);
-    }
-    result = TclGetLoadedPackages(interp, interpName);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoLocalsCmd --
- *
- *      Called to implement the "info locals" command to return a list of
- *      local variables that match an optional pattern. Handles the
- *      following syntax:
- *
- *          info locals ?pattern?
- *
- * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLocalsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    char *pattern;
-    Tcl_Obj *listPtr;
-
-    if (objc == 2) {
-        pattern = NULL;
-    } else if (objc == 3) {
-        pattern = Tcl_GetString(objv[2]);
-    } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
-    }
-    
-    if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) {
-        return TCL_OK;
-    }
-
-    /*
-     * Return a list containing names of first the compiled locals (i.e. the
-     * ones stored in the call frame), then the variables in the local hash
-     * table (if one exists).
-     */
-    
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    AppendLocals(interp, listPtr, pattern, 0);
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AppendLocals --
- *
- *	Append the local variables for the current frame to the
- *	specified list object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AppendLocals(interp, listPtr, pattern, includeLinks)
-    Tcl_Interp *interp;		/* Current interpreter. */
-    Tcl_Obj *listPtr;		/* List object to append names to. */
-    CONST char *pattern;	/* Pattern to match against. */
-    int includeLinks;		/* 1 if upvars should be included, else 0. */
-{
-    Interp *iPtr = (Interp *) interp;
-    CompiledLocal *localPtr;
-    Var *varPtr;
-    int i, localVarCt;
-    char *varName;
-    Tcl_HashTable *localVarTablePtr;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-
-    localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
-    localVarCt = iPtr->varFramePtr->numCompiledLocals;
-    varPtr = iPtr->varFramePtr->compiledLocals;
-    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
-
-    for (i = 0; i < localVarCt; i++) {
-	/*
-	 * Skip nameless (temporary) variables and undefined variables
-	 */
-
-	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
-	        && (includeLinks || !TclIsVarLink(varPtr))) {
-	    varName = varPtr->name;
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-		        Tcl_NewStringObj(varName, -1));
-	    }
-        }
-	varPtr++;
-	localPtr = localPtr->nextPtr;
-    }
-    
-    if (localVarTablePtr != NULL) {
-	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
-	        entryPtr != NULL;
-                entryPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)
-		    && (includeLinks || !TclIsVarLink(varPtr))) {
-		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
-		if ((pattern == NULL)
-		        || Tcl_StringMatch(varName, pattern)) {
-		    Tcl_ListObjAppendElement(interp, listPtr,
-			    Tcl_NewStringObj(varName, -1));
-		}
-	    }
-	}
+    } else {			/* Get pkgs just in specified interp. */
+	interpName = TclGetString(objv[1]);
     }
+    return TclGetLoadedPackages(interp, interpName);
 }
 
 /*
@@ -1760,41 +1582,34 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
  *
  * InfoNameOfExecutableCmd --
  *
- *      Called to implement the "info nameofexecutable" command that returns
- *      the name of the binary file running this application. Handles the
- *      following syntax:
+ *	Called to implement the "info nameofexecutable" command that returns
+ *	the name of the binary file running this application. Handles the
+ *	following syntax:
  *
- *          info nameofexecutable
+ *	    info nameofexecutable
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoNameOfExecutableCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoNameOfExecutableCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    CONST char *nameOfExecutable;
-
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
-    }
-
-    nameOfExecutable = Tcl_GetNameOfExecutable();
-    
-    if (nameOfExecutable != NULL) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), nameOfExecutable, -1);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
+    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
     return TCL_OK;
 }
 
@@ -1803,41 +1618,41 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
  *
  * InfoPatchLevelCmd --
  *
- *      Called to implement the "info patchlevel" command that returns the
- *      default value for an argument to a procedure. Handles the following
- *      syntax:
+ *	Called to implement the "info patchlevel" command that returns the
+ *	default value for an argument to a procedure. Handles the following
+ *	syntax:
  *
- *          info patchlevel
+ *	    info patchlevel
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoPatchLevelCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoPatchLevelCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    CONST char *patchlevel;
+    const char *patchlevel;
 
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
 
     patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
-            (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
     if (patchlevel != NULL) {
-        Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
-        return TCL_OK;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
+	return TCL_OK;
     }
     return TCL_ERROR;
 }
@@ -1847,76 +1662,76 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
  *
  * InfoProcsCmd --
  *
- *	Called to implement the "info procs" command that returns the
- *	list of procedures in the interpreter that match an optional pattern.
- *	The pattern, if any, consists of an optional sequence of namespace
- *	names separated by "::" qualifiers, which is followed by a
- *	glob-style pattern that restricts which commands are returned.
- *	Handles the following syntax:
+ *	Called to implement the "info procs" command that returns the list of
+ *	procedures in the interpreter that match an optional pattern. The
+ *	pattern, if any, consists of an optional sequence of namespace names
+ *	separated by "::" qualifiers, which is followed by a glob-style
+ *	pattern that restricts which commands are returned. Handles the
+ *	following syntax:
  *
- *          info procs ?pattern?
+ *	    info procs ?pattern?
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoProcsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoProcsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *cmdName, *pattern;
-    CONST char *simplePattern;
+    const char *simplePattern;
     Namespace *nsPtr;
 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS
     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
 #endif
-    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
+    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
     Command *cmdPtr, *realCmdPtr;
 
     /*
-     * Get the pattern and find the "effective namespace" in which to
-     * list procs.
+     * Get the pattern and find the "effective namespace" in which to list
+     * procs.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 3) {
+    } else if (objc == 2) {
 	/*
 	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an
-	 * error was found while parsing the pattern, return it. Otherwise,
-	 * if the namespace wasn't found, just leave nsPtr NULL: we will
-	 * return an empty list since no commands there can be found.
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
+	 * was found while parsing the pattern, return it. Otherwise, if the
+	 * namespace wasn't found, just leave nsPtr NULL: we will return an
+	 * empty list since no commands there can be found.
 	 */
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
-	pattern = Tcl_GetString(objv[2]);
+	pattern = TclGetString(objv[1]);
 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
 		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
 		&simplePattern);
 
-	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
+	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
     }
 
     if (nsPtr == NULL) {
@@ -1924,13 +1739,13 @@ InfoProcsCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Scan through the effective namespace's command table and create a
-     * list with all procs that match the pattern. If a specific
-     * namespace was requested in the pattern, qualify the command names
-     * with the namespace name.
+     * Scan through the effective namespace's command table and create a list
+     * with all procs that match the pattern. If a specific namespace was
+     * requested in the pattern, qualify the command names with the namespace
+     * name.
      */
 
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    listPtr = Tcl_NewListObj(0, NULL);
 #ifndef INFO_PROCS_SEARCH_GLOBAL_NS
     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
@@ -1944,7 +1759,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
 		    goto simpleProcOK;
 		}
 	    } else {
-	      simpleProcOK:
+	    simpleProcOK:
 		if (specificNsInPattern) {
 		    elemObjPtr = Tcl_NewObj();
 		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1962,7 +1777,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
-	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 
 		if (!TclIsProc(cmdPtr)) {
@@ -1972,7 +1787,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
 			goto procOK;
 		    }
 		} else {
-		  procOK:
+		procOK:
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1988,35 +1803,36 @@ InfoProcsCmd(dummy, interp, objc, objv)
 
 	/*
 	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern, then add in
-	 * all global :: procs that match the simple pattern. Of course,
-	 * we add in only those procs that aren't hidden by a proc in
-	 * the effective namespace.
+	 * specific namespace wasn't requested in the pattern, then add in all
+	 * global :: procs that match the simple pattern. Of course, we add in
+	 * only those procs that aren't hidden by a proc in the effective
+	 * namespace.
 	 */
 
 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS
 	/*
-	 * If "info procs" worked like "info commands", returning the
-	 * commands also seen in the global namespace, then you would
-	 * include this code.  As this could break backwards compatibilty
-	 * with 8.0-8.2, we decided not to "fix" it in 8.3, leaving the
-	 * behavior slightly different.
+	 * If "info procs" worked like "info commands", returning the commands
+	 * also seen in the global namespace, then you would include this
+	 * code. As this could break backwards compatibilty with 8.0-8.2, we
+	 * decided not to "fix" it in 8.3, leaving the behavior slightly
+	 * different.
 	 */
+
 	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
 	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
 	    while (entryPtr != NULL) {
 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
 		if ((simplePattern == NULL)
-	                || Tcl_StringMatch(cmdName, simplePattern)) {
-		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
+		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
 			cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 			realCmdPtr = (Command *) TclGetOriginalCommand(
-			        (Tcl_Command) cmdPtr);
+				(Tcl_Command) cmdPtr);
 
 			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
 				&& TclIsProc(realCmdPtr))) {
 			    Tcl_ListObjAppendElement(interp, listPtr,
-			            Tcl_NewStringObj(cmdName, -1));
+				    Tcl_NewStringObj(cmdName, -1));
 			}
 		    }
 		}
@@ -2035,47 +1851,46 @@ InfoProcsCmd(dummy, interp, objc, objv)
  *
  * InfoScriptCmd --
  *
- *      Called to implement the "info script" command that returns the
- *      script file that is currently being evaluated. Handles the
- *      following syntax:
+ *	Called to implement the "info script" command that returns the script
+ *	file that is currently being evaluated. Handles the following syntax:
  *
- *          info script ?newName?
+ *	    info script ?newName?
  *
  *	If newName is specified, it will set that as the internal name.
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.  It may change the
- *	internal script filename.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message. It may change the internal
+ *	script filename.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoScriptCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoScriptCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    if ((objc != 2) && (objc != 3)) {
-        Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
-        return TCL_ERROR;
+    if ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
+	return TCL_ERROR;
     }
 
-    if (objc == 3) {
+    if (objc == 2) {
 	if (iPtr->scriptFile != NULL) {
 	    Tcl_DecrRefCount(iPtr->scriptFile);
 	}
-	iPtr->scriptFile = objv[2];
+	iPtr->scriptFile = objv[1];
 	Tcl_IncrRefCount(iPtr->scriptFile);
     }
     if (iPtr->scriptFile != NULL) {
-        Tcl_SetObjResult(interp, iPtr->scriptFile);
+	Tcl_SetObjResult(interp, iPtr->scriptFile);
     }
     return TCL_OK;
 }
@@ -2085,36 +1900,36 @@ InfoScriptCmd(dummy, interp, objc, objv)
  *
  * InfoSharedlibCmd --
  *
- *      Called to implement the "info sharedlibextension" command that
- *      returns the file extension used for shared libraries. Handles the
- *      following syntax:
+ *	Called to implement the "info sharedlibextension" command that returns
+ *	the file extension used for shared libraries. Handles the following
+ *	syntax:
  *
- *          info sharedlibextension
+ *	    info sharedlibextension
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoSharedlibCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoSharedlibCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
-    
+
 #ifdef TCL_SHLIB_EXT
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1));
 #endif
     return TCL_OK;
 }
@@ -2124,40 +1939,40 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
  *
  * InfoTclVersionCmd --
  *
- *      Called to implement the "info tclversion" command that returns the
- *      version number for this Tcl library. Handles the following syntax:
+ *	Called to implement the "info tclversion" command that returns the
+ *	version number for this Tcl library. Handles the following syntax:
  *
- *          info tclversion
+ *	    info tclversion
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InfoTclVersionCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+InfoTclVersionCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    CONST char *version;
+    Tcl_Obj *version;
 
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
     }
 
-    version = Tcl_GetVar(interp, "tcl_version",
-        (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
+	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
     if (version != NULL) {
-        Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
-        return TCL_OK;
+	Tcl_SetObjResult(interp, version);
+	return TCL_OK;
     }
     return TCL_ERROR;
 }
@@ -2165,204 +1980,67 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * InfoVarsCmd --
- *
- *	Called to implement the "info vars" command that returns the
- *	list of variables in the interpreter that match an optional pattern.
- *	The pattern, if any, consists of an optional sequence of namespace
- *	names separated by "::" qualifiers, which is followed by a
- *	glob-style pattern that restricts which variables are returned.
- *	Handles the following syntax:
+ * Tcl_JoinObjCmd --
  *
- *          info vars ?pattern?
+ *	This procedure is invoked to process the "join" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
- *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *      Returns a result in the interpreter's result object. If there is
- *	an error, the result is an error message.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-InfoVarsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+int
+Tcl_JoinObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    char *varName, *pattern;
-    CONST char *simplePattern;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Var *varPtr;
-    Namespace *nsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
-
-    /*
-     * Get the pattern and find the "effective namespace" in which to
-     * list variables. We only use this effective namespace if there's
-     * no active Tcl procedure frame.
-     */
-
-    if (objc == 2) {
-        simplePattern = NULL;
-	nsPtr = currNsPtr;
-	specificNsInPattern = 0;
-    } else if (objc == 3) {
-	/*
-	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an
-	 * error was found while parsing the pattern, return it. Otherwise,
-	 * if the namespace wasn't found, just leave nsPtr NULL: we will
-	 * return an empty list since no variables there can be found.
-	 */
+    int listLen, i;
+    Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
 
-	Namespace *dummy1NsPtr, *dummy2NsPtr;
-
-        pattern = Tcl_GetString(objv[2]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
-		&simplePattern);
-
-	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
-	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
-	}
-    } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
-        return TCL_ERROR;
+    if ((objc < 2) || (objc > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
+	return TCL_ERROR;
     }
 
     /*
-     * If the namespace specified in the pattern wasn't found, just return.
+     * Make sure the list argument is a list object and get its length and a
+     * pointer to its array of element pointers.
      */
 
-    if (nsPtr == NULL) {
-	return TCL_OK;
+    if (TclListObjGetElements(interp, objv[1], &listLen,
+	    &elemPtrs) != TCL_OK) {
+	return TCL_ERROR;
     }
-    
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    
-    if ((iPtr->varFramePtr == NULL)
-	    || !iPtr->varFramePtr->isProcCallFrame
-	    || specificNsInPattern) {
-	/*
-	 * There is no frame pointer, the frame pointer was pushed only
-	 * to activate a namespace, or we are in a procedure call frame
-	 * but a specific namespace was specified. Create a list containing
-	 * only the variables in the effective namespace's variable table.
-	 */
-	
-	if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
-	    /*
-	     * If we can just do hash lookups, that simplifies things
-	     * a lot.
-	     */
 
-	    entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
-	    if (entryPtr != NULL) {
-		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		if (!TclIsVarUndefined(varPtr)
-			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
-		    if (specificNsInPattern) {
-			elemObjPtr = Tcl_NewObj();
-			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-				    elemObjPtr);
-		    } else {
-			elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
-		    }
-		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		}
-	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-		entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,
-			simplePattern);
-		if (entryPtr != NULL) {
-		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		    if (!TclIsVarUndefined(varPtr)
-			    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
-			Tcl_ListObjAppendElement(interp, listPtr,
-				Tcl_NewStringObj(simplePattern, -1));
-		    }
-		}
-	    }
-	} else {
-	    /*
-	     * Have to scan the tables of variables.
-	     */
+    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
+    Tcl_IncrRefCount(joinObjPtr);
 
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
-	    while (entryPtr != NULL) {
-		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		if (!TclIsVarUndefined(varPtr)
-			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
-		    varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
-		    if ((simplePattern == NULL)
-			    || Tcl_StringMatch(varName, simplePattern)) {
-			if (specificNsInPattern) {
-			    elemObjPtr = Tcl_NewObj();
-			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-				    elemObjPtr);
-			} else {
-			    elemObjPtr = Tcl_NewStringObj(varName, -1);
-			}
-			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-
-	    /*
-	     * If the effective namespace isn't the global ::
-	     * namespace, and a specific namespace wasn't requested in
-	     * the pattern (i.e., the pattern only specifies variable
-	     * names), then add in all global :: variables that match
-	     * the simple pattern. Of course, add in only those
-	     * variables that aren't hidden by a variable in the
-	     * effective namespace.
-	     */
-
-	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-		entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
-		while (entryPtr != NULL) {
-		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		    if (!TclIsVarUndefined(varPtr)
-			    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
-			varName = Tcl_GetHashKey(&globalNsPtr->varTable,
-				entryPtr);
-			if ((simplePattern == NULL)
-				|| Tcl_StringMatch(varName, simplePattern)) {
-			    if (Tcl_FindHashEntry(&nsPtr->varTable,
-				    varName) == NULL) {
-				Tcl_ListObjAppendElement(interp, listPtr,
-					Tcl_NewStringObj(varName, -1));
-			    }
-			}
-		    }
-		    entryPtr = Tcl_NextHashEntry(&search);
-		}
-	    }
+    resObjPtr = Tcl_NewObj();
+    for (i = 0;  i < listLen;  i++) {
+	if (i > 0) {
+	    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
 	}
-    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
-	AppendLocals(interp, listPtr, simplePattern, 1);
+	Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
     }
-    
-    Tcl_SetObjResult(interp, listPtr);
+    Tcl_DecrRefCount(joinObjPtr);
+    Tcl_SetObjResult(interp, resObjPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_JoinObjCmd --
+ * Tcl_LassignObjCmd --
  *
- *	This procedure is invoked to process the "join" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "lassign" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -2373,54 +2051,59 @@ InfoVarsCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_JoinObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+Tcl_LassignObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *joinString, *bytes;
-    int joinLength, listLen, length, i, result;
-    Tcl_Obj **elemPtrs;
-    Tcl_Obj *resObjPtr;
+    Tcl_Obj *listCopyPtr;
+    Tcl_Obj **listObjv;		/* The contents of the list. */
+    int listObjc;		/* The length of the list. */
+    int code = TCL_OK;
 
-    if (objc == 2) {
-	joinString = " ";
-	joinLength = 1;
-    } else if (objc == 3) {
-	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list varName ?varName ...?");
 	return TCL_ERROR;
     }
 
-    /*
-     * Make sure the list argument is a list object and get its length and
-     * a pointer to its array of element pointers.
-     */
-
-    result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
+    listCopyPtr = TclListObjCopy(interp, objv[1]);
+    if (listCopyPtr == NULL) {
+	return TCL_ERROR;
     }
 
-    /*
-     * Now concatenate strings to form the "joined" result. We append
-     * directly into the interpreter's result object.
-     */
+    TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
 
-    resObjPtr = Tcl_GetObjResult(interp);
+    objc -= 2;
+    objv += 2;
+    while (code == TCL_OK && objc > 0 && listObjc > 0) {
+	if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
+		*listObjv++, TCL_LEAVE_ERR_MSG)) {
+	    code = TCL_ERROR;
+	}
+	objc--; listObjc--;
+    }
 
-    for (i = 0;  i < listLen;  i++) {
-	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
-	if (i > 0) {
-	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);
+    if (code == TCL_OK && objc > 0) {
+	Tcl_Obj *emptyObj;
+	TclNewObj(emptyObj);
+	Tcl_IncrRefCount(emptyObj);
+	while (code == TCL_OK && objc-- > 0) {
+	    if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
+		    emptyObj, TCL_LEAVE_ERR_MSG)) {
+		code = TCL_ERROR;
+	    }
 	}
-	Tcl_AppendToObj(resObjPtr, bytes, length);
+	Tcl_DecrRefCount(emptyObj);
     }
-    return TCL_OK;
+
+    if (code == TCL_OK && listObjc > 0) {
+	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
+    }
+
+    Tcl_DecrRefCount(listCopyPtr);
+    return code;
 }
 
 /*
@@ -2440,16 +2123,15 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
 int
-Tcl_LindexObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LindexObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
 
-    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted */
+    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
@@ -2457,31 +2139,27 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * If objc == 3, then objv[ 2 ] may be either a single index or
-     * a list of indices: go to TclLindexList to determine which.
-     * If objc >= 4, or objc == 2, then objv[ 2 .. objc-2 ] are all
-     * single indices and processed as such in TclLindexFlat.
+     * If objc==3, then objv[2] may be either a single index or a list of
+     * indices: go to TclLindexList to determine which. If objc>=4, or
+     * objc==2, then objv[2 .. objc-2] are all single indices and processed as
+     * such in TclLindexFlat.
      */
 
-    if ( objc == 3 ) {
-
-	elemPtr = TclLindexList( interp, objv[ 1 ], objv[ 2 ] );
-
+    if (objc == 3) {
+	elemPtr = TclLindexList(interp, objv[1], objv[2]);
     } else {
-
-	elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );
-
+	elemPtr = TclLindexFlat(interp, objv[1], objc-2, objv+2);
     }
-	
+
     /*
-     * Set the interpreter's object result to the last element extracted
+     * Set the interpreter's object result to the last element extracted.
      */
 
-    if ( elemPtr == NULL ) {
+    if (elemPtr == NULL) {
 	return TCL_ERROR;
     } else {
 	Tcl_SetObjResult(interp, elemPtr);
-	Tcl_DecrRefCount( elemPtr );
+	Tcl_DecrRefCount(elemPtr);
 	return TCL_OK;
     }
 }
@@ -2489,306 +2167,14 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * TclLindexList --
- *
- *	This procedure handles the 'lindex' command when objc==3.
- *
- * Results:
- *	Returns a pointer to the object extracted, or NULL if an
- *	error occurred.
- *
- * Side effects:
- *	None.
- *
- * If objv[1] can be parsed as a list, TclLindexList handles extraction
- * of the desired element locally.  Otherwise, it invokes
- * TclLindexFlat to treat objv[1] as a scalar.
- *
- * The reference count of the returned object includes one reference
- * corresponding to the pointer returned.  Thus, the calling code will
- * usually do something like:
- *	Tcl_SetObjResult( interp, result );
- *	Tcl_DecrRefCount( result );
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclLindexList( interp, listPtr, argPtr )
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    Tcl_Obj* listPtr;		/* List being unpacked */
-    Tcl_Obj* argPtr;		/* Index or index list */
-{
-
-    Tcl_Obj **elemPtrs;		/* Elements of the list being manipulated. */
-    int listLen;		/* Length of the list being manipulated. */
-    int index;			/* Index into the list */
-    int result;			/* Result returned from a Tcl library call */
-    int i;			/* Current index number */
-    Tcl_Obj** indices;		/* Array of list indices */
-    int indexCount;		/* Size of the array of list indices */
-    Tcl_Obj* oldListPtr;	/* Temp location to preserve the list
-				 * pointer when replacing it with a sublist */
-
-    /*
-     * Determine whether argPtr designates a list or a single index.
-     * We have to be careful about the order of the checks to avoid
-     * repeated shimmering; see TIP#22 and TIP#33 for the details.
-     */
-
-    if ( argPtr->typePtr != &tclListType 
-	 && TclGetIntForIndex( NULL , argPtr, 0, &index ) == TCL_OK ) {
-
-	/*
-	 * argPtr designates a single index.
-	 */
-
-	return TclLindexFlat( interp, listPtr, 1, &argPtr );
-
-    } else if ( Tcl_ListObjGetElements( NULL, argPtr, &indexCount, &indices )
-		!= TCL_OK ) {
-
-	/*
-	 * argPtr designates something that is neither an index nor a
-	 * well-formed list.  Report the error via TclLindexFlat.
-	 */
-	
-	return TclLindexFlat( interp, listPtr, 1, &argPtr );
-    }
-
-    /*
-     * Record the reference to the list that we are maintaining in
-     * the activation record.
-     */
-
-    Tcl_IncrRefCount( listPtr );
-
-    /*
-     * argPtr designates a list, and the 'else if' above has parsed it
-     * into indexCount and indices.
-     */
-
-    for ( i = 0; i < indexCount; ++i ) {
-
-	/*
-	 * Convert the current listPtr to a list if necessary.
-	 */
-	    
-	result = Tcl_ListObjGetElements( interp, listPtr,
-					 &listLen, &elemPtrs);
-	if (result != TCL_OK) {
-	    Tcl_DecrRefCount( listPtr );
-	    return NULL;
-	}
-	    
-	/*
-	 * Get the index from indices[ i ]
-	 */
-	
-	result = TclGetIntForIndex( interp, indices[ i ],
-				    /*endValue*/ (listLen - 1),
-				    &index );
-	if ( result != TCL_OK ) {
-	    /*
-	     * Index could not be parsed
-	     */
-
-	    Tcl_DecrRefCount( listPtr );
-	    return NULL;
-
-	} else if ( index < 0
-		    || index >= listLen ) {
-	    /*
-	     * Index is out of range
-	     */
-	    Tcl_DecrRefCount( listPtr );
-	    listPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount( listPtr );
-	    return listPtr;
-	}
-	
-	/*
-	 * Make sure listPtr still refers to a list object.
-	 * If it shared a Tcl_Obj structure with the arguments, then
-	 * it might have just been converted to something else.
-	 */
-	
-	if (listPtr->typePtr != &tclListType) {
-	    result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
-					    &elemPtrs);
-	    if (result != TCL_OK) {
-		Tcl_DecrRefCount( listPtr );
-		return NULL;
-	    }
-	}
-	
-	/*
-	 * Extract the pointer to the appropriate element
-	 */
-	
-	oldListPtr = listPtr;
-	listPtr = elemPtrs[ index ];
-	Tcl_IncrRefCount( listPtr );
-	Tcl_DecrRefCount( oldListPtr );
-	
-	/*
-	 * The work we did above may have caused the internal rep
-	 * of *argPtr to change to something else.  Get it back.
-	 */
-	
-	result = Tcl_ListObjGetElements( interp, argPtr,
-					 &indexCount, &indices );
-	if ( result != TCL_OK ) {
-	    /* 
-	     * This can't happen unless some extension corrupted a Tcl_Obj.
-	     */
-	    Tcl_DecrRefCount( listPtr );
-	    return NULL;
-	}
-	
-    } /* end for */
-
-    /*
-     * Return the last object extracted.  Its reference count will include
-     * the reference being returned.
-     */
-
-    return listPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclLindexFlat --
- *
- *	This procedure handles the 'lindex' command, given that the
- *	arguments to the command are known to be a flat list.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- * This procedure is called from either tclExecute.c or
- * Tcl_LindexObjCmd whenever either is presented with
- * objc == 2 or objc >= 4.  It is also called from TclLindexList
- * for the objc==3 case once it is determined that objv[2] cannot
- * be parsed as a list.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclLindexFlat( interp, listPtr, indexCount, indexArray )
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    Tcl_Obj* listPtr;		/* Tcl object representing the list */
-    int indexCount;		/* Count of indices */
-    Tcl_Obj* CONST indexArray[];
-				/* Array of pointers to Tcl objects
-				 * representing the indices in the
-				 * list */
-{
-
-    int i;			/* Current list index */
-    int result;			/* Result of Tcl library calls */
-    int listLen;		/* Length of the current list being 
-				 * processed */
-    Tcl_Obj** elemPtrs;		/* Array of pointers to the elements
-				 * of the current list */
-    int index;			/* Parsed version of the current element
-				 * of indexArray  */
-    Tcl_Obj* oldListPtr;	/* Temporary to hold listPtr so that
-				 * its ref count can be decremented. */
-
-    /*
-     * Record the reference to the 'listPtr' object that we are
-     * maintaining in the C activation record.
-     */
-
-    Tcl_IncrRefCount( listPtr );
-
-    for ( i = 0; i < indexCount; ++i ) {
-
-	/*
-	 * Convert the current listPtr to a list if necessary.
-	 */
-	
-	result = Tcl_ListObjGetElements(interp, listPtr,
-					&listLen, &elemPtrs);
-	if (result != TCL_OK) {
-	    Tcl_DecrRefCount( listPtr );
-	    return NULL;
-	}
-	
-	/*
-	 * Get the index from objv[i]
-	 */
-	
-	result = TclGetIntForIndex( interp, indexArray[ i ],
-				    /*endValue*/ (listLen - 1),
-				    &index );
-	if ( result != TCL_OK ) {
-
-	    /* Index could not be parsed */
-
-	    Tcl_DecrRefCount( listPtr );
-	    return NULL;
-
-	} else if ( index < 0
-		    || index >= listLen ) {
-	    
-	    /*
-	     * Index is out of range
-	     */
-		
-	    Tcl_DecrRefCount( listPtr );
-	    listPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount( listPtr );
-	    return listPtr;
-	}
-	    
-	/*
-	 * Make sure listPtr still refers to a list object.
-	 * It might have been converted to something else above
-	 * if objv[1] overlaps with one of the other parameters.
-	 */
-	
-	if (listPtr->typePtr != &tclListType) {
-	    result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
-					    &elemPtrs);
-	    if (result != TCL_OK) {
-		Tcl_DecrRefCount( listPtr );
-		return NULL;
-	    }
-	}
-	
-	/*
-	 * Extract the pointer to the appropriate element
-	 */
-	
-	oldListPtr = listPtr;
-	listPtr = elemPtrs[ index ];
-	Tcl_IncrRefCount( listPtr );
-	Tcl_DecrRefCount( oldListPtr );
-	
-    }
-
-    return listPtr;
-
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_LinsertObjCmd --
  *
  *	This object-based procedure is invoked to process the "linsert" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A new Tcl list object formed by inserting zero or more elements 
- *	into a list.
+ *	A new Tcl list object formed by inserting zero or more elements into a
+ *	list.
  *
  * Side effects:
  *	See the user documentation.
@@ -2796,34 +2182,33 @@ TclLindexFlat( interp, listPtr, indexCount, indexArray )
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LinsertObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    register int objc;		/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LinsertObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    register int objc,		/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *listPtr;
-    int index, isDuplicate, len, result;
+    int index, len, result;
 
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
 	return TCL_ERROR;
     }
 
-    result = Tcl_ListObjLength(interp, objv[1], &len);
+    result = TclListObjLength(interp, objv[1], &len);
     if (result != TCL_OK) {
 	return result;
     }
 
     /*
-     * Get the index.  "end" is interpreted to be the index after the last
+     * Get the index. "end" is interpreted to be the index after the last
      * element, such that using it will cause any inserted elements to be
      * appended to the list.
      */
 
-    result = TclGetIntForIndex(interp, objv[2], /*end*/ len, &index);
+    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
     if (result != TCL_OK) {
 	return result;
     }
@@ -2832,33 +2217,25 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * If the list object is unshared we can modify it directly. Otherwise
-     * we create a copy to modify: this is "copy on write".
+     * If the list object is unshared we can modify it directly. Otherwise we
+     * create a copy to modify: this is "copy on write".
      */
 
     listPtr = objv[1];
-    isDuplicate = 0;
     if (Tcl_IsShared(listPtr)) {
-	listPtr = Tcl_DuplicateObj(listPtr);
-	isDuplicate = 1;
+	listPtr = TclListObjCopy(NULL, listPtr);
     }
 
     if ((objc == 4) && (index == len)) {
 	/*
 	 * Special case: insert one element at the end of the list.
 	 */
-	result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
-    } else if (objc > 3) {
-	result = Tcl_ListObjReplace(interp, listPtr, index, 0,
-				    (objc-3), &(objv[3]));
-    }
-    if (result != TCL_OK) {
-	if (isDuplicate) {
-	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
-	}
-	return result;
+
+	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
+    } else {
+	Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
     }
-    
+
     /*
      * Set the interpreter's object result.
      */
@@ -2872,8 +2249,8 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_ListObjCmd --
  *
- *	This procedure is invoked to process the "list" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "list" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -2884,21 +2261,21 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_ListObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    register int objc;			/* Number of arguments. */
-    register Tcl_Obj *CONST objv[];	/* The argument objects. */
+Tcl_ListObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    register int objc,		/* Number of arguments. */
+    register Tcl_Obj *const objv[])
+				/* The argument objects. */
 {
     /*
      * If there are no list elements, the result is an empty object.
-     * Otherwise modify the interpreter's result object to be a list object.
+     * Otherwise set the interpreter's result object to be a list object.
      */
-    
+
     if (objc > 1) {
-	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
+	Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
     }
     return TCL_OK;
 }
@@ -2909,7 +2286,7 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
  * Tcl_LlengthObjCmd --
  *
  *	This object-based procedure is invoked to process the "llength" Tcl
- *	command.  See the user documentation for details on what it does.
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -2920,13 +2297,13 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LlengthObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LlengthObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    register Tcl_Obj *const objv[])
+				/* Argument objects. */
 {
     int listLen, result;
 
@@ -2935,17 +2312,17 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    result = Tcl_ListObjLength(interp, objv[1], &listLen);
+    result = TclListObjLength(interp, objv[1], &listLen);
     if (result != TCL_OK) {
 	return result;
     }
 
     /*
      * Set the interpreter's object result to an integer object holding the
-     * length. 
+     * length.
      */
 
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
     return TCL_OK;
 }
 
@@ -2954,8 +2331,8 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_LrangeObjCmd --
  *
- *	This procedure is invoked to process the "lrange" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "lrange" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -2966,17 +2343,16 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    register Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LrangeObjCmd(
+    ClientData notUsed,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    register Tcl_Obj *const objv[])
+				/* Argument objects. */
 {
-    Tcl_Obj *listPtr;
-    Tcl_Obj **elemPtrs;
-    int listLen, first, last, numElems, result;
+    Tcl_Obj *listPtr, **elemPtrs;
+    int listLen, first, result;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
@@ -2984,62 +2360,143 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
     }
 
     /*
-     * Make sure the list argument is a list object and get its length and
-     * a pointer to its array of element pointers.
+     * Make sure the list argument is a list object and get its length and a
+     * pointer to its array of element pointers.
      */
 
-    listPtr = objv[1];
-    result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
+    listPtr = TclListObjCopy(interp, objv[1]);
+    if (listPtr == NULL) {
+	return TCL_ERROR;
     }
+    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
 
-    /*
-     * Get the first and last indexes.
-     */
-
-    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
+    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
 	    &first);
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (first < 0) {
-	first = 0;
+    if (result == TCL_OK) {
+	int last;
+
+	if (first < 0) {
+	    first = 0;
+	}
+
+	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
+		&last);
+	if (result == TCL_OK) {
+	    if (last >= listLen) {
+		last = (listLen - 1);
+	    }
+
+	    if (first <= last) {
+		int numElems = (last - first + 1);
+
+		Tcl_SetObjResult(interp,
+			Tcl_NewListObj(numElems, &(elemPtrs[first])));
+	    }
+	}
     }
 
-    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
-	    &last);
-    if (result != TCL_OK) {
-	return result;
+    Tcl_DecrRefCount(listPtr);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LrepeatObjCmd --
+ *
+ *	This procedure is invoked to process the "lrepeat" Tcl command. See
+ *	the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LrepeatObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    register int objc,		/* Number of arguments. */
+    register Tcl_Obj *const objv[])
+				/* The argument objects. */
+{
+    int elementCount, i, totalElems;
+    Tcl_Obj *listPtr, **dataArray;
+    List *listRepPtr;
+
+    /*
+     * Check arguments for legality:
+     *		lrepeat posInt value ?value ...?
+     */
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
+	return TCL_ERROR;
     }
-    if (last >= listLen) {
-	last = (listLen - 1);
+    if (TCL_ERROR == TclGetIntFromObj(interp, objv[1], &elementCount)) {
+	return TCL_ERROR;
     }
-    
-    if (first > last) {
-	return TCL_OK;		/* the result is an empty object */
+    if (elementCount < 1) {
+	Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
+	return TCL_ERROR;
     }
 
     /*
-     * Make sure listPtr still refers to a list object. It might have been
-     * converted to an int above if the argument objects were shared.
-     */  
+     * Skip forward to the interesting arguments now we've finished parsing.
+     */
+
+    objc -= 2;
+    objv += 2;
 
-    if (listPtr->typePtr != &tclListType) {
-        result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
-                &elemPtrs);
-        if (result != TCL_OK) {
-            return result;
-        }
+    /* Final sanity check. Do not exceed limits on max list length. */
+
+    if (objc > LIST_MAX/elementCount) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+	return TCL_ERROR;
     }
+    totalElems = objc * elementCount;
 
     /*
-     * Extract a range of fields. We modify the interpreter's result object
-     * to be a list object containing the specified elements.
+     * Get an empty list object that is allocated large enough to hold each
+     * init value elementCount times.
      */
 
-    numElems = (last - first + 1);
-    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
+    listPtr = Tcl_NewListObj(totalElems, NULL);
+    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr->elemCount = elementCount*objc;
+    dataArray = &listRepPtr->elements;
+
+    /*
+     * Set the elements. Note that we handle the common degenerate case of a
+     * single value being repeated separately to permit the compiler as much
+     * room as possible to optimize a loop that might be run a very large
+     * number of times.
+     */
+
+    if (objc == 1) {
+	register Tcl_Obj *tmpPtr = objv[0];
+
+	tmpPtr->refCount += elementCount;
+	for (i=0 ; i<elementCount ; i++) {
+	    dataArray[i] = tmpPtr;
+	}
+    } else {
+	int j, k = 0;
+
+	for (i=0 ; i<elementCount ; i++) {
+	    for (j=0 ; j<objc ; j++) {
+		Tcl_IncrRefCount(objv[j]);
+		dataArray[k++] = objv[j];
+	    }
+	}
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
@@ -3048,12 +2505,12 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
  *
  * Tcl_LreplaceObjCmd --
  *
- *	This object-based procedure is invoked to process the "lreplace" 
- *	Tcl command. See the user documentation for details on what it does.
+ *	This object-based procedure is invoked to process the "lreplace" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A new Tcl list object formed by replacing zero or more elements of
- *	a list.
+ *	A new Tcl list object formed by replacing zero or more elements of a
+ *	list.
  *
  * Side effects:
  *	See the user documentation.
@@ -3061,16 +2518,15 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LreplaceObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Tcl_Obj *listPtr;
-    int isDuplicate, first, last, listLen, numToDelete, result;
+    int first, last, listLen, numToDelete, result;
 
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -3078,42 +2534,41 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    result = Tcl_ListObjLength(interp, objv[1], &listLen);
+    result = TclListObjLength(interp, objv[1], &listLen);
     if (result != TCL_OK) {
 	return result;
     }
 
     /*
-     * Get the first and last indexes.  "end" is interpreted to be the index
-     * for the last element, such that using it will cause that element to
-     * be included for deletion.
+     * Get the first and last indexes. "end" is interpreted to be the index
+     * for the last element, such that using it will cause that element to be
+     * included for deletion.
      */
 
-    result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
+    result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first);
     if (result != TCL_OK) {
 	return result;
     }
 
-    result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last);
+    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
     if (result != TCL_OK) {
 	return result;
     }
 
-    if (first < 0)  {
+    if (first < 0) {
     	first = 0;
     }
 
     /*
      * Complain if the user asked for a start element that is greater than the
-     * list length.  This won't ever trigger for the "end*" case as that will
+     * list length. This won't ever trigger for the "end-*" case as that will
      * be properly constrained by TclGetIntForIndex because we use listLen-1
      * (to allow for replacing the last elem).
      */
 
     if ((first >= listLen) && (listLen > 0)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"list doesn't contain element ",
-		Tcl_GetString(objv[2]), (int *) NULL);
+	Tcl_AppendResult(interp, "list doesn't contain element ",
+		TclGetString(objv[2]), NULL);
 	return TCL_ERROR;
     }
     if (last >= listLen) {
@@ -3126,35 +2581,109 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * If the list object is unshared we can modify it directly, otherwise
-     * we create a copy to modify: this is "copy on write".
+     * If the list object is unshared we can modify it directly, otherwise we
+     * create a copy to modify: this is "copy on write".
      */
 
     listPtr = objv[1];
-    isDuplicate = 0;
     if (Tcl_IsShared(listPtr)) {
-	listPtr = Tcl_DuplicateObj(listPtr);
-	isDuplicate = 1;
+	listPtr = TclListObjCopy(NULL, listPtr);
     }
-    if (objc > 4) {
-	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
-	        (objc-4), &(objv[4]));
-    } else {
-	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
-		0, NULL);
+
+    /*
+     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
+     * objc == 4. In this case, the list value of listPtr is not changed (no
+     * elements are removed or added), but by making the call we are assured
+     * we end up with a list in canonical form. Resist any temptation to
+     * optimize this case away.
+     */
+
+    Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4]));
+
+    /*
+     * Set the interpreter's object result.
+     */
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LreverseObjCmd --
+ *
+ *	This procedure is invoked to process the "lreverse" Tcl command. See
+ *	the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LreverseObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument values. */
+{
+    Tcl_Obj **elemv;
+    int elemc, i, j;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list");
+	return TCL_ERROR;
     }
-    if (result != TCL_OK) {
-	if (isDuplicate) {
-	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
-	}
-	return result;
+    if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     /*
-     * Set the interpreter's object result. 
+     * If the list is empty, just return it [Bug 1876793]
      */
 
-    Tcl_SetObjResult(interp, listPtr);
+    if (!elemc) {
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+
+    if (Tcl_IsShared(objv[1])
+	    || (ListRepPtr(objv[1])->refCount > 1)) {	/* Bug 1675044 */
+	Tcl_Obj *resultObj, **dataArray;
+	List *listRepPtr;
+
+	resultObj = Tcl_NewListObj(elemc, NULL);
+	listRepPtr = ListRepPtr(resultObj);
+	listRepPtr->elemCount = elemc;
+	dataArray = &listRepPtr->elements;
+
+	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
+	    dataArray[j] = elemv[i];
+	    Tcl_IncrRefCount(elemv[i]);
+	}
+
+	Tcl_SetObjResult(interp, resultObj);
+    } else {
+
+	/*
+	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
+	 * returning a pointer to the live array of Tcl_Obj values.
+	 */
+
+	for (i=0,j=elemc-1 ; i<j ; i++,j--) {
+	    Tcl_Obj *tmp = elemv[i];
+
+	    elemv[i] = elemv[j];
+	    elemv[j] = tmp;
+	}
+	TclInvalidateStringRep(objv[1]);
+	Tcl_SetObjResult(interp, objv[1]);
+    }
     return TCL_OK;
 }
 
@@ -3163,8 +2692,8 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_LsearchObjCmd --
  *
- *	This procedure is invoked to process the "lsearch" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "lsearch" Tcl command. See
+ *	the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -3176,30 +2705,34 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
  */
 
 int
-Tcl_LsearchObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument values. */
+Tcl_LsearchObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument values. */
 {
     char *bytes, *patternBytes;
     int i, match, mode, index, result, listc, length, elemLen;
-    int dataType, isIncreasing, lower, upper, patInt, objInt;
-    int offset, allMatches, inlineReturn, negatedMatch;
+    int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
     double patDouble, objDouble;
-    Tcl_Obj *patObj, **listv, *listPtr, *startPtr;
+    SortInfo sortInfo;
+    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
+    SortStrCmpFn_t strCmpFn = strcmp;
     Tcl_RegExp regexp = NULL;
-    static CONST char *options[] = {
-	"-all",	    "-ascii", "-decreasing", "-dictionary",
-	"-exact",   "-glob",  "-increasing", "-inline",
-	"-integer", "-not",   "-real",	     "-regexp",
-	"-sorted",  "-start", NULL
+    static const char *options[] = {
+	"-all",	    "-ascii",   "-decreasing", "-dictionary",
+	"-exact",   "-glob",    "-increasing", "-index",
+	"-inline",  "-integer", "-nocase",     "-not",
+	"-real",    "-regexp",  "-sorted",     "-start",
+	"-subindices", NULL
     };
     enum options {
 	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
-	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INLINE,
-	LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP,
-	LSEARCH_SORTED, LSEARCH_START
+	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
+	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
+	LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
+	LSEARCH_SUBINDICES
     };
     enum datatypes {
 	ASCII, DICTIONARY, INTEGER, REAL
@@ -3213,10 +2746,19 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     isIncreasing = 1;
     allMatches = 0;
     inlineReturn = 0;
+    returnSubindices = 0;
     negatedMatch = 0;
     listPtr = NULL;
     startPtr = NULL;
     offset = 0;
+    noCase = 0;
+    sortInfo.compareCmdPtr = NULL;
+    sortInfo.isIncreasing = 1;
+    sortInfo.sortMode = 0;
+    sortInfo.interp = interp;
+    sortInfo.resultCode = TCL_OK;
+    sortInfo.indexv = NULL;
+    sortInfo.indexc = 0;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
@@ -3226,9 +2768,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     for (i = 1; i < objc-2; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
 		!= TCL_OK) {
-	    if (startPtr) {
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    return TCL_ERROR;
 	}
 	switch ((enum options) index) {
@@ -3240,6 +2785,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    break;
 	case LSEARCH_DECREASING:	/* -decreasing */
 	    isIncreasing = 0;
+	    sortInfo.isIncreasing = 0;
 	    break;
 	case LSEARCH_DICTIONARY:	/* -dictionary */
 	    dataType = DICTIONARY;
@@ -3252,6 +2798,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    break;
 	case LSEARCH_INCREASING:	/* -increasing */
 	    isIncreasing = 1;
+	    sortInfo.isIncreasing = 1;
 	    break;
 	case LSEARCH_INLINE:		/* -inline */
 	    inlineReturn = 1;
@@ -3259,6 +2806,10 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	case LSEARCH_INTEGER:		/* -integer */
 	    dataType = INTEGER;
 	    break;
+	case LSEARCH_NOCASE:		/* -nocase */
+	    strCmpFn = strcasecmp;
+	    noCase = 1;
+	    break;
 	case LSEARCH_NOT:		/* -not */
 	    negatedMatch = 1;
 	    break;
@@ -3271,88 +2822,183 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	case LSEARCH_SORTED:		/* -sorted */
 	    mode = SORTED;
 	    break;
+	case LSEARCH_SUBINDICES:	/* -subindices */
+	    returnSubindices = 1;
+	    break;
 	case LSEARCH_START:		/* -start */
 	    /*
-	     * If there was a previous -start option, release its saved
-	     * index because it will either be replaced or there will be
-	     * an error.
+	     * If there was a previous -start option, release its saved index
+	     * because it will either be replaced or there will be an error.
 	     */
-	    if (startPtr) {
+
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
 	    if (i > objc-4) {
+		if (sortInfo.indexc > 1) {
+		    ckfree((char *) sortInfo.indexv);
+		}
 		Tcl_AppendResult(interp, "missing starting index", NULL);
 		return TCL_ERROR;
 	    }
 	    i++;
 	    if (objv[i] == objv[objc - 2]) {
 		/*
-		 * Take copy to prevent shimmering problems.  Note
-		 * that it does not matter if the index obj is also a
-		 * component of the list being searched.  We only need
-		 * to copy where the list and the index are
-		 * one-and-the-same.
+		 * Take copy to prevent shimmering problems. Note that it does
+		 * not matter if the index obj is also a component of the list
+		 * being searched. We only need to copy where the list and the
+		 * index are one-and-the-same.
 		 */
+
 		startPtr = Tcl_DuplicateObj(objv[i]);
 	    } else {
 		startPtr = objv[i];
 		Tcl_IncrRefCount(startPtr);
 	    }
+	    break;
+	case LSEARCH_INDEX: {		/* -index */
+	    Tcl_Obj **indices;
+	    int j;
+
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
+	    if (i > objc-4) {
+		if (startPtr != NULL) {
+		    Tcl_DecrRefCount(startPtr);
+		}
+		Tcl_AppendResult(interp,
+			"\"-index\" option must be followed by list index",
+			NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Store the extracted indices for processing by sublist
+	     * extraction. Note that we don't do this using objects because
+	     * that has shimmering problems.
+	     */
+
+	    i++;
+	    if (TclListObjGetElements(interp, objv[i],
+		    &sortInfo.indexc, &indices) != TCL_OK) {
+		if (startPtr != NULL) {
+		    Tcl_DecrRefCount(startPtr);
+		}
+		return TCL_ERROR;
+	    }
+	    switch (sortInfo.indexc) {
+	    case 0:
+		sortInfo.indexv = NULL;
+		break;
+	    case 1:
+		sortInfo.indexv = &sortInfo.singleIndex;
+		break;
+	    default:
+		sortInfo.indexv = (int *)
+			ckalloc(sizeof(int) * sortInfo.indexc);
+	    }
+
+	    /*
+	     * Fill the array by parsing each index. We don't know whether
+	     * their scale is sensible yet, but we at least perform the
+	     * syntactic check here.
+	     */
+
+	    for (j=0 ; j<sortInfo.indexc ; j++) {
+		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
+			&sortInfo.indexv[j]) != TCL_OK) {
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
+		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			    "\n    (-index option item number %d)", j));
+		    return TCL_ERROR;
+		}
+	    }
+	    break;
+	}
+	}
+    }
+
+    /*
+     * Subindices only make sense if asked for with -index option set.
+     */
+
+    if (returnSubindices && sortInfo.indexc==0) {
+	if (startPtr != NULL) {
+	    Tcl_DecrRefCount(startPtr);
 	}
+	Tcl_AppendResult(interp,
+		"-subindices cannot be used without -index option", NULL);
+	return TCL_ERROR;
     }
 
     if ((enum modes) mode == REGEXP) {
 	/*
 	 * We can shimmer regexp/list if listv[i] == pattern, so get the
 	 * regexp rep before the list rep. First time round, omit the interp
-         * and hope that the compilation will succeed. If it fails, we'll
-         * recompile in "expensive" mode with a place to put error messages.
+	 * and hope that the compilation will succeed. If it fails, we'll
+	 * recompile in "expensive" mode with a place to put error messages.
 	 */
 
 	regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1],
-		TCL_REG_ADVANCED | TCL_REG_NOSUB);
+		TCL_REG_ADVANCED | TCL_REG_NOSUB |
+		(noCase ? TCL_REG_NOCASE : 0));
 	if (regexp == NULL) {
-            /*
-             * Failed to compile the RE. Try again without the TCL_REG_NOSUB
-             * flag in case the RE had sub-expressions in it [Bug 1366683].
-             * If this fails, an error message will be left in the
-             * interpreter.
-             */
-
-            regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
-		    TCL_REG_ADVANCED);
+	    /*
+	     * Failed to compile the RE. Try again without the TCL_REG_NOSUB
+	     * flag in case the RE had sub-expressions in it [Bug 1366683]. If
+	     * this fails, an error message will be left in the interpreter.
+	     */
+
+	    regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
+		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
 	}
 
 	if (regexp == NULL) {
-	    if (startPtr) {
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Make sure the list argument is a list object and get its length and
-     * a pointer to its array of element pointers.
+     * Make sure the list argument is a list object and get its length and a
+     * pointer to its array of element pointers.
      */
 
-    result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
+    result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
     if (result != TCL_OK) {
-	if (startPtr) {
+	if (startPtr != NULL) {
 	    Tcl_DecrRefCount(startPtr);
 	}
+	if (sortInfo.indexc > 1) {
+	    ckfree((char *) sortInfo.indexv);
+	}
 	return result;
     }
 
     /*
      * Get the user-specified start offset.
      */
+
     if (startPtr) {
-	result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
+	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
 	Tcl_DecrRefCount(startPtr);
 	if (result != TCL_OK) {
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    return result;
 	}
+	if (offset < 0) {
+	    offset = 0;
+	}
 
 	/*
 	 * If the search started past the end of the list, we just return a
@@ -3360,6 +3006,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	 */
 
 	if (offset > listc-1) {
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    if (allMatches || inlineReturn) {
 		Tcl_ResetResult(interp);
 	    } else {
@@ -3367,9 +3016,6 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    }
 	    return TCL_OK;
 	}
-	if (offset < 0) {
-	    offset = 0;
-	}
     }
 
     patObj = objv[objc - 1];
@@ -3378,59 +3024,91 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	switch ((enum datatypes) dataType) {
 	case ASCII:
 	case DICTIONARY:
-	    patternBytes = Tcl_GetStringFromObj(patObj, &length);
+	    patternBytes = TclGetStringFromObj(patObj, &length);
 	    break;
 	case INTEGER:
-	    result = Tcl_GetIntFromObj(interp, patObj, &patInt);
+	    result = TclGetIntFromObj(interp, patObj, &patInt);
 	    if (result != TCL_OK) {
+		if (sortInfo.indexc > 1) {
+		    ckfree((char *) sortInfo.indexv);
+		}
 		return result;
 	    }
-	    Tcl_ListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+
+	    /*
+	     * List representation might have been shimmered; restore it. [Bug
+	     * 1844789]
+	     */
+
+	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	case REAL:
 	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
 	    if (result != TCL_OK) {
+		if (sortInfo.indexc > 1) {
+		    ckfree((char *) sortInfo.indexv);
+		}
 		return result;
 	    }
-	    Tcl_ListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+
+	    /*
+	     * List representation might have been shimmered; restore it. [Bug
+	     * 1844789]
+	     */
+
+	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	}
     } else {
-	patternBytes = Tcl_GetStringFromObj(patObj, &length);
+	patternBytes = TclGetStringFromObj(patObj, &length);
     }
 
     /*
-     * Set default index value to -1, indicating failure; if we find the
-     * item in the course of our search, index will be set to the correct
-     * value.
+     * Set default index value to -1, indicating failure; if we find the item
+     * in the course of our search, index will be set to the correct value.
      */
+
     index = -1;
     match = 0;
 
     if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
 	/*
-	 * If the data is sorted, we can do a more intelligent search.
-	 * Note that there is no point in being smart when -all was
-	 * specified; in that case, we have to look at all items anyway,
-	 * and there is no sense in doing this when the match sense is
-	 * inverted.
+	 * If the data is sorted, we can do a more intelligent search. Note
+	 * that there is no point in being smart when -all was specified; in
+	 * that case, we have to look at all items anyway, and there is no
+	 * sense in doing this when the match sense is inverted.
 	 */
+
 	lower = offset - 1;
 	upper = listc;
-	while (lower + 1 != upper) {
+	while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
 	    i = (lower + upper)/2;
+	    if (sortInfo.indexc != 0) {
+		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+		if (sortInfo.resultCode != TCL_OK) {
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
+		    return sortInfo.resultCode;
+		}
+	    } else {
+		itemPtr = listv[i];
+	    }
 	    switch ((enum datatypes) dataType) {
 	    case ASCII:
-		bytes = Tcl_GetString(listv[i]);
-		match = strcmp(patternBytes, bytes);
+		bytes = TclGetString(itemPtr);
+		match = strCmpFn(patternBytes, bytes);
 		break;
 	    case DICTIONARY:
-		bytes = Tcl_GetString(listv[i]);
+		bytes = TclGetString(itemPtr);
 		match = DictionaryCompare(patternBytes, bytes);
 		break;
 	    case INTEGER:
-		result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+		result = TclGetIntFromObj(interp, itemPtr, &objInt);
 		if (result != TCL_OK) {
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
 		    return result;
 		}
 		if (patInt == objInt) {
@@ -3442,8 +3120,11 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 		}
 		break;
 	    case REAL:
-		result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble);
+		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
 		if (result != TCL_OK) {
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
 		    return result;
 		}
 		if (patDouble == objDouble) {
@@ -3457,17 +3138,19 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    }
 	    if (match == 0) {
 		/*
-		 * Normally, binary search is written to stop when it
-		 * finds a match.  If there are duplicates of an element in
-		 * the list, our first match might not be the first occurance.
-		 * Consider:  0 0 0 1 1 1 2 2 2
-		 * To maintain consistancy with standard lsearch semantics,
-		 * we must find the leftmost occurance of the pattern in the
-		 * list.  Thus we don't just stop searching here.  This
+		 * Normally, binary search is written to stop when it finds a
+		 * match. If there are duplicates of an element in the list,
+		 * our first match might not be the first occurance.
+		 * Consider: 0 0 0 1 1 1 2 2 2
+		 *
+		 * To maintain consistancy with standard lsearch semantics, we
+		 * must find the leftmost occurance of the pattern in the
+		 * list. Thus we don't just stop searching here. This
 		 * variation means that a search always makes log n
-		 * comparisons (normal binary search might "get lucky" with
-		 * an early comparison).
+		 * comparisons (normal binary search might "get lucky" with an
+		 * early comparison).
 		 */
+
 		index = i;
 		upper = i;
 	    } else if (match > 0) {
@@ -3492,83 +3175,138 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	 *   - our matching sense is negated
 	 *   - we're building a list of all matched items
 	 */
+
 	if (allMatches) {
-	    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+	    listPtr = Tcl_NewListObj(0, NULL);
 	}
 	for (i = offset; i < listc; i++) {
 	    match = 0;
+	    if (sortInfo.indexc != 0) {	    
+		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+		if (sortInfo.resultCode != TCL_OK) {
+		    if (listPtr != NULL) {
+			Tcl_DecrRefCount(listPtr);
+		    }
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
+		    return sortInfo.resultCode;
+		}
+	    } else {
+		itemPtr = listv[i];
+	    }
+		
 	    switch ((enum modes) mode) {
 	    case SORTED:
 	    case EXACT:
 		switch ((enum datatypes) dataType) {
 		case ASCII:
-		    bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
 		    if (length == elemLen) {
-			match = (memcmp(bytes, patternBytes,
-				(size_t) length) == 0);
+			/*
+			 * This split allows for more optimal compilation of
+			 * memcmp/strcasecmp.
+			 */
+
+			if (noCase) {
+			    match = (strcasecmp(bytes, patternBytes) == 0);
+			} else {
+			    match = (memcmp(bytes, patternBytes,
+				    (size_t) length) == 0);
+			}
 		    }
 		    break;
+
 		case DICTIONARY:
-		    bytes = Tcl_GetString(listv[i]);
+		    bytes = TclGetString(itemPtr);
 		    match = (DictionaryCompare(bytes, patternBytes) == 0);
 		    break;
+
 		case INTEGER:
-		    result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+		    result = TclGetIntFromObj(interp, itemPtr, &objInt);
 		    if (result != TCL_OK) {
-			if (listPtr) {
+			if (listPtr != NULL) {
 			    Tcl_DecrRefCount(listPtr);
 			}
+			if (sortInfo.indexc > 1) {
+			    ckfree((char *) sortInfo.indexv);
+			}
 			return result;
 		    }
 		    match = (objInt == patInt);
 		    break;
+
 		case REAL:
-		    result = Tcl_GetDoubleFromObj(interp, listv[i],
-			    &objDouble);
+		    result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
 		    if (result != TCL_OK) {
 			if (listPtr) {
 			    Tcl_DecrRefCount(listPtr);
 			}
+			if (sortInfo.indexc > 1) {
+			    ckfree((char *) sortInfo.indexv);
+			}
 			return result;
 		    }
 		    match = (objDouble == patDouble);
 		    break;
 		}
 		break;
+
 	    case GLOB:
-		match = Tcl_StringMatch(Tcl_GetString(listv[i]),
-			patternBytes);
+		match = Tcl_StringCaseMatch(TclGetString(itemPtr),
+			patternBytes, noCase);
 		break;
+
 	    case REGEXP:
-		match = Tcl_RegExpExecObj(interp, regexp, listv[i], 0, 0, 0);
+		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
 		if (match < 0) {
 		    Tcl_DecrRefCount(patObj);
-		    if (listPtr) {
+		    if (listPtr != NULL) {
 			Tcl_DecrRefCount(listPtr);
 		    }
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
 		    return TCL_ERROR;
 		}
 		break;
 	    }
+
 	    /*
-	     * Invert match condition for -not
+	     * Invert match condition for -not.
 	     */
+
 	    if (negatedMatch) {
 		match = !match;
 	    }
-	    if (match != 0) {
-		if (!allMatches) {
-		    index = i;
-		    break;
-		} else if (inlineReturn) {
-		    /*
-		     * Note that these appends are not expected to fail.
-		     */
-		    Tcl_ListObjAppendElement(interp, listPtr, listv[i]);
+	    if (!match) {
+		continue;
+	    }
+	    if (!allMatches) {
+		index = i;
+		break;
+	    } else if (inlineReturn) {
+		/*
+		 * Note that these appends are not expected to fail.
+		 */
+
+		if (returnSubindices && (sortInfo.indexc != 0)) {
+		    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
 		} else {
-		    Tcl_ListObjAppendElement(interp, listPtr,
-			    Tcl_NewIntObj(i));
+		    itemPtr = listv[i];
+		}
+		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+	    } else if (returnSubindices) {
+		int j;
+
+		itemPtr = Tcl_NewIntObj(i);
+		for (j=0 ; j<sortInfo.indexc ; j++) {
+		    Tcl_ListObjAppendElement(interp, itemPtr,
+			    Tcl_NewIntObj(sortInfo.indexv[j]));
 		}
+		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+	    } else {
+		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
 	    }
 	}
     }
@@ -3576,19 +3314,40 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     /*
      * Return everything or a single value.
      */
+
     if (allMatches) {
 	Tcl_SetObjResult(interp, listPtr);
     } else if (!inlineReturn) {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+	if (returnSubindices) {
+	    int j;
+
+	    itemPtr = Tcl_NewIntObj(index);
+	    for (j=0 ; j<sortInfo.indexc ; j++) {
+		Tcl_ListObjAppendElement(interp, itemPtr,
+			Tcl_NewIntObj(sortInfo.indexv[j]));
+	    }
+	    Tcl_SetObjResult(interp, itemPtr);
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+	}
     } else if (index < 0) {
 	/*
-	 * Is this superfluous?  The result should be a blank object
-	 * by default...
+	 * Is this superfluous? The result should be a blank object by
+	 * default...
 	 */
+
 	Tcl_SetObjResult(interp, Tcl_NewObj());
     } else {
 	Tcl_SetObjResult(interp, listv[index]);
     }
+
+    /*
+     * Cleanup the index list array.
+     */
+
+    if (sortInfo.indexc > 1) {
+	ckfree((char *) sortInfo.indexv);
+    }
     return TCL_OK;
 }
 
@@ -3597,8 +3356,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
  *
  * Tcl_LsetObjCmd --
  *
- *	This procedure is invoked to process the "lset" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "lset" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -3610,66 +3369,71 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
  */
 
 int
-Tcl_LsetObjCmd( clientData, interp, objc, objv )
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument values. */
+Tcl_LsetObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument values. */
 {
+    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
+    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
 
-    Tcl_Obj* listPtr;		/* Pointer to the list being altered. */
-    Tcl_Obj* finalValuePtr;	/* Value finally assigned to the variable */
-
-    /* Check parameter count */
+    /*
+     * Check parameter count.
+     */
 
-    if ( objc < 3 ) {
-	Tcl_WrongNumArgs( interp, 1, objv, "listVar index ?index...? value" );
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index...? value");
 	return TCL_ERROR;
     }
 
-    /* Look up the list variable's value */
+    /*
+     * Look up the list variable's value.
+     */
 
-    listPtr = Tcl_ObjGetVar2( interp, objv[ 1 ], (Tcl_Obj*) NULL,
-			      TCL_LEAVE_ERR_MSG );
-    if ( listPtr == NULL ) {
+    listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (listPtr == NULL) {
 	return TCL_ERROR;
     }
 
-    /* 
-     * Substitute the value in the value.  Return either the value or
-     * else an unshared copy of it.
+    /*
+     * Substitute the value in the value. Return either the value or else an
+     * unshared copy of it.
      */
 
-    if ( objc == 4 ) {
-	finalValuePtr = TclLsetList( interp, listPtr,
-				     objv[ 2 ], objv[ 3 ] );
+    if (objc == 4) {
+	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
     } else {
-	finalValuePtr = TclLsetFlat( interp, listPtr,
-				     objc-3, objv+2, objv[ objc-1 ] );
+	finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
+		objv[objc-1]);
     }
 
     /*
      * If substitution has failed, bail out.
      */
 
-    if ( finalValuePtr == NULL ) {
+    if (finalValuePtr == NULL) {
 	return TCL_ERROR;
     }
 
-    /* Finally, update the variable so that traces fire. */
+    /*
+     * Finally, update the variable so that traces fire.
+     */
 
-    listPtr = Tcl_ObjSetVar2( interp, objv[1], NULL, finalValuePtr,
-			      TCL_LEAVE_ERR_MSG );
-    Tcl_DecrRefCount( finalValuePtr );
-    if ( listPtr == NULL ) {
+    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
+	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(finalValuePtr);
+    if (listPtr == NULL) {
 	return TCL_ERROR;
     }
 
-    /* Return the new value of the variable as the interpreter result. */
+    /*
+     * Return the new value of the variable as the interpreter result.
+     */
 
-    Tcl_SetObjResult( interp, listPtr );
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
-
 }
 
 /*
@@ -3677,8 +3441,8 @@ Tcl_LsetObjCmd( clientData, interp, objc, objv )
  *
  * Tcl_LsortObjCmd --
  *
- *	This procedure is invoked to process the "lsort" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "lsort" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -3690,27 +3454,34 @@ Tcl_LsetObjCmd( clientData, interp, objc, objv )
  */
 
 int
-Tcl_LsortObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument values. */
+Tcl_LsortObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument values. */
 {
-    int i, index, unique;
-    Tcl_Obj *resultPtr;
-    int length;
-    Tcl_Obj *cmdPtr, **listObjPtrs;
-    SortElement *elementArray;
-    SortElement *elementPtr;        
-    SortInfo sortInfo;                  /* Information about this sort that
-                                         * needs to be passed to the 
-                                         * comparison function */
-    static CONST char *switches[] = {
+    int i, j, index, indices, length, nocase = 0, sortMode, indexc;
+    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
+    SortElement *elementArray, *elementPtr;
+    SortInfo sortInfo;		/* Information about this sort that needs to
+				 * be passed to the comparison function. */
+    static const char *switches[] = {
 	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-integer", "-real", "-unique", (char *) NULL
+	"-index", "-indices", "-integer", "-nocase", "-real", "-unique", NULL
+    };
+    enum Lsort_Switches {
+	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
+	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
+	LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE
     };
 
-    resultPtr = Tcl_GetObjResult(interp);
+    /*
+     * The subList array below holds pointers to temporary lists built during
+     * the merge sort. Element i of the array holds a list of length 2**i.
+     */
+#   define NUM_LISTS 30
+    SortElement *subList[NUM_LISTS+1];
+
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
 	return TCL_ERROR;
@@ -3722,199 +3493,312 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 
     sortInfo.isIncreasing = 1;
     sortInfo.sortMode = SORTMODE_ASCII;
-    sortInfo.index = SORTIDX_NONE;
+    sortInfo.indexv = NULL;
+    sortInfo.indexc = 0;
+    sortInfo.unique = 0;
     sortInfo.interp = interp;
-    sortInfo.resultCode = TCL_OK;
+    sortInfo.resultCode = TCL_OK;    
     cmdPtr = NULL;
-    unique = 0;
+    indices = 0;
     for (i = 1; i < objc-1; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
-		!= TCL_OK) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
+		&index) != TCL_OK) {
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    return TCL_ERROR;
 	}
-	switch (index) {
-	    case 0:			/* -ascii */
-		sortInfo.sortMode = SORTMODE_ASCII;
-		break;
-	    case 1:			/* -command */
-		if (i == (objc-2)) {
-		    Tcl_AppendToObj(resultPtr,
-			    "\"-command\" option must be followed by comparison command",
-			    -1);
-		    return TCL_ERROR;
+	switch ((enum Lsort_Switches) index) {
+	case LSORT_ASCII:
+	    sortInfo.sortMode = SORTMODE_ASCII;
+	    break;
+	case LSORT_COMMAND:
+	    if (i == (objc-2)) {
+		if (sortInfo.indexc > 1) {
+		    ckfree((char *) sortInfo.indexv);
 		}
-		sortInfo.sortMode = SORTMODE_COMMAND;
-		cmdPtr = objv[i+1];
-		i++;
-		break;
-	    case 2:			/* -decreasing */
-		sortInfo.isIncreasing = 0;
-		break;
-	    case 3:			/* -dictionary */
-		sortInfo.sortMode = SORTMODE_DICTIONARY;
+		Tcl_AppendResult(interp,
+			"\"-command\" option must be followed "
+			"by comparison command", NULL);
+		return TCL_ERROR;
+	    }
+	    sortInfo.sortMode = SORTMODE_COMMAND;
+	    cmdPtr = objv[i+1];
+	    i++;
+	    break;
+	case LSORT_DECREASING:
+	    sortInfo.isIncreasing = 0;
+	    break;
+	case LSORT_DICTIONARY:
+	    sortInfo.sortMode = SORTMODE_DICTIONARY;
+	    break;
+	case LSORT_INCREASING:
+	    sortInfo.isIncreasing = 1;
+	    break;
+	case LSORT_INDEX: {
+	    Tcl_Obj **indices;
+
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
+	    if (i == (objc-2)) {
+		Tcl_AppendResult(interp, "\"-index\" option must be "
+			"followed by list index", NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Take copy to prevent shimmering problems.
+	     */
+
+	    if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
+		    &indices) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch (sortInfo.indexc) {
+	    case 0:
+		sortInfo.indexv = NULL;
 		break;
-	    case 4:			/* -increasing */
-		sortInfo.isIncreasing = 1;
+	    case 1:
+		sortInfo.indexv = &sortInfo.singleIndex;
 		break;
-	    case 5:			/* -index */
-		if (i == (objc-2)) {
-		    Tcl_AppendToObj(resultPtr,
-			    "\"-index\" option must be followed by list index",
-			    -1);
-		    return TCL_ERROR;
-		}
-		if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
-			&sortInfo.index) != TCL_OK) {
+	    default:
+		sortInfo.indexv = (int *)
+			ckalloc(sizeof(int) * sortInfo.indexc);
+	    }
+
+	    /*
+	     * Fill the array by parsing each index. We don't know whether
+	     * their scale is sensible yet, but we at least perform the
+	     * syntactic check here.
+	     */
+
+	    for (j=0 ; j<sortInfo.indexc ; j++) {
+		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
+			&sortInfo.indexv[j]) != TCL_OK) {
+		    if (sortInfo.indexc > 1) {
+			ckfree((char *) sortInfo.indexv);
+		    }
+		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			    "\n    (-index option item number %d)", j));
 		    return TCL_ERROR;
 		}
-		i++;
-		break;
-	    case 6:			/* -integer */
-		sortInfo.sortMode = SORTMODE_INTEGER;
-		break;
-	    case 7:			/* -real */
-		sortInfo.sortMode = SORTMODE_REAL;
-		break;
-	    case 8:			/* -unique */
-		unique = 1;
-		break;
+	    }
+	    i++;
+	    break;
 	}
+	case LSORT_INTEGER:
+	    sortInfo.sortMode = SORTMODE_INTEGER;
+	    break;
+	case LSORT_NOCASE:
+	    nocase = 1;
+	    break;
+	case LSORT_REAL:
+	    sortInfo.sortMode = SORTMODE_REAL;
+	    break;
+	case LSORT_UNIQUE:
+	    sortInfo.unique = 1;
+	    break;
+	case LSORT_INDICES:
+	    indices = 1;
+	    break;
+	}
+    }
+    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
+	sortInfo.sortMode = SORTMODE_ASCII_NC;
     }
+
+    listObj = objv[objc-1];
+
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_Obj *newCommandPtr, *newObjPtr;
+
 	/*
-	 * The existing command is a list. We want to flatten it, append
-	 * two dummy arguments on the end, and replace these arguments
-	 * later.
+	 * When sorting using a command, we are reentrant and therefore might
+	 * have the representation of the list being sorted shimmered out from
+	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
+	 * 1675116]
 	 */
 
-        Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
-	Tcl_Obj *newObjPtr = Tcl_NewObj();
+	listObj = TclListObjCopy(interp, listObj);
+	if (listObj == NULL) {
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * The existing command is a list. We want to flatten it, append two
+	 * dummy arguments on the end, and replace these arguments later.
+	 */
 
+	newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+	TclNewObj(newObjPtr);
 	Tcl_IncrRefCount(newCommandPtr);
 	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
 		!= TCL_OK) {
-	    Tcl_DecrRefCount(newCommandPtr);
+	    TclDecrRefCount(newCommandPtr);
+	    TclDecrRefCount(listObj);
 	    Tcl_IncrRefCount(newObjPtr);
-	    Tcl_DecrRefCount(newObjPtr);
+	    TclDecrRefCount(newObjPtr);
+	    if (sortInfo.indexc > 1) {
+		ckfree((char *) sortInfo.indexv);
+	    }
 	    return TCL_ERROR;
 	}
 	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
 	sortInfo.compareCmdPtr = newCommandPtr;
     }
 
-    sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
+    sortInfo.resultCode = TclListObjGetElements(interp, listObj,
 	    &length, &listObjPtrs);
     if (sortInfo.resultCode != TCL_OK || length <= 0) {
 	goto done;
     }
-    elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
-    for (i=0; i < length; i++){
-	elementArray[i].objPtr = listObjPtrs[i];
-	elementArray[i].count = 0;
-	elementArray[i].nextPtr = &elementArray[i+1];
-
+    sortInfo.numElements = length;
+    
+    indexc = sortInfo.indexc;
+    sortMode = sortInfo.sortMode;
+    if ((sortMode == SORTMODE_ASCII_NC)
+	    || (sortMode == SORTMODE_DICTIONARY)) {
 	/*
-	 * When sorting using a command, we are reentrant and therefore might
-	 * have the representation of the list being sorted shimmered out from
-	 * underneath our feet. Increment the reference counts of the elements
-	 * to sort to prevent this. [Bug 1675116]
+	 * For this function's purpose all string-based modes are equivalent
 	 */
+	
+	sortMode = SORTMODE_ASCII;
+    }
 
-	Tcl_IncrRefCount(elementArray[i].objPtr);
+    /*
+     * Initialize the sublists. After the following loop, subList[i] will
+     * contain a sorted sublist of length 2**i. Use one extra subList at the
+     * end, always at NULL, to indicate the end of the lists.
+     */
+    
+    for (j=0 ; j<=NUM_LISTS ; j++) {
+	subList[j] = NULL;
     }
-    elementArray[length-1].nextPtr = NULL;
-    elementPtr = MergeSort(elementArray, &sortInfo);
-    if (sortInfo.resultCode == TCL_OK) {
-	/*
-	 * Note: must clear the interpreter's result object: it could
-	 * have been set by the -command script.
-	 */
 
-	Tcl_ResetResult(interp);
-	resultPtr = Tcl_GetObjResult(interp);
-	if (unique) {
-	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
-		if (elementPtr->count == 0) {
-		    Tcl_ListObjAppendElement(interp, resultPtr,
-			    elementPtr->objPtr);
-		}
+    /*
+     * The following loop creates a SortElement for each list element and
+     * begins sorting it into the sublists as it appears.
+     */
+
+    elementArray = (SortElement *) ckalloc( length * sizeof(SortElement));
+
+    for (i=0; i < length; i++){
+	if (indexc) {
+	    /*
+	     * If this is an indexed sort, retrieve the corresponding element
+	     */
+	    indexPtr = SelectObjFromSublist(listObjPtrs[i], &sortInfo);
+	    if (sortInfo.resultCode != TCL_OK) {
+		goto done1;
 	    }
 	} else {
-	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
-		Tcl_ListObjAppendElement(interp, resultPtr,
-			elementPtr->objPtr);
+	    indexPtr = listObjPtrs[i];
+	}
+
+	/*
+	 * Determine the "value" of this object for sorting purposes
+	 */
+	
+	if (sortMode == SORTMODE_ASCII) {
+	    elementArray[i].index.strValuePtr = TclGetString(indexPtr);
+	} else if (sortMode == SORTMODE_INTEGER) {
+	    long a;
+	    if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+		sortInfo.resultCode = TCL_ERROR;
+		goto done1;
+	    }
+	    elementArray[i].index.intValue = a;
+	} else if (sortInfo.sortMode == SORTMODE_REAL) {
+	    double a;
+	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+		sortInfo.resultCode = TCL_ERROR;
+		goto done1;
 	    }
+	    elementArray[i].index.doubleValue = a;
+	} else {
+	    elementArray[i].index.objValuePtr = indexPtr;
 	}
-    }
-    for (i=0; i<length; i++) {
-	Tcl_DecrRefCount(elementArray[i].objPtr);
-    }
-    ckfree((char*) elementArray);
 
-    done:
-    if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	Tcl_DecrRefCount(sortInfo.compareCmdPtr);
-	sortInfo.compareCmdPtr = NULL;
+	/*
+	 * Determine the representation of this element in the result: either
+	 * the objPtr itself, or its index in the original list.
+	 */
+	
+	elementArray[i].objPtr = (indices ? INT2PTR(i) : listObjPtrs[i]);
+
+	/*
+	 * Merge this element in the pre-existing sublists (and merge together
+	 * sublists when we have two of the same size).
+	 */
+	
+	elementArray[i].nextPtr = NULL;
+	elementPtr = &elementArray[i];
+	for (j=0 ; subList[j] ; j++) {
+	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
+	    subList[j] = NULL;
+	}
+	if (j >= NUM_LISTS) {
+	    j = NUM_LISTS-1;
+	}
+	subList[j] = elementPtr;
     }
-    return sortInfo.resultCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MergeSort -
- *
- *	This procedure sorts a linked list of SortElement structures
- *	use the merge-sort algorithm.
- *
- * Results:
- *      A pointer to the head of the list after sorting is returned.
- *
- * Side effects:
- *	None, unless a user-defined comparison command does something
- *	weird.
- *
- *----------------------------------------------------------------------
- */
 
-static SortElement *
-MergeSort(headPtr, infoPtr)
-    SortElement *headPtr;               /* First element on the list */
-    SortInfo *infoPtr;                  /* Information needed by the
-                                         * comparison operator */
-{
     /*
-     * The subList array below holds pointers to temporary lists built
-     * during the merge sort.  Element i of the array holds a list of
-     * length 2**i.
+     * Merge all sublists
      */
+    
+    elementPtr = subList[0];
+    for (j=1 ; j<NUM_LISTS ; j++) {
+	elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
+    }
 
-#   define NUM_LISTS 30
-    SortElement *subList[NUM_LISTS];
-    SortElement *elementPtr;
-    int i;
 
-    for(i = 0; i < NUM_LISTS; i++){
-        subList[i] = NULL;
-    }
-    while (headPtr != NULL) {
-	elementPtr = headPtr;
-	headPtr = headPtr->nextPtr;
-	elementPtr->nextPtr = 0;
-	for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
-	    elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
-	    subList[i] = NULL;
-	}
-	if (i >= NUM_LISTS) {
-	    i = NUM_LISTS-1;
+    /*
+     * Now store the sorted elements in the result list.
+     */
+    
+    if (sortInfo.resultCode == TCL_OK) {
+	List *listRepPtr;
+	Tcl_Obj **newArray, *objPtr;
+	int i;
+	
+	resultPtr = Tcl_NewListObj(sortInfo.numElements, NULL);
+	listRepPtr = ListRepPtr(resultPtr);
+	newArray = &listRepPtr->elements;
+	if (indices) {
+	    for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
+		objPtr = Tcl_NewIntObj(PTR2INT(elementPtr->objPtr));
+		newArray[i++] = objPtr;
+		Tcl_IncrRefCount(objPtr);
+	    }
+	} else {
+	    for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
+		objPtr = elementPtr->objPtr;
+		newArray[i++] = objPtr;
+		Tcl_IncrRefCount(objPtr);
+	    }
 	}
-	subList[i] = elementPtr;
+	listRepPtr->elemCount = i;
+	Tcl_SetObjResult(interp, resultPtr);
     }
-    elementPtr = NULL;
-    for (i = 0; i < NUM_LISTS; i++){
-        elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+
+  done1:
+    ckfree((char *)elementArray);
+
+  done:
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	TclDecrRefCount(sortInfo.compareCmdPtr);
+	TclDecrRefCount(listObj);
+	sortInfo.compareCmdPtr = NULL;
+    }
+    if (sortInfo.indexc > 1) {
+	ckfree((char *) sortInfo.indexv);
     }
-    return elementPtr;
+    return sortInfo.resultCode;
 }
 
 /*
@@ -3926,65 +3810,91 @@ MergeSort(headPtr, infoPtr)
  *	into a single sorted list.
  *
  * Results:
- *      The unified list of SortElement structures.
+ *	The unified list of SortElement structures.
  *
  * Side effects:
- *	None, unless a user-defined comparison command does something
- *	weird.
- *
+ *      If infoPtr->unique is set then infoPtr->numElements may be updated.
+ *	Possibly others, if a user-defined comparison command does something
+ *      weird. 
+ *
+ * Note:
+ *      If infoPtr->unique is set, the merge assumes that there are no
+ *	"repeated" elements in each of the left and right lists. In that case,
+ *	if any element of the left list is equivalent to one in the right list
+ *	it is omitted from the merged list.
+ *      This simplified mechanism works because of the special way
+ *	our MergeSort creates the sublists to be merged and will fail to
+ *	eliminate all repeats in the general case where they are already
+ *	present in either the left or right list. A general code would need to
+ *	skip adjacent initial repeats in the left and right lists before
+ *	comparing their initial elements, at each step. 
  *----------------------------------------------------------------------
  */
 
 static SortElement *
-MergeLists(leftPtr, rightPtr, infoPtr)
-    SortElement *leftPtr;               /* First list to be merged; may be
-					 * NULL. */
-    SortElement *rightPtr;              /* Second list to be merged; may be
-					 * NULL. */
-    SortInfo *infoPtr;                  /* Information needed by the
-                                         * comparison operator. */
+MergeLists(
+    SortElement *leftPtr,	/* First list to be merged; may be NULL. */
+    SortElement *rightPtr,	/* Second list to be merged; may be NULL. */
+    SortInfo *infoPtr)		/* Information needed by the comparison
+				 * operator. */
 {
-    SortElement *headPtr;
-    SortElement *tailPtr;
+    SortElement *headPtr, *tailPtr;
     int cmp;
 
     if (leftPtr == NULL) {
-        return rightPtr;
+	return rightPtr;
     }
     if (rightPtr == NULL) {
-        return leftPtr;
+	return leftPtr;
     }
-    cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
-    if (cmp > 0) {
+    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+    if (cmp > 0 || (cmp == 0 && infoPtr->unique)) {
+	if (cmp == 0) {
+	    infoPtr->numElements--;
+	    leftPtr = leftPtr->nextPtr;
+	}
 	tailPtr = rightPtr;
 	rightPtr = rightPtr->nextPtr;
     } else {
-	if (cmp == 0) {
-	    leftPtr->count++;
-	}
 	tailPtr = leftPtr;
 	leftPtr = leftPtr->nextPtr;
     }
     headPtr = tailPtr;
-    while ((leftPtr != NULL) && (rightPtr != NULL)) {
-	cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
-	if (cmp > 0) {
-	    tailPtr->nextPtr = rightPtr;
-	    tailPtr = rightPtr;
-	    rightPtr = rightPtr->nextPtr;
-	} else {
-	    if (cmp == 0) {
-		leftPtr->count++;
+    if (!infoPtr->unique) {
+	while ((leftPtr != NULL) && (rightPtr != NULL)) {
+	    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+	    if (cmp > 0) {
+		tailPtr->nextPtr = rightPtr;
+		tailPtr = rightPtr;
+		rightPtr = rightPtr->nextPtr;
+	    } else {
+		tailPtr->nextPtr = leftPtr;
+		tailPtr = leftPtr;
+		leftPtr = leftPtr->nextPtr;
+	    }
+	}
+    } else {
+	while ((leftPtr != NULL) && (rightPtr != NULL)) {
+	    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
+	    if (cmp >= 0) {
+		if (cmp == 0) {
+		    infoPtr->numElements--;
+		    leftPtr = leftPtr->nextPtr;
+		}
+		tailPtr->nextPtr = rightPtr;
+		tailPtr = rightPtr;
+		rightPtr = rightPtr->nextPtr;
+	    } else {
+		tailPtr->nextPtr = leftPtr;
+		tailPtr = leftPtr;
+		leftPtr = leftPtr->nextPtr;
 	    }
-	    tailPtr->nextPtr = leftPtr;
-	    tailPtr = leftPtr;
-	    leftPtr = leftPtr->nextPtr;
 	}
     }
     if (leftPtr != NULL) {
-       tailPtr->nextPtr = leftPtr;
+	tailPtr->nextPtr = leftPtr;
     } else {
-       tailPtr->nextPtr = rightPtr;
+	tailPtr->nextPtr = rightPtr;
     }
     return headPtr;
 }
@@ -3998,163 +3908,98 @@ MergeLists(leftPtr, rightPtr, infoPtr)
  *	ordering between two elements.
  *
  * Results:
- *      A negative results means the the first element comes before the
- *      second, and a positive results means that the second element
- *      should come first.  A result of zero means the two elements
- *      are equal and it doesn't matter which comes first.
+ *	A negative results means the the first element comes before the
+ *	second, and a positive results means that the second element should
+ *	come first. A result of zero means the two elements are equal and it
+ *	doesn't matter which comes first.
  *
  * Side effects:
- *	None, unless a user-defined comparison command does something
- *	weird.
+ *	None, unless a user-defined comparison command does something weird.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SortCompare(objPtr1, objPtr2, infoPtr)
-    Tcl_Obj *objPtr1, *objPtr2;		/* Values to be compared. */
-    SortInfo *infoPtr;                  /* Information passed from the
-                                         * top-level "lsort" command */
+SortCompare(
+    SortElement *elemPtr1, SortElement *elemPtr2,
+				/* Values to be compared. */
+    SortInfo *infoPtr)		/* Information passed from the top-level
+				 * "lsort" command. */
 {
-    int order, listLen, index;
-    Tcl_Obj *objPtr;
-    char buffer[TCL_INTEGER_SPACE];
-
-    order = 0;
-    if (infoPtr->resultCode != TCL_OK) {
-	/*
-	 * Once an error has occurred, skip any future comparisons
-	 * so as to preserve the error message in sortInterp->result.
-	 */
-
-	return order;
-    }
-    if (infoPtr->index != SORTIDX_NONE) {
-	/*
-	 * The "-index" option was specified.  Treat each object as a
-	 * list, extract the requested element from each list, and
-	 * compare the elements, not the lists.  "end"-relative indices
-	 * are signaled here with large negative values.
-	 */
-
-	if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (infoPtr->index < SORTIDX_NONE) {
-	    index = listLen + infoPtr->index + 1;
-	} else {
-	    index = infoPtr->index;
-	}
+    int order = 0;
 
-	if (Tcl_ListObjIndex(infoPtr->interp, objPtr1, index, &objPtr)
-		!= TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (objPtr == NULL) {
-	    objPtr = objPtr1;
-	    missingElement:
-	    TclFormatInt(buffer, infoPtr->index);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
-			"element ", buffer, " missing from sublist \"",
-			Tcl_GetString(objPtr), "\"", (char *) NULL);
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	objPtr1 = objPtr;
-
-	if (Tcl_ListObjLength(infoPtr->interp, objPtr2, &listLen) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (infoPtr->index < SORTIDX_NONE) {
-	    index = listLen + infoPtr->index + 1;
-	} else {
-	    index = infoPtr->index;
-	}
-
-	if (Tcl_ListObjIndex(infoPtr->interp, objPtr2, index, &objPtr)
-		!= TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (objPtr == NULL) {
-	    objPtr = objPtr2;
-	    goto missingElement;
-	}
-	objPtr2 = objPtr;
-    }
     if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
+	order = strcmp(elemPtr1->index.strValuePtr,
+		elemPtr2->index.strValuePtr);
+    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
+	order = strcasecmp(elemPtr1->index.strValuePtr,
+		elemPtr2->index.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
-	order = DictionaryCompare(
-		Tcl_GetString(objPtr1),	Tcl_GetString(objPtr2));
+	order = DictionaryCompare(elemPtr1->index.strValuePtr,
+		elemPtr2->index.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
 	long a, b;
 
-	if ((Tcl_GetLongFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
-		|| (Tcl_GetLongFromObj(infoPtr->interp, objPtr2, &b)
-		!= TCL_OK)) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (a > b) {
-	    order = 1;
-	} else if (b > a) {
-	    order = -1;
-	}
+	a = elemPtr1->index.intValue;
+	b = elemPtr2->index.intValue;
+	order = ((a >= b) - (a <= b));
     } else if (infoPtr->sortMode == SORTMODE_REAL) {
 	double a, b;
 
-	if ((Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
-	      || (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b)
-		      != TCL_OK)) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (a > b) {
-	    order = 1;
-	} else if (b > a) {
-	    order = -1;
-	}
+	a = elemPtr1->index.doubleValue;
+	b = elemPtr2->index.doubleValue;
+	order = ((a >= b) - (a <= b));
     } else {
 	Tcl_Obj **objv, *paramObjv[2];
 	int objc;
+	Tcl_Obj *objPtr1, *objPtr2;
+
+	if (infoPtr->resultCode != TCL_OK) {
+	    /*
+	     * Once an error has occurred, skip any future comparisons so as
+	     * to preserve the error message in sortInterp->result.
+	     */
+	    
+	    return 0;
+	}
+
 
+	objPtr1 = elemPtr1->index.objValuePtr;
+	objPtr2 = elemPtr2->index.objValuePtr;
+	
 	paramObjv[0] = objPtr1;
 	paramObjv[1] = objPtr2;
 
-  	/*
- 	 * We made space in the command list for the two things to
-	 * compare. Replace them and evaluate the result.
+	/*
+	 * We made space in the command list for the two things to compare.
+	 * Replace them and evaluate the result.
 	 */
 
-	Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+	TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
 	Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
 		2, 2, paramObjv);
-   	Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+	TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
 		&objc, &objv);
 
 	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
-  
-  	if (infoPtr->resultCode != TCL_OK) {
+
+	if (infoPtr->resultCode != TCL_OK) {
 	    Tcl_AddErrorInfo(infoPtr->interp,
 		    "\n    (-compare command)");
-	    return order;
+	    return 0;
 	}
 
 	/*
 	 * Parse the result of the command.
 	 */
 
-	if (Tcl_GetIntFromObj(infoPtr->interp,
+	if (TclGetIntFromObj(infoPtr->interp,
 		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
 	    Tcl_ResetResult(infoPtr->interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
-		    "-compare command returned non-integer result", -1);
+	    Tcl_AppendResult(infoPtr->interp,
+		    "-compare command returned non-integer result", NULL);
 	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
+	    return 0;
 	}
     }
     if (!infoPtr->isIncreasing) {
@@ -4168,18 +4013,18 @@ SortCompare(objPtr1, objPtr2, infoPtr)
  *
  * DictionaryCompare
  *
- *	This function compares two strings as if they were being used in
- *	an index or card catalog.  The case of alphabetic characters is
- *	ignored, except to break ties.  Thus "B" comes before "b" but
- *	after "a".  Also, integers embedded in the strings compare in
- *	numerical order.  In other words, "x10y" comes after "x9y", not
- *      before it as it would when using strcmp().
+ *	This function compares two strings as if they were being used in an
+ *	index or card catalog. The case of alphabetic characters is ignored,
+ *	except to break ties. Thus "B" comes before "b" but after "a". Also,
+ *	integers embedded in the strings compare in numerical order. In other
+ *	words, "x10y" comes after "x9y", not * before it as it would when
+ *	using strcmp().
  *
  * Results:
- *      A negative result means that the first element comes before the
- *      second, and a positive result means that the second element
- *      should come first.  A result of zero means the two elements
- *      are equal and it doesn't matter which comes first.
+ *	A negative result means that the first element comes before the
+ *	second, and a positive result means that the second element should
+ *	come first. A result of zero means the two elements are equal and it
+ *	doesn't matter which comes first.
  *
  * Side effects:
  *	None.
@@ -4188,22 +4033,21 @@ SortCompare(objPtr1, objPtr2, infoPtr)
  */
 
 static int
-DictionaryCompare(left, right)
-    char *left, *right;          /* The strings to compare */
+DictionaryCompare(
+    char *left, char *right)	/* The strings to compare. */
 {
     Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
     int diff, zeros;
     int secondaryDiff = 0;
 
     while (1) {
-	if (isdigit(UCHAR(*right)) /* INTL: digit */
-		&& isdigit(UCHAR(*left))) { /* INTL: digit */
+	if (isdigit(UCHAR(*right))		/* INTL: digit */
+		&& isdigit(UCHAR(*left))) {	/* INTL: digit */
 	    /*
-	     * There are decimal numbers embedded in the two
-	     * strings.  Compare them as numbers, rather than
-	     * strings.  If one number has more leading zeros than
-	     * the other, the number with more leading zeros sorts
-	     * later, but only as a secondary choice.
+	     * There are decimal numbers embedded in the two strings. Compare
+	     * them as numbers, rather than strings. If one number has more
+	     * leading zeros than the other, the number with more leading
+	     * zeros sorts later, but only as a secondary choice.
 	     */
 
 	    zeros = 0;
@@ -4220,10 +4064,10 @@ DictionaryCompare(left, right)
 	    }
 
 	    /*
-	     * The code below compares the numbers in the two
-	     * strings without ever converting them to integers.  It
-	     * does this by first comparing the lengths of the
-	     * numbers and then comparing the digit values.
+	     * The code below compares the numbers in the two strings without
+	     * ever converting them to integers. It does this by first
+	     * comparing the lengths of the numbers and then comparing the
+	     * digit values.
 	     */
 
 	    diff = 0;
@@ -4233,13 +4077,13 @@ DictionaryCompare(left, right)
 		}
 		right++;
 		left++;
-		if (!isdigit(UCHAR(*right))) { /* INTL: digit */
-		    if (isdigit(UCHAR(*left))) { /* INTL: digit */
+		if (!isdigit(UCHAR(*right))) {		/* INTL: digit */
+		    if (isdigit(UCHAR(*left))) {	/* INTL: digit */
 			return 1;
 		    } else {
 			/*
-			 * The two numbers have the same length. See
-			 * if their values are different.
+			 * The two numbers have the same length. See if their
+			 * values are different.
 			 */
 
 			if (diff != 0) {
@@ -4247,7 +4091,7 @@ DictionaryCompare(left, right)
 			}
 			break;
 		    }
-		} else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
+		} else if (!isdigit(UCHAR(*left))) {	/* INTL: digit */
 		    return -1;
 		}
 	    }
@@ -4255,7 +4099,7 @@ DictionaryCompare(left, right)
 	}
 
 	/*
-	 * Convert character to Unicode for comparison purposes.  If either
+	 * Convert character to Unicode for comparison purposes. If either
 	 * string is at the terminating null, do a byte-wise comparison and
 	 * bail out immediately.
 	 */
@@ -4263,12 +4107,14 @@ DictionaryCompare(left, right)
 	if ((*left != '\0') && (*right != '\0')) {
 	    left += Tcl_UtfToUniChar(left, &uniLeft);
 	    right += Tcl_UtfToUniChar(right, &uniRight);
+
 	    /*
 	     * Convert both chars to lower for the comparison, because
-	     * dictionary sorts are case insensitve.  Covert to lower, not
+	     * dictionary sorts are case insensitve. Covert to lower, not
 	     * upper, so chars between Z and a will sort before A (where most
-	     * other interesting punctuations occur)
+	     * other interesting punctuations occur).
 	     */
+
 	    uniLeftLower = Tcl_UniCharToLower(uniLeft);
 	    uniRightLower = Tcl_UniCharToLower(uniRight);
 	} else {
@@ -4276,18 +4122,18 @@ DictionaryCompare(left, right)
 	    break;
 	}
 
-        diff = uniLeftLower - uniRightLower;
-        if (diff) {
+	diff = uniLeftLower - uniRightLower;
+	if (diff) {
 	    return diff;
-	} else if (secondaryDiff == 0) {
-	    if (Tcl_UniCharIsUpper(uniLeft) &&
-		    Tcl_UniCharIsLower(uniRight)) {
+	}
+	if (secondaryDiff == 0) {
+	    if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
 		secondaryDiff = -1;
 	    } else if (Tcl_UniCharIsUpper(uniRight)
 		    && Tcl_UniCharIsLower(uniLeft)) {
 		secondaryDiff = 1;
 	    }
-        }
+	}
     }
     if (diff == 0) {
 	diff = secondaryDiff;
@@ -4296,10 +4142,90 @@ DictionaryCompare(left, right)
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * SelectObjFromSublist --
+ *
+ *	This procedure is invoked from lsearch and SortCompare. It is used for
+ *	implementing the -index option, for the lsort and lsearch commands.
+ *
+ * Results:
+ *	Returns NULL if a failure occurs, and sets the result in the infoPtr.
+ *	Otherwise returns the Tcl_Obj* to the item.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Note:
+ *	No reference counting is done, as the result is only used internally
+ *	and never passed directly to user code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+SelectObjFromSublist(
+    Tcl_Obj *objPtr,		/* Obj to select sublist from. */
+    SortInfo *infoPtr)		/* Information passed from the top-level
+				 * "lsearch" or "lsort" command. */
+{
+    int i;
+
+    /*
+     * Quick check for case when no "-index" option is there.
+     */
+
+    if (infoPtr->indexc == 0) {
+	return objPtr;
+    }
+
+    /*
+     * Iterate over the indices, traversing through the nested sublists as we
+     * go.
+     */
+
+    for (i=0 ; i<infoPtr->indexc ; i++) {
+	int listLen, index;
+	Tcl_Obj *currentObj;
+
+	if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+	index = infoPtr->indexv[i];
+
+	/*
+	 * Adjust for end-based indexing.
+	 */
+
+	if (index < SORTIDX_NONE) {
+	    index += listLen + 1;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
+		&currentObj) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+	if (currentObj == NULL) {
+	    char buffer[TCL_INTEGER_SPACE];
+
+	    TclFormatInt(buffer, index);
+	    Tcl_AppendResult(infoPtr->interp, "element ", buffer,
+		    " missing from sublist \"", TclGetString(objPtr), "\"",
+		    NULL);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+	objPtr = currentObj;
+    }
+    return objPtr;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 4ada397..0ad77aa 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1,153 +1,34 @@
-/* 
+/*
  * tclCmdMZ.c --
  *
- *	This file contains the top-level command routines for most of
- *	the Tcl built-in commands whose names begin with the letters
- *	M to Z.  It contains only commands in the generic core (i.e.
- *	those that don't depend much upon UNIX facilities).
+ *	This file contains the top-level command routines for most of the Tcl
+ *	built-in commands whose names begin with the letters M to Z. It
+ *	contains only commands in the generic core (i.e. those that don't
+ *	depend much upon UNIX facilities).
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 Scriptics Corporation.
  * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2003 Donal K. Fellows.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclRegexp.h"
-#include "tclCompile.h"
-
-/*
- * Structures used to hold information about variable traces:
- */
-
-typedef struct {
-    int flags;			/* Operations for which Tcl command is
-				 * to be invoked. */
-    size_t length;		/* Number of non-NULL chars. in command. */
-    char command[4];		/* Space for Tcl command to invoke.  Actual
-				 * size will be as large as necessary to
-				 * hold command.  This field must be the
-				 * last in the structure, so that it can
-				 * be larger than 4 bytes. */
-} TraceVarInfo;
-
-typedef struct {
-    VarTrace trace;
-    TraceVarInfo tvar;
-} CompoundVarTrace;
-
-/*
- * Structure used to hold information about command traces:
- */
-
-typedef struct {
-    int flags;			/* Operations for which Tcl command is
-				 * to be invoked. */
-    size_t length;		/* Number of non-NULL chars. in command. */
-    Tcl_Trace stepTrace;        /* Used for execution traces, when tracing
-                                 * inside the given command */
-    int startLevel;             /* Used for bookkeeping with step execution
-                                 * traces, store the level at which the step
-                                 * trace was invoked */
-    char *startCmd;             /* Used for bookkeeping with step execution
-                                 * traces, store the command name which invoked
-                                 * step trace */
-    int curFlags;               /* Trace flags for the current command */
-    int curCode;                /* Return code for the current command */
-    int refCount;               /* Used to ensure this structure is
-                                 * not deleted too early.  Keeps track
-                                 * of how many pieces of code have
-                                 * a pointer to this structure. */
-    char command[4];		/* Space for Tcl command to invoke.  Actual
-				 * size will be as large as necessary to
-				 * hold command.  This field must be the
-				 * last in the structure, so that it can
-				 * be larger than 4 bytes. */
-} TraceCommandInfo;
-
-/* 
- * Used by command execution traces.  Note that we assume in the code
- * that the first two defines are exactly 4 times the
- * 'TCL_TRACE_ENTER_EXEC' and 'TCL_TRACE_LEAVE_EXEC' constants.
- * 
- * TCL_TRACE_ENTER_DURING_EXEC  - Trace each command inside the command
- *                                currently being traced, before execution.
- * TCL_TRACE_LEAVE_DURING_EXEC  - Trace each command inside the command
- *                                currently being traced, after execution.
- * TCL_TRACE_ANY_EXEC           - OR'd combination of all EXEC flags.
- * TCL_TRACE_EXEC_IN_PROGRESS   - The callback procedure on this trace
- *                                is currently executing.  Therefore we
- *                                don't let further traces execute.
- * TCL_TRACE_EXEC_DIRECT        - This execution trace is triggered directly
- *                                by the command being traced, not because
- *                                of an internal trace.
- * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also
- * be used in command execution traces.
- */
-#define TCL_TRACE_ENTER_DURING_EXEC	4
-#define TCL_TRACE_LEAVE_DURING_EXEC	8
-#define TCL_TRACE_ANY_EXEC              15
-#define TCL_TRACE_EXEC_IN_PROGRESS      0x10
-#define TCL_TRACE_EXEC_DIRECT           0x20
-
-/*
- * Forward declarations for procedures defined in this file:
- */
-
-typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
-	int optionIndex, int objc, Tcl_Obj *CONST objv[]));
-
-Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
-Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
-Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
 
-/* 
- * Each subcommand has a number of 'types' to which it can apply.
- * Currently 'execution', 'command' and 'variable' are the only
- * types supported.  These three arrays MUST be kept in sync!
- * In the future we may provide an API to add to the list of
- * supported trace types.
- */
-static CONST char *traceTypeOptions[] = {
-    "execution", "command", "variable", (char*) NULL
-};
-static Tcl_TraceTypeObjCmd *CONST traceSubCmds[] = {
-    TclTraceExecutionObjCmd,
-    TclTraceCommandObjCmd,
-    TclTraceVariableObjCmd
-};
-
-/*
- * Declarations for local procedures to this file:
- */
-static int              CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
-                            Trace *tracePtr, Command *cmdPtr,
-                            CONST char *command, int numChars,
-                            int objc, Tcl_Obj *CONST objv[]));
-static char *		TraceVarProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, CONST char *name1, 
-                            CONST char *name2, int flags));
-static void		TraceCommandProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, CONST char *oldName,
-                            CONST char *newName, int flags));
-static Tcl_CmdObjTraceProc TraceExecutionProc;
-
-#ifdef TCL_TIP280
-static void             ListLines _ANSI_ARGS_((Tcl_Obj* listObj, int line,
-					       int n, int* lines,
-					       Tcl_Obj* const* elems));
-#endif
+static int		UniCharIsAscii(int character);
+static int		UniCharIsHexDigit(int character);
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_PwdObjCmd --
  *
- *	This procedure is invoked to process the "pwd" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "pwd" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -158,13 +39,12 @@ static void             ListLines _ANSI_ARGS_((Tcl_Obj* listObj, int line,
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_PwdObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_PwdObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *retVal;
 
@@ -187,8 +67,8 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_RegexpObjCmd --
  *
- *	This procedure is invoked to process the "regexp" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "regexp" Tcl command. See
+ *	the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -199,23 +79,22 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_RegexpObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_RegexpObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, indices, match, about, offset, all, doinline, numMatchesSaved;
-    int cflags, eflags, stringLength;
+    int cflags, eflags, stringLength, matchLength;
     Tcl_RegExp regExpr;
-    Tcl_Obj *objPtr, *resultPtr;
+    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
     Tcl_RegExpInfo info;
-    static CONST char *options[] = {
+    static const char *options[] = {
 	"-all",		"-about",	"-indices",	"-inline",
 	"-expanded",	"-line",	"-linestop",	"-lineanchor",
-	"-nocase",	"-start",	"--",		(char *) NULL
+	"-nocase",	"-start",	"--",		NULL
     };
     enum options {
 	REGEXP_ALL,	REGEXP_ABOUT,	REGEXP_INDICES,	REGEXP_INLINE,
@@ -223,165 +102,180 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 	REGEXP_NOCASE,	REGEXP_START,	REGEXP_LAST
     };
 
-    indices	= 0;
-    about	= 0;
-    cflags	= TCL_REG_ADVANCED;
-    eflags	= 0;
-    offset	= 0;
-    all		= 0;
-    doinline	= 0;
-    
+    indices = 0;
+    about = 0;
+    cflags = TCL_REG_ADVANCED;
+    eflags = 0;
+    offset = 0;
+    all = 0;
+    doinline = 0;
+
     for (i = 1; i < objc; i++) {
 	char *name;
 	int index;
 
-	name = Tcl_GetString(objv[i]);
+	name = TclGetString(objv[i]);
 	if (name[0] != '-') {
 	    break;
 	}
 	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
 		&index) != TCL_OK) {
-	    return TCL_ERROR;
+	    goto optionError;
 	}
 	switch ((enum options) index) {
-	    case REGEXP_ALL: {
-		all = 1;
-		break;
-	    }
-	    case REGEXP_INDICES: {
-		indices = 1;
-		break;
-	    }
-	    case REGEXP_INLINE: {
-		doinline = 1;
-		break;
-	    }
-	    case REGEXP_NOCASE: {
-		cflags |= TCL_REG_NOCASE;
-		break;
-	    }
-	    case REGEXP_ABOUT: {
-		about = 1;
-		break;
-	    }
-	    case REGEXP_EXPANDED: {
-		cflags |= TCL_REG_EXPANDED;
-		break;
-	    }
-	    case REGEXP_LINE: {
-		cflags |= TCL_REG_NEWLINE;
-		break;
-	    }
-	    case REGEXP_LINESTOP: {
-		cflags |= TCL_REG_NLSTOP;
-		break;
-	    }
-	    case REGEXP_LINEANCHOR: {
-		cflags |= TCL_REG_NLANCH;
-		break;
+	case REGEXP_ALL:
+	    all = 1;
+	    break;
+	case REGEXP_INDICES:
+	    indices = 1;
+	    break;
+	case REGEXP_INLINE:
+	    doinline = 1;
+	    break;
+	case REGEXP_NOCASE:
+	    cflags |= TCL_REG_NOCASE;
+	    break;
+	case REGEXP_ABOUT:
+	    about = 1;
+	    break;
+	case REGEXP_EXPANDED:
+	    cflags |= TCL_REG_EXPANDED;
+	    break;
+	case REGEXP_LINE:
+	    cflags |= TCL_REG_NEWLINE;
+	    break;
+	case REGEXP_LINESTOP:
+	    cflags |= TCL_REG_NLSTOP;
+	    break;
+	case REGEXP_LINEANCHOR:
+	    cflags |= TCL_REG_NLANCH;
+	    break;
+	case REGEXP_START: {
+	    int temp;
+	    if (++i >= objc) {
+		goto endOfForLoop;
 	    }
-	    case REGEXP_START: {
-		if (++i >= objc) {
-		    goto endOfForLoop;
-		}
-		if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (offset < 0) {
-		    offset = 0;
-		}
-		break;
+	    if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) {
+		goto optionError;
 	    }
-	    case REGEXP_LAST: {
-		i++;
-		goto endOfForLoop;
+	    if (startIndex) {
+		Tcl_DecrRefCount(startIndex);
 	    }
+	    startIndex = objv[i];
+	    Tcl_IncrRefCount(startIndex);
+	    break;
+	}
+	case REGEXP_LAST:
+	    i++;
+	    goto endOfForLoop;
 	}
     }
 
-    endOfForLoop:
+  endOfForLoop:
     if ((objc - i) < (2 - about)) {
-	Tcl_WrongNumArgs(interp, 1, objv, 
-	  "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
-	return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv,
+	    "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+	goto optionError;
     }
     objc -= i;
     objv += i;
 
+    /*
+     * Check if the user requested -inline, but specified match variables; a
+     * no-no.
+     */
+
     if (doinline && ((objc - 2) != 0)) {
-	/*
-	 * User requested -inline, but specified match variables - a no-no.
-	 */
-	Tcl_AppendResult(interp, "regexp match variables not allowed",
-		" when using -inline", (char *) NULL);
-	return TCL_ERROR;
+	Tcl_AppendResult(interp, "regexp match variables not allowed"
+		" when using -inline", NULL);
+	goto optionError;
     }
 
     /*
      * Handle the odd about case separately.
      */
+
     if (about) {
 	regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
 	if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) {
+	optionError:
+	    if (startIndex) {
+		Tcl_DecrRefCount(startIndex);
+	    }
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
     }
 
     /*
-     * Get the length of the string that we are matching against so
-     * we can do the termination test for -all matches.  Do this before
-     * getting the regexp to avoid shimmering problems.
+     * Get the length of the string that we are matching against so we can do
+     * the termination test for -all matches. Do this before getting the
+     * regexp to avoid shimmering problems.
      */
+
     objPtr = objv[1];
     stringLength = Tcl_GetCharLength(objPtr);
 
+    if (startIndex) {
+	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+	Tcl_DecrRefCount(startIndex);
+	if (offset < 0) {
+	    offset = 0;
+	}
+    }
+
     regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
     if (regExpr == NULL) {
 	return TCL_ERROR;
     }
 
-    if (offset > 0) {
-	/*
-	 * Add flag if using offset (string is part of a larger string),
-	 * so that "^" won't match.
-	 */
-	eflags |= TCL_REG_NOTBOL;
-    }
-
     objc -= 2;
     objv += 2;
-    resultPtr = Tcl_GetObjResult(interp);
 
     if (doinline) {
 	/*
 	 * Save all the subexpressions, as we will return them as a list
 	 */
+
 	numMatchesSaved = -1;
     } else {
 	/*
-	 * Save only enough subexpressions for matches we want to keep,
-	 * expect in the case of -all, where we need to keep at least
-	 * one to know where to move the offset.
+	 * Save only enough subexpressions for matches we want to keep, expect
+	 * in the case of -all, where we need to keep at least one to know
+	 * where to move the offset.
 	 */
+
 	numMatchesSaved = (objc == 0) ? all : objc;
     }
 
     /*
-     * The following loop is to handle multiple matches within the
-     * same source string;  each iteration handles one match.  If "-all"
-     * hasn't been specified then the loop body only gets executed once.
-     * We terminate the loop when the starting offset is past the end of the
-     * string.
+     * The following loop is to handle multiple matches within the same source
+     * string; each iteration handles one match. If "-all" hasn't been
+     * specified then the loop body only gets executed once. We terminate the
+     * loop when the starting offset is past the end of the string.
      */
 
     while (1) {
-	match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
-		offset /* offset */, numMatchesSaved, eflags 
-		| ((offset > 0 && offset < stringLength &&
-		   (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
-		   ? TCL_REG_NOTBOL : 0));
+	/*
+	 * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing
+	 * TCL_REG_NOTBOL indicates that the character at offset should not be
+	 * considered the start of the line. If for example the pattern {^} is
+	 * passed and -start is positive, then the pattern will not match the
+	 * start of the string unless the previous character is a newline.
+	 */
+
+	if (offset == 0) {
+	    eflags = 0;
+	} else if (offset > stringLength) {
+	    eflags = TCL_REG_NOTBOL;
+	} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
+	    eflags = 0;
+	} else {
+	    eflags = TCL_REG_NOTBOL;
+	}
 
+	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
+		numMatchesSaved, eflags);
 	if (match < 0) {
 	    return TCL_ERROR;
 	}
@@ -391,16 +285,16 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 	     * We want to set the value of the intepreter result only when
 	     * this is the first time through the loop.
 	     */
+
 	    if (all <= 1) {
 		/*
-		 * If inlining, set the interpreter's object result to an
-		 * empty list, otherwise set it to an integer object w/
-		 * value 0.
+		 * If inlining, the interpreter's object result remains an
+		 * empty list, otherwise set it to an integer object w/ value
+		 * 0.
 		 */
-		if (doinline) {
-		    Tcl_SetListObj(resultPtr, 0, NULL);
-		} else {
-		    Tcl_SetIntObj(resultPtr, 0);
+
+		if (!doinline) {
+		    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
 		}
 		return TCL_OK;
 	    }
@@ -408,17 +302,21 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 	}
 
 	/*
-	 * If additional variable names have been specified, return
-	 * index information in those variables.
+	 * If additional variable names have been specified, return index
+	 * information in those variables.
 	 */
 
 	Tcl_RegExpGetInfo(regExpr, &info);
 	if (doinline) {
 	    /*
-	     * It's the number of substitutions, plus one for the matchVar
-	     * at index 0
+	     * It's the number of substitutions, plus one for the matchVar at
+	     * index 0
 	     */
+
 	    objc = info.nsubs + 1;
+	    if (all <= 1) {
+		resultPtr = Tcl_NewObj();
+	    }
 	}
 	for (i = 0; i < objc; i++) {
 	    Tcl_Obj *newPtr;
@@ -428,12 +326,13 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		Tcl_Obj *objs[2];
 
 		/*
-		 * Only adjust the match area if there was a match for
-		 * that area.  (Scriptics Bug 4391/SF Bug #219232)
+		 * Only adjust the match area if there was a match for that
+		 * area. (Scriptics Bug 4391/SF Bug #219232)
 		 */
+
 		if (i <= info.nsubs && info.matches[i].start >= 0) {
 		    start = offset + info.matches[i].start;
-		    end   = offset + info.matches[i].end;
+		    end = offset + info.matches[i].end;
 
 		    /*
 		     * Adjust index so it refers to the last character in the
@@ -445,7 +344,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		    }
 		} else {
 		    start = -1;
-		    end   = -1;
+		    end = -1;
 		}
 
 		objs[0] = Tcl_NewLongObj(start);
@@ -465,6 +364,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
 			!= TCL_OK) {
 		    Tcl_DecrRefCount(newPtr);
+		    Tcl_DecrRefCount(resultPtr);
 		    return TCL_ERROR;
 		}
 	    } else {
@@ -472,8 +372,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
 		if (valuePtr == NULL) {
 		    Tcl_AppendResult(interp, "couldn't set variable \"",
-			    Tcl_GetString(objv[i]), "\"", (char *) NULL);
-		    Tcl_DecrRefCount(newPtr);
+			    TclGetString(objv[i]), "\"", NULL);
 		    return TCL_ERROR;
 		}
 	    }
@@ -482,37 +381,44 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 	if (all == 0) {
 	    break;
 	}
+
+	/*
+	 * Adjust the offset to the character just after the last one in the
+	 * matchVar and increment all to count how many times we are making a
+	 * match. We always increment the offset by at least one to prevent
+	 * endless looping (as in the case: regexp -all {a*} a). Otherwise,
+	 * when we match the NULL string at the end of the input string, we
+	 * will loop indefinately (because the length of the match is 0, so
+	 * offset never changes).
+	 */
+
+	matchLength = info.matches[0].end - info.matches[0].start;
+	offset += info.matches[0].end;
+
 	/*
-	 * Adjust the offset to the character just after the last one
-	 * in the matchVar and increment all to count how many times
-	 * we are making a match.  We always increment the offset by at least
-	 * one to prevent endless looping (as in the case:
-	 * regexp -all {a*} a).  Otherwise, when we match the NULL string at
-	 * the end of the input string, we will loop indefinately (because the
-	 * length of the match is 0, so offset never changes).
+	 * A match of length zero could happen for {^} {$} or {.*} and in
+	 * these cases we always want to bump the index up one.
 	 */
-	if (info.matches[0].end == 0) {
+
+	if (matchLength == 0) {
 	    offset++;
 	}
-	offset += info.matches[0].end;
 	all++;
-	eflags |= TCL_REG_NOTBOL;
 	if (offset >= stringLength) {
 	    break;
 	}
     }
 
     /*
-     * Set the interpreter's object result to an integer object
-     * with value 1 if -all wasn't specified, otherwise it's all-1
-     * (the number of times through the while - 1).
-     * Get the resultPtr again as the Tcl_ObjSetVar2 above may have
-     * cause the result to change. [Patch #558324] (watson).
+     * Set the interpreter's object result to an integer object with value 1
+     * if -all wasn't specified, otherwise it's all-1 (the number of times
+     * through the while - 1).
      */
 
-    if (!doinline) {
-	resultPtr = Tcl_GetObjResult(interp);
-	Tcl_SetIntObj(resultPtr, (all ? all-1 : 1));
+    if (doinline) {
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1));
     }
     return TCL_OK;
 }
@@ -522,8 +428,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_RegsubObjCmd --
  *
- *	This procedure is invoked to process the "regsub" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "regsub" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -534,22 +440,21 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_RegsubObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_RegsubObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
     int start, end, subStart, subEnd, match;
     Tcl_RegExp regExpr;
     Tcl_RegExpInfo info;
-    Tcl_Obj *resultPtr, *subPtr, *objPtr;
+    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
     Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
 
-    static CONST char *options[] = {
+    static const char *options[] = {
 	"-all",		"-nocase",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",	"-start",
 	"--",		NULL
@@ -568,95 +473,107 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
     for (idx = 1; idx < objc; idx++) {
 	char *name;
 	int index;
-	
-	name = Tcl_GetString(objv[idx]);
+
+	name = TclGetString(objv[idx]);
 	if (name[0] != '-') {
 	    break;
 	}
 	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
 		TCL_EXACT, &index) != TCL_OK) {
-	    return TCL_ERROR;
+	    goto optionError;
 	}
 	switch ((enum options) index) {
-	    case REGSUB_ALL: {
-		all = 1;
-		break;
-	    }
-	    case REGSUB_NOCASE: {
-		cflags |= TCL_REG_NOCASE;
-		break;
-	    }
-	    case REGSUB_EXPANDED: {
-		cflags |= TCL_REG_EXPANDED;
-		break;
-	    }
-	    case REGSUB_LINE: {
-		cflags |= TCL_REG_NEWLINE;
-		break;
-	    }
-	    case REGSUB_LINESTOP: {
-		cflags |= TCL_REG_NLSTOP;
-		break;
-	    }
-	    case REGSUB_LINEANCHOR: {
-		cflags |= TCL_REG_NLANCH;
-		break;
+	case REGSUB_ALL:
+	    all = 1;
+	    break;
+	case REGSUB_NOCASE:
+	    cflags |= TCL_REG_NOCASE;
+	    break;
+	case REGSUB_EXPANDED:
+	    cflags |= TCL_REG_EXPANDED;
+	    break;
+	case REGSUB_LINE:
+	    cflags |= TCL_REG_NEWLINE;
+	    break;
+	case REGSUB_LINESTOP:
+	    cflags |= TCL_REG_NLSTOP;
+	    break;
+	case REGSUB_LINEANCHOR:
+	    cflags |= TCL_REG_NLANCH;
+	    break;
+	case REGSUB_START: {
+	    int temp;
+	    if (++idx >= objc) {
+		goto endOfForLoop;
 	    }
-	    case REGSUB_START: {
-		if (++idx >= objc) {
-		    goto endOfForLoop;
-		}
-		if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (offset < 0) {
-		    offset = 0;
-		}
-		break;
+	    if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) {
+		goto optionError;
 	    }
-	    case REGSUB_LAST: {
-		idx++;
-		goto endOfForLoop;
+	    if (startIndex) {
+		Tcl_DecrRefCount(startIndex);
 	    }
+	    startIndex = objv[idx];
+	    Tcl_IncrRefCount(startIndex);
+	    break;
+	}
+	case REGSUB_LAST:
+	    idx++;
+	    goto endOfForLoop;
 	}
     }
-    endOfForLoop:
+
+  endOfForLoop:
     if (objc-idx < 3 || objc-idx > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"?switches? exp string subSpec ?varName?");
+    optionError:
+	if (startIndex) {
+	    Tcl_DecrRefCount(startIndex);
+	}
 	return TCL_ERROR;
     }
 
     objc -= idx;
     objv += idx;
 
+    if (startIndex) {
+	int stringLength = Tcl_GetCharLength(objv[1]);
+
+	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+	Tcl_DecrRefCount(startIndex);
+	if (offset < 0) {
+	    offset = 0;
+	}
+    }
+
     if (all && (offset == 0)
-	    && (strpbrk(Tcl_GetString(objv[2]), "&\\") == NULL)
-	    && (strpbrk(Tcl_GetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
+	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
+	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
 	/*
-	 * This is a simple one pair string map situation.  We make use of
-	 * a slightly modified version of the one pair STR_MAP code.
+	 * This is a simple one pair string map situation. We make use of a
+	 * slightly modified version of the one pair STR_MAP code.
 	 */
+
 	int slen, nocase;
-	int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *,
-		unsigned long));
+	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
 	Tcl_UniChar *p, wsrclc;
 
 	numMatches = 0;
-	nocase     = (cflags & TCL_REG_NOCASE);
-	strCmpFn   = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
+	nocase = (cflags & TCL_REG_NOCASE);
+	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
 
-	wsrc     = Tcl_GetUnicodeFromObj(objv[0], &slen);
-	wstring  = Tcl_GetUnicodeFromObj(objv[1], &wlen);
+	wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
+	wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
 	wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
-	wend     = wstring + wlen - (slen ? slen - 1 : 0);
-	result   = TCL_OK;
+	wend = wstring + wlen - (slen ? slen - 1 : 0);
+	result = TCL_OK;
 
 	if (slen == 0) {
 	    /*
-	     * regsub behavior for "" matches between each character.
-	     * 'string map' skips the "" case.
+	     * regsub behavior for "" matches between each character. 'string
+	     * map' skips the "" case.
 	     */
+
 	    if (wstring < wend) {
 		resultPtr = Tcl_NewUnicodeObj(wstring, 0);
 		Tcl_IncrRefCount(resultPtr);
@@ -670,10 +587,9 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	} else {
 	    wsrclc = Tcl_UniCharToLower(*wsrc);
 	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
-		if (((*wstring == *wsrc) ||
-			(nocase && (Tcl_UniCharToLower(*wstring) ==
-				wsrclc))) &&
-			((slen == 1) || (strCmpFn(wstring, wsrc,
+		if ((*wstring == *wsrc ||
+			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
+			(slen==1 || (strCmpFn(wstring, wsrc,
 				(unsigned long) slen) == 0))) {
 		    if (numMatches == 0) {
 			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
@@ -707,9 +623,9 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Make sure to avoid problems where the objects are shared.  This
-     * can cause RegExpObj <> UnicodeObj shimmering that causes data
-     * corruption.  [Bug #461322]
+     * Make sure to avoid problems where the objects are shared. This can
+     * cause RegExpObj <> UnicodeObj shimmering that causes data corruption.
+     * [Bug #461322]
      */
 
     if (objv[1] == objv[0]) {
@@ -728,27 +644,27 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
     result = TCL_OK;
 
     /*
-     * The following loop is to handle multiple matches within the
-     * same source string;  each iteration handles one match and its
-     * corresponding substitution.  If "-all" hasn't been specified
-     * then the loop body only gets executed once.  We must use
-     * 'offset <= wlen' in particular for the case where the regexp
-     * pattern can match the empty string - this is useful when
-     * doing, say, 'regsub -- ^ $str ...' when $str might be empty.
+     * The following loop is to handle multiple matches within the same source
+     * string; each iteration handles one match and its corresponding
+     * substitution. If "-all" hasn't been specified then the loop body only
+     * gets executed once. We must use 'offset <= wlen' in particular for the
+     * case where the regexp pattern can match the empty string - this is
+     * useful when doing, say, 'regsub -- ^ $str ...' when $str might be
+     * empty.
      */
 
     numMatches = 0;
     for ( ; offset <= wlen; ) {
 
 	/*
-	 * The flags argument is set if string is part of a larger string,
-	 * so that "^" won't match.
+	 * The flags argument is set if string is part of a larger string, so
+	 * that "^" won't match.
 	 */
 
 	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
 		10 /* matches */, ((offset > 0 &&
-		   (wstring[offset-1] != (Tcl_UniChar)'\n'))
-		   ? TCL_REG_NOTBOL : 0));
+		(wstring[offset-1] != (Tcl_UniChar)'\n'))
+		? TCL_REG_NOTBOL : 0));
 
 	if (match < 0) {
 	    result = TCL_ERROR;
@@ -762,9 +678,10 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	    Tcl_IncrRefCount(resultPtr);
 	    if (offset > 0) {
 		/*
-		 * Copy the initial portion of the string in if an offset
-		 * was specified.
+		 * Copy the initial portion of the string in if an offset was
+		 * specified.
 		 */
+
 		Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
 	    }
 	}
@@ -782,7 +699,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 
 	/*
 	 * Append the subSpec argument to the variable, making appropriate
-	 * substitutions.  This code is a bit hairy because of the backslash
+	 * substitutions. This code is a bit hairy because of the backslash
 	 * conventions and because the code saves up ranges of characters in
 	 * subSpec to reduce the number of calls to Tcl_SetVar.
 	 */
@@ -810,10 +727,12 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	    } else {
 		continue;
 	    }
+
 	    if (wfirstChar != wsrc) {
 		Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
 			wsrc - wfirstChar);
 	    }
+
 	    if (idx <= info.nsubs) {
 		subStart = info.matches[idx].start;
 		subEnd = info.matches[idx].end;
@@ -822,18 +741,21 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 			    wstring + offset + subStart, subEnd - subStart);
 		}
 	    }
+
 	    if (*wsrc == '\\') {
 		wsrc++;
 	    }
 	    wfirstChar = wsrc + 1;
 	}
+
 	if (wfirstChar != wsrc) {
 	    Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
 	}
+
 	if (end == 0) {
 	    /*
-	     * Always consume at least one character of the input string
-	     * in order to prevent infinite loops.
+	     * Always consume at least one character of the input string in
+	     * order to prevent infinite loops.
 	     */
 
 	    if (offset < wlen) {
@@ -844,10 +766,10 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	    offset += end;
 	    if (start == end) {
 		/*
-		 * We matched an empty string, which means we must go 
-		 * forward one more step so we don't match again at the
-		 * same spot.
+		 * We matched an empty string, which means we must go forward
+		 * one more step so we don't match again at the same spot.
 		 */
+
 		if (offset < wlen) {
 		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
 		}
@@ -863,12 +785,14 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
      * Copy the portion of the source string after the last match to the
      * result variable.
      */
-    regsubDone:
+
+  regsubDone:
     if (numMatches == 0) {
 	/*
-	 * On zero matches, just ignore the offset, since it shouldn't
-	 * matter to us in this case, and the user may have skewed it.
+	 * On zero matches, just ignore the offset, since it shouldn't matter
+	 * to us in this case, and the user may have skewed it.
 	 */
+
 	resultPtr = objv[1];
 	Tcl_IncrRefCount(resultPtr);
     } else if (offset < wlen) {
@@ -877,27 +801,34 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
     if (objc == 4) {
 	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
 	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    Tcl_GetString(objv[3]), "\"", (char *) NULL);
+		    TclGetString(objv[3]), "\"", NULL);
 	    result = TCL_ERROR;
 	} else {
 	    /*
 	     * Set the interpreter's object result to an integer object
-	     * holding the number of matches. 
+	     * holding the number of matches.
 	     */
 
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches));
 	}
     } else {
 	/*
 	 * No varname supplied, so just return the modified string.
 	 */
+
 	Tcl_SetObjResult(interp, resultPtr);
     }
 
-    done:
-    if (objPtr && (objv[1] == objv[0])) { Tcl_DecrRefCount(objPtr); }
-    if (subPtr && (objv[2] == objv[0])) { Tcl_DecrRefCount(subPtr); }
-    if (resultPtr) { Tcl_DecrRefCount(resultPtr); }
+  done:
+    if (objPtr && (objv[1] == objv[0])) {
+	Tcl_DecrRefCount(objPtr);
+    }
+    if (subPtr && (objv[2] == objv[0])) {
+	Tcl_DecrRefCount(subPtr);
+    }
+    if (resultPtr) {
+	Tcl_DecrRefCount(resultPtr);
+    }
     return result;
 }
 
@@ -906,8 +837,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_RenameObjCmd --
  *
- *	This procedure is invoked to process the "rename" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "rename" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -918,23 +849,22 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_RenameObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Arbitrary value passed to the command. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_RenameObjCmd(
+    ClientData dummy,		/* Arbitrary value passed to the command. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *oldName, *newName;
-    
+
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
 	return TCL_ERROR;
     }
 
-    oldName = Tcl_GetString(objv[1]);
-    newName = Tcl_GetString(objv[2]);
+    oldName = TclGetString(objv[1]);
+    newName = TclGetString(objv[2]);
     return TclRenameCommand(interp, oldName, newName);
 }
 
@@ -955,83 +885,34 @@ Tcl_RenameObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_ReturnObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ReturnObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    int optionLen, argLen, code, result;
-
-    if (iPtr->errorInfo != NULL) {
-	ckfree(iPtr->errorInfo);
-	iPtr->errorInfo = NULL;
-    }
-    if (iPtr->errorCode != NULL) {
-	ckfree(iPtr->errorCode);
-	iPtr->errorCode = NULL;
-    }
-    code = TCL_OK;
-    
-    for (objv++, objc--;  objc > 1;  objv += 2, objc -= 2) {
-	char *option = Tcl_GetStringFromObj(objv[0], &optionLen);
-	char *arg = Tcl_GetStringFromObj(objv[1], &argLen);
-    	
-	if (strcmp(option, "-code") == 0) {
-	    register int c = arg[0];
-	    if ((c == 'o') && (strcmp(arg, "ok") == 0)) {
-		code = TCL_OK;
-	    } else if ((c == 'e') && (strcmp(arg, "error") == 0)) {
-		code = TCL_ERROR;
-	    } else if ((c == 'r') && (strcmp(arg, "return") == 0)) {
-		code = TCL_RETURN;
-	    } else if ((c == 'b') && (strcmp(arg, "break") == 0)) {
-		code = TCL_BREAK;
-	    } else if ((c == 'c') && (strcmp(arg, "continue") == 0)) {
-		code = TCL_CONTINUE;
-	    } else {
-		result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objv[1],
-		        &code);
-		if (result != TCL_OK) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "bad completion code \"",
-			    Tcl_GetString(objv[1]),
-			    "\": must be ok, error, return, break, ",
-			    "continue, or an integer", (char *) NULL);
-		    return result;
-		}
-	    }
-	} else if (strcmp(option, "-errorinfo") == 0) {
-	    iPtr->errorInfo =
-		(char *) ckalloc((unsigned) (strlen(arg) + 1));
-	    strcpy(iPtr->errorInfo, arg);
-	} else if (strcmp(option, "-errorcode") == 0) {
-	    iPtr->errorCode =
-		(char *) ckalloc((unsigned) (strlen(arg) + 1));
-	    strcpy(iPtr->errorCode, arg);
-	} else {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "bad option \"", option,
-		    "\": must be -code, -errorcode, or -errorinfo",
-		    (char *) NULL);
-	    return TCL_ERROR;
-	}
+    int code, level;
+    Tcl_Obj *returnOpts;
+
+    /*
+     * General syntax: [return ?-option value ...? ?result?]
+     * An even number of words means an explicit result argument is present.
+     */
+
+    int explicitResult = (0 == (objc % 2));
+    int numOptionWords = objc - 1 - explicitResult;
+
+    if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1,
+	    &returnOpts, &code, &level)) {
+	return TCL_ERROR;
     }
-    
-    if (objc == 1) {
-	/*
-	 * Set the interpreter's object result. An inline version of
-	 * Tcl_SetObjResult.
-	 */
 
-	Tcl_SetObjResult(interp, objv[0]);
+    code = TclProcessReturn(interp, code, level, returnOpts);
+    if (explicitResult) {
+	Tcl_SetObjResult(interp, objv[objc-1]);
     }
-    iPtr->returnCode = code;
-    return TCL_RETURN;
+    return code;
 }
 
 /*
@@ -1039,8 +920,8 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_SourceObjCmd --
  *
- *	This procedure is invoked to process the "source" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "source" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -1051,20 +932,37 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_SourceObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_SourceObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
+    const char *encodingName = NULL;
+    Tcl_Obj *fileName;
+
+    if (objc != 2 && objc !=4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
 	return TCL_ERROR;
     }
 
-    return Tcl_FSEvalFile(interp, objv[1]);
+    fileName = objv[objc-1];
+
+    if (objc == 4) {
+	static const char *options[] = {
+	    "-encoding", NULL
+	};
+	int index;
+
+	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options,
+		"option", TCL_EXACT, &index)) {
+	    return TCL_ERROR;
+	}
+	encodingName = TclGetString(objv[2]);
+    }
+
+    return Tcl_FSEvalFileEx(interp, fileName, encodingName);
 }
 
 /*
@@ -1072,8 +970,8 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_SplitObjCmd --
  *
- *	This procedure is invoked to process the "split" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "split" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1084,17 +982,16 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_SplitObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_SplitObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_UniChar ch;
     int len;
-    char *splitChars, *string, *end;
+    char *splitChars, *stringPtr, *end;
     int splitCharLen, stringLen;
     Tcl_Obj *listPtr, *objPtr;
 
@@ -1102,16 +999,16 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
 	splitChars = " \n\t\r";
 	splitCharLen = 4;
     } else if (objc == 3) {
-	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
+	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
 	return TCL_ERROR;
     }
 
-    string = Tcl_GetStringFromObj(objv[1], &stringLen);
-    end = string + stringLen;
-    listPtr = Tcl_GetObjResult(interp);
-    
+    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
+    end = stringPtr + stringLen;
+    listPtr = Tcl_NewObj();
+
     if (stringLen == 0) {
 	/*
 	 * Do nothing.
@@ -1124,87 +1021,92 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
 	/*
 	 * Handle the special case of splitting on every character.
 	 *
-	 * Uses a hash table to ensure that each kind of character has
-	 * only one Tcl_Obj instance (multiply-referenced) in the
-	 * final list.  This is a *major* win when splitting on a long
-	 * string (especially in the megabyte range!) - DKF
+	 * Uses a hash table to ensure that each kind of character has only
+	 * one Tcl_Obj instance (multiply-referenced) in the final list. This
+	 * is a *major* win when splitting on a long string (especially in the
+	 * megabyte range!) - DKF
 	 */
 
 	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
-	for ( ; string < end; string += len) {
-	    len = TclUtfToUniChar(string, &ch);
-	    /* Assume Tcl_UniChar is an integral type... */
-	    hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew);
+
+	for ( ; stringPtr < end; stringPtr += len) {
+	    len = TclUtfToUniChar(stringPtr, &ch);
+
+	    /*
+	     * Assume Tcl_UniChar is an integral type...
+	     */
+
+	    hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0+ch, &isNew);
 	    if (isNew) {
-		objPtr = Tcl_NewStringObj(string, len);
-		/* Don't need to fiddle with refcount... */
+		TclNewStringObj(objPtr, stringPtr, len);
+
+		/*
+		 * Don't need to fiddle with refcount...
+		 */
+
 		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
 	    } else {
-		objPtr = (Tcl_Obj*) Tcl_GetHashValue(hPtr);
+		objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
 	    }
 	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
 	}
 	Tcl_DeleteHashTable(&charReuseTable);
+
     } else if (splitCharLen == 1) {
 	char *p;
 
 	/*
-	 * Handle the special case of splitting on a single character.
-	 * This is only true for the one-char ASCII case, as one unicode
-	 * char is > 1 byte in length.
+	 * Handle the special case of splitting on a single character. This is
+	 * only true for the one-char ASCII case, as one unicode char is > 1
+	 * byte in length.
 	 */
 
-	while (*string && (p = strchr(string, (int) *splitChars)) != NULL) {
-	    objPtr = Tcl_NewStringObj(string, p - string);
+	while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
+	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
 	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-	    string = p + 1;
+	    stringPtr = p + 1;
 	}
-	objPtr = Tcl_NewStringObj(string, end - string);
+	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
 	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
     } else {
 	char *element, *p, *splitEnd;
 	int splitLen;
 	Tcl_UniChar splitChar;
-	
+
 	/*
-	 * Normal case: split on any of a given set of characters.
-	 * Discard instances of the split characters.
+	 * Normal case: split on any of a given set of characters. Discard
+	 * instances of the split characters.
 	 */
 
 	splitEnd = splitChars + splitCharLen;
 
-	for (element = string; string < end; string += len) {
-	    len = TclUtfToUniChar(string, &ch);
+	for (element = stringPtr; stringPtr < end; stringPtr += len) {
+	    len = TclUtfToUniChar(stringPtr, &ch);
 	    for (p = splitChars; p < splitEnd; p += splitLen) {
 		splitLen = TclUtfToUniChar(p, &splitChar);
 		if (ch == splitChar) {
-		    objPtr = Tcl_NewStringObj(element, string - element);
+		    TclNewStringObj(objPtr, element, stringPtr - element);
 		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-		    element = string + len;
+		    element = stringPtr + len;
 		    break;
 		}
 	    }
 	}
-	objPtr = Tcl_NewStringObj(element, string - element);
+
+	TclNewStringObj(objPtr, element, stringPtr - element);
 	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
     }
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_StringObjCmd --
+ * StringFirstCmd --
  *
- *	This procedure is invoked to process the "string" Tcl command.
- *	See the user documentation for details on what it does.  Note
- *	that this command only functions correctly on properly formed
- *	Tcl UTF strings.
- *
- *	Note that the primary methods here (equal, compare, match, ...)
- *	have bytecode equivalents.  You will find the code for those in
- *	tclExecute.c.  The code here will only be used in the non-bc
- *	case (like in an 'eval').
+ *	This procedure is invoked to process the "string first" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1215,1248 +1117,882 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_StringObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+static int
+StringFirstCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int index, left, right;
-    Tcl_Obj *resultPtr;
-    char *string1, *string2;
-    int length1, length2;
-    static CONST char *options[] = {
-	"bytelength",	"compare",	"equal",	"first",
-	"index",	"is",		"last",		"length",
-	"map",		"match",	"range",	"repeat",
-	"replace",	"tolower",	"toupper",	"totitle",
-	"trim",		"trimleft",	"trimright",
-	"wordend",	"wordstart",	(char *) NULL
-    };
-    enum options {
-	STR_BYTELENGTH,	STR_COMPARE,	STR_EQUAL,	STR_FIRST,
-	STR_INDEX,	STR_IS,		STR_LAST,	STR_LENGTH,
-	STR_MAP,	STR_MATCH,	STR_RANGE,	STR_REPEAT,
-	STR_REPLACE,	STR_TOLOWER,	STR_TOUPPER,	STR_TOTITLE,
-	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
-	STR_WORDEND,	STR_WORDSTART
-    };	  
-
-    if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
-	return TCL_ERROR;
-    }
-    
-    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
-	    &index) != TCL_OK) {
+    Tcl_UniChar *ustring1, *ustring2;
+    int match, start, length1, length2;
+
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"needleString haystackString ?startIndex?");
 	return TCL_ERROR;
     }
 
-    resultPtr = Tcl_GetObjResult(interp);
-    switch ((enum options) index) {
-	case STR_EQUAL:
-	case STR_COMPARE: {
-	    /*
-	     * Remember to keep code here in some sync with the
-	     * byte-compiled versions in tclExecute.c (INST_STR_EQ,
-	     * INST_STR_NEQ and INST_STR_CMP as well as the expr string
-	     * comparison in INST_EQ/INST_NEQ/INST_LT/...).
-	     */
-	    int i, match, length, nocase = 0, reqlength = -1;
-	    int (*strCmpFn)();
-
-	    if (objc < 4 || objc > 7) {
-	    str_cmp_args:
-	        Tcl_WrongNumArgs(interp, 2, objv,
-				 "?-nocase? ?-length int? string1 string2");
-		return TCL_ERROR;
-	    }
-
-	    for (i = 2; i < objc-2; i++) {
-		string2 = Tcl_GetStringFromObj(objv[i], &length2);
-		if ((length2 > 1)
-			&& strncmp(string2, "-nocase", (size_t)length2) == 0) {
-		    nocase = 1;
-		} else if ((length2 > 1)
-			&& strncmp(string2, "-length", (size_t)length2) == 0) {
-		    if (i+1 >= objc-2) {
-			goto str_cmp_args;
-		    }
-		    if (Tcl_GetIntFromObj(interp, objv[++i],
-			    &reqlength) != TCL_OK) {
-			return TCL_ERROR;
-		    }
-		} else {
-		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
-			    string2, "\": must be -nocase or -length",
-			    (char *) NULL);
-		    return TCL_ERROR;
-		}
-	    }
+    /*
+     * We are searching string2 for the sequence string1.
+     */
 
-	    /*
-	     * From now on, we only access the two objects at the end
-	     * of the argument array.
-	     */
-	    objv += objc-2;
+    match = -1;
+    start = 0;
+    length2 = -1;
 
-	    if ((reqlength == 0) || (objv[0] == objv[1])) {
-		/*
-		 * Alway match at 0 chars of if it is the same obj.
-		 */
+    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
+    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
 
-		Tcl_SetBooleanObj(resultPtr,
-			((enum options) index == STR_EQUAL));
-		break;
-	    } else if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-		    objv[1]->typePtr == &tclByteArrayType) {
-		/*
-		 * Use binary versions of comparisons since that won't
-		 * cause undue type conversions and it is much faster.
-		 * Only do this if we're case-sensitive (which is all
-		 * that really makes sense with byte arrays anyway, and
-		 * we have no memcasecmp() for some reason... :^)
-		 */
-		string1 = (char*) Tcl_GetByteArrayFromObj(objv[0], &length1);
-		string2 = (char*) Tcl_GetByteArrayFromObj(objv[1], &length2);
-		strCmpFn = memcmp;
-	    } else if ((objv[0]->typePtr == &tclStringType)
-		    && (objv[1]->typePtr == &tclStringType)) {
-		/*
-		 * Do a unicode-specific comparison if both of the args
-		 * are of String type.  In benchmark testing this proved
-		 * the most efficient check between the unicode and
-		 * string comparison operations.
-		 */
-		string1 = (char*) Tcl_GetUnicodeFromObj(objv[0], &length1);
-		string2 = (char*) Tcl_GetUnicodeFromObj(objv[1], &length2);
-		strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
-	    } else {
-		/*
-		 * As a catch-all we will work with UTF-8.  We cannot use
-		 * memcmp() as that is unsafe with any string containing
-		 * NULL (\xC0\x80 in Tcl's utf rep).  We can use the more
-		 * efficient TclpUtfNcmp2 if we are case-sensitive and no
-		 * specific length was requested.
-		 */
-		string1 = (char*) Tcl_GetStringFromObj(objv[0], &length1);
-		string2 = (char*) Tcl_GetStringFromObj(objv[1], &length2);
-		if ((reqlength < 0) && !nocase) {
-		    strCmpFn = TclpUtfNcmp2;
-		} else {
-		    length1 = Tcl_NumUtfChars(string1, length1);
-		    length2 = Tcl_NumUtfChars(string2, length2);
-		    strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp;
-		}
-	    }
-
-	    if (((enum options) index == STR_EQUAL)
-		    && (reqlength < 0) && (length1 != length2)) {
-		match = 1; /* this will be reversed below */
-	    } else {
-		length = (length1 < length2) ? length1 : length2;
-		if (reqlength > 0 && reqlength < length) {
-		    length = reqlength;
-		} else if (reqlength < 0) {
-		    /*
-		     * The requested length is negative, so we ignore it by
-		     * setting it to length + 1 so we correct the match var.
-		     */
-		    reqlength = length + 1;
-		}
-		match = strCmpFn(string1, string2, (unsigned) length);
-		if ((match == 0) && (reqlength > length)) {
-		    match = length1 - length2;
-		}
-	    }
+    if (objc == 4) {
+	/*
+	 * If a startIndex is specified, we will need to fast forward to that
+	 * point in the string before we think about a match.
+	 */
 
-	    if ((enum options) index == STR_EQUAL) {
-		Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
-	    } else {
-		Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
-					  (match < 0) ? -1 : 0));
-	    }
-	    break;
+	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
+	    return TCL_ERROR;
 	}
-	case STR_FIRST: {
-	    Tcl_UniChar *ustring1, *ustring2;
-	    int match, start;
 
-	    if (objc < 4 || objc > 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv,
-				 "subString string ?startIndex?");
-		return TCL_ERROR;
-	    }
+	/*
+	 * Reread to prevent shimmering problems.
+	 */
+
+	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
+	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
 
+	if (start >= length2) {
+	    goto str_first_done;
+	} else if (start > 0) {
+	    ustring2 += start;
+	    length2 -= start;
+	} else if (start < 0) {
 	    /*
-	     * We are searching string2 for the sequence string1.
+	     * Invalid start index mapped to string start; Bug #423581
 	     */
 
-	    match = -1;
 	    start = 0;
-	    length2 = -1;
-
-	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
-	    ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
+	}
+    }
 
-	    if (objc == 5) {
-		/*
-		 * If a startIndex is specified, we will need to fast
-		 * forward to that point in the string before we think
-		 * about a match
-		 */
-		if (TclGetIntForIndex(interp, objv[4], length2 - 1,
-			&start) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (start >= length2) {
-		    goto str_first_done;
-		} else if (start > 0) {
-		    ustring2 += start;
-		    length2  -= start;
-		} else if (start < 0) {
-		    /*
-		     * Invalid start index mapped to string start;
-		     * Bug #423581
-		     */
-		    start = 0;
-		}
-	    }
+    /*
+     * If the length of the needle is more than the length of the haystack, it
+     * cannot be contained in there so we can avoid searching. [Bug 2960021]
+     */
 
-	    if (length1 > 0) {
-		register Tcl_UniChar *p, *end;
+    if (length1 > 0 && length1 <= length2) {
+	register Tcl_UniChar *p, *end;
 
-		end = ustring2 + length2 - length1 + 1;
-		for (p = ustring2;  p < end;  p++) {
-		    /*
-		     * Scan forward to find the first character.
-		     */
-		    if ((*p == *ustring1) &&
-			    (TclUniCharNcmp(ustring1, p,
-				    (unsigned long) length1) == 0)) {
-			match = p - ustring2;
-			break;
-		    }
-		}
-	    }
+	end = ustring2 + length2 - length1 + 1;
+	for (p = ustring2;  p < end;  p++) {
 	    /*
-	     * Compute the character index of the matching string by
-	     * counting the number of characters before the match.
+	     * Scan forward to find the first character.
 	     */
-	    if ((match != -1) && (objc == 5)) {
-		match += start;
-	    }
 
-	    str_first_done:
-	    Tcl_SetIntObj(resultPtr, match);
-	    break;
-	}
-	case STR_INDEX: {
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
-		return TCL_ERROR;
+	    if ((*p == *ustring1) && (TclUniCharNcmp(ustring1, p,
+		    (unsigned long) length1) == 0)) {
+		match = p - ustring2;
+		break;
 	    }
+	}
+    }
 
-	    /*
-	     * If we have a ByteArray object, avoid indexing in the
-	     * Utf string since the byte array contains one byte per
-	     * character.  Otherwise, use the Unicode string rep to
-	     * get the index'th char.
-	     */
+    /*
+     * Compute the character index of the matching string by counting the
+     * number of characters before the match.
+     */
 
-	    if (objv[2]->typePtr == &tclByteArrayType) {
-		string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
+    if ((match != -1) && (objc == 4)) {
+	match += start;
+    }
 
-		if (TclGetIntForIndex(interp, objv[3], length1 - 1,
-			&index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if ((index >= 0) && (index < length1)) {
-		    Tcl_SetByteArrayObj(resultPtr,
-			    (unsigned char *)(&string1[index]), 1);
-		}
-	    } else {
-		/*
-		 * Get Unicode char length to calulate what 'end' means.
-		 */
-		length1 = Tcl_GetCharLength(objv[2]);
+  str_first_done:
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringLastCmd --
+ *
+ *	This procedure is invoked to process the "string last" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-		if (TclGetIntForIndex(interp, objv[3], length1 - 1,
-			&index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if ((index >= 0) && (index < length1)) {
-		    char buf[TCL_UTF_MAX];
-		    Tcl_UniChar ch;
+static int
+StringLastCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_UniChar *ustring1, *ustring2, *p;
+    int match, start, length1, length2;
 
-		    ch      = Tcl_GetUniChar(objv[2], index);
-		    length1 = Tcl_UniCharToUtf(ch, buf);
-		    Tcl_SetStringObj(resultPtr, buf, length1);
-		}
-	    }
-	    break;
-	}
-	case STR_IS: {
-	    char *end;
-	    Tcl_UniChar ch;
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"needleString haystackString ?startIndex?");
+	return TCL_ERROR;
+    }
 
-            /*
-	     * The UniChar comparison function
-	     */
+    /*
+     * We are searching string2 for the sequence string1.
+     */
 
-	    int (*chcomp)_ANSI_ARGS_((int)) = NULL; 
-	    int i, failat = 0, result = 1, strict = 0;
-	    Tcl_Obj *objPtr, *failVarObj = NULL;
-
-	    static CONST char *isOptions[] = {
-		"alnum",	"alpha",	"ascii",	"control",
-		"boolean",	"digit",	"double",	"false",
-		"graph",	"integer",	"lower",	"print",
-		"punct",	"space",	"true",		"upper",
-		"wordchar",	"xdigit",	(char *) NULL
-	    };
-	    enum isOptions {
-		STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
-		STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_FALSE,
-		STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LOWER,	STR_IS_PRINT,
-		STR_IS_PUNCT,	STR_IS_SPACE,	STR_IS_TRUE,	STR_IS_UPPER,
-		STR_IS_WORD,	STR_IS_XDIGIT
-	    };
-
-	    if (objc < 4 || objc > 7) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-				 "class ?-strict? ?-failindex var? str");
-		return TCL_ERROR;
-	    }
-	    if (Tcl_GetIndexFromObj(interp, objv[2], isOptions, "class", 0,
-				    &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (objc != 4) {
-		for (i = 3; i < objc-1; i++) {
-		    string2 = Tcl_GetStringFromObj(objv[i], &length2);
-		    if ((length2 > 1) &&
-			strncmp(string2, "-strict", (size_t) length2) == 0) {
-			strict = 1;
-		    } else if ((length2 > 1) &&
-			    strncmp(string2, "-failindex",
-				    (size_t) length2) == 0) {
-			if (i+1 >= objc-1) {
-			    Tcl_WrongNumArgs(interp, 3, objv,
-					     "?-strict? ?-failindex var? str");
-			    return TCL_ERROR;
-			}
-			failVarObj = objv[++i];
-		    } else {
-			Tcl_AppendStringsToObj(resultPtr, "bad option \"",
-				string2, "\": must be -strict or -failindex",
-				(char *) NULL);
-			return TCL_ERROR;
-		    }
-		}
-	    }
+    match = -1;
+    start = 0;
+    length2 = -1;
 
-	    /*
-	     * We get the objPtr so that we can short-cut for some classes
-	     * by checking the object type (int and double), but we need
-	     * the string otherwise, because we don't want any conversion
-	     * of type occuring (as, for example, Tcl_Get*FromObj would do
-	     */
-	    objPtr = objv[objc-1];
-	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
-	    if (length1 == 0) {
-		if (strict) {
-		    result = 0;
-		}
-		goto str_is_done;
-	    }
-	    end = string1 + length1;
+    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
+    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
 
-	    /*
-	     * When entering here, result == 1 and failat == 0
-	     */
-	    switch ((enum isOptions) index) {
-		case STR_IS_ALNUM:
-		    chcomp = Tcl_UniCharIsAlnum;
-		    break;
-		case STR_IS_ALPHA:
-		    chcomp = Tcl_UniCharIsAlpha;
-		    break;
-		case STR_IS_ASCII:
-		    for (; string1 < end; string1++, failat++) {
-			/*
-			 * This is a valid check in unicode, because all
-			 * bytes < 0xC0 are single byte chars (but isascii
-			 * limits that def'n to 0x80).
-			 */
-			if (*((unsigned char *)string1) >= 0x80) {
-			    result = 0;
-			    break;
-			}
-		    }
-		    break;
-		case STR_IS_BOOL:
-		case STR_IS_TRUE:
-		case STR_IS_FALSE:
-		    /* Optimizers, beware Bug 1187123 ! */
-		    if ((Tcl_GetBoolean(NULL, string1, &i)
-				== TCL_ERROR) ||
-			       (((enum isOptions) index == STR_IS_TRUE) &&
-				i == 0) ||
-			       (((enum isOptions) index == STR_IS_FALSE) &&
-				i != 0)) {
-			result = 0;
-		    }
-		    break;
-		case STR_IS_CONTROL:
-		    chcomp = Tcl_UniCharIsControl;
-		    break;
-		case STR_IS_DIGIT:
-		    chcomp = Tcl_UniCharIsDigit;
-		    break;
-		case STR_IS_DOUBLE: {
-		    char *stop;
+    if (objc == 4) {
+	/*
+	 * If a startIndex is specified, we will need to restrict the string
+	 * range to that char index in the string
+	 */
 
-		    if ((objPtr->typePtr == &tclDoubleType) ||
-			(objPtr->typePtr == &tclIntType)) {
-			break;
-		    }
-		    /*
-		     * This is adapted from Tcl_GetDouble
-		     *
-		     * The danger in this function is that
-		     * "12345678901234567890" is an acceptable 'double',
-		     * but will later be interp'd as an int by something
-		     * like [expr].  Therefore, we check to see if it looks
-		     * like an int, and if so we do a range check on it.
-		     * If strtoul gets to the end, we know we either
-		     * received an acceptable int, or over/underflow
-		     */
-		    if (TclLooksLikeInt(string1, length1)) {
-			errno = 0;
-#ifdef TCL_WIDE_INT_IS_LONG
-			strtoul(string1, &stop, 0); /* INTL: Tcl source. */
-#else
-			strtoull(string1, &stop, 0); /* INTL: Tcl source. */
-#endif
-			if (stop == end) {
-			    if (errno == ERANGE) {
-				result = 0;
-				failat = -1;
-			    }
-			    break;
-			}
-		    }
-		    errno = 0;
-		    strtod(string1, &stop); /* INTL: Tcl source. */
-		    if (errno == ERANGE) {
-			/*
-			 * if (errno == ERANGE), then it was an over/underflow
-			 * problem, but in this method, we only want to know
-			 * yes or no, so bad flow returns 0 (false) and sets
-			 * the failVarObj to the string length.
-			 */
-			result = 0;
-			failat = -1;
-		    } else if (stop == string1) {
-			/*
-			 * In this case, nothing like a number was found
-			 */
-			result = 0;
-			failat = 0;
-		    } else {
-			/*
-			 * Assume we sucked up one char per byte
-			 * and then we go onto SPACE, since we are
-			 * allowed trailing whitespace
-			 */
-			failat = stop - string1;
-			string1 = stop;
-			chcomp = Tcl_UniCharIsSpace;
-		    }
-		    break;
-		}
-		case STR_IS_GRAPH:
-		    chcomp = Tcl_UniCharIsGraph;
-		    break;
-		case STR_IS_INT: {
-		    char *stop;
-		    long int l = 0;
+	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
+	    return TCL_ERROR;
+	}
 
-		    if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) {
-			break;
-		    }
-		    /*
-		     * Like STR_IS_DOUBLE, but we use strtoul.
-		     * Since Tcl_GetIntFromObj already failed,
-		     * we set result to 0.
-		     */
-		    result = 0;
-		    errno = 0;
-		    l = strtol(string1, &stop, 0); /* INTL: Tcl source. */
-		    if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
-			/*
-			 * if (errno == ERANGE), then it was an over/underflow
-			 * problem, but in this method, we only want to know
-			 * yes or no, so bad flow returns 0 (false) and sets
-			 * the failVarObj to the string length.
-			 */
-			failat = -1;
+	/*
+	 * Reread to prevent shimmering problems.
+	 */
 
-		    } else if (stop == string1) {
-			/*
-			 * In this case, nothing like a number was found
-			 */
-			failat = 0;
-		    } else {
-			/*
-			 * Assume we sucked up one char per byte
-			 * and then we go onto SPACE, since we are
-			 * allowed trailing whitespace
-			 */
-			failat = stop - string1;
-			string1 = stop;
-			chcomp = Tcl_UniCharIsSpace;
-		    }
-		    break;
-		}
-		case STR_IS_LOWER:
-		    chcomp = Tcl_UniCharIsLower;
-		    break;
-		case STR_IS_PRINT:
-		    chcomp = Tcl_UniCharIsPrint;
-		    break;
-		case STR_IS_PUNCT:
-		    chcomp = Tcl_UniCharIsPunct;
-		    break;
-		case STR_IS_SPACE:
-		    chcomp = Tcl_UniCharIsSpace;
-		    break;
-		case STR_IS_UPPER:
-		    chcomp = Tcl_UniCharIsUpper;
-		    break;
-		case STR_IS_WORD:
-		    chcomp = Tcl_UniCharIsWordChar;
-		    break;
-		case STR_IS_XDIGIT: {
-		    for (; string1 < end; string1++, failat++) {
-			/* INTL: We assume unicode is bad for this class */
-			if ((*((unsigned char *)string1) >= 0xC0) ||
-			    !isxdigit(*(unsigned char *)string1)) {
-			    result = 0;
-			    break;
-			}
-		    }
-		    break;
-		}
-	    }
-	    if (chcomp != NULL) {
-		for (; string1 < end; string1 += length2, failat++) {
-		    length2 = TclUtfToUniChar(string1, &ch);
-		    if (!chcomp(ch)) {
-			result = 0;
-			break;
-		    }
-		}
-	    }
-	str_is_done:
-	    /*
-	     * Only set the failVarObj when we will return 0
-	     * and we have indicated a valid fail index (>= 0)
-	     */
-	    if ((result == 0) && (failVarObj != NULL)) {
-		Tcl_Obj *resPtr, *tmpPtr = Tcl_NewIntObj(failat);
-
-		Tcl_IncrRefCount(tmpPtr);
-		resPtr = Tcl_ObjSetVar2(interp, failVarObj, NULL, tmpPtr,
-			TCL_LEAVE_ERR_MSG);
-		Tcl_DecrRefCount(tmpPtr);
-		if (resPtr == NULL) {
-		    return TCL_ERROR;
-		}
-	    }
-	    Tcl_SetBooleanObj(resultPtr, result);
-	    break;
+	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
+	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
+
+	if (start < 0) {
+	    goto str_last_done;
+	} else if (start < length2) {
+	    p = ustring2 + start + 1 - length1;
+	} else {
+	    p = ustring2 + length2 - length1;
 	}
-	case STR_LAST: {
-	    Tcl_UniChar *ustring1, *ustring2, *p;
-	    int match, start;
+    } else {
+	p = ustring2 + length2 - length1;
+    }
 
-	    if (objc < 4 || objc > 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv,
-				 "subString string ?startIndex?");
-		return TCL_ERROR;
-	    }
+    /*
+     * If the length of the needle is more than the length of the haystack, it
+     * cannot be contained in there so we can avoid searching. [Bug 2960021]
+     */
 
+    if (length1 > 0 && length1 <= length2) {
+	for (; p >= ustring2; p--) {
 	    /*
-	     * We are searching string2 for the sequence string1.
+	     * Scan backwards to find the first character.
 	     */
 
-	    match = -1;
-	    start = 0;
-	    length2 = -1;
+	    if ((*p == *ustring1) && !memcmp(ustring1, p,
+		    sizeof(Tcl_UniChar) * (size_t)length1)) {
+		match = p - ustring2;
+		break;
+	    }
+	}
+    }
+
+  str_last_done:
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringIndexCmd --
+ *
+ *	This procedure is invoked to process the "string index" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
-	    ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
+static int
+StringIndexCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int length, index;
 
-	    if (objc == 5) {
-		/*
-		 * If a startIndex is specified, we will need to restrict
-		 * the string range to that char index in the string
-		 */
-		if (TclGetIntForIndex(interp, objv[4], length2 - 1,
-			&start) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (start < 0) {
-		    goto str_last_done;
-		} else if (start < length2) {
-		    p = ustring2 + start + 1 - length1;
-		} else {
-		    p = ustring2 + length2 - length1;
-		}
-	    } else {
-		p = ustring2 + length2 - length1;
-	    }
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
+	return TCL_ERROR;
+    }
 
-	    if (length1 > 0) {
-		for (; p >= ustring2;  p--) {
-		    /*
-		     * Scan backwards to find the first character.
-		     */
-		    if ((*p == *ustring1) &&
-			    (memcmp((char *) ustring1, (char *) p, (size_t)
-				    (length1 * sizeof(Tcl_UniChar))) == 0)) {
-			match = p - ustring2;
-			break;
-		    }
-		}
-	    }
+    /*
+     * If we have a ByteArray object, avoid indexing in the Utf string since
+     * the byte array contains one byte per character. Otherwise, use the
+     * Unicode string rep to get the index'th char.
+     */
 
-	    str_last_done:
-	    Tcl_SetIntObj(resultPtr, match);
-	    break;
+    if (objv[1]->typePtr == &tclByteArrayType) {
+	const unsigned char *string =
+		Tcl_GetByteArrayFromObj(objv[1], &length);
+
+	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
+	    return TCL_ERROR;
 	}
-	case STR_BYTELENGTH:
-	case STR_LENGTH: {
-	    if (objc != 3) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string");
-		return TCL_ERROR;
-	    }
+	string = Tcl_GetByteArrayFromObj(objv[1], &length);
+	if ((index >= 0) && (index < length)) {
+	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(string + index, 1));
+	}
+    } else {
+	/*
+	 * Get Unicode char length to calulate what 'end' means.
+	 */
 
-	    if ((enum options) index == STR_BYTELENGTH) {
-		(void) Tcl_GetStringFromObj(objv[2], &length1);
-	    } else {
-		/*
-		 * If we have a ByteArray object, avoid recomputing the
-		 * string since the byte array contains one byte per
-		 * character.  Otherwise, use the Unicode string rep to
-		 * calculate the length.
-		 */
+	length = Tcl_GetCharLength(objv[1]);
 
-		if (objv[2]->typePtr == &tclByteArrayType) {
-		    (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
-		} else {
-		    length1 = Tcl_GetCharLength(objv[2]);
-		}
-	    }
-	    Tcl_SetIntObj(resultPtr, length1);
-	    break;
+	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
+	    return TCL_ERROR;
 	}
-	case STR_MAP: {
-	    int mapElemc, nocase = 0, copySource = 0;
-	    Tcl_Obj **mapElemv, *sourceObj;
-	    Tcl_UniChar *ustring1, *ustring2, *p, *end;
-	    int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*,
-					CONST Tcl_UniChar*, unsigned long));
-
-	    if (objc < 4 || objc > 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
-		return TCL_ERROR;
-	    }
+	if ((index >= 0) && (index < length)) {
+	    char buf[TCL_UTF_MAX];
+	    Tcl_UniChar ch;
 
-	    if (objc == 5) {
-		string2 = Tcl_GetStringFromObj(objv[2], &length2);
-		if ((length2 > 1) &&
-		    strncmp(string2, "-nocase", (size_t) length2) == 0) {
-		    nocase = 1;
-		} else {
-		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
-					   string2, "\": must be -nocase",
-					   (char *) NULL);
-		    return TCL_ERROR;
-		}
-	    }
+	    ch = Tcl_GetUniChar(objv[1], index);
+	    length = Tcl_UniCharToUtf(ch, buf);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringIsCmd --
+ *
+ *	This procedure is invoked to process the "string is" Tcl command. See
+ *	the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
-				       &mapElemv) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (mapElemc == 0) {
-		/*
-		 * empty charMap, just return whatever string was given
-		 */
-		Tcl_SetObjResult(interp, objv[objc-1]);
-		return TCL_OK;
-	    } else if (mapElemc & 1) {
-		/*
-		 * The charMap must be an even number of key/value items
-		 */
-		Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
-		return TCL_ERROR;
-	    }
+static int
+StringIsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    const char *string1, *end, *stop;
+    Tcl_UniChar ch;
+    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
+    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
+    Tcl_Obj *objPtr, *failVarObj = NULL;
+    Tcl_WideInt w;
+
+    static const char *isClasses[] = {
+	"alnum",	"alpha",	"ascii",	"control",
+	"boolean",	"digit",	"double",	"false",
+	"graph",	"integer",	"list",		"lower",
+	"print",	"punct",	"space",	"true",
+	"upper",	"wideinteger",	"wordchar",	"xdigit",
+	NULL
+    };
+    enum isClasses {
+	STR_IS_ALNUM, STR_IS_ALPHA,	STR_IS_ASCII,  STR_IS_CONTROL,
+	STR_IS_BOOL,  STR_IS_DIGIT,	STR_IS_DOUBLE, STR_IS_FALSE,
+	STR_IS_GRAPH, STR_IS_INT,	STR_IS_LIST,   STR_IS_LOWER,
+	STR_IS_PRINT, STR_IS_PUNCT,	STR_IS_SPACE,  STR_IS_TRUE,
+	STR_IS_UPPER, STR_IS_WIDE,	STR_IS_WORD,   STR_IS_XDIGIT
+    };
+    static const char *isOptions[] = {
+	"-strict", "-failindex", NULL
+    };
+    enum isOptions {
+	OPT_STRICT, OPT_FAILIDX
+    };
 
-	    /*
-	     * Take a copy of the source string object if it is the
-	     * same as the map string to cut out nasty sharing
-	     * crashes. [Bug 1018562]
-	     */
-	    if (objv[objc-2] == objv[objc-1]) {
-		sourceObj = Tcl_DuplicateObj(objv[objc-1]);
-		copySource = 1;
-	    } else {
-		sourceObj = objv[objc-1];
+    if (objc < 3 || objc > 6) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"class ?-strict? ?-failindex var? str");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (objc != 3) {
+	for (i = 2; i < objc-1; i++) {
+	    int idx2;
+
+	    if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0,
+		    &idx2) != TCL_OK) {
+		return TCL_ERROR;
 	    }
-	    ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
-	    if (length1 == 0) {
-		/*
-		 * Empty input string, just stop now
-		 */
-		if (copySource) {
-		    Tcl_DecrRefCount(sourceObj);
+	    switch ((enum isOptions) idx2) {
+	    case OPT_STRICT:
+		strict = 1;
+		break;
+	    case OPT_FAILIDX:
+		if (i+1 >= objc-1) {
+		    Tcl_WrongNumArgs(interp, 2, objv,
+			    "?-strict? ?-failindex var? str");
+		    return TCL_ERROR;
 		}
+		failVarObj = objv[++i];
 		break;
 	    }
-	    end = ustring1 + length1;
+	}
+    }
+
+    /*
+     * We get the objPtr so that we can short-cut for some classes by checking
+     * the object type (int and double), but we need the string otherwise,
+     * because we don't want any conversion of type occuring (as, for example,
+     * Tcl_Get*FromObj would do).
+     */
 
-	    strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
+    objPtr = objv[objc-1];
 
-	    /*
-	     * Force result to be Unicode
-	     */
-	    Tcl_SetUnicodeObj(resultPtr, ustring1, 0);
+    /*
+     * When entering here, result == 1 and failat == 0.
+     */
 
-	    if (mapElemc == 2) {
-		/*
-		 * Special case for one map pair which avoids the extra
-		 * for loop and extra calls to get Unicode data.  The
-		 * algorithm is otherwise identical to the multi-pair case.
-		 * This will be >30% faster on larger strings.
-		 */
-		int mapLen;
-		Tcl_UniChar *mapString, u2lc;
-
-		ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
-		p = ustring1;
-		if ((length2 > length1) || (length2 == 0)) {
-		    /* match string is either longer than input or empty */
-		    ustring1 = end;
-		} else {
-		    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
-		    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
-		    for (; ustring1 < end; ustring1++) {
-			if (((*ustring1 == *ustring2) ||
-				(nocase && (Tcl_UniCharToLower(*ustring1) ==
-					u2lc))) &&
-				((length2 == 1) || strCmpFn(ustring1, ustring2,
-					(unsigned long) length2) == 0)) {
-			    if (p != ustring1) {
-				Tcl_AppendUnicodeToObj(resultPtr, p,
-					ustring1 - p);
-				p = ustring1 + length2;
-			    } else {
-				p += length2;
-			    }
-			    ustring1 = p - 1;
-
-			    Tcl_AppendUnicodeToObj(resultPtr, mapString,
-				    mapLen);
-			}
-		    }
-		}
+    switch ((enum isClasses) index) {
+    case STR_IS_ALNUM:
+	chcomp = Tcl_UniCharIsAlnum;
+	break;
+    case STR_IS_ALPHA:
+	chcomp = Tcl_UniCharIsAlpha;
+	break;
+    case STR_IS_ASCII:
+	chcomp = UniCharIsAscii;
+	break;
+    case STR_IS_BOOL:
+    case STR_IS_TRUE:
+    case STR_IS_FALSE:
+	if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) {
+	    if (strict) {
+		result = 0;
 	    } else {
-		Tcl_UniChar **mapStrings, *u2lc = NULL;
-		int *mapLens;
-		/*
-		 * Precompute pointers to the unicode string and length.
-		 * This saves us repeated function calls later,
-		 * significantly speeding up the algorithm.  We only need
-		 * the lowercase first char in the nocase case.
-		 */
-		mapStrings = (Tcl_UniChar **) ckalloc((mapElemc * 2)
-			* sizeof(Tcl_UniChar *));
-		mapLens = (int *) ckalloc((mapElemc * 2) * sizeof(int));
-		if (nocase) {
-		    u2lc = (Tcl_UniChar *)
-			ckalloc((mapElemc) * sizeof(Tcl_UniChar));
-		}
-		for (index = 0; index < mapElemc; index++) {
-		    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
-			    &(mapLens[index]));
-		    if (nocase && ((index % 2) == 0)) {
-			u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
-		    }
-		}
-		for (p = ustring1; ustring1 < end; ustring1++) {
-		    for (index = 0; index < mapElemc; index += 2) {
-			/*
-			 * Get the key string to match on.
-			 */
-			ustring2 = mapStrings[index];
-			length2  = mapLens[index];
-			if ((length2 > 0) && ((*ustring1 == *ustring2) ||
-				(nocase && (Tcl_UniCharToLower(*ustring1) ==
-					u2lc[index/2]))) &&
-				/* restrict max compare length */
-				((end - ustring1) >= length2) &&
-				((length2 == 1) || strCmpFn(ustring2, ustring1,
-					(unsigned long) length2) == 0)) {
-			    if (p != ustring1) {
-				/*
-				 * Put the skipped chars onto the result first
-				 */
-				Tcl_AppendUnicodeToObj(resultPtr, p,
-					ustring1 - p);
-				p = ustring1 + length2;
-			    } else {
-				p += length2;
-			    }
-			    /*
-			     * Adjust len to be full length of matched string
-			     */
-			    ustring1 = p - 1;
-
-			    /*
-			     * Append the map value to the unicode string
-			     */
-			    Tcl_AppendUnicodeToObj(resultPtr,
-				    mapStrings[index+1], mapLens[index+1]);
-			    break;
-			}
-		    }
-		}
-		ckfree((char *) mapStrings);
-		ckfree((char *) mapLens);
-		if (nocase) {
-		    ckfree((char *) u2lc);
-		}
-	    }
-	    if (p != ustring1) {
-		/*
-		 * Put the rest of the unmapped chars onto result
-		 */
-		Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
-	    }
-	    if (copySource) {
-		Tcl_DecrRefCount(sourceObj);
-	    }
+		string1 = TclGetStringFromObj(objPtr, &length1);
+		result = length1 == 0;
+	    }
+	} else if (((index == STR_IS_TRUE) &&
+		objPtr->internalRep.longValue == 0)
+	    || ((index == STR_IS_FALSE) &&
+		objPtr->internalRep.longValue != 0)) {
+	    result = 0;
+	}
+	break;
+    case STR_IS_CONTROL:
+	chcomp = Tcl_UniCharIsControl;
+	break;
+    case STR_IS_DIGIT:
+	chcomp = Tcl_UniCharIsDigit;
+	break;
+    case STR_IS_DOUBLE: {
+	/* TODO */
+	if ((objPtr->typePtr == &tclDoubleType) ||
+		(objPtr->typePtr == &tclIntType) ||
+#ifndef NO_WIDE_TYPE
+		(objPtr->typePtr == &tclWideIntType) ||
+#endif
+		(objPtr->typePtr == &tclBignumType)) {
 	    break;
 	}
-	case STR_MATCH: {
-	    Tcl_UniChar *ustring1, *ustring2;
-	    int nocase = 0;
-
-	    if (objc < 4 || objc > 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
-		return TCL_ERROR;
+	string1 = TclGetStringFromObj(objPtr, &length1);
+	if (length1 == 0) {
+	    if (strict) {
+		result = 0;
 	    }
-
-	    if (objc == 5) {
-		string2 = Tcl_GetStringFromObj(objv[2], &length2);
-		if ((length2 > 1) &&
-		    strncmp(string2, "-nocase", (size_t) length2) == 0) {
-		    nocase = 1;
-		} else {
-		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
-					   string2, "\": must be -nocase",
-					   (char *) NULL);
-		    return TCL_ERROR;
-		}
+	    goto str_is_done;
+	}
+	end = string1 + length1;
+	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+		(const char **) &stop, 0) != TCL_OK) {
+	    result = 0;
+	    failat = 0;
+	} else {
+	    failat = stop - string1;
+	    if (stop < end) {
+		result = 0;
+		TclFreeIntRep(objPtr);
+		objPtr->typePtr = NULL;
 	    }
-	    ustring1 = Tcl_GetUnicodeFromObj(objv[objc-1], &length1);
-	    ustring2 = Tcl_GetUnicodeFromObj(objv[objc-2], &length2);
-	    Tcl_SetBooleanObj(resultPtr, TclUniCharMatch(ustring1, length1,
-		    ustring2, length2, nocase));
+	}
+	break;
+    }
+    case STR_IS_GRAPH:
+	chcomp = Tcl_UniCharIsGraph;
+	break;
+    case STR_IS_INT:
+	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
+	    break;
+	}
+	goto failedIntParse;
+    case STR_IS_WIDE:
+	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
 	    break;
 	}
-	case STR_RANGE: {
-	    int first, last;
 
-	    if (objc != 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
-		return TCL_ERROR;
+    failedIntParse:
+	string1 = TclGetStringFromObj(objPtr, &length1);
+	if (length1 == 0) {
+	    if (strict) {
+		result = 0;
 	    }
-
+	    goto str_is_done;
+	}
+	result = 0;
+	if (failVarObj == NULL) {
 	    /*
-	     * If we have a ByteArray object, avoid indexing in the
-	     * Utf string since the byte array contains one byte per
-	     * character.  Otherwise, use the Unicode string rep to
-	     * get the range.
+	     * Don't bother computing the failure point if we're not going to
+	     * return it.
 	     */
 
-	    if (objv[2]->typePtr == &tclByteArrayType) {
-		string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
-		length1--;
+	    break;
+	}
+	end = string1 + length1;
+	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+	    if (stop == end) {
+		/*
+		 * Entire string parses as an integer, but rejected by
+		 * Tcl_Get(Wide)IntFromObj() so we must have overflowed the
+		 * target type, and our convention is to return failure at
+		 * index -1 in that situation.
+		 */
+
+		failat = -1;
 	    } else {
 		/*
-		 * Get the length in actual characters.
+		 * Some prefix parsed as an integer, but not the whole string,
+		 * so return failure index as the point where parsing stopped.
+		 * Clear out the internal rep, since keeping it would leave
+		 * *objPtr in an inconsistent state.
 		 */
-		string1 = NULL;
-		length1 = Tcl_GetCharLength(objv[2]) - 1;
-	    }
 
-	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
-		    || (TclGetIntForIndex(interp, objv[4], length1,
-			    &last) != TCL_OK)) {
-		return TCL_ERROR;
+		failat = stop - string1;
+		TclFreeIntRep(objPtr);
+		objPtr->typePtr = NULL;
 	    }
+	} else {
+	    /*
+	     * No prefix is a valid integer. Fail at beginning.
+	     */
 
-	    if (first < 0) {
-		first = 0;
-	    }
-	    if (last >= length1) {
-		last = length1;
-	    }
-	    if (last >= first) {
-		if (string1 != NULL) {
-		    int numBytes = last - first + 1;
-		    resultPtr = Tcl_NewByteArrayObj(
-			(unsigned char *) &string1[first], numBytes);
-		    Tcl_SetObjResult(interp, resultPtr);
-		} else {
-		    Tcl_SetObjResult(interp,
-			    Tcl_GetRange(objv[2], first, last));
-		}
-	    }
+	    failat = 0;
+	}
+	break;
+    case STR_IS_LIST:
+	/*
+	 * We ignore the strictness here, since empty strings are always
+	 * well-formed lists.
+	 */
+
+	if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) {
 	    break;
 	}
-	case STR_REPEAT: {
-	    int count;
 
-	    if (objc != 4) {
-		Tcl_WrongNumArgs(interp, 2, objv, "string count");
-		return TCL_ERROR;
-	    }
+	if (failVarObj != NULL) {
+	    /*
+	     * Need to figure out where the list parsing failed, which is
+	     * fairly expensive. This is adapted from the core of
+	     * SetListFromAny().
+	     */
 
-	    if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
-		return TCL_ERROR;
-	    }
+	    const char *elemStart, *nextElem;
+	    int lenRemain, elemSize;
+	    register const char *p;
+
+	    string1 = TclGetStringFromObj(objPtr, &length1);
+	    end = string1 + length1;
+	    failat = -1;
+	    for (p=string1, lenRemain=length1; lenRemain > 0;
+		    p=nextElem, lenRemain=end-nextElem) {
+		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
+			&elemStart, &nextElem, &elemSize, NULL)) {
+		    Tcl_Obj *tmpStr;
 
-	    if (count == 1) {
-		Tcl_SetObjResult(interp, objv[2]);
-	    } else if (count > 1) {
-		string1 = Tcl_GetStringFromObj(objv[2], &length1);
-		if (length1 > 0) {
-		    /*
-		     * Only build up a string that has data.  Instead of
-		     * building it up with repeated appends, we just allocate
-		     * the necessary space once and copy the string value in.
-		     * Check for overflow with back-division. [Bug #714106]
-		     */
-		    length2		= length1 * count;
-		    if ((length2 / count) != length1) {
-			char buf[TCL_INTEGER_SPACE+1];
-			sprintf(buf, "%d", INT_MAX);
-			Tcl_AppendStringsToObj(resultPtr,
-				"string size overflow, must be less than ",
-				buf, (char *) NULL);
-			return TCL_ERROR;
-		    }
 		    /*
-		     * Include space for the NULL
+		     * This is the simplest way of getting the number of
+		     * characters parsed. Note that this is not the same as
+		     * the number of bytes when parsing strings with non-ASCII
+		     * characters in them.
+		     *
+		     * Skip leading spaces first. This is only really an issue
+		     * if it is the first "element" that has the failure.
 		     */
-		    string2		= (char *) ckalloc((size_t) length2+1);
-		    for (index = 0; index < count; index++) {
-			memcpy(string2 + (length1 * index), string1,
-				(size_t) length1);
+
+		    while (TclIsSpaceProc(*p)) {
+			p++;
 		    }
-		    string2[length2]	= '\0';
-		    /*
-		     * We have to directly assign this instead of using
-		     * Tcl_SetStringObj (and indirectly TclInitStringRep)
-		     * because that makes another copy of the data.
-		     */
-		    resultPtr		= Tcl_NewObj();
-		    resultPtr->bytes	= string2;
-		    resultPtr->length	= length2;
-		    Tcl_SetObjResult(interp, resultPtr);
+		    TclNewStringObj(tmpStr, string1, p-string1);
+		    failat = Tcl_GetCharLength(tmpStr);
+		    TclDecrRefCount(tmpStr);
+		    break;
 		}
 	    }
-	    break;
 	}
-	case STR_REPLACE: {
-	    Tcl_UniChar *ustring1;
-	    int first, last;
-
-	    if (objc < 5 || objc > 6) {
-	        Tcl_WrongNumArgs(interp, 2, objv,
-				 "string first last ?string?");
-		return TCL_ERROR;
+	result = 0;
+	break;
+    case STR_IS_LOWER:
+	chcomp = Tcl_UniCharIsLower;
+	break;
+    case STR_IS_PRINT:
+	chcomp = Tcl_UniCharIsPrint;
+	break;
+    case STR_IS_PUNCT:
+	chcomp = Tcl_UniCharIsPunct;
+	break;
+    case STR_IS_SPACE:
+	chcomp = Tcl_UniCharIsSpace;
+	break;
+    case STR_IS_UPPER:
+	chcomp = Tcl_UniCharIsUpper;
+	break;
+    case STR_IS_WORD:
+	chcomp = Tcl_UniCharIsWordChar;
+	break;
+    case STR_IS_XDIGIT:
+	chcomp = UniCharIsHexDigit;
+	break;
+    }
+
+    if (chcomp != NULL) {
+	string1 = TclGetStringFromObj(objPtr, &length1);
+	if (length1 == 0) {
+	    if (strict) {
+		result = 0;
+	    }
+	    goto str_is_done;
+	}
+	end = string1 + length1;
+	for (; string1 < end; string1 += length2, failat++) {
+	    length2 = TclUtfToUniChar(string1, &ch);
+	    if (!chcomp(ch)) {
+		result = 0;
+		break;
 	    }
+	}
+    }
 
-	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
-	    length1--;
+    /*
+     * Only set the failVarObj when we will return 0 and we have indicated a
+     * valid fail index (>= 0).
+     */
 
-	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
-		    || (TclGetIntForIndex(interp, objv[4], length1,
-			    &last) != TCL_OK)) {
-		return TCL_ERROR;
-	    }
+ str_is_done:
+    if ((result == 0) && (failVarObj != NULL) &&
+	Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
+		TCL_LEAVE_ERR_MSG) == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+    return TCL_OK;
+}
 
-	    if ((last < first) || (last < 0) || (first > length1)) {
-		Tcl_SetObjResult(interp, objv[2]);
-	    } else {
-		if (first < 0) {
-		    first = 0;
-		}
+static int
+UniCharIsAscii(
+    int character)
+{
+    return (character >= 0) && (character < 0x80);
+}
 
-		Tcl_SetUnicodeObj(resultPtr, ustring1, first);
-		if (objc == 6) {
-		    Tcl_AppendObjToObj(resultPtr, objv[5]);
-		}
-		if (last < length1) {
-		    Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
-			    length1 - last);
-		}
-	    }
-	    break;
-	}
-	case STR_TOLOWER:
-	case STR_TOUPPER:
-	case STR_TOTITLE:
-	    if (objc < 3 || objc > 5) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
-		return TCL_ERROR;
-	    }
+static int
+UniCharIsHexDigit(
+    int character)
+{
+    return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMapCmd --
+ *
+ *	This procedure is invoked to process the "string map" Tcl command. See
+ *	the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
+static int
+StringMapCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int length1, length2, mapElemc, index;
+    int nocase = 0, mapWithDict = 0, copySource = 0;
+    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
+    Tcl_UniChar *ustring1, *ustring2, *p, *end;
+    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long);
+
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
+	return TCL_ERROR;
+    }
 
-	    if (objc == 3) {
-		/*
-		 * Since the result object is not a shared object, it is
-		 * safe to copy the string into the result and do the
-		 * conversion in place.  The conversion may change the length
-		 * of the string, so reset the length after conversion.
-		 */
+    if (objc == 4) {
+	const char *string = TclGetStringFromObj(objv[1], &length2);
 
-		Tcl_SetStringObj(resultPtr, string1, length1);
-		if ((enum options) index == STR_TOLOWER) {
-		    length1 = Tcl_UtfToLower(Tcl_GetString(resultPtr));
-		} else if ((enum options) index == STR_TOUPPER) {
-		    length1 = Tcl_UtfToUpper(Tcl_GetString(resultPtr));
-		} else {
-		    length1 = Tcl_UtfToTitle(Tcl_GetString(resultPtr));
-		}
-		Tcl_SetObjLength(resultPtr, length1);
-	    } else {
-		int first, last;
-		CONST char *start, *end;
+	if ((length2 > 1) &&
+		strncmp(string, "-nocase", (size_t) length2) == 0) {
+	    nocase = 1;
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", string,
+		    "\": must be -nocase", NULL);
+	    return TCL_ERROR;
+	}
+    }
 
-		length1 = Tcl_NumUtfChars(string1, length1) - 1;
-		if (TclGetIntForIndex(interp, objv[3], length1,
-				      &first) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (first < 0) {
-		    first = 0;
-		}
-		last = first;
-		if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1,
-						      &last) != TCL_OK)) {
-		    return TCL_ERROR;
-		}
-		if (last >= length1) {
-		    last = length1;
-		}
-		if (last < first) {
-		    Tcl_SetObjResult(interp, objv[2]);
-		    break;
-		}
-		start = Tcl_UtfAtIndex(string1, first);
-		end = Tcl_UtfAtIndex(start, last - first + 1);
-		length2 = end-start;
-		string2 = ckalloc((size_t) length2+1);
-		memcpy(string2, start, (size_t) length2);
-		string2[length2] = '\0';
-		if ((enum options) index == STR_TOLOWER) {
-		    length2 = Tcl_UtfToLower(string2);
-		} else if ((enum options) index == STR_TOUPPER) {
-		    length2 = Tcl_UtfToUpper(string2);
-		} else {
-		    length2 = Tcl_UtfToTitle(string2);
-		}
-		Tcl_SetStringObj(resultPtr, string1, start - string1);
-		Tcl_AppendToObj(resultPtr, string2, length2);
-		Tcl_AppendToObj(resultPtr, end, -1);
-		ckfree(string2);
-	    }
-	    break;
+    /*
+     * This test is tricky, but has to be that way or you get other strange
+     * inconsistencies (see test string-10.20 for illustration why!)
+     */
 
-	case STR_TRIM: {
-	    Tcl_UniChar ch, trim;
-	    register CONST char *p, *end;
-	    char *check, *checkEnd;
-	    int offset;
-
-	    left = 1;
-	    right = 1;
-
-	    dotrim:
-	    if (objc == 4) {
-		string2 = Tcl_GetStringFromObj(objv[3], &length2);
-	    } else if (objc == 3) {
-		string2 = " \t\n\r";
-		length2 = strlen(string2);
-	    } else {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
-		return TCL_ERROR;
-	    }
-	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
-	    checkEnd = string2 + length2;
+    if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
+	int i, done;
+	Tcl_DictSearch search;
 
-	    if (left) {
-		end = string1 + length1;
-		/*
-		 * The outer loop iterates over the string.  The inner
-		 * loop iterates over the trim characters.  The loops
-		 * terminate as soon as a non-trim character is discovered
-		 * and string1 is left pointing at the first non-trim
-		 * character.
-		 */
+	/*
+	 * We know the type exactly, so all dict operations will succeed for
+	 * sure. This shortens this code quite a bit.
+	 */
 
-		for (p = string1; p < end; p += offset) {
-		    offset = TclUtfToUniChar(p, &ch);
-		    
-		    for (check = string2; ; ) {
-			if (check >= checkEnd) {
-			    p = end;
-			    break;
-			}
-			check += TclUtfToUniChar(check, &trim);
-			if (ch == trim) {
-			    length1 -= offset;
-			    string1 += offset;
-			    break;
-			}
-		    }
-		}
-	    }
-	    if (right) {
-	        end = string1;
+	Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
+	if (mapElemc == 0) {
+	    /*
+	     * Empty charMap, just return whatever string was given.
+	     */
 
-		/*
-		 * The outer loop iterates over the string.  The inner
-		 * loop iterates over the trim characters.  The loops
-		 * terminate as soon as a non-trim character is discovered
-		 * and length1 marks the last non-trim character.
-		 */
+	    Tcl_SetObjResult(interp, objv[objc-1]);
+	    return TCL_OK;
+	}
 
-		for (p = string1 + length1; p > end; ) {
-		    p = Tcl_UtfPrev(p, string1);
-		    offset = TclUtfToUniChar(p, &ch);
-		    for (check = string2; ; ) {
-		        if (check >= checkEnd) {
-			    p = end;
-			    break;
-			}
-			check += TclUtfToUniChar(check, &trim);
-			if (ch == trim) {
-			    length1 -= offset;
-			    break;
-			}
-		    }
-		}
-	    }
-	    Tcl_SetStringObj(resultPtr, string1, length1);
-	    break;
+	mapElemc *= 2;
+	mapWithDict = 1;
+
+	/*
+	 * Copy the dictionary out into an array; that's the easiest way to
+	 * adapt this code...
+	 */
+
+	mapElemv = (Tcl_Obj **)
+		TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
+	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
+		mapElemv+1, &done);
+	for (i=2 ; i<mapElemc ; i+=2) {
+	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
 	}
-	case STR_TRIMLEFT: {
-	    left = 1;
-	    right = 0;
-	    goto dotrim;
+	Tcl_DictObjDone(&search);
+    } else {
+	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
+		&mapElemv) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	case STR_TRIMRIGHT: {
-	    left = 0;
-	    right = 1;
-	    goto dotrim;
+	if (mapElemc == 0) {
+	    /*
+	     * empty charMap, just return whatever string was given.
+	     */
+
+	    Tcl_SetObjResult(interp, objv[objc-1]);
+	    return TCL_OK;
+	} else if (mapElemc & 1) {
+	    /*
+	     * The charMap must be an even number of key/value items.
+	     */
+
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("char map list unbalanced", -1));
+	    return TCL_ERROR;
 	}
-	case STR_WORDEND: {
-	    int cur;
-	    Tcl_UniChar ch;
-	    CONST char *p, *end;
-	    int numChars;
-	    
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
-		return TCL_ERROR;
-	    }
+    }
 
-	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
-	    numChars = Tcl_NumUtfChars(string1, length1);
-	    if (TclGetIntForIndex(interp, objv[3], numChars-1,
-				  &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (index < 0) {
-		index = 0;
-	    }
-	    if (index < numChars) {
-		p = Tcl_UtfAtIndex(string1, index);
-		end = string1+length1;
-		for (cur = index; p < end; cur++) {
-		    p += TclUtfToUniChar(p, &ch);
-		    if (!Tcl_UniCharIsWordChar(ch)) {
-			break;
+    /*
+     * Take a copy of the source string object if it is the same as the map
+     * string to cut out nasty sharing crashes. [Bug 1018562]
+     */
+
+    if (objv[objc-2] == objv[objc-1]) {
+	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
+	copySource = 1;
+    } else {
+	sourceObj = objv[objc-1];
+    }
+    ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
+    if (length1 == 0) {
+	/*
+	 * Empty input string, just stop now.
+	 */
+
+	goto done;
+    }
+    end = ustring1 + length1;
+
+    strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+
+    /*
+     * Force result to be Unicode
+     */
+
+    resultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+
+    if (mapElemc == 2) {
+	/*
+	 * Special case for one map pair which avoids the extra for loop and
+	 * extra calls to get Unicode data. The algorithm is otherwise
+	 * identical to the multi-pair case. This will be >30% faster on
+	 * larger strings.
+	 */
+
+	int mapLen;
+	Tcl_UniChar *mapString, u2lc;
+
+	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
+	p = ustring1;
+	if ((length2 > length1) || (length2 == 0)) {
+	    /*
+	     * Match string is either longer than input or empty.
+	     */
+
+	    ustring1 = end;
+	} else {
+	    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
+	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
+	    for (; ustring1 < end; ustring1++) {
+		if (((*ustring1 == *ustring2) ||
+			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
+			(length2==1 || strCmpFn(ustring1, ustring2,
+				(unsigned long) length2) == 0)) {
+		    if (p != ustring1) {
+			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+			p = ustring1 + length2;
+		    } else {
+			p += length2;
 		    }
+		    ustring1 = p - 1;
+
+		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
 		}
-		if (cur == index) {
-		    cur++;
-		}
-	    } else {
-		cur = numChars;
 	    }
-	    Tcl_SetIntObj(resultPtr, cur);
-	    break;
 	}
-	case STR_WORDSTART: {
-	    int cur;
-	    Tcl_UniChar ch;
-	    CONST char *p;
-	    int numChars;
-	    
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "string index");
-		return TCL_ERROR;
-	    }
+    } else {
+	Tcl_UniChar **mapStrings, *u2lc = NULL;
+	int *mapLens;
 
-	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
-	    numChars = Tcl_NumUtfChars(string1, length1);
-	    if (TclGetIntForIndex(interp, objv[3], numChars-1,
-				  &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (index >= numChars) {
-		index = numChars - 1;
+	/*
+	 * Precompute pointers to the unicode string and length. This saves us
+	 * repeated function calls later, significantly speeding up the
+	 * algorithm. We only need the lowercase first char in the nocase
+	 * case.
+	 */
+
+	mapStrings = (Tcl_UniChar **) TclStackAlloc(interp,
+		mapElemc * 2 * sizeof(Tcl_UniChar *));
+	mapLens = (int *) TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
+	if (nocase) {
+	    u2lc = (Tcl_UniChar *) TclStackAlloc(interp,
+		    mapElemc * sizeof(Tcl_UniChar));
+	}
+	for (index = 0; index < mapElemc; index++) {
+	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
+		    mapLens+index);
+	    if (nocase && ((index % 2) == 0)) {
+		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
 	    }
-	    cur = 0;
-	    if (index > 0) {
-		p = Tcl_UtfAtIndex(string1, index);
-	        for (cur = index; cur >= 0; cur--) {
-		    TclUtfToUniChar(p, &ch);
-		    if (!Tcl_UniCharIsWordChar(ch)) {
-			break;
+	}
+	for (p = ustring1; ustring1 < end; ustring1++) {
+	    for (index = 0; index < mapElemc; index += 2) {
+		/*
+		 * Get the key string to match on.
+		 */
+
+		ustring2 = mapStrings[index];
+		length2 = mapLens[index];
+		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
+			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
+			/* Restrict max compare length. */
+			(end-ustring1 >= length2) && ((length2 == 1) ||
+			!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
+		    if (p != ustring1) {
+			/*
+			 * Put the skipped chars onto the result first.
+			 */
+
+			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+			p = ustring1 + length2;
+		    } else {
+			p += length2;
 		    }
-		    p = Tcl_UtfPrev(p, string1);
-		}
-		if (cur != index) {
-		    cur += 1;
+
+		    /*
+		     * Adjust len to be full length of matched string.
+		     */
+
+		    ustring1 = p - 1;
+
+		    /*
+		     * Append the map value to the unicode string.
+		     */
+
+		    Tcl_AppendUnicodeToObj(resultPtr,
+			    mapStrings[index+1], mapLens[index+1]);
+		    break;
 		}
 	    }
-	    Tcl_SetIntObj(resultPtr, cur);
-	    break;
 	}
+	if (nocase) {
+	    TclStackFree(interp, u2lc);
+	}
+	TclStackFree(interp, mapLens);
+	TclStackFree(interp, mapStrings);
+    }
+    if (p != ustring1) {
+	/*
+	 * Put the rest of the unmapped chars onto result.
+	 */
+
+	Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+  done:
+    if (mapWithDict) {
+	TclStackFree(interp, mapElemv);
+    }
+    if (copySource) {
+	Tcl_DecrRefCount(sourceObj);
     }
     return TCL_OK;
 }
@@ -2464,11 +2000,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SubstObjCmd --
+ * StringMatchCmd --
  *
- *	This procedure is invoked to process the "subst" Tcl command.
- *	See the user documentation for details on what it does.  This
- *	command relies on Tcl_SubstObj() for its implementation.
+ *	This procedure is invoked to process the "string match" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
  *	A standard Tcl result.
@@ -2479,94 +2015,49 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_SubstObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];       	/* Argument objects. */
+static int
+StringMatchCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static CONST char *substOptions[] = {
-	"-nobackslashes", "-nocommands", "-novariables", (char *) NULL
-    };
-    enum substOptions {
-	SUBST_NOBACKSLASHES,      SUBST_NOCOMMANDS,       SUBST_NOVARS
-    };
-    Tcl_Obj *resultPtr;
-    int optionIndex, flags, i;
+    int nocase = 0;
 
-    /*
-     * Parse command-line options.
-     */
-
-    flags = TCL_SUBST_ALL;
-    for (i = 1; i < (objc-1); i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], substOptions,
-		"switch", 0, &optionIndex) != TCL_OK) {
-
-	    return TCL_ERROR;
-	}
-	switch (optionIndex) {
-	    case SUBST_NOBACKSLASHES: {
-		flags &= ~TCL_SUBST_BACKSLASHES;
-		break;
-	    }
-	    case SUBST_NOCOMMANDS: {
-		flags &= ~TCL_SUBST_COMMANDS;
-		break;
-	    }
-	    case SUBST_NOVARS: {
-		flags &= ~TCL_SUBST_VARIABLES;
-		break;
-	    }
-	    default: {
-		panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
-	    }
-	}
-    }
-    if (i != (objc-1)) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-nobackslashes? ?-nocommands? ?-novariables? string");
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
 	return TCL_ERROR;
     }
 
-    /*
-     * Perform the substitution.
-     */
-    resultPtr = Tcl_SubstObj(interp, objv[i], flags);
+    if (objc == 4) {
+	int length;
+	const char *string = TclGetStringFromObj(objv[1], &length);
 
-    if (resultPtr == NULL) {
-	return TCL_ERROR;
+	if ((length > 1) &&
+	    strncmp(string, "-nocase", (size_t) length) == 0) {
+	    nocase = TCL_MATCH_NOCASE;
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", string,
+		    "\": must be -nocase", NULL);
+	    return TCL_ERROR;
+	}
     }
-    Tcl_SetObjResult(interp, resultPtr);
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SubstObj --
- *
- *	This function performs the substitutions specified on the
- *	given string as described in the user documentation for the
- *	"subst" Tcl command.  This code is heavily based on an
- *	implementation by Andrew Payne.  Note that if a command
- *	substitution returns TCL_CONTINUE or TCL_RETURN from its
- *	evaluation and is not completely well-formed, the results are
- *	not defined (or at least hard to characterise.)  This fault
- *	will be fixed at some point, but the cost of the only sane
- *	fix (well-formedness check first) is such that you need to
- *	"precompile and cache" to stop everyone from being hit with
- *	the consequences every time through.  Note that the current
- *	behaviour is not a security hole; it just restarts parsing
- *	the string following the substitution in a mildly surprising
- *	place, and it is a very bad idea to count on this remaining
- *	the same in future...
+ * StringRangeCmd --
+ *
+ *	This procedure is invoked to process the "string range" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	A Tcl_Obj* containing the substituted string, or NULL to
- *	indicate that an error occurred.
+ *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
@@ -2574,144 +2065,77 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-Tcl_SubstObj(interp, objPtr, flags)
-    Tcl_Interp *interp;
-    Tcl_Obj *objPtr;
-    int flags;
+static int
+StringRangeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Obj *resultObj;
-    char *p, *old;
-    int length;
+    const unsigned char *string;
+    int length, first, last;
 
-    old = p = Tcl_GetStringFromObj(objPtr, &length);
-    resultObj = Tcl_NewStringObj("", 0);
-    while (length) {
-	switch (*p) {
-	case '\\':
-	    if (flags & TCL_SUBST_BACKSLASHES) {
-		char buf[TCL_UTF_MAX];
-		int count;
-
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		Tcl_AppendToObj(resultObj, buf,
-				TclParseBackslash(p, length, &count, buf));
-		p += count; length -= count;
-		old = p;
-	    } else {
-		p++; length--;
-	    }
-	    break;
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
+	return TCL_ERROR;
+    }
 
-	case '$':
-	    if (flags & TCL_SUBST_VARIABLES) {
-		Tcl_Parse parse;
-		int code;
+    /*
+     * If we have a ByteArray object, avoid indexing in the Utf string since
+     * the byte array contains one byte per character. Otherwise, use the
+     * Unicode string rep to get the range.
+     */
 
-		/*
-		 * Code is simpler overall if we (effectively) inline
-		 * Tcl_ParseVar, particularly as that allows us to use
-		 * a non-string interface when we come to appending
-		 * the variable contents to the result object.  There
-		 * are a few other optimisations that doing this
-		 * enables (like being able to continue the run of
-		 * unsubstituted characters straight through if a '$'
-		 * does not precede a variable name.)
-		 */
-		if (Tcl_ParseVarName(interp, p, length, &parse, 0) != TCL_OK) {
-		    goto errorResult;
-		}
-		if (parse.numTokens == 1) {
-		    /*
-		     * There isn't a variable name after all: the $ is
-		     * just a $.
-		     */
-		    p++; length--;
-		    break;
-		}
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		p += parse.tokenPtr->size;
-		length -= parse.tokenPtr->size;
-		code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
-		        parse.numTokens);
-		if (code == TCL_ERROR) {
-		    goto errorResult;
-		}
-		if (code == TCL_BREAK) {
-		    Tcl_ResetResult(interp);
-		    return resultObj;
-		}
-		if (code != TCL_CONTINUE) {
-		    Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
-		}
-		Tcl_ResetResult(interp);
-		old = p;
-	    } else {
-		p++; length--;
-	    }
-	    break;
+    if (objv[1]->typePtr == &tclByteArrayType) {
+	string = Tcl_GetByteArrayFromObj(objv[1], &length);
+	length--;
+    } else {
+	/*
+	 * Get the length in actual characters.
+	 */
 
-	case '[':
-	    if (flags & TCL_SUBST_COMMANDS) {
-		Interp *iPtr = (Interp *) interp;
-		int code;
+	string = NULL;
+	length = Tcl_GetCharLength(objv[1]) - 1;
+    }
 
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		iPtr->evalFlags = TCL_BRACKET_TERM;
-		iPtr->numLevels++;
-		code = TclInterpReady(interp);
-		if (code == TCL_OK) {
-		    code = Tcl_EvalEx(interp, p+1, length-1, 0);
-		}
-		iPtr->numLevels--;
-		switch (code) {
-		case TCL_ERROR:
-		    goto errorResult;
-		case TCL_BREAK:
-		    Tcl_ResetResult(interp);
-		    return resultObj;
-		default:
-		    Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
-		case TCL_CONTINUE:
-		    Tcl_ResetResult(interp);
-		    old = p = (p+1 + iPtr->termOffset + 1);
-		    length -= (iPtr->termOffset + 2);
-		}
-	    } else {
-		p++; length--;
-	    }
-	    break;
-	default:
-	    p++; length--;
-	    break;
-	}
+    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
+	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (first < 0) {
+	first = 0;
     }
-    if (p != old) {
-	Tcl_AppendToObj(resultObj, old, p-old);
+    if (last >= length) {
+	last = length;
     }
-    return resultObj;
+    if (last >= first) {
+	if (string != NULL) {
+	    /*
+	     * Reread the string to prevent shimmering nasties.
+	     */
 
- errorResult:
-    Tcl_DecrRefCount(resultObj);
-    return NULL;
+	    string = Tcl_GetByteArrayFromObj(objv[1], &length);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewByteArrayObj(string+first, last - first + 1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
+	}
+    }
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SwitchObjCmd --
+ * StringReptCmd --
  *
- *	This object-based procedure is invoked to process the "switch" Tcl
- *	command. See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "string repeat" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	A standard Tcl object result.
+ *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
@@ -2719,263 +2143,159 @@ Tcl_SubstObj(interp, objPtr, flags)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_SwitchObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+static int
+StringReptCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int i, j, index, mode, matched, result, splitObjs;
-    char *string, *pattern;
-    Tcl_Obj *stringObj;
-    Tcl_Obj *CONST *savedObjv = objv;
-#ifdef TCL_TIP280
-    Interp*  iPtr  = (Interp*) interp;
-    int      pc    = 0;
-    int      bidx  = 0;    /* Index of body argument */
-    Tcl_Obj* blist = NULL; /* List obj which is the body */
-    CmdFrame ctx;          /* Copy of the topmost cmdframe,
-			    * to allow us to mess with the
-			    * line information */
-#endif
-    static CONST char *options[] = {
-	"-exact",	"-glob",	"-regexp",	"--", 
-	NULL
-    };
-    enum options {
-	OPT_EXACT,	OPT_GLOB,	OPT_REGEXP,	OPT_LAST
-    };
+    const char *string1;
+    char *string2;
+    int count, index, length1, length2;
+    Tcl_Obj *resultPtr;
 
-    mode = OPT_EXACT;
-    for (i = 1; i < objc; i++) {
-	string = Tcl_GetString(objv[i]);
-	if (string[0] != '-') {
-	    break;
-	}
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, 
-		&index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (index == OPT_LAST) {
-	    i++;
-	    break;
-	}
-	mode = index;
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string count");
+	return TCL_ERROR;
     }
 
-    if (objc - i < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? string pattern body ... ?default body?");
+    if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    stringObj = objv[i];
-    objc -= i + 1;
-    objv += i + 1;
-#ifdef TCL_TIP280
-    bidx = i+1; /* First after the match string */
-#endif
-
     /*
-     * If all of the pattern/command pairs are lumped into a single
-     * argument, split them out again.
-     *
-     * TIP #280: Determine the lines the words in the list start at, based on
-     * the same data for the list word itself. The cmdFramePtr line information
-     * is manipulated directly.
+     * Check for cases that allow us to skip copying stuff.
      */
 
-    splitObjs = 0;
-    if (objc == 1) {
-	Tcl_Obj **listv;
-#ifdef TCL_TIP280
-	blist = objv[0];
-#endif
-	if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+    if (count == 1) {
+	Tcl_SetObjResult(interp, objv[1]);
+	goto done;
+    } else if (count < 1) {
+	goto done;
+    }
+    string1 = TclGetStringFromObj(objv[1], &length1);
+    if (length1 <= 0) {
+	goto done;
+    }
 
-	/*
-	 * Ensure that the list is non-empty.
-	 */
+    /*
+     * Only build up a string that has data. Instead of building it up with
+     * repeated appends, we just allocate the necessary space once and copy
+     * the string value in.
+     *
+     * We have to worry about overflow [Bugs 714106, 2561746].
+     * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
+     * We need to keep 2 <= length2 <= INT_MAX.
+     */
 
-	if (objc < 1) {
-	    Tcl_WrongNumArgs(interp, 1, savedObjv,
-		    "?switches? string {pattern body ... ?default body?}");
-	    return TCL_ERROR;
-	}
-	objv = listv;
-	splitObjs = 1;
+    if (count > (INT_MAX / length1)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"result exceeds max size for a Tcl value (%d bytes)", INT_MAX));
+	return TCL_ERROR;
     }
+    length2 = length1 * count;
 
     /*
-     * Complain if there is an odd number of words in the list of
-     * patterns and bodies.
+     * Include space for the NUL.
      */
 
-    if (objc % 2) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
-
+    string2 = attemptckalloc((unsigned) length2 + 1);
+    if (string2 == NULL) {
 	/*
-	 * Check if this can be due to a badly placed comment
-	 * in the switch block.
-	 *
-	 * The following is an heuristic to detect the infamous
-	 * "comment in switch" error: just check if a pattern
-	 * begins with '#'.
+	 * Alloc failed. Note that in this case we try to do an error message
+	 * since this is a case that's most likely when the alloc is large and
+	 * that's easy to do with this API. Note that if we fail allocating a
+	 * short string, this will likely keel over too (and fatally).
 	 */
 
-	if (splitObjs) {
-	    for (i=0 ; i<objc ; i+=2) {
-		if (Tcl_GetString(objv[i])[0] == '#') {
-		    Tcl_AppendResult(interp, ", this may be due to a ",
-			    "comment incorrectly placed outside of a ",
-			    "switch body - see the \"switch\" ",
-			    "documentation", NULL);
-		    break;
-		}
-	    }
-	}
-
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"string size overflow, out of memory allocating %u bytes",
+		length2 + 1));
 	return TCL_ERROR;
     }
+    for (index = 0; index < count; index++) {
+	memcpy(string2 + (length1 * index), string1, (size_t) length1);
+    }
+    string2[length2] = '\0';
 
     /*
-     * Complain if the last body is a continuation.  Note that this
-     * check assumes that the list is non-empty!
+     * We have to directly assign this instead of using Tcl_SetStringObj (and
+     * indirectly TclInitStringRep) because that makes another copy of the
+     * data.
      */
 
-    if (strcmp(Tcl_GetString(objv[objc-1]), "-") == 0) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "no body specified for pattern \"",
-		Tcl_GetString(objv[objc-2]), "\"", NULL);
-	return TCL_ERROR;
-    }
-
-    for (i = 0; i < objc; i += 2) {
-	/*
-	 * See if the pattern matches the string.
-	 */
-
-	pattern = Tcl_GetString(objv[i]);
-
-	matched = 0;
-	if ((i == objc - 2) 
-		&& (*pattern == 'd') 
-		&& (strcmp(pattern, "default") == 0)) {
-	    matched = 1;
-	} else {
-	    switch (mode) {
-		case OPT_EXACT:
-		    matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0);
-		    break;
-		case OPT_GLOB:
-		    matched = Tcl_StringMatch(Tcl_GetString(stringObj),
-			    pattern);
-		    break;
-		case OPT_REGEXP:
-		    matched = Tcl_RegExpMatchObj(interp, stringObj, objv[i]);
-		    if (matched < 0) {
-			return TCL_ERROR;
-		    }
-		    break;
-	    }
-	}
-	if (matched == 0) {
-	    continue;
-	}
+    TclNewObj(resultPtr);
+    resultPtr->bytes = string2;
+    resultPtr->length = length2;
+    Tcl_SetObjResult(interp, resultPtr);
 
-	/*
-	 * We've got a match. Find a body to execute, skipping bodies
-	 * that are "-".
-	 *
-	 * TIP#280: Now is also the time to determine a line number for the
-	 * single-word case.
-	 */
+  done:
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringRplcCmd --
+ *
+ *	This procedure is invoked to process the "string replace" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-#ifdef TCL_TIP280
-	ctx = *iPtr->cmdFramePtr;
+static int
+StringRplcCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_UniChar *ustring;
+    int first, last, length;
 
-	if (splitObjs) {
-	    /* We have to perform the GetSrc and other type dependent handling
-	     * of the frame here because we are munging with the line numbers,
-	     * something the other commands like if, etc. are not doing. Them
-	     * are fine with simply passing the CmdFrame through and having
-	     * the special handling done in 'info frame', or the bc compiler
-	     */
+    if (objc < 4 || objc > 5) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
+	return TCL_ERROR;
+    }
 
-	    if (ctx.type == TCL_LOCATION_BC) {
-		/* Note: Type BC => ctx.data.eval.path    is not used.
-		 *                  ctx.data.tebc.codePtr is used instead.
-		 */
-		TclGetSrcInfoForPc (&ctx);
-		pc = 1;
-		/* The line information in the cmdFrame is now a copy we do
-		 * not own */
-	    }
+    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
+    length--;
 
-	    if (ctx.type == TCL_LOCATION_SOURCE) {
-		int bline = ctx.line [bidx];
-		if (bline >= 0) {
-		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
-		    ctx.nline = objc;
+    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
+	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
+	return TCL_ERROR;
+    }
 
-		    ListLines (blist, bline, objc, ctx.line, objv);
-		} else {
-		    int k;
-		    /* Dynamic code word ... All elements are relative to themselves */
+    if ((last < first) || (last < 0) || (first > length)) {
+	Tcl_SetObjResult(interp, objv[1]);
+    } else {
+	Tcl_Obj *resultPtr;
 
-		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
-		    ctx.nline = objc;
-		    for (k=0; k < objc; k++) {ctx.line[k] = -1;}
-		}
-	    } else {
-		int k;
-		/* Anything else ... No information, or dynamic ... */
+	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
+	length--;
 
-		ctx.line  = (int*) ckalloc (objc * sizeof(int));
-		ctx.nline = objc;
-		for (k=0; k < objc; k++) {ctx.line[k] = -1;}
-	    }
+	if (first < 0) {
+	    first = 0;
 	}
-#endif
 
-	for (j = i + 1; ; j += 2) {
-	    if (j >= objc) {
-		/*
-		 * This shouldn't happen since we've checked that the
-		 * last body is not a continuation...
-		 */
-		panic("fall-out when searching for body to match pattern");
-	    }
-	    if (strcmp(Tcl_GetString(objv[j]), "-") != 0) {
-		break;
-	    }
+	resultPtr = Tcl_NewUnicodeObj(ustring, first);
+	if (objc == 5) {
+	    Tcl_AppendObjToObj(resultPtr, objv[4]);
 	}
-#ifndef TCL_TIP280
-	result = Tcl_EvalObjEx(interp, objv[j], 0);
-#else
-	/* TIP #280. Make invoking context available to switch branch */
-	result = TclEvalObjEx(interp, objv[j], 0, &ctx, splitObjs ? j : bidx+j);
-	if (splitObjs) {
-	    ckfree ((char*) ctx.line);
-	    if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
-		/* Death of SrcInfo reference */
-		Tcl_DecrRefCount (ctx.data.eval.path);
-	    }
-	}
-#endif
-	if (result == TCL_ERROR) {
-	    char msg[100 + TCL_INTEGER_SPACE];
-
-	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", pattern,
-		    interp->errorLine);
-	    Tcl_AddObjErrorInfo(interp, msg, -1);
+	if (last < length) {
+	    Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
+		    length - last);
 	}
-	return result;
+	Tcl_SetObjResult(interp, resultPtr);
     }
     return TCL_OK;
 }
@@ -2983,13 +2303,14 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TimeObjCmd --
+ * StringRevCmd --
  *
- *	This object-based procedure is invoked to process the "time" Tcl
- *	command.  See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "string reverse" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	A standard Tcl object result.
+ *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
@@ -2997,1938 +2318,1622 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_TimeObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+static int
+StringRevCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register Tcl_Obj *objPtr;
-    Tcl_Obj *objs[4];
-    register int i, result;
-    int count;
-    double totalMicroSec;
-    Tcl_Time start, stop;
-
-    if (objc == 2) {
-	count = 1;
-    } else if (objc == 3) {
-	result = Tcl_GetIntFromObj(interp, objv[2], &count);
-	if (result != TCL_OK) {
-	    return result;
-	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string");
 	return TCL_ERROR;
     }
-    
-    objPtr = objv[1];
-    i = count;
-    Tcl_GetTime(&start);
-    while (i-- > 0) {
-	result = Tcl_EvalObjEx(interp, objPtr, 0);
-	if (result != TCL_OK) {
-	    return result;
-	}
-    }
-    Tcl_GetTime(&stop);
-    
-    totalMicroSec = ( ( (double) ( stop.sec - start.sec ) ) * 1.0e6
-		      + ( stop.usec - start.usec ) );
-    if (count <= 1) {
-	/* Use int obj since we know time is not fractional [Bug 1202178] */
-	objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
-    } else {
-	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
-    }
-    objs[1] = Tcl_NewStringObj("microseconds", -1);
-    objs[2] = Tcl_NewStringObj("per", -1);
-    objs[3] = Tcl_NewStringObj("iteration", -1);
-    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
+
+    Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TraceObjCmd --
- *
- *	This procedure is invoked to process the "trace" Tcl command.
- *	See the user documentation for details on what it does.
- *	
- *	Standard syntax as of Tcl 8.4 is
- *	
- *	 trace {add|info|remove} {command|variable} name ops cmd
+ * StringStartCmd --
  *
+ *	This procedure is invoked to process the "string wordstart" Tcl
+ *	command. See the user documentation for details on what it does. Note
+ *	that this command only functions correctly on properly formed Tcl UTF
+ *	strings.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
+ *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_TraceObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+static int
+StringStartCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int optionIndex;
-    char *name, *flagOps, *p;
-    /* Main sub commands to 'trace' */
-    static CONST char *traceOptions[] = {
-	"add", "info", "remove", 
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-	"variable", "vdelete", "vinfo", 
-#endif
-	(char *) NULL
-    };
-    /* 'OLD' options are pre-Tcl-8.4 style */
-    enum traceOptions {
-	TRACE_ADD, TRACE_INFO, TRACE_REMOVE, 
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
-#endif
-    };
+    Tcl_UniChar ch;
+    const char *p, *string;
+    int cur, index, length, numChars;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string index");
 	return TCL_ERROR;
     }
 
-    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
-		"option", 0, &optionIndex) != TCL_OK) {
+    string = TclGetStringFromObj(objv[1], &length);
+    numChars = Tcl_NumUtfChars(string, length);
+    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
 	return TCL_ERROR;
     }
-    switch ((enum traceOptions) optionIndex) {
-	case TRACE_ADD: 
-	case TRACE_REMOVE:
-	case TRACE_INFO: {
-	    /* 
-	     * All sub commands of trace add/remove must take at least
-	     * one more argument.  Beyond that we let the subcommand itself
-	     * control the argument structure.
-	     */
-	    int typeIndex;
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
-		return TCL_ERROR;
-	    }
-	    if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions,
-			"option", 0, &typeIndex) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
-	}
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-        case TRACE_OLD_VARIABLE:
-	case TRACE_OLD_VDELETE: {
-	    Tcl_Obj *copyObjv[6];
-	    Tcl_Obj *opsList;
-	    int code, numFlags;
-
-	    if (objc != 5) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
-		return TCL_ERROR;
-	    }
-
-	    opsList = Tcl_NewObj();
-	    Tcl_IncrRefCount(opsList);
-	    flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
-	    if (numFlags == 0) {
-		Tcl_DecrRefCount(opsList);
-		goto badVarOps;
-	    }
-	    for (p = flagOps; *p != 0; p++) {
-		if (*p == 'r') {
-		    Tcl_ListObjAppendElement(NULL, opsList,
-			    Tcl_NewStringObj("read", -1));
-		} else if (*p == 'w') {
-		    Tcl_ListObjAppendElement(NULL, opsList,
-			    Tcl_NewStringObj("write", -1));
-		} else if (*p == 'u') {
-		    Tcl_ListObjAppendElement(NULL, opsList,
-			    Tcl_NewStringObj("unset", -1));
-		} else if (*p == 'a') {
-		    Tcl_ListObjAppendElement(NULL, opsList,
-			    Tcl_NewStringObj("array", -1));
-		} else {
-		    Tcl_DecrRefCount(opsList);
-		    goto badVarOps;
-		}
-	    }
-	    copyObjv[0] = NULL;
-	    memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
-	    copyObjv[4] = opsList;
-	    if  (optionIndex == TRACE_OLD_VARIABLE) {
-		code = (traceSubCmds[2])(interp,TRACE_ADD,objc+1,copyObjv);
-	    } else {
-		code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
+    string = TclGetStringFromObj(objv[1], &length);
+    if (index >= numChars) {
+	index = numChars - 1;
+    }
+    cur = 0;
+    if (index > 0) {
+	p = Tcl_UtfAtIndex(string, index);
+	for (cur = index; cur >= 0; cur--) {
+	    TclUtfToUniChar(p, &ch);
+	    if (!Tcl_UniCharIsWordChar(ch)) {
+		break;
 	    }
-	    Tcl_DecrRefCount(opsList);
-	    return code;
+	    p = Tcl_UtfPrev(p, string);
 	}
-	case TRACE_OLD_VINFO: {
-	    ClientData clientData;
-	    char ops[5];
-	    Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
-
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "name");
-		return TCL_ERROR;
-	    }
-	    resultListPtr = Tcl_GetObjResult(interp);
-	    clientData = 0;
-	    name = Tcl_GetString(objv[2]);
-	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
-		    TraceVarProc, clientData)) != 0) {
-
-		TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
-
-		pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		p = ops;
-		if (tvarPtr->flags & TCL_TRACE_READS) {
-		    *p = 'r';
-		    p++;
-		}
-		if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		    *p = 'w';
-		    p++;
-		}
-		if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		    *p = 'u';
-		    p++;
-		}
-		if (tvarPtr->flags & TCL_TRACE_ARRAY) {
-		    *p = 'a';
-		    p++;
-		}
-		*p = '\0';
-
-		/*
-		 * Build a pair (2-item list) with the ops string as
-		 * the first obj element and the tvarPtr->command string
-		 * as the second obj element.  Append the pair (as an
-		 * element) to the end of the result object list.
-		 */
-
-		elemObjPtr = Tcl_NewStringObj(ops, -1);
-		Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
-		elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
-		Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
-		Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
-	    }
-	    Tcl_SetObjResult(interp, resultListPtr);
-	    break;
+	if (cur != index) {
+	    cur += 1;
 	}
-#endif /* TCL_REMOVE_OBSOLETE_TRACES */
     }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
     return TCL_OK;
-
-    badVarOps:
-    Tcl_AppendResult(interp, "bad operations \"", flagOps,
-	    "\": should be one or more of rwua", (char *) NULL);
-    return TCL_ERROR;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TclTraceExecutionObjCmd --
+ * StringEndCmd --
  *
- *	Helper function for Tcl_TraceObjCmd; implements the
- *	[trace {add|remove|info} execution ...] subcommands.
- *	See the user documentation for details on what these do.
+ *	This procedure is invoked to process the "string wordend" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	Standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Depends on the operation (add, remove, or info) being performed;
- *	may add or remove command traces on a command.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int optionIndex;			/* Add, info or remove */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+static int
+StringEndCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int commandLength, index;
-    char *name, *command;
-    size_t length;
-    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static CONST char *opStrings[] = { "enter", "leave", 
-                                 "enterstep", "leavestep", (char *) NULL };
-    enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
-                      TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP };
-    
-    switch ((enum traceOptions) optionIndex) {
-	case TRACE_ADD: 
-	case TRACE_REMOVE: {
-	    int flags = 0;
-	    int i, listLen, result;
-	    Tcl_Obj **elemPtrs;
-	    if (objc != 6) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
-		return TCL_ERROR;
-	    }
-	    /*
-	     * Make sure the ops argument is a list object; get its length and
-	     * a pointer to its array of element pointers.
-	     */
-
-	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
-		    &elemPtrs);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    if (listLen == 0) {
-		Tcl_SetResult(interp, "bad operation list \"\": must be "
-	          "one or more of enter, leave, enterstep, or leavestep", 
-		  TCL_STATIC);
-		return TCL_ERROR;
-	    }
-	    for (i = 0; i < listLen; i++) {
-		if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
-			"operation", TCL_EXACT, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch ((enum operations) index) {
-		    case TRACE_EXEC_ENTER:
-			flags |= TCL_TRACE_ENTER_EXEC;
-			break;
-		    case TRACE_EXEC_LEAVE:
-			flags |= TCL_TRACE_LEAVE_EXEC;
-			break;
-		    case TRACE_EXEC_ENTER_STEP:
-			flags |= TCL_TRACE_ENTER_DURING_EXEC;
-			break;
-		    case TRACE_EXEC_LEAVE_STEP:
-			flags |= TCL_TRACE_LEAVE_DURING_EXEC;
-			break;
-		}
-	    }
-	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
-	    length = (size_t) commandLength;
-	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
-		TraceCommandInfo *tcmdPtr;
-		tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
-			(sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
-				+ length + 1));
-		tcmdPtr->flags = flags;
-		tcmdPtr->stepTrace = NULL;
-		tcmdPtr->startLevel = 0;
-		tcmdPtr->startCmd = NULL;
-		tcmdPtr->length = length;
-		tcmdPtr->refCount = 1;
-		flags |= TCL_TRACE_DELETE;
-		if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
-			     TCL_TRACE_LEAVE_DURING_EXEC)) {
-		    flags |= (TCL_TRACE_ENTER_EXEC | 
-			      TCL_TRACE_LEAVE_EXEC);
-		}
-		memcpy(tcmdPtr->command, command, length + 1);
-		name = Tcl_GetString(objv[3]);
-		if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
-			(ClientData) tcmdPtr) != TCL_OK) {
-		    ckfree((char *) tcmdPtr);
-		    return TCL_ERROR;
-		}
-	    } else {
-		/*
-		 * Search through all of our traces on this command to
-		 * see if there's one with the given command.  If so, then
-		 * delete the first one that matches.
-		 */
-		
-		TraceCommandInfo *tcmdPtr;
-		ClientData clientData = NULL;
-		name = Tcl_GetString(objv[3]);
-
-		/* First ensure the name given is valid */
-		if (Tcl_FindCommand(interp, name, NULL, 
-				    TCL_LEAVE_ERR_MSG) == NULL) {
-		    return TCL_ERROR;
-		}
-				    
-		while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-			TraceCommandProc, clientData)) != NULL) {
-		    tcmdPtr = (TraceCommandInfo *) clientData;
-		    /* 
-		     * In checking the 'flags' field we must remove any
-		     * extraneous flags which may have been temporarily
-		     * added by various pieces of the trace mechanism.
-		     */
-		    if ((tcmdPtr->length == length)
-			    && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | 
-						   TCL_TRACE_RENAME | 
-						   TCL_TRACE_DELETE)) == flags)
-			    && (strncmp(command, tcmdPtr->command,
-				    (size_t) length) == 0)) {
-			flags |= TCL_TRACE_DELETE;
-			if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
-				     TCL_TRACE_LEAVE_DURING_EXEC)) {
-			    flags |= (TCL_TRACE_ENTER_EXEC | 
-				      TCL_TRACE_LEAVE_EXEC);
-			}
-			Tcl_UntraceCommand(interp, name,
-				flags, TraceCommandProc, clientData);
-			if (tcmdPtr->stepTrace != NULL) {
-			    /* 
-			     * We need to remove the interpreter-wide trace 
-			     * which we created to allow 'step' traces.
-			     */
-			    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
-			    tcmdPtr->stepTrace = NULL;
-                            if (tcmdPtr->startCmd != NULL) {
-			        ckfree((char *)tcmdPtr->startCmd);
-			    }
-			}
-			if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
-			    /* Postpone deletion */
-			    tcmdPtr->flags = 0;
-			}
-			tcmdPtr->refCount--;
-			if (tcmdPtr->refCount < 0) {
-			    Tcl_Panic("TclTraceExecutionObjCmd: negative TraceCommandInfo refCount");
-			}
-			if (tcmdPtr->refCount == 0) {
-			    ckfree((char*)tcmdPtr);
-			}
-			break;
-		    }
-		}
-	    }
-	    break;
-	}
-	case TRACE_INFO: {
-	    ClientData clientData;
-	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
-	    if (objc != 4) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name");
-		return TCL_ERROR;
-	    }
-
-	    clientData = NULL;
-	    name = Tcl_GetString(objv[3]);
-	    
-	    /* First ensure the name given is valid */
-	    if (Tcl_FindCommand(interp, name, NULL, 
-				TCL_LEAVE_ERR_MSG) == NULL) {
-		return TCL_ERROR;
-	    }
-				
-	    resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		    TraceCommandProc, clientData)) != NULL) {
-		int numOps = 0;
-
-		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    Tcl_UniChar ch;
+    const char *p, *end, *string;
+    int cur, index, length, numChars;
 
-		/*
-		 * Build a list with the ops list as the first obj
-		 * element and the tcmdPtr->command string as the
-		 * second obj element.  Append this list (as an
-		 * element) to the end of the result object list.
-		 */
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string index");
+	return TCL_ERROR;
+    }
 
-		elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		Tcl_IncrRefCount(elemObjPtr);
-		if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("enter",5));
-		}
-		if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("leave",5));
-		}
-		if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("enterstep",9));
-		}
-		if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("leavestep",9));
-		}
-		Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
-		if (0 == numOps) {
-		    Tcl_DecrRefCount(elemObjPtr);
-                    continue;
-                }
-		eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
-		Tcl_DecrRefCount(elemObjPtr);
-		elemObjPtr = NULL;
-		
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, 
-			Tcl_NewStringObj(tcmdPtr->command, -1));
-		Tcl_ListObjAppendElement(interp, resultListPtr,
-			eachTraceObjPtr);
+    string = TclGetStringFromObj(objv[1], &length);
+    numChars = Tcl_NumUtfChars(string, length);
+    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    string = TclGetStringFromObj(objv[1], &length);
+    if (index < 0) {
+	index = 0;
+    }
+    if (index < numChars) {
+	p = Tcl_UtfAtIndex(string, index);
+	end = string+length;
+	for (cur = index; p < end; cur++) {
+	    p += TclUtfToUniChar(p, &ch);
+	    if (!Tcl_UniCharIsWordChar(ch)) {
+		break;
 	    }
-	    Tcl_SetObjResult(interp, resultListPtr);
-	    break;
 	}
+	if (cur == index) {
+	    cur++;
+	}
+    } else {
+	cur = numChars;
     }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TclTraceCommandObjCmd --
+ * StringEqualCmd --
  *
- *	Helper function for Tcl_TraceObjCmd; implements the
- *	[trace {add|info|remove} command ...] subcommands.
- *	See the user documentation for details on what these do.
+ *	This procedure is invoked to process the "string equal" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	Standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Depends on the operation (add, remove, or info) being performed;
- *	may add or remove command traces on a command.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int optionIndex;			/* Add, info or remove */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+static int
+StringEqualCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int commandLength, index;
-    char *name, *command;
-    size_t length;
-    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
-    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
-    
-    switch ((enum traceOptions) optionIndex) {
-	case TRACE_ADD: 
-	case TRACE_REMOVE: {
-	    int flags = 0;
-	    int i, listLen, result;
-	    Tcl_Obj **elemPtrs;
-	    if (objc != 6) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
-		return TCL_ERROR;
-	    }
-	    /*
-	     * Make sure the ops argument is a list object; get its length and
-	     * a pointer to its array of element pointers.
-	     */
+    /*
+     * Remember to keep code here in some sync with the byte-compiled versions
+     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
+     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
+     */
 
-	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
-		    &elemPtrs);
-	    if (result != TCL_OK) {
-		return result;
+    char *string1, *string2;
+    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
+    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
+    strCmpFn_t strCmpFn;
+
+    if (objc < 3 || objc > 6) {
+    str_cmp_args:
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-nocase? ?-length int? string1 string2");
+	return TCL_ERROR;
+    }
+
+    for (i = 1; i < objc-2; i++) {
+	string2 = TclGetStringFromObj(objv[i], &length2);
+	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
+	    nocase = 1;
+	} else if ((length2 > 1)
+		&& !strncmp(string2, "-length", (size_t)length2)) {
+	    if (i+1 >= objc-2) {
+		goto str_cmp_args;
 	    }
-	    if (listLen == 0) {
-		Tcl_SetResult(interp, "bad operation list \"\": must be "
-			"one or more of delete or rename", TCL_STATIC);
+	    ++i;
+	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    for (i = 0; i < listLen; i++) {
-		if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
-			"operation", TCL_EXACT, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch ((enum operations) index) {
-		    case TRACE_CMD_RENAME:
-			flags |= TCL_TRACE_RENAME;
-			break;
-		    case TRACE_CMD_DELETE:
-			flags |= TCL_TRACE_DELETE;
-			break;
-		}
-	    }
-	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
-	    length = (size_t) commandLength;
-	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
-		TraceCommandInfo *tcmdPtr;
-		tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
-			(sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
-				+ length + 1));
-		tcmdPtr->flags = flags;
-		tcmdPtr->stepTrace = NULL;
-		tcmdPtr->startLevel = 0;
-		tcmdPtr->startCmd = NULL;
-		tcmdPtr->length = length;
-		tcmdPtr->refCount = 1;
-		flags |= TCL_TRACE_DELETE;
-		memcpy(tcmdPtr->command, command, length + 1);
-		name = Tcl_GetString(objv[3]);
-		if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
-			(ClientData) tcmdPtr) != TCL_OK) {
-		    ckfree((char *) tcmdPtr);
-		    return TCL_ERROR;
-		}
-	    } else {
-		/*
-		 * Search through all of our traces on this command to
-		 * see if there's one with the given command.  If so, then
-		 * delete the first one that matches.
-		 */
-		
-		TraceCommandInfo *tcmdPtr;
-		ClientData clientData = NULL;
-		name = Tcl_GetString(objv[3]);
-		
-		/* First ensure the name given is valid */
-		if (Tcl_FindCommand(interp, name, NULL, 
-				    TCL_LEAVE_ERR_MSG) == NULL) {
-		    return TCL_ERROR;
-		}
-				    
-		while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-			TraceCommandProc, clientData)) != NULL) {
-		    tcmdPtr = (TraceCommandInfo *) clientData;
-		    if ((tcmdPtr->length == length)
-			    && (tcmdPtr->flags == flags)
-			    && (strncmp(command, tcmdPtr->command,
-				    (size_t) length) == 0)) {
-			Tcl_UntraceCommand(interp, name,
-				flags | TCL_TRACE_DELETE,
-				TraceCommandProc, clientData);
-			tcmdPtr->flags |= TCL_TRACE_DESTROYED;
-			tcmdPtr->refCount--;
-			if (tcmdPtr->refCount < 0) {
-			    Tcl_Panic("TclTraceCommandObjCmd: negative TraceCommandInfo refCount");
-			}
-			if (tcmdPtr->refCount == 0) {
-			    ckfree((char *) tcmdPtr);
-			}
-			break;
-		    }
-		}
-	    }
-	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", string2,
+		    "\": must be -nocase or -length", NULL);
+	    return TCL_ERROR;
 	}
-	case TRACE_INFO: {
-	    ClientData clientData;
-	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
-	    if (objc != 4) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name");
-		return TCL_ERROR;
-	    }
+    }
 
-	    clientData = NULL;
-	    name = Tcl_GetString(objv[3]);
-	    
-	    /* First ensure the name given is valid */
-	    if (Tcl_FindCommand(interp, name, NULL, 
-				TCL_LEAVE_ERR_MSG) == NULL) {
-		return TCL_ERROR;
-	    }
-				
-	    resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		    TraceCommandProc, clientData)) != NULL) {
-		int numOps = 0;
+    /*
+     * From now on, we only access the two objects at the end of the argument
+     * array.
+     */
 
-		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    objv += objc-2;
 
-		/*
-		 * Build a list with the ops list as
-		 * the first obj element and the tcmdPtr->command string
-		 * as the second obj element.  Append this list (as an
-		 * element) to the end of the result object list.
-		 */
+    if ((reqlength == 0) || (objv[0] == objv[1])) {
+	/*
+	 * Always match at 0 chars of if it is the same obj.
+	 */
 
-		elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		Tcl_IncrRefCount(elemObjPtr);
-		if (tcmdPtr->flags & TCL_TRACE_RENAME) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("rename",6));
-		}
-		if (tcmdPtr->flags & TCL_TRACE_DELETE) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("delete",6));
-		}
-		Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
-		if (0 == numOps) {
-		    Tcl_DecrRefCount(elemObjPtr);
-                    continue;
-                }
-		eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
-		Tcl_DecrRefCount(elemObjPtr);
-
-		elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
-		Tcl_ListObjAppendElement(interp, resultListPtr,
-			eachTraceObjPtr);
-	    }
-	    Tcl_SetObjResult(interp, resultListPtr);
-	    break;
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+	return TCL_OK;
+    }
+
+    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
+	    objv[1]->typePtr == &tclByteArrayType) {
+	/*
+	 * Use binary versions of comparisons since that won't cause undue
+	 * type conversions and it is much faster. Only do this if we're
+	 * case-sensitive (which is all that really makes sense with byte
+	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
+	 */
+
+	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
+	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
+	strCmpFn = (strCmpFn_t) memcmp;
+    } else if ((objv[0]->typePtr == &tclStringType)
+	    && (objv[1]->typePtr == &tclStringType)) {
+	/*
+	 * Do a unicode-specific comparison if both of the args are of String
+	 * type. In benchmark testing this proved the most efficient check
+	 * between the unicode and string comparison operations.
+	 */
+
+	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
+	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
+	strCmpFn = (strCmpFn_t)
+		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+    } else {
+	/*
+	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
+	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
+	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
+	 * case-sensitive and no specific length was requested.
+	 */
+
+	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
+	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
+	if ((reqlength < 0) && !nocase) {
+	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
+	} else {
+	    length1 = Tcl_NumUtfChars(string1, length1);
+	    length2 = Tcl_NumUtfChars(string2, length2);
+	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+	}
+    }
+
+    if ((reqlength < 0) && (length1 != length2)) {
+	match = 1;		/* This will be reversed below. */
+    } else {
+	length = (length1 < length2) ? length1 : length2;
+	if (reqlength > 0 && reqlength < length) {
+	    length = reqlength;
+	} else if (reqlength < 0) {
+	    /*
+	     * The requested length is negative, so we ignore it by setting it
+	     * to length + 1 so we correct the match var.
+	     */
+
+	    reqlength = length + 1;
+	}
+
+	match = strCmpFn(string1, string2, (unsigned) length);
+	if ((match == 0) && (reqlength > length)) {
+	    match = length1 - length2;
 	}
     }
+
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TclTraceVariableObjCmd --
+ * StringCmpCmd --
  *
- *	Helper function for Tcl_TraceObjCmd; implements the
- *	[trace {add|info|remove} variable ...] subcommands.
- *	See the user documentation for details on what these do.
+ *	This procedure is invoked to process the "string compare" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	Standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Depends on the operation (add, remove, or info) being performed;
- *	may add or remove variable traces on a variable.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int optionIndex;			/* Add, info or remove */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+static int
+StringCmpCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int commandLength, index;
-    char *name, *command;
-    size_t length;
-    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static CONST char *opStrings[] = { "array", "read", "unset", "write",
-				     (char *) NULL };
-    enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET,
-			  TRACE_VAR_WRITE };
-        
-    switch ((enum traceOptions) optionIndex) {
-	case TRACE_ADD: 
-	case TRACE_REMOVE: {
-	    int flags = 0;
-	    int i, listLen, result;
-	    Tcl_Obj **elemPtrs;
-	    if (objc != 6) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
-		return TCL_ERROR;
-	    }
-	    /*
-	     * Make sure the ops argument is a list object; get its length and
-	     * a pointer to its array of element pointers.
-	     */
+    /*
+     * Remember to keep code here in some sync with the byte-compiled versions
+     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
+     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
+     */
 
-	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
-		    &elemPtrs);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    if (listLen == 0) {
-		Tcl_SetResult(interp, "bad operation list \"\": must be "
-			"one or more of array, read, unset, or write",
-			TCL_STATIC);
-		return TCL_ERROR;
-	    }
-	    for (i = 0; i < listLen ; i++) {
-		if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
-			"operation", TCL_EXACT, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		switch ((enum operations) index) {
-		    case TRACE_VAR_ARRAY:
-			flags |= TCL_TRACE_ARRAY;
-			break;
-		    case TRACE_VAR_READ:
-			flags |= TCL_TRACE_READS;
-			break;
-		    case TRACE_VAR_UNSET:
-			flags |= TCL_TRACE_UNSETS;
-			break;
-		    case TRACE_VAR_WRITE:
-			flags |= TCL_TRACE_WRITES;
-			break;
-		}
-	    }
-	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
-	    length = (size_t) commandLength;
-	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
-		/*
-		 * This code essentially mallocs together the VarTrace and the
-		 * TraceVarInfo, then inlines the Tcl_TraceVar(). This is
-		 * necessary in order to have the TraceVarInfo to be freed 
-		 * automatically when the VarTrace is freed [Bug 1348775]
-		 */
+    char *string1, *string2;
+    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
+    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
+    strCmpFn_t strCmpFn;
 
-		CompoundVarTrace *compTracePtr;
-		TraceVarInfo *tvarPtr;
-		Var *varPtr, *arrayPtr;
-		VarTrace *tracePtr;
-		int flagMask;
-
-		compTracePtr = (CompoundVarTrace *) ckalloc((unsigned)
-			(sizeof(CompoundVarTrace) - sizeof(tvarPtr->command)
-				+ length + 1));
-		tracePtr = &(compTracePtr->trace);
-		tvarPtr = &(compTracePtr->tvar);
-		tvarPtr->flags = flags;
-		if (objv[0] == NULL) {
-		    tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
-		}
-		tvarPtr->length = length;
-		flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
-		memcpy(tvarPtr->command, command, length + 1);
-		name = Tcl_GetString(objv[3]);
-		flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
-		varPtr = TclLookupVar(interp, name, NULL,
-			(flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace",
-			/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-		if (varPtr == NULL) {
-		    ckfree((char *) tracePtr);
-		    return TCL_ERROR;
-		}
-		flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES
-			| TCL_TRACE_UNSETS | TCL_TRACE_ARRAY
-			| TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-		flagMask |= TCL_TRACE_OLD_STYLE;
-#endif
-		tracePtr->traceProc = TraceVarProc;
-		tracePtr->clientData = (ClientData) tvarPtr;
-		tracePtr->flags = flags & flagMask;
-		tracePtr->nextPtr = varPtr->tracePtr;
-		varPtr->tracePtr = tracePtr;
-	    } else {
-		/*
-		 * Search through all of our traces on this variable to
-		 * see if there's one with the given command.  If so, then
-		 * delete the first one that matches.
-		 */
-		
-		TraceVarInfo *tvarPtr;
-		ClientData clientData = 0;
-		name = Tcl_GetString(objv[3]);
-		while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
-			TraceVarProc, clientData)) != 0) {
-		    tvarPtr = (TraceVarInfo *) clientData;
-		    if ((tvarPtr->length == length)
-			    && ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
-			    && (strncmp(command, tvarPtr->command,
-				    (size_t) length) == 0)) {
-			Tcl_UntraceVar2(interp, name, NULL, 
-			  flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
-				TraceVarProc, clientData);
-			break;
-		    }
-		}
+    if (objc < 3 || objc > 6) {
+    str_cmp_args:
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-nocase? ?-length int? string1 string2");
+	return TCL_ERROR;
+    }
+
+    for (i = 1; i < objc-2; i++) {
+	string2 = TclGetStringFromObj(objv[i], &length2);
+	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
+	    nocase = 1;
+	} else if ((length2 > 1)
+		&& !strncmp(string2, "-length", (size_t)length2)) {
+	    if (i+1 >= objc-2) {
+		goto str_cmp_args;
 	    }
-	    break;
-	}
-	case TRACE_INFO: {
-	    ClientData clientData;
-	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
-	    if (objc != 4) {
-		Tcl_WrongNumArgs(interp, 3, objv, "name");
+	    ++i;
+	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", string2,
+		    "\": must be -nocase or -length", NULL);
+	    return TCL_ERROR;
+	}
+    }
 
-	    resultListPtr = Tcl_GetObjResult(interp);
-	    clientData = 0;
-	    name = Tcl_GetString(objv[3]);
-	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
-		    TraceVarProc, clientData)) != 0) {
+    /*
+     * From now on, we only access the two objects at the end of the argument
+     * array.
+     */
 
-		TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+    objv += objc-2;
 
-		/*
-		 * Build a list with the ops list as
-		 * the first obj element and the tcmdPtr->command string
-		 * as the second obj element.  Append this list (as an
-		 * element) to the end of the result object list.
-		 */
+    if ((reqlength == 0) || (objv[0] == objv[1])) {
+	/*
+	 * Always match at 0 chars of if it is the same obj.
+	 */
 
-		elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		if (tvarPtr->flags & TCL_TRACE_ARRAY) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("array", 5));
-		}
-		if (tvarPtr->flags & TCL_TRACE_READS) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("read", 4));
-		}
-		if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("write", 5));
-		}
-		if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
-			    Tcl_NewStringObj("unset", 5));
-		}
-		eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+	return TCL_OK;
+    }
 
-		elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
-		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
-		Tcl_ListObjAppendElement(interp, resultListPtr,
-			eachTraceObjPtr);
-	    }
-	    Tcl_SetObjResult(interp, resultListPtr);
-	    break;
+    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
+	    objv[1]->typePtr == &tclByteArrayType) {
+	/*
+	 * Use binary versions of comparisons since that won't cause undue
+	 * type conversions and it is much faster. Only do this if we're
+	 * case-sensitive (which is all that really makes sense with byte
+	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
+	 */
+
+	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
+	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
+	strCmpFn = (strCmpFn_t) memcmp;
+    } else if ((objv[0]->typePtr == &tclStringType)
+	    && (objv[1]->typePtr == &tclStringType)) {
+	/*
+	 * Do a unicode-specific comparison if both of the args are of String
+	 * type. In benchmark testing this proved the most efficient check
+	 * between the unicode and string comparison operations.
+	 */
+
+	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
+	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
+	strCmpFn = (strCmpFn_t)
+		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+    } else {
+	/*
+	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
+	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
+	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
+	 * case-sensitive and no specific length was requested.
+	 */
+
+	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
+	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
+	if ((reqlength < 0) && !nocase) {
+	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
+	} else {
+	    length1 = Tcl_NumUtfChars(string1, length1);
+	    length2 = Tcl_NumUtfChars(string2, length2);
+	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
 	}
     }
+
+    length = (length1 < length2) ? length1 : length2;
+    if (reqlength > 0 && reqlength < length) {
+	length = reqlength;
+    } else if (reqlength < 0) {
+	/*
+	 * The requested length is negative, so we ignore it by setting it to
+	 * length + 1 so we correct the match var.
+	 */
+
+	reqlength = length + 1;
+    }
+
+    match = strCmpFn(string1, string2, (unsigned) length);
+    if ((match == 0) && (reqlength > length)) {
+	match = length1 - length2;
+    }
+
+    Tcl_SetObjResult(interp,
+	    Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringBytesCmd --
+ *
+ *	This procedure is invoked to process the "string bytelength" Tcl
+ *	command. See the user documentation for details on what it does. Note
+ *	that this command only functions correctly on properly formed Tcl UTF
+ *	strings.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
+static int
+StringBytesCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int length;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string");
+	return TCL_ERROR;
+    }
+
+    (void) TclGetStringFromObj(objv[1], &length);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CommandTraceInfo --
+ * StringLenCmd --
  *
- *	Return the clientData value associated with a trace on a
- *	command.  This procedure can also be used to step through
- *	all of the traces on a particular command that have the
- *	same trace procedure.
+ *	This procedure is invoked to process the "string length" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	The return value is the clientData value associated with
- *	a trace on the given command.  Information will only be
- *	returned for a trace with proc as trace procedure.  If
- *	the clientData argument is NULL then the first such trace is
- *	returned;  otherwise, the next relevant one after the one
- *	given by clientData will be returned.  If the command
- *	doesn't exist then an error message is left in the interpreter
- *	and NULL is returned.  Also, if there are no (more) traces for 
- *	the given command, NULL is returned.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-ClientData
-Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
-    Tcl_Interp *interp;		/* Interpreter containing command. */
-    CONST char *cmdName;	/* Name of command. */
-    int flags;			/* OR-ed combo or TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY (can be 0). */
-    Tcl_CommandTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData prevClientData;	/* If non-NULL, gives last value returned
-				 * by this procedure, so this call will
-				 * return the next trace after that one.
-				 * If NULL, this call will return the
-				 * first trace. */
+static int
+StringLenCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Command *cmdPtr;
-    register CommandTrace *tracePtr;
+    int length;
 
-    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
-		NULL, TCL_LEAVE_ERR_MSG);
-    if (cmdPtr == NULL) {
-	return NULL;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string");
+	return TCL_ERROR;
     }
 
     /*
-     * Find the relevant trace, if any, and return its clientData.
+     * If we have a ByteArray object, avoid recomputing the string since the
+     * byte array contains one byte per character. Otherwise, use the Unicode
+     * string rep to calculate the length.
      */
 
-    tracePtr = cmdPtr->tracePtr;
-    if (prevClientData != NULL) {
-	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
-	    if ((tracePtr->clientData == prevClientData)
-		    && (tracePtr->traceProc == proc)) {
-		tracePtr = tracePtr->nextPtr;
-		break;
-	    }
-	}
-    }
-    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
-	if (tracePtr->traceProc == proc) {
-	    return tracePtr->clientData;
-	}
+    if (objv[1]->typePtr == &tclByteArrayType) {
+	(void) Tcl_GetByteArrayFromObj(objv[1], &length);
+    } else {
+	length = Tcl_GetCharLength(objv[1]);
     }
-    return NULL;
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TraceCommand --
+ * StringLowerCmd --
  *
- *	Arrange for rename/deletes to a command to cause a
- *	procedure to be invoked, which can monitor the operations.
- *	
- *	Also optionally arrange for execution of that command
- *	to cause a procedure to be invoked.
+ *	This procedure is invoked to process the "string tolower" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	A standard Tcl return value.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	A trace is set up on the command given by cmdName, such that
- *	future changes to the command will be intermediated by
- *	proc.  See the manual entry for complete details on the calling
- *	sequence for proc.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which command is
-				 * to be traced. */
-    CONST char *cmdName;	/* Name of command. */
-    int flags;			/* OR-ed collection of bits, including any
-				 * of TCL_TRACE_RENAME, TCL_TRACE_DELETE,
-				 * and any of the TRACE_*_EXEC flags */
-    Tcl_CommandTraceProc *proc;	/* Procedure to call when specified ops are
-				 * invoked upon varName. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+static int
+StringLowerCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Command *cmdPtr;
-    register CommandTrace *tracePtr;
+    int length1, length2;
+    char *string1, *string2;
 
-    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
-	    NULL, TCL_LEAVE_ERR_MSG);
-    if (cmdPtr == NULL) {
+    if (objc < 2 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
 	return TCL_ERROR;
     }
 
-    /*
-     * Set up trace information.
-     */
+    string1 = TclGetStringFromObj(objv[1], &length1);
 
-    tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
-    tracePtr->traceProc = proc;
-    tracePtr->clientData = clientData;
-    tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE
-			       | TCL_TRACE_ANY_EXEC);
-    tracePtr->nextPtr = cmdPtr->tracePtr;
-    tracePtr->refCount = 1;
-    cmdPtr->tracePtr = tracePtr;
-    if ((tracePtr->flags & TCL_TRACE_ANY_EXEC) 
-	    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
-        cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
+    if (objc == 2) {
+	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
 
-	/*
-	 * Bug 3484621: New execution trace means we no longer compile
-	 * this command if we normally would.  Invalidate bytecode.
-	 */
+	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
+	Tcl_SetObjLength(resultPtr, length1);
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	int first, last;
+	const char *start, *end;
+	Tcl_Obj *resultPtr;
 
-	if (cmdPtr->compileProc != NULL) {
-	    ((Interp *)interp)->compileEpoch++;
+	length1 = Tcl_NumUtfChars(string1, length1) - 1;
+	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
+	    return TCL_ERROR;
 	}
+	if (first < 0) {
+	    first = 0;
+	}
+	last = first;
+
+	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+		&last) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+
+	if (last >= length1) {
+	    last = length1;
+	}
+	if (last < first) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
+
+	string1 = TclGetStringFromObj(objv[1], &length1);
+	start = Tcl_UtfAtIndex(string1, first);
+	end = Tcl_UtfAtIndex(start, last - first + 1);
+	resultPtr = Tcl_NewStringObj(string1, end - string1);
+	string2 = TclGetString(resultPtr) + (start - string1);
+
+	length2 = Tcl_UtfToLower(string2);
+	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+
+	Tcl_AppendToObj(resultPtr, end, -1);
+	Tcl_SetObjResult(interp, resultPtr);
     }
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UntraceCommand --
+ * StringUpperCmd --
  *
- *	Remove a previously-created trace for a command.
+ *	This procedure is invoked to process the "string toupper" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	If there exists a trace for the command given by cmdName
- *	with the given flags, proc, and clientData, then that trace
- *	is removed.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter containing command. */
-    CONST char *cmdName;	/* Name of command. */
-    int flags;			/* OR-ed collection of bits, including any
-				 * of TCL_TRACE_RENAME, TCL_TRACE_DELETE,
-				 * and any of the TRACE_*_EXEC flags */
-    Tcl_CommandTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+static int
+StringUpperCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register CommandTrace *tracePtr;
-    CommandTrace *prevPtr;
-    Command *cmdPtr;
-    Interp *iPtr = (Interp *) interp;
-    ActiveCommandTrace *activePtr;
-    int hasExecTraces = 0;
-    
-    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
-		NULL, TCL_LEAVE_ERR_MSG);
-    if (cmdPtr == NULL) {
-	return;
+    int length1, length2;
+    char *string1, *string2;
+
+    if (objc < 2 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
+	return TCL_ERROR;
     }
 
-    flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
+    string1 = TclGetStringFromObj(objv[1], &length1);
+
+    if (objc == 2) {
+	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
+
+	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
+	Tcl_SetObjLength(resultPtr, length1);
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	int first, last;
+	const char *start, *end;
+	Tcl_Obj *resultPtr;
 
-    for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL;  ;
-	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
-	if (tracePtr == NULL) {
-	    return;
+	length1 = Tcl_NumUtfChars(string1, length1) - 1;
+	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	if ((tracePtr->traceProc == proc) 
-	    && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | 
-				    TCL_TRACE_ANY_EXEC)) == flags)
-		&& (tracePtr->clientData == clientData)) {
-	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
-		hasExecTraces = 1;
-	    }
-	    break;
+	if (first < 0) {
+	    first = 0;
 	}
-    }
-    
-    /*
-     * The code below makes it possible to delete traces while traces
-     * are active: it makes sure that the deleted trace won't be
-     * processed by CallCommandTraces.
-     */
+	last = first;
 
-    for (activePtr = iPtr->activeCmdTracePtr;  activePtr != NULL;
-	 activePtr = activePtr->nextPtr) {
-	if (activePtr->nextTracePtr == tracePtr) {
-	    if (activePtr->reverseScan) {
-		activePtr->nextTracePtr = prevPtr;
-	    } else {
-		activePtr->nextTracePtr = tracePtr->nextPtr;
-	    }
+	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+		&last) != TCL_OK)) {
+	    return TCL_ERROR;
 	}
-    }
-    if (prevPtr == NULL) {
-	cmdPtr->tracePtr = tracePtr->nextPtr;
-    } else {
-	prevPtr->nextPtr = tracePtr->nextPtr;
-    }
-    tracePtr->flags = 0;
-    
-    if ((--tracePtr->refCount) <= 0) {
-	ckfree((char*)tracePtr);
-    }
-    
-    if (hasExecTraces) {
-	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
-	     prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
-	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
-	        return;
-	    }
+
+	if (last >= length1) {
+	    last = length1;
+	}
+	if (last < first) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
 	}
-	/* 
-	 * None of the remaining traces on this command are execution
-	 * traces.  We therefore remove this flag:
-	 */
-	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
 
-	/*
-	 * Bug 3484621: No more execution trace means we can compile
-	 * the command again.  If we will, invalidate bytecode.
-	 */
+	string1 = TclGetStringFromObj(objv[1], &length1);
+	start = Tcl_UtfAtIndex(string1, first);
+	end = Tcl_UtfAtIndex(start, last - first + 1);
+	resultPtr = Tcl_NewStringObj(string1, end - string1);
+	string2 = TclGetString(resultPtr) + (start - string1);
 
-	if (cmdPtr->compileProc != NULL) {
-	    ((Interp *)interp)->compileEpoch++;
-	}
+	length2 = Tcl_UtfToUpper(string2);
+	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+
+	Tcl_AppendToObj(resultPtr, end, -1);
+	Tcl_SetObjResult(interp, resultPtr);
     }
+
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TraceCommandProc --
+ * StringTitleCmd --
  *
- *	This procedure is called to handle command changes that have
- *	been traced using the "trace" command, when using the 
- *	'rename' or 'delete' options.
+ *	This procedure is invoked to process the "string totitle" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Depends on the command associated with the trace.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static void
-TraceCommandProc(clientData, interp, oldName, newName, flags)
-    ClientData clientData;	/* Information about the command trace. */
-    Tcl_Interp *interp;		/* Interpreter containing command. */
-    CONST char *oldName;	/* Name of command being changed. */
-    CONST char *newName;	/* New name of command.  Empty string
-                  		 * or NULL means command is being deleted
-                  		 * (renamed to ""). */
-    int flags;			/* OR-ed bits giving operation and other
-				 * information. */
+static int
+StringTitleCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    int stateCode;
-    Tcl_SavedResult state;
-    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
-    int code;
-    Tcl_DString cmd;
-    
-    tcmdPtr->refCount++;
-    
-    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)) {
-	/*
-	 * Generate a command to execute by appending list elements
-	 * for the old and new command name and the operation.
-	 */
+    int length1, length2;
+    char *string1, *string2;
 
-	Tcl_DStringInit(&cmd);
-	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
-	Tcl_DStringAppendElement(&cmd, oldName);
-	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
-	if (flags & TCL_TRACE_RENAME) {
-	    Tcl_DStringAppend(&cmd, " rename", 7);
-	} else if (flags & TCL_TRACE_DELETE) {
-	    Tcl_DStringAppend(&cmd, " delete", 7);
-	}
+    if (objc < 2 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
+	return TCL_ERROR;
+    }
 
-	/*
-	 * Execute the command.  Save the interp's result used for the
-	 * command, including the value of iPtr->returnCode which may be
-	 * modified when Tcl_Eval is invoked. We discard any object
-	 * result the command returns.
-	 *
-	 * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to
-	 * other areas that this will be destroyed by us, otherwise a
-	 * double-free might occur depending on what the eval does.
-	 */
+    string1 = TclGetStringFromObj(objv[1], &length1);
 
-	Tcl_SaveResult(interp, &state);
-	stateCode = iPtr->returnCode;
-	if (flags & TCL_TRACE_DESTROYED) {
-	    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
-	}
+    if (objc == 2) {
+	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
 
-	code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
-		Tcl_DStringLength(&cmd), 0);
-	if (code != TCL_OK) {	     
-	    /* We ignore errors in these traced commands */
-	}
+	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
+	Tcl_SetObjLength(resultPtr, length1);
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	int first, last;
+	const char *start, *end;
+	Tcl_Obj *resultPtr;
 
-	Tcl_RestoreResult(interp, &state);
-	iPtr->returnCode = stateCode;
-	
-	Tcl_DStringFree(&cmd);
-    }
-    /*
-     * We delete when the trace was destroyed or if this is a delete trace,
-     * because command deletes are unconditional, so the trace must go away.
-     */
-    if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
-	int untraceFlags = tcmdPtr->flags;
-
-	if (tcmdPtr->stepTrace != NULL) {
-	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
-	    tcmdPtr->stepTrace = NULL;
-            if (tcmdPtr->startCmd != NULL) {
-	        ckfree((char *)tcmdPtr->startCmd);
-	    }
+	length1 = Tcl_NumUtfChars(string1, length1) - 1;
+	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
-	    /* Postpone deletion, until exec trace returns */
-	    tcmdPtr->flags = 0;
+	if (first < 0) {
+	    first = 0;
 	}
+	last = first;
 
-	/*
-	 * We need to construct the same flags for Tcl_UntraceCommand
-	 * as were passed to Tcl_TraceCommand.  Reproduce the processing
-	 * of [trace add execution/command].  Be careful to keep this
-	 * code in sync with that.
-	 */
+	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
+		&last) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
 
-	if (untraceFlags & TCL_TRACE_ANY_EXEC) {
-	    untraceFlags |= TCL_TRACE_DELETE;
-	    if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC 
-		    | TCL_TRACE_LEAVE_DURING_EXEC)) {
-		untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
-	    }
-	} else if (untraceFlags & TCL_TRACE_RENAME) {
-	    untraceFlags |= TCL_TRACE_DELETE;
+	if (last >= length1) {
+	    last = length1;
+	}
+	if (last < first) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
 	}
 
-	/* 
-	 * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the
-	 * command we're tracing has just gone away.  Then decrement the
-	 * clientData refCount that was set up by trace creation.
-	 *
-	 * Note that we save the (return) state of the interpreter to prevent
-	 * bizarre error messages.
-	 */
+	string1 = TclGetStringFromObj(objv[1], &length1);
+	start = Tcl_UtfAtIndex(string1, first);
+	end = Tcl_UtfAtIndex(start, last - first + 1);
+	resultPtr = Tcl_NewStringObj(string1, end - string1);
+	string2 = TclGetString(resultPtr) + (start - string1);
 
-	Tcl_SaveResult(interp, &state);
-	stateCode = iPtr->returnCode;
-	Tcl_UntraceCommand(interp, oldName, untraceFlags,
-		TraceCommandProc, clientData);
-	Tcl_RestoreResult(interp, &state);
-	iPtr->returnCode = stateCode;
+	length2 = Tcl_UtfToTitle(string2);
+	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
 
-	tcmdPtr->refCount--;
-    }
-    tcmdPtr->refCount--;
-    if (tcmdPtr->refCount < 0) {
-	Tcl_Panic("TraceCommandProc: negative TraceCommandInfo refCount");
-    }
-    if (tcmdPtr->refCount == 0) {
-        ckfree((char*)tcmdPtr);
+	Tcl_AppendToObj(resultPtr, end, -1);
+	Tcl_SetObjResult(interp, resultPtr);
     }
-    return;
+
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCheckExecutionTraces --
+ * StringTrimCmd --
  *
- *	Checks on all current command execution traces, and invokes
- *	procedures which have been registered.  This procedure can be
- *	used by other code which performs execution to unify the
- *	tracing system, so that execution traces will function for that
- *	other code.
- *	
- *	For instance extensions like [incr Tcl] which use their
- *	own execution technique can make use of Tcl's tracing.
- *	
- *	This procedure is called by 'TclEvalObjvInternal'
+ *	This procedure is invoked to process the "string trim" Tcl command.
+ *	See the user documentation for details on what it does. Note that this
+ *	command only functions correctly on properly formed Tcl UTF strings.
  *
  * Results:
- *      The return value is a standard Tcl completion code such as
- *      TCL_OK or TCL_ERROR, etc.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Those side effects made by any trace procedures called.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
-int 
-TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, 
-			traceFlags, objc, objv)
-    Tcl_Interp *interp;		/* The current interpreter. */
-    CONST char *command;        /* Pointer to beginning of the current 
-				 * command string. */
-    int numChars;               /* The number of characters in 'command' 
-				 * which are part of the command string. */
-    Command *cmdPtr;		/* Points to command's Command struct. */
-    int code;                   /* The current result code. */
-    int traceFlags;             /* Current tracing situation. */
-    int objc;			/* Number of arguments for the command. */
-    Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
+
+static int
+StringTrimCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    CommandTrace *tracePtr, *lastTracePtr;
-    ActiveCommandTrace active;
-    int curLevel;
-    int traceCode = TCL_OK;
-    TraceCommandInfo* tcmdPtr;
-    
-    if (command == NULL || cmdPtr->tracePtr == NULL) {
-	return traceCode;
-    }
-    
-    curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
-    
-    active.nextPtr = iPtr->activeCmdTracePtr;
-    iPtr->activeCmdTracePtr = &active;
-
-    active.cmdPtr = cmdPtr;
-    lastTracePtr = NULL;
-    for (tracePtr = cmdPtr->tracePtr; 
-	 (traceCode == TCL_OK) && (tracePtr != NULL);
-	 tracePtr = active.nextTracePtr) {
-        if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
-            /* execute the trace command in order of creation for "leave" */
-	    active.reverseScan = 1;
-	    active.nextTracePtr = NULL;
-            tracePtr = cmdPtr->tracePtr;
-            while (tracePtr->nextPtr != lastTracePtr) {
-	        active.nextTracePtr = tracePtr;
-	        tracePtr = tracePtr->nextPtr;
-            }
-        } else {
-	    active.reverseScan = 0;
-	    active.nextTracePtr = tracePtr->nextPtr;
-        }
-	if (tracePtr->traceProc == TraceCommandProc) {
-	    tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
-	    if (tcmdPtr->flags != 0) {
-        	tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
-        	tcmdPtr->curCode  = code;
-		tcmdPtr->refCount++;
-		traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, 
-			curLevel, command, (Tcl_Command)cmdPtr, objc, objv);
-		tcmdPtr->refCount--;
-		if (tcmdPtr->refCount < 0) {
-		    Tcl_Panic("TclCheckExecutionTraces: negative TraceCommandInfo refCount");
-		}
-		if (tcmdPtr->refCount == 0) {
-		    ckfree((char*)tcmdPtr);
-		}
-	    }
-	}
-	if (active.nextTracePtr) {
-	    lastTracePtr = active.nextTracePtr->nextPtr;
-	}
+    const char *string1, *string2;
+    int triml, trimr, length1, length2;
+
+    if (objc == 3) {
+	string2 = TclGetStringFromObj(objv[2], &length2);
+    } else if (objc == 2) {
+	string2 = " \t\n\r";
+	length2 = strlen(string2);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+	return TCL_ERROR;
     }
-    iPtr->activeCmdTracePtr = active.nextPtr;
-    return(traceCode);
+    string1 = TclGetStringFromObj(objv[1], &length1);
+
+    triml = TclTrimLeft(string1, length1, string2, length2);
+    trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
+
+    Tcl_SetObjResult(interp,
+	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCheckInterpTraces --
+ * StringTrimLCmd --
  *
- *	Checks on all current traces, and invokes procedures which
- *	have been registered.  This procedure can be used by other
- *	code which performs execution to unify the tracing system.
- *	For instance extensions like [incr Tcl] which use their
- *	own execution technique can make use of Tcl's tracing.
- *	
- *	This procedure is called by 'TclEvalObjvInternal'
+ *	This procedure is invoked to process the "string trimleft" Tcl
+ *	command. See the user documentation for details on what it does. Note
+ *	that this command only functions correctly on properly formed Tcl UTF
+ *	strings.
  *
  * Results:
- *      The return value is a standard Tcl completion code such as
- *      TCL_OK or TCL_ERROR, etc.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Those side effects made by any trace procedures called.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
-int 
-TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, 
-		     traceFlags, objc, objv)
-    Tcl_Interp *interp;		/* The current interpreter. */
-    CONST char *command;        /* Pointer to beginning of the current 
-				 * command string. */
-    int numChars;               /* The number of characters in 'command' 
-				 * which are part of the command string. */
-    Command *cmdPtr;		/* Points to command's Command struct. */
-    int code;                   /* The current result code. */
-    int traceFlags;             /* Current tracing situation. */
-    int objc;			/* Number of arguments for the command. */
-    Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
+
+static int
+StringTrimLCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Trace *tracePtr, *lastTracePtr;
-    ActiveInterpTrace active;
-    int curLevel;
-    int traceCode = TCL_OK;
-    
-    if (command == NULL || iPtr->tracePtr == NULL ||
-           (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
-	return(traceCode);
-    }
-    
-    curLevel = iPtr->numLevels;
-    
-    active.nextPtr = iPtr->activeInterpTracePtr;
-    iPtr->activeInterpTracePtr = &active;
-
-    lastTracePtr = NULL;
-    for ( tracePtr = iPtr->tracePtr;
-          (traceCode == TCL_OK) && (tracePtr != NULL);
-	  tracePtr = active.nextTracePtr) {
-        if (traceFlags & TCL_TRACE_ENTER_EXEC) {
-            /* 
-             * Execute the trace command in reverse order of creation
-             * for "enterstep" operation. The order is changed for
-             * "enterstep" instead of for "leavestep" as was done in 
-             * TclCheckExecutionTraces because for step traces,
-             * Tcl_CreateObjTrace creates one more linked list of traces
-             * which results in one more reversal of trace invocation.
-             */
-	    active.reverseScan = 1;
-	    active.nextTracePtr = NULL;
-            tracePtr = iPtr->tracePtr;
-            while (tracePtr->nextPtr != lastTracePtr) {
-	        active.nextTracePtr = tracePtr;
-	        tracePtr = tracePtr->nextPtr;
-            }
-	    if (active.nextTracePtr) {
-		lastTracePtr = active.nextTracePtr->nextPtr;
-	    }
-        } else {
-	    active.reverseScan = 0;
-	    active.nextTracePtr = tracePtr->nextPtr;
-        }
-	if (tracePtr->level > 0 && curLevel > tracePtr->level) {
-	    continue;
-	}
-	if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) {
-            /*
-	     * The proc invoked might delete the traced command which 
-	     * which might try to free tracePtr.  We want to use tracePtr
-	     * until the end of this if section, so we use
-	     * Tcl_Preserve() and Tcl_Release() to be sure it is not
-	     * freed while we still need it.
-	     */
-	    Tcl_Preserve((ClientData) tracePtr);
-	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
-	    
-	    if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
-	        /* New style trace */
-		if (tracePtr->flags & traceFlags) {
-		    if (tracePtr->proc == TraceExecutionProc) {
-			TraceCommandInfo *tcmdPtr =
-				(TraceCommandInfo *) tracePtr->clientData;
-			tcmdPtr->curFlags = traceFlags;
-			tcmdPtr->curCode  = code;
-		    }
-		    traceCode = (tracePtr->proc)(tracePtr->clientData, 
-			    interp, curLevel, command, (Tcl_Command)cmdPtr,
-			    objc, objv);
-		}
-	    } else {
-		/* Old-style trace */
-		
-		if (traceFlags & TCL_TRACE_ENTER_EXEC) {
-		    /* 
-		     * Old-style interpreter-wide traces only trigger
-		     * before the command is executed.
-		     */
-		    traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr,
-				       command, numChars, objc, objv);
-		}
-	    }
-	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
-	    Tcl_Release((ClientData) tracePtr);
-	}
+    const char *string1, *string2;
+    int trim, length1, length2;
+
+    if (objc == 3) {
+	string2 = TclGetStringFromObj(objv[2], &length2);
+    } else if (objc == 2) {
+	string2 = " \t\n\r";
+	length2 = strlen(string2);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+	return TCL_ERROR;
     }
-    iPtr->activeInterpTracePtr = active.nextPtr;
-    return(traceCode);
+    string1 = TclGetStringFromObj(objv[1], &length1);
+
+    trim = TclTrimLeft(string1, length1, string2, length2);
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CallTraceProcedure --
+ * StringTrimRCmd --
  *
- *	Invokes a trace procedure registered with an interpreter. These
- *	procedures trace command execution. Currently this trace procedure
- *	is called with the address of the string-based Tcl_CmdProc for the
- *	command, not the Tcl_ObjCmdProc.
+ *	This procedure is invoked to process the "string trimright" Tcl
+ *	command. See the user documentation for details on what it does. Note
+ *	that this command only functions correctly on properly formed Tcl UTF
+ *	strings.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Those side effects made by the trace procedure.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
-    Tcl_Interp *interp;		/* The current interpreter. */
-    register Trace *tracePtr;	/* Describes the trace procedure to call. */
-    Command *cmdPtr;		/* Points to command's Command struct. */
-    CONST char *command;	/* Points to the first character of the
-				 * command's source before substitutions. */
-    int numChars;		/* The number of characters in the
-				 * command's source. */
-    register int objc;		/* Number of arguments for the command. */
-    Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
+StringTrimRCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    char *commandCopy;
-    int traceCode;
+    const char *string1, *string2;
+    int trim, length1, length2;
+
+    if (objc == 3) {
+	string2 = TclGetStringFromObj(objv[2], &length2);
+    } else if (objc == 2) {
+	string2 = " \t\n\r";
+	length2 = strlen(string2);
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+	return TCL_ERROR;
+    }
+    string1 = TclGetStringFromObj(objv[1], &length1);
 
-   /*
-     * Copy the command characters into a new string.
-     */
+    trim = TclTrimRight(string1, length1, string2, length2);
 
-    commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
-    memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
-    commandCopy[numChars] = '\0';
-    
-    /*
-     * Call the trace procedure then free allocated storage.
-     */
-    
-    traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr,
-                              iPtr->numLevels, commandCopy,
-                              (Tcl_Command) cmdPtr, objc, objv );
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStringCmd --
+ *
+ *	This procedure creates the "string" Tcl command. See the user
+ *	documentation for details on what it does. Note that this command only
+ *	functions correctly on properly formed Tcl UTF strings.
+ *
+ *	Also note that the primary methods here (equal, compare, match, ...)
+ *	have bytecode equivalents. You will find the code for those in
+ *	tclExecute.c. The code here will only be used in the non-bc case (like
+ *	in an 'eval').
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    ckfree((char *) commandCopy);
-    return(traceCode);
+Tcl_Command
+TclInitStringCmd(
+    Tcl_Interp *interp)		/* Current interpreter. */
+{
+    static const EnsembleImplMap stringImplMap[] = {
+	{"bytelength",	StringBytesCmd,	NULL},
+	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd},
+	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd},
+	{"first",	StringFirstCmd,	NULL},
+	{"index",	StringIndexCmd,	TclCompileStringIndexCmd},
+	{"is",		StringIsCmd,	NULL},
+	{"last",	StringLastCmd,	NULL},
+	{"length",	StringLenCmd,	TclCompileStringLenCmd},
+	{"map",		StringMapCmd,	NULL},
+	{"match",	StringMatchCmd,	TclCompileStringMatchCmd},
+	{"range",	StringRangeCmd,	NULL},
+	{"repeat",	StringReptCmd,	NULL},
+	{"replace",	StringRplcCmd,	NULL},
+	{"reverse",	StringRevCmd,	NULL},
+	{"tolower",	StringLowerCmd,	NULL},
+	{"toupper",	StringUpperCmd,	NULL},
+	{"totitle",	StringTitleCmd,	NULL},
+	{"trim",	StringTrimCmd,	NULL},
+	{"trimleft",	StringTrimLCmd,	NULL},
+	{"trimright",	StringTrimRCmd,	NULL},
+	{"wordend",	StringEndCmd,	NULL},
+	{"wordstart",	StringStartCmd,	NULL},
+	{NULL, NULL, NULL}
+    };
+
+    return TclMakeEnsemble(interp, "string", stringImplMap);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CommandObjTraceDeleted --
+ * Tcl_SubstObjCmd --
  *
- *	Ensure the trace is correctly deleted by decrementing its
- *	refCount and only deleting if no other references exist.
+ *	This procedure is invoked to process the "subst" Tcl command. See the
+ *	user documentation for details on what it does. This command relies on
+ *	Tcl_SubstObj() for its implementation.
  *
  * Results:
- *      None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	May release memory.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
-static void 
-CommandObjTraceDeleted(ClientData clientData) {
-    TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
-    tcmdPtr->refCount--;
-    if (tcmdPtr->refCount < 0) {
-	Tcl_Panic("CommandObjTraceDeleted: negative TraceCommandInfo refCount");
+
+int
+Tcl_SubstObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *substOptions[] = {
+	"-nobackslashes", "-nocommands", "-novariables", NULL
+    };
+    enum substOptions {
+	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
+    };
+    Tcl_Obj *resultPtr;
+    int flags, i;
+
+    /*
+     * Parse command-line options.
+     */
+
+    flags = TCL_SUBST_ALL;
+    for (i = 1; i < (objc-1); i++) {
+	int optionIndex;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], substOptions, "switch", 0,
+		&optionIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (optionIndex) {
+	case SUBST_NOBACKSLASHES:
+	    flags &= ~TCL_SUBST_BACKSLASHES;
+	    break;
+	case SUBST_NOCOMMANDS:
+	    flags &= ~TCL_SUBST_COMMANDS;
+	    break;
+	case SUBST_NOVARS:
+	    flags &= ~TCL_SUBST_VARIABLES;
+	    break;
+	default:
+	    Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
+	}
     }
-    if (tcmdPtr->refCount == 0) {
-        ckfree((char*)tcmdPtr);
+    if (i != objc-1) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-nobackslashes? ?-nocommands? ?-novariables? string");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Perform the substitution.
+     */
+
+    resultPtr = Tcl_SubstObj(interp, objv[i], flags);
+
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
     }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TraceExecutionProc --
+ * Tcl_SwitchObjCmd --
  *
- *	This procedure is invoked whenever code relevant to a
- *	'trace execution' command is executed.  It is called in one
- *	of two ways in Tcl's core:
- *	
- *	(i) by the TclCheckExecutionTraces, when an execution trace 
- *	has been triggered.
- *	(ii) by TclCheckInterpTraces, when a prior execution trace has
- *	created a trace of the internals of a procedure, passing in
- *	this procedure as the one to be called.
+ *	This object-based procedure is invoked to process the "switch" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *      The return value is a standard Tcl completion code such as
- *      TCL_OK or TCL_ERROR, etc.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *	May invoke an arbitrary Tcl procedure, and may create or
- *	delete an interpreter-wide trace.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
-static int
-TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, 
-	      int level, CONST char* command, Tcl_Command cmdInfo,
-	      int objc, struct Tcl_Obj *CONST objv[]) {
-    int call = 0;
+
+int
+Tcl_SwitchObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved;
+    int noCase, patternLength;
+    char *pattern;
+    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
+    Tcl_Obj *const *savedObjv = objv;
+    Tcl_RegExp regExpr = NULL;
     Interp *iPtr = (Interp *) interp;
-    TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
-    int flags = tcmdPtr->curFlags;
-    int code  = tcmdPtr->curCode;
-    int traceCode  = TCL_OK;
-    
-    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
-	/* 
-	 * Inside any kind of execution trace callback, we do
-	 * not allow any further execution trace callbacks to
-	 * be called for the same trace.
-	 */
-	return traceCode;
+    int pc = 0;
+    int bidx = 0;		/* Index of body argument. */
+    Tcl_Obj *blist = NULL;	/* List obj which is the body */
+    CmdFrame *ctxPtr;		/* Copy of the topmost cmdframe, to allow us
+				 * to mess with the line information */
+
+    /*
+     * If you add options that make -e and -g not unique prefixes of -exact or
+     * -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
+     */
+
+    static const char *options[] = {
+	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
+	"--", NULL
+    };
+    enum options {
+	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
+	OPT_LAST
+    };
+    typedef int (*strCmpFn_t)(const char *, const char *);
+    strCmpFn_t strCmpFn = strcmp;
+
+    mode = OPT_EXACT;
+    foundmode = 0;
+    indexVarObj = NULL;
+    matchVarObj = NULL;
+    numMatchesSaved = 0;
+    noCase = 0;
+    for (i = 1; i < objc-2; i++) {
+	if (TclGetString(objv[i])[0] != '-') {
+	    break;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum options) index) {
+	    /*
+	     * General options.
+	     */
+
+	case OPT_LAST:
+	    i++;
+	    goto finishedOptions;
+	case OPT_NOCASE:
+	    strCmpFn = strcasecmp;
+	    noCase = 1;
+	    break;
+
+	    /*
+	     * Handle the different switch mode options.
+	     */
+
+	default:
+	    if (foundmode) {
+		/*
+		 * Mode already set via -exact, -glob, or -regexp.
+		 */
+
+		Tcl_AppendResult(interp, "bad option \"",
+			TclGetString(objv[i]), "\": ", options[mode],
+			" option already found", NULL);
+		return TCL_ERROR;
+	    } else {
+		foundmode = 1;
+		mode = index;
+		break;
+	    }
+
+	    /*
+	     * Check for TIP#75 options specifying the variables to write
+	     * regexp information into.
+	     */
+
+	case OPT_INDEXV:
+	    i++;
+	    if (i >= objc-2) {
+		Tcl_AppendResult(interp, "missing variable name argument to ",
+			"-indexvar", " option", NULL);
+		return TCL_ERROR;
+	    }
+	    indexVarObj = objv[i];
+	    numMatchesSaved = -1;
+	    break;
+	case OPT_MATCHV:
+	    i++;
+	    if (i >= objc-2) {
+		Tcl_AppendResult(interp, "missing variable name argument to ",
+			"-matchvar", " option", NULL);
+		return TCL_ERROR;
+	    }
+	    matchVarObj = objv[i];
+	    numMatchesSaved = -1;
+	    break;
+	}
+    }
+
+  finishedOptions:
+    if (objc - i < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? string pattern body ... ?default body?");
+	return TCL_ERROR;
+    }
+    if (indexVarObj != NULL && mode != OPT_REGEXP) {
+	Tcl_AppendResult(interp,
+		"-indexvar option requires -regexp option", NULL);
+	return TCL_ERROR;
+    }
+    if (matchVarObj != NULL && mode != OPT_REGEXP) {
+	Tcl_AppendResult(interp,
+		"-matchvar option requires -regexp option", NULL);
+	return TCL_ERROR;
     }
-    
-    if (!Tcl_InterpDeleted(interp)) {
+
+    stringObj = objv[i];
+    objc -= i + 1;
+    objv += i + 1;
+    bidx = i + 1;		/* First after the match string. */
+
+    /*
+     * If all of the pattern/command pairs are lumped into a single argument,
+     * split them out again.
+     *
+     * TIP #280: Determine the lines the words in the list start at, based on
+     * the same data for the list word itself. The cmdFramePtr line
+     * information is manipulated directly.
+     */
+
+    splitObjs = 0;
+    if (objc == 1) {
+	Tcl_Obj **listv;
+	blist = objv[0];
+
+	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
+	    return TCL_ERROR;
+	}
+
 	/*
-	 * Check whether the current call is going to eval arbitrary
-	 * Tcl code with a generated trace, or whether we are only
-	 * going to setup interpreter-wide traces to implement the
-	 * 'step' traces.  This latter situation can happen if
-	 * we create a command trace without either before or after
-	 * operations, but with either of the step operations.
+	 * Ensure that the list is non-empty.
 	 */
-	if (flags & TCL_TRACE_EXEC_DIRECT) {
-	    call = flags & tcmdPtr->flags 
-		    & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
-	} else {
-	    call = 1;
+
+	if (objc < 1) {
+	    Tcl_WrongNumArgs(interp, 1, savedObjv,
+		    "?switches? string {pattern body ... ?default body?}");
+	    return TCL_ERROR;
 	}
+	objv = listv;
+	splitObjs = 1;
+    }
+
+    /*
+     * Complain if there is an odd number of words in the list of patterns and
+     * bodies.
+     */
+
+    if (objc % 2) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
+
 	/*
-	 * First, if we have returned back to the level at which we
-	 * created an interpreter trace for enterstep and/or leavestep
-         * execution traces, we remove it here.
+	 * Check if this can be due to a badly placed comment in the switch
+	 * block.
+	 *
+	 * The following is an heuristic to detect the infamous "comment in
+	 * switch" error: just check if a pattern begins with '#'.
 	 */
-	if (flags & TCL_TRACE_LEAVE_EXEC) {
-	    if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)
-                && (strcmp(command, tcmdPtr->startCmd) == 0)) {
-		Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
-		tcmdPtr->stepTrace = NULL;
-                if (tcmdPtr->startCmd != NULL) {
-	            ckfree((char *)tcmdPtr->startCmd);
-	        }
+
+	if (splitObjs) {
+	    for (i=0 ; i<objc ; i+=2) {
+		if (TclGetString(objv[i])[0] == '#') {
+		    Tcl_AppendResult(interp, ", this may be due to a "
+			    "comment incorrectly placed outside of a "
+			    "switch body - see the \"switch\" "
+			    "documentation", NULL);
+		    break;
+		}
 	    }
 	}
-	
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Complain if the last body is a continuation. Note that this check
+     * assumes that the list is non-empty!
+     */
+
+    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "no body specified for pattern \"",
+		TclGetString(objv[objc-2]), "\"", NULL);
+	return TCL_ERROR;
+    }
+
+    for (i = 0; i < objc; i += 2) {
 	/*
-	 * Second, create the tcl callback, if required.
+	 * See if the pattern matches the string.
 	 */
-	if (call) {
-	    Tcl_SavedResult state;
-	    int stateCode, i, saveInterpFlags;
-	    Tcl_DString cmd;
-	    Tcl_DString sub;
-
-	    Tcl_DStringInit(&cmd);
-	    Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
-	    /* Append command with arguments */
-	    Tcl_DStringInit(&sub);
-	    for (i = 0; i < objc; i++) {
-	        char* str;
-	        int len;
-	        str = Tcl_GetStringFromObj(objv[i],&len);
-	        Tcl_DStringAppendElement(&sub, str);
-	    }
-	    Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
-	    Tcl_DStringFree(&sub);
 
-	    if (flags & TCL_TRACE_ENTER_EXEC) {
-		/* Append trace operation */
-		if (flags & TCL_TRACE_EXEC_DIRECT) {
-		    Tcl_DStringAppendElement(&cmd, "enter");
+	pattern = TclGetStringFromObj(objv[i], &patternLength);
+
+	if ((i == objc - 2) && (*pattern == 'd')
+		&& (strcmp(pattern, "default") == 0)) {
+	    Tcl_Obj *emptyObj = NULL;
+
+	    /*
+	     * If either indexVarObj or matchVarObj are non-NULL, we're in
+	     * REGEXP mode but have reached the default clause anyway. TIP#75
+	     * specifies that we set the variables to empty lists (== empty
+	     * objects) in that case.
+	     */
+
+	    if (indexVarObj != NULL) {
+		TclNewObj(emptyObj);
+		if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj,
+			TCL_LEAVE_ERR_MSG) == NULL) {
+		    return TCL_ERROR;
+		}
+	    }
+	    if (matchVarObj != NULL) {
+		if (emptyObj == NULL) {
+		    TclNewObj(emptyObj);
+		}
+		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
+			TCL_LEAVE_ERR_MSG) == NULL) {
+		    return TCL_ERROR;
+		}
+	    }
+	    goto matchFound;
+	} else {
+	    switch (mode) {
+	    case OPT_EXACT:
+		if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
+		    goto matchFound;
+		}
+		break;
+	    case OPT_GLOB:
+		if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern,
+			noCase)) {
+		    goto matchFound;
+		}
+		break;
+	    case OPT_REGEXP:
+		regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
+			TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
+		if (regExpr == NULL) {
+		    return TCL_ERROR;
 		} else {
-		    Tcl_DStringAppendElement(&cmd, "enterstep");
+		    int matched = Tcl_RegExpExecObj(interp, regExpr,
+			    stringObj, 0, numMatchesSaved, 0);
+
+		    if (matched < 0) {
+			return TCL_ERROR;
+		    } else if (matched) {
+			goto matchFoundRegexp;
+		    }
 		}
-	    } else if (flags & TCL_TRACE_LEAVE_EXEC) {
-		Tcl_Obj* resultCode;
-		char* resultCodeStr;
-
-		/* Append result code */
-		resultCode = Tcl_NewIntObj(code);
-		resultCodeStr = Tcl_GetString(resultCode);
-		Tcl_DStringAppendElement(&cmd, resultCodeStr);
-		Tcl_DecrRefCount(resultCode);
-		
-		/* Append result string */
-		Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp));
-		/* Append trace operation */
-		if (flags & TCL_TRACE_EXEC_DIRECT) {
-		    Tcl_DStringAppendElement(&cmd, "leave");
+		break;
+	    }
+	}
+    }
+    return TCL_OK;
+
+  matchFoundRegexp:
+    /*
+     * We are operating in REGEXP mode and we need to store information about
+     * what we matched in some user-nominated arrays. So build the lists of
+     * values and indices to write here. [TIP#75]
+     */
+
+    if (numMatchesSaved) {
+	Tcl_RegExpInfo info;
+	Tcl_Obj *matchesObj, *indicesObj = NULL;
+
+	Tcl_RegExpGetInfo(regExpr, &info);
+	if (matchVarObj != NULL) {
+	    TclNewObj(matchesObj);
+	} else {
+	    matchesObj = NULL;
+	}
+	if (indexVarObj != NULL) {
+	    TclNewObj(indicesObj);
+	}
+
+	for (j=0 ; j<=info.nsubs ; j++) {
+	    if (indexVarObj != NULL) {
+		Tcl_Obj *rangeObjAry[2];
+
+		if (info.matches[j].end > 0) {
+		    rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
+		    rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
 		} else {
-		    Tcl_DStringAppendElement(&cmd, "leavestep");
+		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
 		}
-	    } else {
-		panic("TraceExecutionProc: bad flag combination");
+
+		/*
+		 * Never fails; the object is always clean at this point.
+		 */
+
+		Tcl_ListObjAppendElement(NULL, indicesObj,
+			Tcl_NewListObj(2, rangeObjAry));
 	    }
-	    
-	    /*
-	     * Execute the command.  Save the interp's result used for
-	     * the command, including the value of iPtr->returnCode which
-	     * may be modified when Tcl_Eval is invoked.  We discard any
-	     * object result the command returns.
-	     */
 
-	    Tcl_SaveResult(interp, &state);
-	    stateCode = iPtr->returnCode;
-
-	    saveInterpFlags = iPtr->flags;
-	    iPtr->flags    |= INTERP_TRACE_IN_PROGRESS;
-	    tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
-	    tcmdPtr->refCount++;
-	    /* 
-	     * This line can have quite arbitrary side-effects,
-	     * including deleting the trace, the command being
-	     * traced, or even the interpreter.
-	     */
-	    traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
-	    tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
+	    if (matchVarObj != NULL) {
+		Tcl_Obj *substringObj;
 
-	    /*
-	     * Restore the interp tracing flag to prevent cmd traces
-	     * from affecting interp traces
-	     */
-	    iPtr->flags = saveInterpFlags;;
-	    if (tcmdPtr->flags == 0) {
-		flags |= TCL_TRACE_DESTROYED;
+		substringObj = Tcl_GetRange(stringObj,
+			info.matches[j].start, info.matches[j].end-1);
+
+		/*
+		 * Never fails; the object is always clean at this point.
+		 */
+
+		Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
 	    }
-	    
-            if (traceCode == TCL_OK) {
-		/* Restore result if trace execution was successful */
-		Tcl_RestoreResult(interp, &state);
-		iPtr->returnCode = stateCode;
-            } else {
-		Tcl_DiscardResult(&state);
+	}
+
+	if (indexVarObj != NULL) {
+	    if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
+		    TCL_LEAVE_ERR_MSG) == NULL) {
+		/*
+		 * Careful! Check to see if we have allocated the list of
+		 * matched strings; if so (but there was an error assigning
+		 * the indices list) we have a potential memory leak because
+		 * the match list has not been written to a variable. Except
+		 * that we'll clean that up right now.
+		 */
+
+		if (matchesObj != NULL) {
+		    Tcl_DecrRefCount(matchesObj);
+		}
+		return TCL_ERROR;
 	    }
+	}
+	if (matchVarObj != NULL) {
+	    if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
+		    TCL_LEAVE_ERR_MSG) == NULL) {
+		/*
+		 * Unlike above, if indicesObj is non-NULL at this point, it
+		 * will have been written to a variable already and will hence
+		 * not be leaked.
+		 */
 
-	    Tcl_DStringFree(&cmd);
+		return TCL_ERROR;
+	    }
 	}
-	
+    }
+
+    /*
+     * We've got a match. Find a body to execute, skipping bodies that are
+     * "-".
+     */
+
+  matchFound:
+    ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+    *ctxPtr = *iPtr->cmdFramePtr;
+
+    if (splitObjs) {
 	/*
-	 * Third, if there are any step execution traces for this proc,
-         * we register an interpreter trace to invoke enterstep and/or
-	 * leavestep traces.
-	 * We also need to save the current stack level and the proc
-         * string in startLevel and startCmd so that we can delete this
-         * interpreter trace when it reaches the end of this proc.
+	 * We have to perform the GetSrc and other type dependent handling of
+	 * the frame here because we are munging with the line numbers,
+	 * something the other commands like if, etc. are not doing. Them are
+	 * fine with simply passing the CmdFrame through and having the
+	 * special handling done in 'info frame', or the bc compiler
 	 */
-	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
-	    && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | 
-				  TCL_TRACE_LEAVE_DURING_EXEC))) {
-		tcmdPtr->startLevel = level;
-		tcmdPtr->startCmd = 
-		    (char *) ckalloc((unsigned) (strlen(command) + 1));
-		strcpy(tcmdPtr->startCmd, command);
-		tcmdPtr->refCount++;
-		tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
-		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, 
-		   TraceExecutionProc, (ClientData)tcmdPtr, 
-		   CommandObjTraceDeleted);
+
+	if (ctxPtr->type == TCL_LOCATION_BC) {
+	    /*
+	     * Type BC => ctxPtr->data.eval.path    is not used.
+	     *            ctxPtr->data.tebc.codePtr is used instead.
+	     */
+
+	    TclGetSrcInfoForPc(ctxPtr);
+	    pc = 1;
+
+	    /*
+	     * The line information in the cmdFrame is now a copy we do not
+	     * own.
+	     */
 	}
-    }
-    if (flags & TCL_TRACE_DESTROYED) {
-	if (tcmdPtr->stepTrace != NULL) {
-	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
-	    tcmdPtr->stepTrace = NULL;
-            if (tcmdPtr->startCmd != NULL) {
-	        ckfree((char *)tcmdPtr->startCmd);
+
+	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
+	    int bline = ctxPtr->line[bidx];
+
+	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+	    ctxPtr->nline = objc;
+	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
+	} else {
+	    /*
+	     * This is either a dynamic code word, when all elements are
+	     * relative to themselves, or something else less expected and
+	     * where we have no information. The result is the same in both
+	     * cases; tell the code to come that it doesn't know where it is,
+	     * which triggers reversion to the old behavior.
+	     */
+
+	    int k;
+
+	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+	    ctxPtr->nline = objc;
+	    for (k=0; k < objc; k++) {
+		ctxPtr->line[k] = -1;
 	    }
 	}
     }
-    if (call) {
-	tcmdPtr->refCount--;
-	if (tcmdPtr->refCount < 0) {
-	    Tcl_Panic("TraceExecutionProc: negative TraceCommandInfo refCount");
+
+    for (j = i + 1; ; j += 2) {
+	if (j >= objc) {
+	    /*
+	     * This shouldn't happen since we've checked that the last body is
+	     * not a continuation...
+	     */
+
+	    Tcl_Panic("fall-out when searching for body to match pattern");
 	}
-	if (tcmdPtr->refCount == 0) {
-	    ckfree((char*)tcmdPtr);
+	if (strcmp(TclGetString(objv[j]), "-") != 0) {
+	    break;
 	}
     }
-    return traceCode;
+
+    /*
+     * TIP #280: Make invoking context available to switch branch.
+     */
+
+    result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
+    if (splitObjs) {
+	ckfree((char *) ctxPtr->line);
+	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
+	    /*
+	     * Death of SrcInfo reference.
+	     */
+
+	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
+	}
+    }
+
+    /*
+     * Generate an error message if necessary.
+     */
+
+    if (result == TCL_ERROR) {
+	int limit = 50;
+	int overflow = (patternLength > limit);
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"%.*s%s\" arm line %d)",
+		(overflow ? limit : patternLength), pattern,
+		(overflow ? "..." : ""), interp->errorLine));
+    }
+    TclStackFree(interp, ctxPtr);
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TraceVarProc --
+ * Tcl_TimeObjCmd --
  *
- *	This procedure is called to handle variable accesses that have
- *	been traced using the "trace" command.
+ *	This object-based procedure is invoked to process the "time" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	Normally returns NULL.  If the trace command returns an error,
- *	then this procedure returns an error string.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *	Depends on the command associated with the trace.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static char *
-TraceVarProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Information about the variable trace. */
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *name1;		/* Name of variable or array. */
-    CONST char *name2;		/* Name of element within array;  NULL means
-				 * scalar variable is being referenced. */
-    int flags;			/* OR-ed bits giving operation and other
-				 * information. */
+int
+Tcl_TimeObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_SavedResult state;
-    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
-    char *result;
-    int code, destroy = 0;
-    Tcl_DString cmd;
-
-    /* 
-     * We might call Tcl_Eval() below, and that might evaluate [trace
-     * vdelete] which might try to free tvarPtr. However we do not
-     * need to protect anything here; it's done by our caller because
-     * the TraceVarInfo is really part of a CompoundVarTrace. [Bug 1348775]
-     */
+    register Tcl_Obj *objPtr;
+    Tcl_Obj *objs[4];
+    register int i, result;
+    int count;
+    double totalMicroSec;
+#ifndef TCL_WIDE_CLICKS
+    Tcl_Time start, stop;
+#else
+    Tcl_WideInt start, stop;
+#endif
 
-    result = NULL;
-    if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)) {
-	if (tvarPtr->length != (size_t) 0) {
-	    /*
-	     * Generate a command to execute by appending list elements
-	     * for the two variable names and the operation. 
-	     */
+    if (objc == 2) {
+	count = 1;
+    } else if (objc == 3) {
+	result = TclGetIntFromObj(interp, objv[2], &count);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
+	return TCL_ERROR;
+    }
 
-	    Tcl_DStringInit(&cmd);
-	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
-	    Tcl_DStringAppendElement(&cmd, name1);
-	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
-		if (flags & TCL_TRACE_ARRAY) {
-		    Tcl_DStringAppend(&cmd, " a", 2);
-		} else if (flags & TCL_TRACE_READS) {
-		    Tcl_DStringAppend(&cmd, " r", 2);
-		} else if (flags & TCL_TRACE_WRITES) {
-		    Tcl_DStringAppend(&cmd, " w", 2);
-		} else if (flags & TCL_TRACE_UNSETS) {
-		    Tcl_DStringAppend(&cmd, " u", 2);
-		}
-	    } else {
+    objPtr = objv[1];
+    i = count;
+#ifndef TCL_WIDE_CLICKS
+    Tcl_GetTime(&start);
+#else
+    start = TclpGetWideClicks();
 #endif
-		if (flags & TCL_TRACE_ARRAY) {
-		    Tcl_DStringAppend(&cmd, " array", 6);
-		} else if (flags & TCL_TRACE_READS) {
-		    Tcl_DStringAppend(&cmd, " read", 5);
-		} else if (flags & TCL_TRACE_WRITES) {
-		    Tcl_DStringAppend(&cmd, " write", 6);
-		} else if (flags & TCL_TRACE_UNSETS) {
-		    Tcl_DStringAppend(&cmd, " unset", 6);
-		}
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-	    }
+    while (i-- > 0) {
+	result = Tcl_EvalObjEx(interp, objPtr, 0);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+#ifndef TCL_WIDE_CLICKS
+    Tcl_GetTime(&stop);
+    totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
+	    + (stop.usec - start.usec);
+#else
+    stop = TclpGetWideClicks();
+    totalMicroSec = ((double) TclpWideClicksToNanoseconds(stop - start))/1.0e3;
 #endif
-	    
-	    /*
-	     * Execute the command.  Save the interp's result used for
-	     * the command. We discard any object result the command returns.
-	     *
-	     * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
-	     * other areas that this will be destroyed by us, otherwise a
-	     * double-free might occur depending on what the eval does.
-	     */
 
-	    Tcl_SaveResult(interp, &state);
-	    if ((flags & TCL_TRACE_DESTROYED)
-		    && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
-		destroy = 1;
-		tvarPtr->flags |= TCL_TRACE_DESTROYED;
-	    }
+    if (count <= 1) {
+	/*
+	 * Use int obj since we know time is not fractional. [Bug 1202178]
+	 */
 
-	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
-		    Tcl_DStringLength(&cmd), 0);
-	    if (code != TCL_OK) {	     /* copy error msg to result */
-		register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
-		Tcl_IncrRefCount(errMsgObj);
-		result = (char *) errMsgObj;
-	    }
+	objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
+    } else {
+	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
+    }
 
-	    Tcl_RestoreResult(interp, &state);
+    /*
+     * Construct the result as a list because many programs have always parsed
+     * as such (extracting the first element, typically).
+     */
 
-	    Tcl_DStringFree(&cmd);
-	}
-    }
-    if (destroy) {
-	if (result != NULL) {
-	    register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+    TclNewLiteralStringObj(objs[1], "microseconds");
+    TclNewLiteralStringObj(objs[2], "per");
+    TclNewLiteralStringObj(objs[3], "iteration");
+    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
 
-	    Tcl_DecrRefCount(errMsgObj);
-	    result = NULL;
-	}
-    }
-    return result;
+    return TCL_OK;
 }
 
 /*
@@ -4936,108 +3941,115 @@ TraceVarProc(clientData, interp, name1, name2, flags)
  *
  * Tcl_WhileObjCmd --
  *
- *      This procedure is invoked to process the "while" Tcl command.
- *      See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "while" Tcl command. See the
+ *	user documentation for details on what it does.
  *
- *	With the bytecode compiler, this procedure is only called when
- *	a command name is computed at runtime, and is "while" or the name
- *	to which "while" was renamed: e.g., "set z while; $z {$i<100} {}"
+ *	With the bytecode compiler, this procedure is only called when a
+ *	command name is computed at runtime, and is "while" or the name to
+ *	which "while" was renamed: e.g., "set z while; $z {$i<100} {}"
  *
  * Results:
- *      A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *      See the user documentation.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-        /* ARGSUSED */
 int
-Tcl_WhileObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;                   /* Not used. */
-    Tcl_Interp *interp;                 /* Current interpreter. */
-    int objc;                           /* Number of arguments. */
-    Tcl_Obj *CONST objv[];       	/* Argument objects. */
+Tcl_WhileObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result, value;
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    Interp *iPtr = (Interp *) interp;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     while (1) {
-        result = Tcl_ExprBooleanObj(interp, objv[1], &value);
-        if (result != TCL_OK) {
-            return result;
-        }
-        if (!value) {
-            break;
-        }
-#ifndef TCL_TIP280
-        result = Tcl_EvalObjEx(interp, objv[2], 0);
-#else
-	/* TIP #280. */
-        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2);
-#endif
-        if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-            if (result == TCL_ERROR) {
-                char msg[32 + TCL_INTEGER_SPACE];
+	result = Tcl_ExprBooleanObj(interp, objv[1], &value);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (!value) {
+	    break;
+	}
 
-                sprintf(msg, "\n    (\"while\" body line %d)",
-                        interp->errorLine);
-                Tcl_AddErrorInfo(interp, msg);
-            }
-            break;
-        }
+	/* TIP #280. */
+        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr, 2);
+	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+	    if (result == TCL_ERROR) {
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"while\" body line %d)", interp->errorLine));
+	    }
+	    break;
+	}
     }
     if (result == TCL_BREAK) {
-        result = TCL_OK;
+	result = TCL_OK;
     }
     if (result == TCL_OK) {
-        Tcl_ResetResult(interp);
+	Tcl_ResetResult(interp);
     }
     return result;
 }
 
-#ifdef TCL_TIP280
-static void
-ListLines(listObj, line, n, lines, elems)
-     Tcl_Obj* listObj; /* Pointer to obj holding a string with list structure.
-			* Assumed to be valid. Assumed to contain n elements.
-			*/
-     int  line;        /* line the list as a whole starts on */
-     int  n;           /* #elements in lines */
-     int* lines;       /* Array of line numbers, to fill */
-     Tcl_Obj* const* elems;  /* The list elems as Tcl_Obj*, in need of derived
-			      * continuation data */
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclListLines --
+ *
+ *	???
+ *
+ * Results:
+ *	Filled in array of line numbers?
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclListLines(
+    Tcl_Obj* listObj,          /* Pointer to obj holding a string with list
+				* structure.  Assumed to be valid. Assumed to
+				* contain n elements.
+				*/
+    int line,			/* Line the list as a whole starts on. */
+    int n,			/* #elements in lines */
+    int *lines,			/* Array of line numbers, to fill. */
+    Tcl_Obj* const* elems)      /* The list elems as Tcl_Obj*, in need of
+				 * derived continuation data */
 {
-    int          i;
-    CONST char*  listStr  = Tcl_GetString (listObj);
-    CONST char*  listHead = listStr;
-    int          length   = strlen( listStr);
-    CONST char*  element  = NULL;
-    CONST char*  next     = NULL;
+    const char*  listStr  = Tcl_GetString (listObj);
+    const char*  listHead = listStr;
+    int i, length = strlen(listStr);
+    const char *element = NULL, *next = NULL;
     ContLineLoc* clLocPtr = TclContinuationsGet(listObj);
-    int*         clNext   = (clLocPtr ? &clLocPtr->loc[0] : NULL);
+    int* clNext   = (clLocPtr ? &clLocPtr->loc[0] : NULL);
 
     for (i = 0; i < n; i++) {
 	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
 
-	TclAdvanceLines (&line, listStr, element); /* Leading whitespace */
+	TclAdvanceLines(&line, listStr, element);
+				/* Leading whitespace */
 	TclAdvanceContinuations (&line, &clNext, element - listHead);
-	if (clNext) {
-	    TclContinuationsEnterDerived (elems[i], element - listHead, clNext);
+	if (elems && clNext) {
+	    TclContinuationsEnterDerived (elems[i], element - listHead,
+					  clNext);
 	}
-
-	lines [i] = line;
-	length   -= (next - listStr);
-	TclAdvanceLines (&line, element, next); /* Element */
-	listStr   = next;
+	lines[i] = line;
+	length -= (next - listStr);
+	TclAdvanceLines(&line, element, next);
+				/* Element */
+	listStr = next;
 
 	if (*element == 0) {
 	    /* ASSERT i == n */
@@ -5045,7 +4057,6 @@ ListLines(listObj, line, n, lines, elems)
 	}
     }
 }
-#endif
 
 /*
  * Local Variables:
@@ -5054,4 +4065,3 @@ ListLines(listObj, line, n, lines, elems)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index a39370e..b6e9527 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1,54 +1,49 @@
-/* 
+/*
  * tclCompCmds.c --
  *
- *	This file contains compilation procedures that compile various
- *	Tcl commands into a sequence of instructions ("bytecodes"). 
+ *	This file contains compilation procedures that compile various Tcl
+ *	commands into a sequence of instructions ("bytecodes").
  *
  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2004-2006 by Donal K. Fellows.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 #include "tclCompile.h"
 
 /*
- * Prototypes for procedures defined later in this file:
+ * Macro that encapsulates an efficiency trick that avoids a function call for
+ * the simplest of compiles. The ANSI C "prototype" for this macro is:
+ *
+ * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ *			    Tcl_Interp *interp, int word);
  */
 
-static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
-static void		FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
-#ifndef TCL_TIP280
-static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
-	int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
-
-#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
-    TclPushVarName (i,v,e,f,l,s,sc) /* ignoring word */
-
-#define DefineLineInformation /**/
-#define SetLineInformation(word) /**/
-#else
-static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
-	int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr,
-	int line, int* clNext));
-
-#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
-    TclPushVarName (i,v,e,f,l,s,sc,                       \
-                    mapPtr->loc [eclIndex].line [(word)], \
-	            mapPtr->loc [eclIndex].next [(word)])
+#define CompileWord(envPtr, tokenPtr, interp, word) \
+    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
+	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
+		(tokenPtr)[1].size), (envPtr)); \
+    } else { \
+        envPtr->line   = mapPtr->loc[eclIndex].line[word]; \
+        envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
+	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
+		(envPtr)); \
+    }
 
-/* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation may
- * reallocate, i.e. move, the array. This is also the reason to save the nuloc
- * now, it may change during the course of the function.
+/*
+ * TIP #280: Remember the per-word line information of the current command. An
+ * index is used instead of a pointer as recursive compilation may reallocate,
+ * i.e. move, the array. This is also the reason to save the nuloc now, it may
+ * change during the course of the function.
  *
- * Macros to encapsulate the variable definition and setup, and their use.
+ * Macro to encapsulate the variable definition and setup.
  */
+
 #define DefineLineInformation \
     ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
     int eclIndex = mapPtr->nuloc - 1
@@ -56,23 +51,163 @@ static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
 #define SetLineInformation(word) \
     envPtr->line   = mapPtr->loc [eclIndex].line [(word)]; \
     envPtr->clNext = mapPtr->loc [eclIndex].next [(word)]
-#endif
 
 /*
- * Flags bits used by TclPushVarName.
+ * Convenience macro for use when compiling bodies of commands. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ *			    Tcl_Interp *interp);
+ */
+
+#define CompileBody(envPtr, tokenPtr, interp) \
+    TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
+	    (envPtr))
+
+/*
+ * Convenience macro for use when compiling tokens to be pushed. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ *			    Tcl_Interp *interp);
+ */
+
+#define CompileTokens(envPtr, tokenPtr, interp) \
+    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
+            (envPtr));
+/*
+ * Convenience macro for use when pushing literals. The ANSI C "prototype" for
+ * this macro is:
+ *
+ * static void		PushLiteral(CompileEnv *envPtr,
+ *			    const char *string, int length);
+ */
+
+#define PushLiteral(envPtr, string, length) \
+    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+
+/*
+ * Macro to advance to the next token; it is more mnemonic than the address
+ * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
+ *
+ * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
+ */
+
+#define TokenAfter(tokenPtr) \
+    ((tokenPtr) + ((tokenPtr)->numComponents + 1))
+
+/*
+ * Macro to get the offset to the next instruction to be issued. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static int	CurrentOffset(CompileEnv *envPtr);
+ */
+
+#define CurrentOffset(envPtr) \
+    ((envPtr)->codeNext - (envPtr)->codeStart)
+
+/*
+ * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
+ * maximal depth of nested CATCH ranges in order to alloc runtime
+ * memory. These macros should compute precisely that? OTOH, the nesting depth
+ * of LOOP ranges is an interesting datum for debugging purposes, and that is
+ * what we compute now.
+ *
+ * static int	DeclareExceptionRange(CompileEnv *envPtr, int type);
+ * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
+ */
+
+#define DeclareExceptionRange(envPtr, type) \
+    (TclCreateExceptRange((type), (envPtr)))
+#define ExceptionRangeStarts(envPtr, index) \
+    (((envPtr)->exceptDepth++), \
+    ((envPtr)->maxExceptDepth = \
+	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
+    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
+#define ExceptionRangeEnds(envPtr, index) \
+    (((envPtr)->exceptDepth--), \
+    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
+	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
+#define ExceptionRangeTarget(envPtr, index, targetType) \
+    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+
+/*
+ * Prototypes for procedures defined later in this file:
  */
 
-#define TCL_CREATE_VAR     1 /* Create a compiled local if none is found */
-#define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */
+static ClientData	DupDictUpdateInfo(ClientData clientData);
+static void		FreeDictUpdateInfo(ClientData clientData);
+static void		PrintDictUpdateInfo(ClientData clientData,
+			    Tcl_Obj *appendObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+static ClientData	DupForeachInfo(ClientData clientData);
+static void		FreeForeachInfo(ClientData clientData);
+static void		PrintForeachInfo(ClientData clientData,
+			    Tcl_Obj *appendObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+static ClientData	DupJumptableInfo(ClientData clientData);
+static void		FreeJumptableInfo(ClientData clientData);
+static void		PrintJumptableInfo(ClientData clientData,
+			    Tcl_Obj *appendObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+static int		PushVarName(Tcl_Interp *interp,
+			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
+			    int flags, int *localIndexPtr,
+			    int *simpleVarNamePtr, int *isScalarPtr,
+			    int line, int* clNext);
+static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, const char *identity,
+			    int instruction, CompileEnv *envPtr);
+static int		CompileComparisonOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int instruction,
+			    CompileEnv *envPtr);
+static int		CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int instruction,
+			    CompileEnv *envPtr);
+static int		CompileUnaryOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int instruction,
+			    CompileEnv *envPtr);
+static void		CompileReturnInternal(CompileEnv *envPtr,
+			    unsigned char op, int code, int level,
+			    Tcl_Obj *returnOpts);
+
+#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
+    PushVarName (i,v,e,f,l,s,sc,                       \
+                    mapPtr->loc [eclIndex].line [(word)], \
+	            mapPtr->loc [eclIndex].next [(word)])
+
+/*
+ * Flags bits used by PushVarName.
+ */
+
+#define TCL_CREATE_VAR     1	/* Create a compiled local if none is found */
+#define TCL_NO_LARGE_INDEX 2	/* Do not return localIndex value > 255 */
 
 /*
  * The structures below define the AuxData types defined in this file.
  */
 
 AuxDataType tclForeachInfoType = {
-    "ForeachInfo",				/* name */
-    DupForeachInfo,				/* dupProc */
-    FreeForeachInfo				/* freeProc */
+    "ForeachInfo",		/* name */
+    DupForeachInfo,		/* dupProc */
+    FreeForeachInfo,		/* freeProc */
+    PrintForeachInfo		/* printProc */
+};
+
+AuxDataType tclJumptableInfoType = {
+    "JumptableInfo",		/* name */
+    DupJumptableInfo,		/* dupProc */
+    FreeJumptableInfo,		/* freeProc */
+    PrintJumptableInfo		/* printProc */
+};
+
+AuxDataType tclDictUpdateInfoType = {
+    "DictUpdateInfo",		/* name */
+    DupDictUpdateInfo,		/* dupProc */
+    FreeDictUpdateInfo,		/* freeProc */
+    PrintDictUpdateInfo		/* printProc */
 };
 
 /*
@@ -83,89 +218,68 @@ AuxDataType tclForeachInfoType = {
  *	Procedure called to compile the "append" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is normally TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message. If
- *	compilation fails because the command requires a second level of
- *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- *	command should be compiled "out of line" by emitting code to
- *	invoke its command procedure (Tcl_AppendObjCmd) at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "append" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "append" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileAppendCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileAppendCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int simpleVarName, isScalar, localIndex, numWords;
-    int code = TCL_OK;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
     if (numWords == 1) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"wrong # args: should be \"append varName ?value value ...?\"",
-		-1);
 	return TCL_ERROR;
     } else if (numWords == 2) {
 	/*
-	 * append varName === set varName
+	 * append varName == set varName
 	 */
-        return TclCompileSetCmd(interp, parsePtr, envPtr);
+
+	return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
     } else if (numWords > 3) {
 	/*
-	 * APPEND instructions currently only handle one value
+	 * APPEND instructions currently only handle one value.
 	 */
-        return TCL_OUT_LINE_COMPILE;
+
+	return TCL_ERROR;
     }
 
     /*
-     * Decide if we can use a frame slot for the var/array name or if we
-     * need to emit code to compute and push the name at runtime. We use a
-     * frame slot (entry in the array of local vars) if we are compiling a
-     * procedure body and if the name is simple text that does not include
-     * namespace qualifiers. 
+     * Decide if we can use a frame slot for the var/array name or if we need
+     * to emit code to compute and push the name at runtime. We use a frame
+     * slot (entry in the array of local vars) if we are compiling a procedure
+     * body and if the name is simple text that does not include namespace
+     * qualifiers.
      */
 
-    varTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-	    &localIndex, &simpleVarName, &isScalar, 1);
-    if (code != TCL_OK) {
-	goto done;
-    }
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+		    &localIndex, &simpleVarName, &isScalar, 1);
 
     /*
-     * We are doing an assignment, otherwise TclCompileSetCmd was called,
-     * so push the new value.  This will need to be extended to push a
-     * value for each argument.
+     * We are doing an assignment, otherwise TclCompileSetCmd was called, so
+     * push the new value. This will need to be extended to push a value for
+     * each argument.
      */
 
     if (numWords > 2) {
-	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-	if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, 
-		    valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
-	} else {
-	    SetLineInformation (2);
-	    code = TclCompileTokens(interp, valueTokenPtr+1,
-	            valueTokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-	}
+	valueTokenPtr = TokenAfter(varTokenPtr);
+	CompileWord(envPtr, valueTokenPtr, interp, 2);
     }
 
     /*
@@ -174,32 +288,27 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
 
     if (simpleVarName) {
 	if (isScalar) {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode(INST_APPEND_STK, envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
 	    }
 	} else {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
 	    }
 	}
     } else {
 	TclEmitOpcode(INST_APPEND_STK, envPtr);
     }
 
-    done:
-    return code;
+    return TCL_OK;
 }
 
 /*
@@ -210,28 +319,26 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "break" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK unless
- *	there was an error during compilation. If an error occurs then
- *	the interpreter's result contains a standard error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "break" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "break" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileBreakCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileBreakCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     if (parsePtr->numWords != 1) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"break\"", -1);
 	return TCL_ERROR;
     }
 
@@ -251,172 +358,239 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "catch" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	compilation was successful. If an error occurs then the
- *	interpreter's result contains a standard error message and TCL_ERROR
- *	is returned. If the command is too complex for TclCompileCatchCmd,
- *	TCL_OUT_LINE_COMPILE is returned indicating that the catch command
- *	should be compiled "out of line" by emitting code to invoke its
- *	command procedure at runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "catch" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "catch" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileCatchCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileCatchCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     JumpFixup jumpFixup;
-    Tcl_Token *cmdTokenPtr, *nameTokenPtr;
-    CONST char *name;
-    int localIndex, nameChars, range, startOffset, jumpDist;
-    int code;
-    int savedStackDepth = envPtr->currStackDepth;
+    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
+    const char *name;
+    int resultIndex, optsIndex, nameChars, range;
+    int initStackDepth = envPtr->currStackDepth;
+    int savedStackDepth;
+    DefineLineInformation;	/* TIP #280 */
 
-    DefineLineInformation;
+    /*
+     * If syntax does not match what we expect for [catch], do not compile.
+     * Let runtime checks determine if syntax has changed.
+     */
 
-    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"catch command ?varName?\"", -1);
+    if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
 	return TCL_ERROR;
     }
 
     /*
-     * If a variable was specified and the catch command is at global level
-     * (not in a procedure), don't compile it inline: the payoff is
-     * too small.
+     * If variables were specified and the catch command is at global level
+     * (not in a procedure), don't compile it inline: the payoff is too small.
      */
 
-    if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
-	return TCL_OUT_LINE_COMPILE;
+    if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
+	return TCL_ERROR;
     }
 
     /*
-     * Make sure the variable name, if any, has no substitutions and just
-     * refers to a local scaler.
+     * Make sure the variable names, if any, have no substitutions and just
+     * refer to local scalars.
      */
 
-    localIndex = -1;
-    cmdTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (parsePtr->numWords == 3) {
-	nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
-	if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    name = nameTokenPtr[1].start;
-	    nameChars = nameTokenPtr[1].size;
+    resultIndex = optsIndex = -1;
+    cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (parsePtr->numWords >= 3) {
+	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
+	/* DGP */
+	if (resultNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+
+	name = resultNameTokenPtr[1].start;
+	nameChars = resultNameTokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
+		resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
+	if (resultIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	/* DKF */
+	if (parsePtr->numWords == 4) {
+	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
+	    if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		return TCL_ERROR;
+	    }
+	    name = optsNameTokenPtr[1].start;
+	    nameChars = optsNameTokenPtr[1].size;
 	    if (!TclIsLocalScalar(name, nameChars)) {
-		return TCL_OUT_LINE_COMPILE;
+		return TCL_ERROR;
+	    }
+	    optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
+		    optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
+	    if (optsIndex < 0) {
+		return TCL_ERROR;
 	    }
-	    localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
-		    nameTokenPtr[1].size, /*create*/ 1, 
-		    /*flags*/ VAR_SCALAR, envPtr->procPtr);
-	} else {
-	   return TCL_OUT_LINE_COMPILE;
 	}
     }
 
     /*
-     * We will compile the catch command. Emit a beginCatch instruction at
-     * the start of the catch body: the subcommand it controls.
+     * We will compile the catch command. Declare the exception range
+     * that it uses.
      */
-    
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-    TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
 
     /*
-     * If the body is a simple word, compile the instructions to
-     * eval it. Otherwise, compile instructions to substitute its
-     * text without catching, a catch instruction that resets the 
-     * stack to what it was before substituting the body, and then 
-     * an instruction to eval the body. Care has to be taken to 
-     * register the correct startOffset for the catch range so that
-     * errors in the substitution are not catched [Bug 219184]
+     * If the body is a simple word, compile a BEGIN_CATCH instruction,
+     * followed by the instructions to eval the body.
+     * Otherwise, compile instructions to substitute the body text before
+     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to
+     * evaluate the substituted body.
+     * Care has to be taken to make sure that substitution happens outside
+     * the catch range so that errors in the substitution are not caught.
+     * [Bug 219184]
+     * The reason for duplicating the script is that EVAL_STK would otherwise
+     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
-    SetLineInformation (1);
+    SetLineInformation(1);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	startOffset = (envPtr->codeNext - envPtr->codeStart);
-	code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
+	savedStackDepth = envPtr->currStackDepth;
+	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+	ExceptionRangeStarts(envPtr, range);
+	CompileBody(envPtr, cmdTokenPtr, interp);
     } else {
-	code = TclCompileTokens(interp, cmdTokenPtr+1,
-	        cmdTokenPtr->numComponents, envPtr);
-	startOffset = (envPtr->codeNext - envPtr->codeStart);
+	CompileTokens(envPtr, cmdTokenPtr, interp);
+	savedStackDepth = envPtr->currStackDepth;
+	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+	ExceptionRangeStarts(envPtr, range);
+	TclEmitOpcode(INST_DUP, envPtr);
 	TclEmitOpcode(INST_EVAL_STK, envPtr);
     }
-    envPtr->exceptArrayPtr[range].codeOffset = startOffset;
+    /* Stack at this point:
+     *    nonsimple:  script <mark> result
+     *    simple:            <mark> result
+     */
 
-    if (code != TCL_OK) {
-	code = TCL_OUT_LINE_COMPILE;
-	goto done;
-    }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - startOffset;
-		    
     /*
-     * The "no errors" epilogue code: store the body's result into the
-     * variable (if any), push "0" (TCL_OK) as the catch's "no error"
+     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch
      * result, and jump around the "error case" code.
      */
 
-    if (localIndex != -1) {
-	if (localIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+    PushLiteral(envPtr, "0", 1);
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+    /* Stack at this point: ?script? <mark> result TCL_OK */
+
+    /*
+     * Emit the "error case" epilogue. Push the interpreter result
+     * and the return code.
+     */
+
+    envPtr->currStackDepth = savedStackDepth;
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    /* Stack at this point:  ?script? */
+    TclEmitOpcode(INST_PUSH_RESULT, envPtr);
+    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
+    /*
+     * Update the target of the jump after the "no errors" code.
+     */
+
+    /* Stack at this point: ?script? result returnCode */
+    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
+		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+    }
+
+    /* Push the return options if the caller wants them */
+
+    if (optsIndex != -1) {
+	TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+    }
+
+    /*
+     * End the catch
+     */
+
+    ExceptionRangeEnds(envPtr, range);
+    TclEmitOpcode(INST_END_CATCH, envPtr);
+
+    /*
+     * At this point, the top of the stack is inconveniently ordered:
+     *		?script? result returnCode ?returnOptions?
+     * Reverse the stack to bring the result to the top.
+     */
+
+    if (optsIndex != -1) {
+	TclEmitInstInt4(INST_REVERSE, 3, envPtr);
+    } else {
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+    }
+
+    /*
+     * Store the result if requested, and remove it from the stack
+     */
+
+    if (resultIndex != -1) {
+	if (resultIndex <= 255) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
 	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	    TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
 	}
     }
     TclEmitOpcode(INST_POP, envPtr);
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
-    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
 
     /*
-     * The "error case" code: store the body's result into the variable (if
-     * any), then push the error result code. The initial PC offset here is
-     * the catch's error target.
+     * Stack is now ?script? ?returnOptions? returnCode.
+     * If the options dict has been requested, it is buried on the stack
+     * under the return code. Reverse the stack to bring it to the top,
+     * store it and remove it from the stack.
      */
 
-    envPtr->currStackDepth = savedStackDepth;
-    envPtr->exceptArrayPtr[range].catchOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    if (localIndex != -1) {
-	TclEmitOpcode(INST_PUSH_RESULT, envPtr);
-	if (localIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+    if (optsIndex != -1) {
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+	if (optsIndex <= 255) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
 	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	    TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
 	}
 	TclEmitOpcode(INST_POP, envPtr);
     }
-    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-
 
     /*
-     * Update the target of the jump after the "no errors" code, then emit
-     * an endCatch instruction at the end of the catch command.
+     * Stack is now ?script? result. Get rid of the subst'ed script
+     * if it's hanging arond.
      */
 
-    jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	    - jumpFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
-	panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+	TclEmitOpcode(INST_POP, envPtr);
     }
-    TclEmitOpcode(INST_END_CATCH, envPtr);
 
-    done:
-    envPtr->currStackDepth = savedStackDepth + 1;
-    envPtr->exceptDepth--;
-    return code;
+    /*
+     * Result of all this, on either branch, should have been to leave
+     * one operand -- the return code -- on the stack.
+     */
+
+    if (envPtr->currStackDepth != initStackDepth + 1) {
+	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
+		  envPtr->currStackDepth, initStackDepth+1);
+    }
+    return TCL_OK;
 }
 
 /*
@@ -427,32 +601,30 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "continue" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK unless
- *	there was an error while parsing string. If an error occurs then
- *	the interpreter's result contains a standard error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "continue" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "continue" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileContinueCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileContinueCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     /*
      * There should be no argument after the "continue".
      */
 
     if (parsePtr->numWords != 1) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"continue\"", -1);
 	return TCL_ERROR;
     }
 
@@ -467,45 +639,789 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileDict*Cmd --
+ *
+ *	Functions called to compile "dict" sucommands.
+ *
+ * Results:
+ * 	All return TCL_OK for a successful compile, and TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "dict" subcommand at
+ *	runtime.
+ *
+ * Notes:
+ *	The following commands are in fairly common use and are possibly worth
+ *	bytecoding:
+ *		dict append
+ *		dict create	[*]
+ *		dict exists	[*]
+ *		dict for
+ *		dict get	[*]
+ *		dict incr
+ *		dict keys	[*]
+ *		dict lappend
+ *		dict set
+ *		dict unset
+ *
+ *	In practice, those that are pure-value operators (marked with [*]) can
+ *	probably be left alone (except perhaps [dict get] which is very very
+ *	common) and [dict update] should be considered instead (really big
+ *	win!)
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileDictSetCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int numWords, i;
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr;
+    int dictVarIndex, nameChars;
+    const char *name;
+
+    /*
+     * There must be at least one argument after the command.
+     */
+
+    if (parsePtr->numWords < 4 || procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * The dictionary variable must be a local scalar that is knowable at
+     * compile time; anything else exceeds the complexity of the opcode. So
+     * discover what the index is.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+    name = varTokenPtr[1].start;
+    nameChars = varTokenPtr[1].size;
+    if (!TclIsLocalScalar(name, nameChars)) {
+	return TCL_ERROR;
+    }
+    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+
+    /*
+     * Remaining words (key path and value to set) can be handled normally.
+     */
+
+    tokenPtr = TokenAfter(varTokenPtr);
+    numWords = parsePtr->numWords-1;
+    for (i=1 ; i<numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    /*
+     * Now emit the instruction to do the dict manipulation.
+     */
+
+    TclEmitInstInt4( INST_DICT_SET, numWords-2,		envPtr);
+    TclEmitInt4(     dictVarIndex,			envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictIncrCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr, *keyTokenPtr;
+    int dictVarIndex, nameChars, incrAmount;
+    const char *name;
+
+    /*
+     * There must be at least two arguments after the command.
+     */
+
+    if (parsePtr->numWords < 3 || parsePtr->numWords > 4 || procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    keyTokenPtr = TokenAfter(varTokenPtr);
+
+    /*
+     * Parse the increment amount, if present.
+     */
+
+    if (parsePtr->numWords == 4) {
+	const char *word;
+	int numBytes, code;
+	Tcl_Token *incrTokenPtr;
+	Tcl_Obj *intObj;
+
+	incrTokenPtr = TokenAfter(keyTokenPtr);
+	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	word = incrTokenPtr[1].start;
+	numBytes = incrTokenPtr[1].size;
+
+	intObj = Tcl_NewStringObj(word, numBytes);
+	Tcl_IncrRefCount(intObj);
+	code = TclGetIntFromObj(NULL, intObj, &incrAmount);
+	TclDecrRefCount(intObj);
+	if (code != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	incrAmount = 1;
+    }
+
+    /*
+     * The dictionary variable must be a local scalar that is knowable at
+     * compile time; anything else exceeds the complexity of the opcode. So
+     * discover what the index is.
+     */
+
+    if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+    name = varTokenPtr[1].start;
+    nameChars = varTokenPtr[1].size;
+    if (!TclIsLocalScalar(name, nameChars)) {
+	return TCL_ERROR;
+    }
+    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+
+    /*
+     * Emit the key and the code to actually do the increment.
+     */
+
+    CompileWord(envPtr, keyTokenPtr, interp, 3);
+    TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount,	envPtr);
+    TclEmitInt4(     dictVarIndex,			envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictGetCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * There must be at least two arguments after the command (the single-arg
+     * case is legal, but too special and magic for us to deal with here).
+     */
+
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    numWords = parsePtr->numWords-1;
+
+    /*
+     * Only compile this because we need INST_DICT_GET anyway.
+     */
+
+    for (i=0 ; i<numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictForCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
+    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
+    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
+    int numVars, endTargetOffset;
+    int savedStackDepth = envPtr->currStackDepth;
+				/* Needed because jumps confuse the stack
+				 * space calculator. */
+    const char **argv;
+    Tcl_DString buffer;
+
+    /*
+     * There must be at least three argument after the command.
+     */
+
+    if (parsePtr->numWords != 4 || procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    dictTokenPtr = TokenAfter(varsTokenPtr);
+    bodyTokenPtr = TokenAfter(dictTokenPtr);
+    if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check we've got a pair of variables and that they are local variables.
+     * Then extract their indices in the LVT.
+     */
+
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size);
+    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
+	    &argv) != TCL_OK) {
+	Tcl_DStringFree(&buffer);
+	return TCL_ERROR;
+    }
+    Tcl_DStringFree(&buffer);
+    if (numVars != 2) {
+	ckfree((char *) argv);
+	return TCL_ERROR;
+    }
+
+    nameChars = strlen(argv[0]);
+    if (!TclIsLocalScalar(argv[0], nameChars)) {
+	ckfree((char *) argv);
+	return TCL_ERROR;
+    }
+    keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr);
+
+    nameChars = strlen(argv[1]);
+    if (!TclIsLocalScalar(argv[1], nameChars)) {
+	ckfree((char *) argv);
+	return TCL_ERROR;
+    }
+    valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr);
+    ckfree((char *) argv);
+
+    /*
+     * Allocate a temporary variable to store the iterator reference. The
+     * variable will contain a Tcl_DictSearch reference which will be
+     * allocated by INST_DICT_FIRST and disposed when the variable is unset
+     * (at which point it should also have been finished with).
+     */
+
+    infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
+
+    /*
+     * Preparation complete; issue instructions. Note that this code issues
+     * fixed-sized jumps. That simplifies things a lot!
+     *
+     * First up, get the dictionary and start the iteration. No catching of
+     * errors at this point.
+     */
+
+    CompileWord(envPtr, dictTokenPtr, interp, 3);
+    TclEmitInstInt4( INST_DICT_FIRST, infoIndex,		envPtr);
+    emptyTargetOffset = CurrentOffset(envPtr);
+    TclEmitInstInt4( INST_JUMP_TRUE4, 0,			envPtr);
+
+    /*
+     * Now we catch errors from here on so that we can finalize the search
+     * started by Tcl_DictObjFirst above.
+     */
+
+    catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange,		envPtr);
+    ExceptionRangeStarts(envPtr, catchRange);
+
+    /*
+     * Inside the iteration, write the loop variables.
+     */
+
+    bodyTargetOffset = CurrentOffset(envPtr);
+    TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex,		envPtr);
+    TclEmitOpcode(   INST_POP,					envPtr);
+    TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex,		envPtr);
+    TclEmitOpcode(   INST_POP,					envPtr);
+
+    /*
+     * Set up the loop exception targets.
+     */
+
+    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+    ExceptionRangeStarts(envPtr, loopRange);
+
+    /*
+     * Compile the loop body itself. It should be stack-neutral.
+     */
+
+    SetLineInformation(3);
+    CompileBody(envPtr, bodyTokenPtr, interp);
+    TclEmitOpcode(   INST_POP,					envPtr);
+
+    /*
+     * Both exception target ranges (error and loop) end here.
+     */
+
+    ExceptionRangeEnds(envPtr, loopRange);
+    ExceptionRangeEnds(envPtr, catchRange);
+
+    /*
+     * Continue (or just normally process) by getting the next pair of items
+     * from the dictionary and jumping back to the code to write them into
+     * variables if there is another pair.
+     */
+
+    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+    TclEmitInstInt4( INST_DICT_NEXT, infoIndex,			envPtr);
+    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
+    TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
+    TclEmitOpcode(   INST_POP,					envPtr);
+    TclEmitOpcode(   INST_POP,					envPtr);
+
+    /*
+     * Now do the final cleanup for the no-error case (this is where we break
+     * out of the loop to) by force-terminating the iteration (if not already
+     * terminated), ditching the exception info and jumping to the last
+     * instruction for this command. In theory, this could be done using the
+     * "finally" clause (next generated) but this is faster.
+     */
+
+    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
+    TclEmitOpcode(   INST_END_CATCH,				envPtr);
+    endTargetOffset = CurrentOffset(envPtr);
+    TclEmitInstInt4( INST_JUMP4, 0,				envPtr);
+
+    /*
+     * Error handler "finally" clause, which force-terminates the iteration
+     * and rethrows the error.
+     */
+
+    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
+    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
+    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
+    TclEmitOpcode(   INST_END_CATCH,				envPtr);
+    TclEmitOpcode(   INST_RETURN_STK,				envPtr);
+
+    /*
+     * Otherwise we're done (the jump after the DICT_FIRST points here) and we
+     * need to pop the bogus key/value pair (pushed to keep stack calculations
+     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
+     */
+
+    envPtr->currStackDepth = savedStackDepth+2;
+    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
+    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
+	    envPtr->codeStart + emptyTargetOffset);
+    TclEmitOpcode(   INST_POP,					envPtr);
+    TclEmitOpcode(   INST_POP,					envPtr);
+    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
+
+    /*
+     * Final stage of the command (normal case) is that we push an empty
+     * object. This is done last to promote peephole optimization when it's
+     * dropped immediately.
+     */
+
+    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
+    TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
+	    envPtr->codeStart + endTargetOffset);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+int
+TclCompileDictUpdateCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    const char *name;
+    int i, nameChars, dictIndex, numVars, range, infoIndex;
+    Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
+    DictUpdateInfo *duiPtr;
+    JumpFixup jumpFixup;
+
+    /*
+     * There must be at least one argument after the command.
+     */
+
+    if (parsePtr->numWords < 5 || procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse the command. Expect the following:
+     *   dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
+     */
+
+    if ((parsePtr->numWords - 1) & 1) {
+	return TCL_ERROR;
+    }
+    numVars = (parsePtr->numWords - 3) / 2;
+
+    /*
+     * The dictionary variable must be a local scalar that is knowable at
+     * compile time; anything else exceeds the complexity of the opcode. So
+     * discover what the index is.
+     */
+
+    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+    name = dictVarTokenPtr[1].start;
+    nameChars = dictVarTokenPtr[1].size;
+    if (!TclIsLocalScalar(name, nameChars)) {
+	return TCL_ERROR;
+    }
+    dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+
+    /*
+     * Assemble the instruction metadata. This is complex enough that it is
+     * represented as auxData; it holds an ordered list of variable indices
+     * that are to be used.
+     */
+
+    duiPtr = (DictUpdateInfo *)
+	    ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+    duiPtr->length = numVars;
+    keyTokenPtrs = (Tcl_Token **) TclStackAlloc(interp,
+	    sizeof(Tcl_Token *) * numVars);
+    tokenPtr = TokenAfter(dictVarTokenPtr);
+
+    for (i=0 ; i<numVars ; i++) {
+	/*
+	 * Put keys to one side for later compilation to bytecode.
+	 */
+
+	keyTokenPtrs[i] = tokenPtr;
+
+	/*
+	 * Variables first need to be checked for sanity.
+	 */
+
+	tokenPtr = TokenAfter(tokenPtr);
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    ckfree((char *) duiPtr);
+	    TclStackFree(interp, keyTokenPtrs);
+	    return TCL_ERROR;
+	}
+	name = tokenPtr[1].start;
+	nameChars = tokenPtr[1].size;
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    ckfree((char *) duiPtr);
+	    TclStackFree(interp, keyTokenPtrs);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Stash the index in the auxiliary data.
+	 */
+
+	duiPtr->varIndices[i] =
+		TclFindCompiledLocal(name, nameChars, 1, procPtr);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	ckfree((char *) duiPtr);
+	TclStackFree(interp, keyTokenPtrs);
+	return TCL_ERROR;
+    }
+    bodyTokenPtr = tokenPtr;
+
+    /*
+     * The list of variables to bind is stored in auxiliary data so that it
+     * can't be snagged by literal sharing and forced to shimmer dangerously.
+     */
+
+    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+
+    for (i=0 ; i<numVars ; i++) {
+	CompileWord(envPtr, keyTokenPtrs[i], interp, i);
+    }
+    TclEmitInstInt4( INST_LIST, numVars,			envPtr);
+    TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex,		envPtr);
+    TclEmitInt4(     infoIndex,					envPtr);
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    TclEmitInstInt4( INST_BEGIN_CATCH4, range,			envPtr);
+
+    ExceptionRangeStarts(envPtr, range);
+    SetLineInformation(parsePtr->numWords - 1);
+    CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, range);
+
+    /*
+     * Normal termination code: the stack has the key list below the result of
+     * the body evaluation: swap them and finish the update code.
+     */
+
+    TclEmitOpcode(   INST_END_CATCH,				envPtr);
+    TclEmitInstInt4( INST_REVERSE, 2,				envPtr);
+    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
+    TclEmitInt4(     infoIndex,					envPtr);
+
+    /*
+     * Jump around the exceptional termination code.
+     */
+
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+    /*
+     * Termination code for non-ok returns: stash the result and return
+     * options in the stack, bring up the key list, finish the update code,
+     * and finally return with the catched return data
+     */
+
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
+    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
+    TclEmitOpcode(   INST_END_CATCH,				envPtr);
+    TclEmitInstInt4( INST_REVERSE, 3,				envPtr);
+
+    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
+    TclEmitInt4(     infoIndex,					envPtr);
+    TclEmitOpcode(   INST_RETURN_STK,				envPtr);
+
+    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+    }
+    TclStackFree(interp, keyTokenPtrs);
+    return TCL_OK;
+}
+
+int
+TclCompileDictAppendCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    int i, dictVarIndex;
+
+    /*
+     * There must be at least two argument after the command. And we impose an
+     * (arbirary) safe limit; anyone exceeding it should stop worrying about
+     * speed quite so much. ;-)
+     */
+
+    if (parsePtr->numWords<4 || parsePtr->numWords>100 || procPtr==NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the index of the local variable that we will be working with.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    } else {
+	register const char *name = tokenPtr[1].start;
+	register int nameChars = tokenPtr[1].size;
+
+	if (!TclIsLocalScalar(name, nameChars)) {
+	    return TCL_ERROR;
+	}
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+    }
+
+    /*
+     * Produce the string to concatenate onto the dictionary entry.
+     */
+
+    tokenPtr = TokenAfter(tokenPtr);
+    for (i=2 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    if (parsePtr->numWords > 4) {
+	TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+    }
+
+    /*
+     * Do the concatenation.
+     */
+
+    TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictLappendCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Proc *procPtr = envPtr->procPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
+    int dictVarIndex, nameChars;
+    const char *name;
+
+    /*
+     * There must be three arguments after the command.
+     */
+
+    if (parsePtr->numWords != 4 || procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    keyTokenPtr = TokenAfter(varTokenPtr);
+    valueTokenPtr = TokenAfter(keyTokenPtr);
+    if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+    name = varTokenPtr[1].start;
+    nameChars = varTokenPtr[1].size;
+    if (!TclIsLocalScalar(name, nameChars)) {
+	return TCL_ERROR;
+    }
+    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+    CompileWord(envPtr, keyTokenPtr, interp, 3);
+    CompileWord(envPtr, valueTokenPtr, interp, 4);
+    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupDictUpdateInfo, FreeDictUpdateInfo --
+ *
+ *	Functions to duplicate, release and print the aux data created for use
+ *	with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions.
+ *
+ * Results:
+ *	DupDictUpdateInfo: a copy of the auxiliary data
+ *	FreeDictUpdateInfo: none
+ *	PrintDictUpdateInfo: none
+ *
+ * Side effects:
+ *	DupDictUpdateInfo: allocates memory
+ *	FreeDictUpdateInfo: releases memory
+ *	PrintDictUpdateInfo: none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupDictUpdateInfo(
+    ClientData clientData)
+{
+    DictUpdateInfo *dui1Ptr, *dui2Ptr;
+    unsigned len;
+
+    dui1Ptr = clientData;
+    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
+    dui2Ptr = (DictUpdateInfo *) ckalloc(len);
+    memcpy(dui2Ptr, dui1Ptr, len);
+    return dui2Ptr;
+}
+
+static void
+FreeDictUpdateInfo(
+    ClientData clientData)
+{
+    ckfree(clientData);
+}
+
+static void
+PrintDictUpdateInfo(
+    ClientData clientData,
+    Tcl_Obj *appendObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    DictUpdateInfo *duiPtr = clientData;
+    int i;
+
+    for (i=0 ; i<duiPtr->length ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(appendObj, ", ", -1);
+	}
+	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileExprCmd --
  *
  *	Procedure called to compile the "expr" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "expr" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "expr" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileExprCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileExprCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *firstWordPtr;
 
-    DefineLineInformation;
-
     if (parsePtr->numWords == 1) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"expr arg ?arg ...?\"", -1);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
-    SetLineInformation (1);
-    firstWordPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-    return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
-	    envPtr);
+    /*
+     * TIP #280: Use the per-word line information of the current command.
+     */
+
+    envPtr->line = envPtr->extCmdMapPtr->loc[
+	    envPtr->extCmdMapPtr->nuloc-1].line[1];
+
+    firstWordPtr = TokenAfter(parsePtr->tokenPtr);
+    TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr);
+    return TCL_OK;
 }
 
 /*
@@ -516,36 +1432,33 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "for" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK unless
- *	there was an error while parsing string. If an error occurs then
- *	the interpreter's result contains a standard error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "for" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "for" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclCompileForCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileForCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
     int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
-    int bodyRange, nextRange, code;
-    char buffer[32 + TCL_INTEGER_SPACE];
+    int bodyRange, nextRange;
     int savedStackDepth = envPtr->currStackDepth;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 5) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"for start test next command\"", -1);
 	return TCL_ERROR;
     }
 
@@ -555,11 +1468,10 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
      */
 
-    startTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-    testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
+    startTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    testTokenPtr = TokenAfter(startTokenPtr);
     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     /*
@@ -567,23 +1479,20 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      * in order to insure correct behaviour [Bug 219166]
      */
 
-    nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
-    bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
-    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
+    nextTokenPtr = TokenAfter(testTokenPtr);
+    bodyTokenPtr = TokenAfter(nextTokenPtr);
+    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
 	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     /*
-     * Create ExceptionRange records for the body and the "next" command.
-     * The "next" command's ExceptionRange supports break but not continue
-     * (and has a -1 continueOffset).
+     * Create ExceptionRange records for the body and the "next" command. The
+     * "next" command's ExceptionRange supports break but not continue (and
+     * has a -1 continueOffset).
      */
 
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     /*
@@ -591,17 +1500,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      */
 
     SetLineInformation (1);
-    code = TclCompileCmdWord(interp, startTokenPtr+1,
-	    startTokenPtr->numComponents, envPtr);
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-            Tcl_AddObjErrorInfo(interp,
-	            "\n    (\"for\" initial command)", -1);
-        }
-	goto done;
-    }
+    CompileBody(envPtr, startTokenPtr, interp);
     TclEmitOpcode(INST_POP, envPtr);
-   
+
     /*
      * Jump to the evaluation of the condition. This code uses the "loop
      * rotation" optimisation (which eliminates one branch from the loop).
@@ -620,46 +1521,23 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      * Compile the loop body.
      */
 
-    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
+    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
     SetLineInformation (4);
-    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-	    bodyTokenPtr->numComponents, envPtr);
+    CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, bodyRange);
     envPtr->currStackDepth = savedStackDepth + 1;
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-	    sprintf(buffer, "\n    (\"for\" body line %d)",
-		    interp->errorLine);
-            Tcl_AddObjErrorInfo(interp, buffer, -1);
-        }
-	goto done;
-    }
-    envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
 
-
     /*
      * Compile the "next" subcommand.
      */
 
-    nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
-    SetLineInformation (3);
     envPtr->currStackDepth = savedStackDepth;
-    code = TclCompileCmdWord(interp, nextTokenPtr+1,
-	    nextTokenPtr->numComponents, envPtr);
+    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
+    SetLineInformation (3);
+    CompileBody(envPtr, nextTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, nextRange);
     envPtr->currStackDepth = savedStackDepth + 1;
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-	    Tcl_AddObjErrorInfo(interp,
-	            "\n    (\"for\" loop-end command)", -1);
-	}
-	goto done;
-    }
-    envPtr->exceptArrayPtr[nextRange].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart)
-	    - nextCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
     envPtr->currStackDepth = savedStackDepth;
 
@@ -668,7 +1546,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
      * terminates the for.
      */
 
-    testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+    testCodeOffset = CurrentOffset(envPtr);
 
     jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
     if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
@@ -676,27 +1554,22 @@ TclCompileForCmd(interp, parsePtr, envPtr)
 	nextCodeOffset += 3;
 	testCodeOffset += 3;
     }
+
     SetLineInformation (2);
     envPtr->currStackDepth = savedStackDepth;
-    code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-	    Tcl_AddObjErrorInfo(interp,
-				"\n    (\"for\" test expression)", -1);
-	}
-	goto done;
-    }
+    TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
-    
-    jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+
+    jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
     if (jumpDist > 127) {
 	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
     } else {
 	TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
     }
-    
+
     /*
-     * Set the loop's offsets and break target.
+     * Fix the starting points of the exception ranges (may have moved due to
+     * jump type modification) and set where the exceptions target.
      */
 
     envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
@@ -704,21 +1577,17 @@ TclCompileForCmd(interp, parsePtr, envPtr)
 
     envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
 
-    envPtr->exceptArrayPtr[bodyRange].breakOffset =
-            envPtr->exceptArrayPtr[nextRange].breakOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    
+    ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
+    ExceptionRangeTarget(envPtr, nextRange, breakOffset);
+
     /*
      * The for command's result is an empty string.
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
-    code = TCL_OK;
+    PushLiteral(envPtr, "", 0);
 
-    done:
-    envPtr->exceptDepth--;
-    return code;
+    return TCL_OK;
 }
 
 /*
@@ -729,27 +1598,24 @@ TclCompileForCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "foreach" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	compilation was successful. If an error occurs then the
- *	interpreter's result contains a standard error message and TCL_ERROR
- *	is returned. If the command is too complex for TclCompileForeachCmd,
- *	TCL_OUT_LINE_COMPILE is returned indicating that the foreach command
- *	should be compiled "out of line" by emitting code to invoke its
- *	command procedure at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "foreach" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "foreach" command at
+ *	runtime.
  *
-n*----------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 int
-TclCompileForeachCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileForeachCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Proc *procPtr = envPtr->procPtr;
     ForeachInfo *infoPtr;	/* Points to the structure describing this
@@ -762,28 +1628,19 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     unsigned char *jumpPc;
     JumpFixup jumpFalseFixup;
-    int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
+    int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
-    char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
-
-#ifdef TCL_TIP280
-    int        bodyIndex;
-#endif
+    DefineLineInformation;	/* TIP #280 */
 
     /*
      * We parse the variable list argument words and create two arrays:
-     *    varcList[i] is number of variables in i-th var list
-     *    varvList[i] points to array of var names in i-th var list
+     *    varcList[i] is number of variables in i-th var list.
+     *    varvList[i] points to array of var names in i-th var list.
      */
 
-#define STATIC_VAR_LIST_SIZE 5
-    int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
-    CONST char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
-    int *varcList = varcListStaticSpace;
-    CONST char ***varvList = varvListStaticSpace;
-
-    DefineLineInformation;
+    int *varcList;
+    const char ***varvList;
 
     /*
      * If the foreach command isn't in a procedure, don't compile it inline:
@@ -791,129 +1648,120 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      */
 
     if (procPtr == NULL) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     numWords = parsePtr->numWords;
     if ((numWords < 4) || (numWords%2 != 0)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
-     * Bail out if the body requires substitutions
-     * in order to insure correct behaviour [Bug 219166]
+     * Bail out if the body requires substitutions in order to insure correct
+     * behaviour. [Bug 219166]
      */
-    for (i = 0, tokenPtr = parsePtr->tokenPtr;
-	    i < numWords-1;
-	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+
+    for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
     }
     bodyTokenPtr = tokenPtr;
     if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
-#ifdef TCL_TIP280
+
     bodyIndex = i-1;
-#endif
 
     /*
      * Allocate storage for the varcList and varvList arrays if necessary.
      */
 
     numLists = (numWords - 2)/2;
-    if (numLists > STATIC_VAR_LIST_SIZE) {
-        varcList = (int *) ckalloc(numLists * sizeof(int));
-        varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
-    }
-    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-        varcList[loopIndex] = 0;
-        varvList[loopIndex] = NULL;
-    }
-    
-    /*
-     * Set the exception stack depth.
-     */ 
-
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+    varcList = (int *) TclStackAlloc(interp, numLists * sizeof(int));
+    memset(varcList, 0, numLists * sizeof(int));
+    varvList = (const char ***) TclStackAlloc(interp,
+	    numLists * sizeof(const char **));
+    memset((char*) varvList, 0, numLists * sizeof(const char **));
 
     /*
-     * Break up each var list and set the varcList and varvList arrays.
-     * Don't compile the foreach inline if any var name needs substitutions
-     * or isn't a scalar, or if any var list needs substitutions.
+     * Break up each var list and set the varcList and varvList arrays. Don't
+     * compile the foreach inline if any var name needs substitutions or isn't
+     * a scalar, or if any var list needs substitutions.
      */
 
     loopIndex = 0;
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
-	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
-	if (i%2 == 1) {
-	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		code = TCL_OUT_LINE_COMPILE;
-		goto done;
-	    } else {
-		/* Lots of copying going on here.  Need a ListObj wizard
-		 * to show a better way. */
-
-		Tcl_DString varList;
-
-		Tcl_DStringInit(&varList);
-		Tcl_DStringAppend(&varList, tokenPtr[1].start,
-			tokenPtr[1].size);
-		code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
-			&varcList[loopIndex], &varvList[loopIndex]);
-		Tcl_DStringFree(&varList);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		numVars = varcList[loopIndex];
+	    i++, tokenPtr = TokenAfter(tokenPtr)) {
+	Tcl_DString varList;
 
-		/*
-		 * If the variable list is empty, we can enter an infinite
-		 * loop when the interpreted version would not. Take care to
-		 * ensure this does not happen. [Bug 1671138]
-		 */
+	if (i%2 != 1) {
+	    continue;
+	}
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
 
-		if (numVars == 0) {
-		    code = TCL_OUT_LINE_COMPILE;
-		    goto done;
-		}
+	/*
+	 * Lots of copying going on here. Need a ListObj wizard to show a
+	 * better way.
+	 */
 
-		for (j = 0;  j < numVars;  j++) {
-		    CONST char *varName = varvList[loopIndex][j];
-		    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
-			code = TCL_OUT_LINE_COMPILE;
-			goto done;
-		    }
-		}
+	Tcl_DStringInit(&varList);
+	Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
+	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
+		&varcList[loopIndex], &varvList[loopIndex]);
+	Tcl_DStringFree(&varList);
+	if (code != TCL_OK) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	numVars = varcList[loopIndex];
+
+	/*
+	 * If the variable list is empty, we can enter an infinite loop when
+	 * the interpreted version would not. Take care to ensure this does
+	 * not happen. [Bug 1671138]
+	 */
+
+	if (numVars == 0) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+
+	for (j = 0;  j < numVars;  j++) {
+	    const char *varName = varvList[loopIndex][j];
+
+	    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+		code = TCL_ERROR;
+		goto done;
 	    }
-	    loopIndex++;
 	}
+	loopIndex++;
     }
 
     /*
-     * We will compile the foreach command.
-     * Reserve (numLists + 1) temporary variables:
+     * We will compile the foreach command. Reserve (numLists + 1) temporary
+     * variables:
      *    - numLists temps to hold each value list
      *    - 1 temp for the loop counter (index of next element in each list)
+     *
      * At this time we don't try to reuse temporaries; if there are two
      * nonoverlapping foreach loops, they don't share any temps.
      */
 
+    code = TCL_OK;
     firstValueTemp = -1;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-		/*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+		/*create*/ 1, procPtr);
 	if (loopIndex == 0) {
 	    firstValueTemp = tempVar;
 	}
     }
     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-	    /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
-    
+	    /*create*/ 1, procPtr);
+
     /*
      * Create and initialize the ForeachInfo and ForeachVarList data
      * structures describing this command. Then create a AuxData record
@@ -921,7 +1769,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      */
 
     infoPtr = (ForeachInfo *) ckalloc((unsigned)
-	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
     infoPtr->numLists = numLists;
     infoPtr->firstValueTemp = firstValueTemp;
     infoPtr->loopCtTemp = loopCtTemp;
@@ -929,36 +1777,36 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
 	ForeachVarList *varListPtr;
 	numVars = varcList[loopIndex];
 	varListPtr = (ForeachVarList *) ckalloc((unsigned)
-	        sizeof(ForeachVarList) + (numVars * sizeof(int)));
+		sizeof(ForeachVarList) + numVars*sizeof(int));
 	varListPtr->numVars = numVars;
 	for (j = 0;  j < numVars;  j++) {
-	    CONST char *varName = varvList[loopIndex][j];
+	    const char *varName = varvList[loopIndex][j];
 	    int nameChars = strlen(varName);
+
 	    varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
-		    nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+		    nameChars, /*create*/ 1, procPtr);
 	}
 	infoPtr->varLists[loopIndex] = varListPtr;
     }
-    infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+
+    /*
+     * Create an exception record to handle [break] and [continue].
+     */
+
+    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
 
     /*
      * Evaluate then store each value list in the associated temporary.
      */
 
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-    
     loopIndex = 0;
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
-	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
 	    SetLineInformation (i);
-	    code = TclCompileTokens(interp, tokenPtr+1,
-		    tokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-
+	    CompileTokens(envPtr, tokenPtr, interp);
 	    tempVar = (firstValueTemp + loopIndex);
 	    if (tempVar <= 255) {
 		TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
@@ -975,50 +1823,36 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      */
 
     TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
-    
+
     /*
      * Top of loop code: assign each loop variable and check whether
      * to terminate the loop.
      */
 
-    envPtr->exceptArrayPtr[range].continueOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
+    ExceptionRangeTarget(envPtr, range, continueOffset);
     TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-    
+
     /*
      * Inline compile the loop body.
      */
 
     SetLineInformation (bodyIndex);
-    envPtr->exceptArrayPtr[range].codeOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-	    bodyTokenPtr->numComponents, envPtr);
+    ExceptionRangeStarts(envPtr, range);
+    CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, range);
     envPtr->currStackDepth = savedStackDepth + 1;
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-	    sprintf(buffer, "\n    (\"foreach\" body line %d)",
-		    interp->errorLine);
-            Tcl_AddObjErrorInfo(interp, buffer, -1);
-        }
-	goto done;
-    }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart)
-	    - envPtr->exceptArrayPtr[range].codeOffset;
     TclEmitOpcode(INST_POP, envPtr);
-	
+
     /*
-     * Jump back to the test at the top of the loop. Generate a 4 byte jump
-     * if the distance to the test is > 120 bytes. This is conservative and
+     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
+     * the distance to the test is > 120 bytes. This is conservative and
      * ensures that we won't have to replace this jump if we later need to
      * replace the ifFalse jump with a 4 byte jump.
      */
 
-    jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
-    jumpBackDist =
-	(jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
+    jumpBackOffset = CurrentOffset(envPtr);
+    jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
     if (jumpBackDist > 120) {
 	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
     } else {
@@ -1029,9 +1863,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      * Fix the target of the jump after the foreach_step test.
      */
 
-    jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	    - jumpFalseFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+    if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
 	/*
 	 * Update the loop body's starting PC offset since it moved down.
 	 */
@@ -1057,28 +1889,24 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
      * Set the loop's break target.
      */
 
-    envPtr->exceptArrayPtr[range].breakOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    
+    ExceptionRangeTarget(envPtr, range, breakOffset);
+
     /*
      * The foreach command's result is an empty string.
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    PushLiteral(envPtr, "", 0);
     envPtr->currStackDepth = savedStackDepth + 1;
 
-    done:
+  done:
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-	if (varvList[loopIndex] != (CONST char **) NULL) {
+	if (varvList[loopIndex] != NULL) {
 	    ckfree((char *) varvList[loopIndex]);
 	}
     }
-    if (varcList != varcListStaticSpace) {
-	ckfree((char *) varcList);
-        ckfree((char *) varvList);
-    }
-    envPtr->exceptDepth--;
+    TclStackFree(interp, (void *)varvList);
+    TclStackFree(interp, varcList);
     return code;
 }
 
@@ -1087,8 +1915,8 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
  *
  * DupForeachInfo --
  *
- *	This procedure duplicates a ForeachInfo structure created as
- *	auxiliary data during the compilation of a foreach command.
+ *	This procedure duplicates a ForeachInfo structure created as auxiliary
+ *	data during the compilation of a foreach command.
  *
  * Results:
  *	A pointer to a newly allocated copy of the existing ForeachInfo
@@ -1096,42 +1924,41 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
  *
  * Side effects:
  *	Storage for the copied ForeachInfo record is allocated. If the
- *	original ForeachInfo structure pointed to any ForeachVarList
- *	records, these structures are also copied and pointers to them
- *	are stored in the new ForeachInfo record.
+ *	original ForeachInfo structure pointed to any ForeachVarList records,
+ *	these structures are also copied and pointers to them are stored in
+ *	the new ForeachInfo record.
  *
  *----------------------------------------------------------------------
  */
 
 static ClientData
-DupForeachInfo(clientData)
-    ClientData clientData;	/* The foreach command's compilation
-				 * auxiliary data to duplicate. */
+DupForeachInfo(
+    ClientData clientData)	/* The foreach command's compilation auxiliary
+				 * data to duplicate. */
 {
-    register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
+    register ForeachInfo *srcPtr = clientData;
     ForeachInfo *dupPtr;
     register ForeachVarList *srcListPtr, *dupListPtr;
-    int numLists = srcPtr->numLists;
-    int numVars, i, j;
-    
+    int numVars, i, j, numLists = srcPtr->numLists;
+
     dupPtr = (ForeachInfo *) ckalloc((unsigned)
-	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
     dupPtr->numLists = numLists;
     dupPtr->firstValueTemp = srcPtr->firstValueTemp;
     dupPtr->loopCtTemp = srcPtr->loopCtTemp;
-    
+
     for (i = 0;  i < numLists;  i++) {
 	srcListPtr = srcPtr->varLists[i];
 	numVars = srcListPtr->numVars;
 	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
-	        sizeof(ForeachVarList) + numVars*sizeof(int));
+		sizeof(ForeachVarList) + numVars*sizeof(int));
 	dupListPtr->numVars = numVars;
 	for (j = 0;  j < numVars;  j++) {
 	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
 	}
 	dupPtr->varLists[i] = dupListPtr;
     }
-    return (ClientData) dupPtr;
+    return dupPtr;
 }
 
 /*
@@ -1154,11 +1981,11 @@ DupForeachInfo(clientData)
  */
 
 static void
-FreeForeachInfo(clientData)
-    ClientData clientData;	/* The foreach command's compilation
-				 * auxiliary data to free. */
+FreeForeachInfo(
+    ClientData clientData)	/* The foreach command's compilation auxiliary
+				 * data to free. */
 {
-    register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
+    register ForeachInfo *infoPtr = clientData;
     register ForeachVarList *listPtr;
     int numLists = infoPtr->numLists;
     register int i;
@@ -1173,58 +2000,111 @@ FreeForeachInfo(clientData)
 /*
  *----------------------------------------------------------------------
  *
+ * PrintForeachInfo --
+ *
+ *	Function to write a human-readable representation of a ForeachInfo
+ *	structure to stdout for debugging.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintForeachInfo(
+    ClientData clientData,
+    Tcl_Obj *appendObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
+
+    Tcl_AppendToObj(appendObj, "data=[", -1);
+
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(appendObj, ", ", -1);
+	}
+	Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+		(unsigned) (infoPtr->firstValueTemp + i));
+    }
+    Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%u",
+	    (unsigned) infoPtr->loopCtTemp);
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(appendObj, ",", -1);
+	}
+	Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%u\t[",
+		(unsigned) (infoPtr->firstValueTemp + i));
+	varsPtr = infoPtr->varLists[i];
+	for (j=0 ; j<varsPtr->numVars ; j++) {
+	    if (j) {
+		Tcl_AppendToObj(appendObj, ", ", -1);
+	    }
+	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+		    (unsigned) varsPtr->varIndexes[j]);
+	}
+	Tcl_AppendToObj(appendObj, "]", -1);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileIfCmd --
  *
  *	Procedure called to compile the "if" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	compilation was successful. If an error occurs then the
- *	interpreter's result contains a standard error message and TCL_ERROR
- *	is returned. If the command is too complex for TclCompileIfCmd,
- *	TCL_OUT_LINE_COMPILE is returned indicating that the if command
- *	should be compiled "out of line" by emitting code to invoke its
- *	command procedure at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "if" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "if" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclCompileIfCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileIfCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     JumpFixupArray jumpFalseFixupArray;
     				/* Used to fix the ifFalse jump after each
 				 * test when its target PC is determined. */
     JumpFixupArray jumpEndFixupArray;
-				/* Used to fix the jump after each "then"
-				 * body to the end of the "if" when that PC
-				 * is determined. */
+				/* Used to fix the jump after each "then" body
+				 * to the end of the "if" when that PC is
+				 * determined. */
     Tcl_Token *tokenPtr, *testTokenPtr;
-    int jumpDist, jumpFalseDist;
-    int jumpIndex = 0;          /* avoid compiler warning. */
-    int numWords, wordIdx, numBytes, j, code;
-    CONST char *word;
-    char buffer[100];
+    int jumpIndex = 0;		/* Avoid compiler warning. */
+    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
+    const char *word;
     int savedStackDepth = envPtr->currStackDepth;
-                                /* Saved stack depth at the start of the first
+				/* Saved stack depth at the start of the first
 				 * test; the envPtr current depth is restored
 				 * to this value at the start of each test. */
-    int realCond = 1;           /* set to 0 for static conditions: "if 0 {..}" */
-    int boolVal;                /* value of static condition */
-    int compileScripts = 1;            
-
-    DefineLineInformation;
+    int realCond = 1;		/* Set to 0 for static conditions:
+				 * "if 0 {..}" */
+    int boolVal;		/* Value of static condition. */
+    int compileScripts = 1;
+    DefineLineInformation;	/* TIP #280 */
 
     /*
-     * Only compile the "if" command if all arguments are simple
-     * words, in order to insure correct substitution [Bug 219166]
+     * Only compile the "if" command if all arguments are simple words, in
+     * order to insure correct substitution [Bug 219166]
      */
 
     tokenPtr = parsePtr->tokenPtr;
@@ -1233,19 +2113,18 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 
     for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_OUT_LINE_COMPILE;
+	    return TCL_ERROR;
 	}
-	tokenPtr += 2;
+	tokenPtr = TokenAfter(tokenPtr);
     }
 
-
     TclInitJumpFixupArray(&jumpFalseFixupArray);
     TclInitJumpFixupArray(&jumpEndFixupArray);
     code = TCL_OK;
 
     /*
-     * Each iteration of this loop compiles one "if expr ?then? body"
-     * or "elseif expr ?then? body" clause. 
+     * Each iteration of this loop compiles one "if expr ?then? body" or
+     * "elseif expr ?then? body" clause.
      */
 
     tokenPtr = parsePtr->tokenPtr;
@@ -1258,84 +2137,66 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	word = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
 	if ((tokenPtr == parsePtr->tokenPtr)
-	        || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
-	    tokenPtr += (tokenPtr->numComponents + 1);
+		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+	    tokenPtr = TokenAfter(tokenPtr);
 	    wordIdx++;
 	} else {
 	    break;
 	}
 	if (wordIdx >= numWords) {
-	    sprintf(buffer,
-	            "wrong # args: no expression after \"%.*s\" argument",
-		    (numBytes > 50 ? 50 : numBytes), word);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
 	    code = TCL_ERROR;
 	    goto done;
 	}
 
 	/*
-	 * Compile the test expression then emit the conditional jump
-	 * around the "then" part. 
+	 * Compile the test expression then emit the conditional jump around
+	 * the "then" part.
 	 */
-	
+
 	envPtr->currStackDepth = savedStackDepth;
 	testTokenPtr = tokenPtr;
 
-
 	if (realCond) {
 	    /*
-	     * Find out if the condition is a constant. 
+	     * Find out if the condition is a constant.
 	     */
-	
+
 	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
 		    testTokenPtr[1].size);
 	    Tcl_IncrRefCount(boolObj);
 	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
-	    Tcl_DecrRefCount(boolObj);
+	    TclDecrRefCount(boolObj);
 	    if (code == TCL_OK) {
 		/*
-		 * A static condition
+		 * A static condition.
 		 */
+
 		realCond = 0;
 		if (!boolVal) {
 		    compileScripts = 0;
 		}
 	    } else {
-		Tcl_ResetResult(interp);
 		SetLineInformation (wordIdx);
-		code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-		if (code != TCL_OK) {
-		    if (code == TCL_ERROR) {
-			Tcl_AddObjErrorInfo(interp,
-			        "\n    (\"if\" test expression)", -1);
-		    }
-		    goto done;
-		}
+		Tcl_ResetResult(interp);
+		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
 		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
 		}
 		jumpIndex = jumpFalseFixupArray.next;
 		jumpFalseFixupArray.next++;
 		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
-			       &(jumpFalseFixupArray.fixup[jumpIndex]));	    
+			jumpFalseFixupArray.fixup+jumpIndex);
 	    }
+	    code = TCL_OK;
 	}
 
-
 	/*
 	 * Skip over the optional "then" before the then clause.
 	 */
 
-	tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+	tokenPtr = TokenAfter(testTokenPtr);
 	wordIdx++;
 	if (wordIdx >= numWords) {
-	    sprintf(buffer,
-		    "wrong # args: no script following \"%.*s\" argument",
-		    (testTokenPtr->size > 50 ? 50 : testTokenPtr->size),
-		    testTokenPtr->start);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -1343,12 +2204,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	    word = tokenPtr[1].start;
 	    numBytes = tokenPtr[1].size;
 	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
-		tokenPtr += (tokenPtr->numComponents + 1);
+		tokenPtr = TokenAfter(tokenPtr);
 		wordIdx++;
 		if (wordIdx >= numWords) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		            "wrong # args: no script following \"then\" argument", -1);
 		    code = TCL_ERROR;
 		    goto done;
 		}
@@ -1362,85 +2220,72 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	if (compileScripts) {
 	    SetLineInformation (wordIdx);
 	    envPtr->currStackDepth = savedStackDepth;
-	    code = TclCompileCmdWord(interp, tokenPtr+1,
-	            tokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		if (code == TCL_ERROR) {
-		    sprintf(buffer, "\n    (\"if\" then script line %d)",
-		            interp->errorLine);
-		    Tcl_AddObjErrorInfo(interp, buffer, -1);
-		}
-		goto done;
-	    }	
+	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
 	if (realCond) {
 	    /*
-	     * Jump to the end of the "if" command. Both jumpFalseFixupArray and
-	     * jumpEndFixupArray are indexed by "jumpIndex".
+	     * Jump to the end of the "if" command. Both jumpFalseFixupArray
+	     * and jumpEndFixupArray are indexed by "jumpIndex".
 	     */
-	    
+
 	    if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
 		TclExpandJumpFixupArray(&jumpEndFixupArray);
 	    }
 	    jumpEndFixupArray.next++;
 	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-	            &(jumpEndFixupArray.fixup[jumpIndex]));
-	    
+		    jumpEndFixupArray.fixup+jumpIndex);
+
 	    /*
-	     * Fix the target of the jumpFalse after the test. Generate a 4 byte
-	     * jump if the distance is > 120 bytes. This is conservative, and
-	     * ensures that we won't have to replace this jump if we later also
-	     * need to replace the proceeding jump to the end of the "if" with a
-	     * 4 byte jump.
+	     * Fix the target of the jumpFalse after the test. Generate a 4
+	     * byte jump if the distance is > 120 bytes. This is conservative,
+	     * and ensures that we won't have to replace this jump if we later
+	     * also need to replace the proceeding jump to the end of the "if"
+	     * with a 4 byte jump.
 	     */
 
-	    jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	            - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
-	    if (TclFixupForwardJump(envPtr,
-	            &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+	    if (TclFixupForwardJumpToHere(envPtr,
+		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
 		/*
 		 * Adjust the code offset for the proceeding jump to the end
 		 * of the "if" command.
 		 */
-		
+
 		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
 	    }
 	} else if (boolVal) {
-	    /* 
-	     *We were processing an "if 1 {...}"; stop compiling
-	     * scripts
+	    /*
+	     * We were processing an "if 1 {...}"; stop compiling scripts.
 	     */
 
 	    compileScripts = 0;
 	} else {
-	    /* 
-	     *We were processing an "if 0 {...}"; reset so that
-	     * the rest (elseif, else) is compiled correctly
+	    /*
+	     * We were processing an "if 0 {...}"; reset so that the rest
+	     * (elseif, else) is compiled correctly.
 	     */
 
 	    realCond = 1;
 	    compileScripts = 1;
-	} 
+	}
 
-	tokenPtr += (tokenPtr->numComponents + 1);
+	tokenPtr = TokenAfter(tokenPtr);
 	wordIdx++;
     }
 
     /*
-     * Restore the current stack depth in the environment; the 
-     * "else" clause (or its default) will add 1 to this.
+     * Restore the current stack depth in the environment; the "else" clause
+     * (or its default) will add 1 to this.
      */
 
     envPtr->currStackDepth = savedStackDepth;
 
     /*
-     * Check for the optional else clause. Do not compile
-     * anything if this was an "if 1 {...}" case.
+     * Check for the optional else clause. Do not compile anything if this was
+     * an "if 1 {...}" case.
      */
 
-    if ((wordIdx < numWords)
-	    && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+    if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
 	/*
 	 * There is an else clause. Skip over the optional "else" word.
 	 */
@@ -1448,12 +2293,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	word = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
 	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
-	    tokenPtr += (tokenPtr->numComponents + 1);
+	    tokenPtr = TokenAfter(tokenPtr);
 	    wordIdx++;
 	    if (wordIdx >= numWords) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		        "wrong # args: no script following \"else\" argument", -1);
 		code = TCL_ERROR;
 		goto done;
 	    }
@@ -1463,28 +2305,17 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	    /*
 	     * Compile the else command body.
 	     */
+
 	    SetLineInformation (wordIdx);
-	    code = TclCompileCmdWord(interp, tokenPtr+1,
-		    tokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		if (code == TCL_ERROR) {
-		    sprintf(buffer, "\n    (\"if\" else script line %d)",
-			    interp->errorLine);
-		    Tcl_AddObjErrorInfo(interp, buffer, -1);
-		}
-		goto done;
-	    }
+	    CompileBody(envPtr, tokenPtr, interp);
 	}
 
 	/*
 	 * Make sure there are no words after the else clause.
 	 */
-	
+
 	wordIdx++;
 	if (wordIdx < numWords) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		    "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -1494,28 +2325,27 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 	 */
 
 	if (compileScripts) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+	    PushLiteral(envPtr, "", 0);
 	}
     }
 
     /*
      * Fix the unconditional jumps to the end of the "if" command.
      */
-    
+
     for (j = jumpEndFixupArray.next;  j > 0;  j--) {
-	jumpIndex = (j - 1);	/* i.e. process the closest jump first */
-	jumpDist = (envPtr->codeNext - envPtr->codeStart)
-	        - jumpEndFixupArray.fixup[jumpIndex].codeOffset;
-	if (TclFixupForwardJump(envPtr,
-	        &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
+	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
+	if (TclFixupForwardJumpToHere(envPtr,
+		jumpEndFixupArray.fixup+jumpIndex, 127)) {
 	    /*
-	     * Adjust the immediately preceeding "ifFalse" jump. We moved
-	     * it's target (just after this jump) down three bytes.
+	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
+	     * target (just after this jump) down three bytes.
 	     */
 
 	    unsigned char *ifFalsePc = envPtr->codeStart
-	            + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
 	    unsigned char opCode = *ifFalsePc;
+
 	    if (opCode == INST_JUMP_FALSE1) {
 		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
 		jumpFalseDist += 3;
@@ -1525,7 +2355,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
 		jumpFalseDist += 3;
 		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
 	    } else {
-		panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
+		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
 	    }
 	}
     }
@@ -1534,7 +2364,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
      * Free the jumpFixupArray array if malloc'ed storage was used.
      */
 
-    done:
+  done:
     envPtr->currStackDepth = savedStackDepth + 1;
     TclFreeJumpFixupArray(&jumpFalseFixupArray);
     TclFreeJumpFixupArray(&jumpEndFixupArray);
@@ -1549,50 +2379,37 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "incr" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	compilation was successful. If an error occurs then the
- *	interpreter's result contains a standard error message and TCL_ERROR
- *	is returned. If the command is too complex for TclCompileIncrCmd,
- *	TCL_OUT_LINE_COMPILE is returned indicating that the incr command
- *	should be compiled "out of line" by emitting code to invoke its
- *	command procedure at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "incr" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "incr" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileIncrCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileIncrCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *incrTokenPtr;
     int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
-    int code = TCL_OK;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"incr varName ?increment?\"", -1);
 	return TCL_ERROR;
     }
 
-    varTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, 
-	    (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
-	    &localIndex, &simpleVarName, &isScalar, 1);
-    if (code != TCL_OK) {
-	goto done;
-    }
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
+		    &localIndex, &simpleVarName, &isScalar, 1);
 
     /*
      * If an increment is given, push it, but see first if it's a small
@@ -1602,44 +2419,29 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
     haveImmValue = 0;
     immValue = 1;
     if (parsePtr->numWords == 3) {
-	incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	incrTokenPtr = TokenAfter(varTokenPtr);
 	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    CONST char *word = incrTokenPtr[1].start;
+	    const char *word = incrTokenPtr[1].start;
 	    int numBytes = incrTokenPtr[1].size;
-
-	    /*
-	     * Note there is a danger that modifying the string could have
-	     * undesirable side effects.  In this case, TclLooksLikeInt has
-	     * no dependencies on shared strings so we should be safe.
-	     */
-
-	    if (TclLooksLikeInt(word, numBytes)) {
-		int code;
-		Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
-		Tcl_IncrRefCount(intObj);
-		code = Tcl_GetIntFromObj(NULL, intObj, &immValue);
-		Tcl_DecrRefCount(intObj);
-		if ((code == TCL_OK)
-			&& (-127 <= immValue) && (immValue <= 127)) {
-		    haveImmValue = 1;
-		}
+	    int code;
+	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
+	    Tcl_IncrRefCount(intObj);
+	    code = TclGetIntFromObj(NULL, intObj, &immValue);
+	    TclDecrRefCount(intObj);
+	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {
+		haveImmValue = 1;
 	    }
 	    if (!haveImmValue) {
-		TclEmitPush(
-			TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
+		PushLiteral(envPtr, word, numBytes);
 	    }
 	} else {
 	    SetLineInformation (2);
-	    code = TclCompileTokens(interp, incrTokenPtr+1, 
-	            incrTokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
+	    CompileTokens(envPtr, incrTokenPtr, interp);
 	}
-    } else {			/* no incr amount given so use 1 */
+    } else {			/* No incr amount given so use 1. */
 	haveImmValue = 1;
     }
-    
+
     /*
      * Emit the instruction to increment the variable.
      */
@@ -1676,16 +2478,15 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 		}
 	    }
 	}
-    } else {			/* non-simple variable name */
+    } else {			/* Non-simple variable name. */
 	if (haveImmValue) {
 	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
 	} else {
 	    TclEmitOpcode(INST_INCR_STK, envPtr);
 	}
     }
-	
-    done:
-    return code;
+
+    return TCL_OK;
 }
 
 /*
@@ -1696,53 +2497,47 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "lappend" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is normally TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message. If
- *	compilation fails because the command requires a second level of
- *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- *	command should be compiled "out of line" by emitting code to
- *	invoke its command procedure (Tcl_LappendObjCmd) at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "lappend" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "lappend" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLappendCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileLappendCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    Tcl_Token *varTokenPtr;
     int simpleVarName, isScalar, localIndex, numWords;
-    int code = TCL_OK;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     /*
      * If we're not in a procedure, don't compile.
      */
+
     if (envPtr->procPtr == NULL) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     numWords = parsePtr->numWords;
     if (numWords == 1) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"wrong # args: should be \"lappend varName ?value value ...?\"", -1);
 	return TCL_ERROR;
     }
     if (numWords != 3) {
 	/*
-	 * LAPPEND instructions currently only handle one value appends
+	 * LAPPEND instructions currently only handle one value appends.
 	 */
-        return TCL_OUT_LINE_COMPILE;
+
+	return TCL_ERROR;
     }
 
     /*
@@ -1750,36 +2545,22 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
      * need to emit code to compute and push the name at runtime. We use a
      * frame slot (entry in the array of local vars) if we are compiling a
      * procedure body and if the name is simple text that does not include
-     * namespace qualifiers. 
+     * namespace qualifiers.
      */
 
-    varTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-	    &localIndex, &simpleVarName, &isScalar, 1);
-    if (code != TCL_OK) {
-	goto done;
-    }
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+		    &localIndex, &simpleVarName, &isScalar, 1);
 
     /*
-     * If we are doing an assignment, push the new value.
-     * In the no values case, create an empty object.
+     * If we are doing an assignment, push the new value. In the no values
+     * case, create an empty object.
      */
 
     if (numWords > 2) {
-	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-	if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, 
-		    valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
-	} else {
-	    SetLineInformation (2);
-	    code = TclCompileTokens(interp, valueTokenPtr+1,
-	            valueTokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-	}
+	Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
+	CompileWord(envPtr, valueTokenPtr, interp, 2);
     }
 
     /*
@@ -1790,112 +2571,239 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
      * The *_STK opcodes should be refactored to make better use of existing
      * LOAD/STORE instructions.
      */
+
     if (simpleVarName) {
 	if (isScalar) {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
 	    }
 	} else {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
 	    }
 	}
     } else {
 	TclEmitOpcode(INST_LAPPEND_STK, envPtr);
     }
 
-    done:
-    return code;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLindexCmd --
+ * TclCompileLassignCmd --
  *
- *	Procedure called to compile the "lindex" command.
+ *	Procedure called to compile the "lassign" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if the
- *	compilation was successful.  If the command cannot be byte-compiled,
- *	TCL_OUT_LINE_COMPILE is returned.  If an error occurs then the
- *	interpreter's result contains an error message, and TCL_ERROR is
- *	returned.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "lindex" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "lassign" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLindexCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileLassignCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr;
-    int code, i;
-    int numWords;
-
-    DefineLineInformation;
+    Tcl_Token *tokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, idx;
+    DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
 
     /*
-     * Quit if too few args
+     * Check for command syntax error, but we'll punt that to runtime.
      */
 
-    if ( numWords <= 1 ) {
-	return TCL_OUT_LINE_COMPILE;
+    if (numWords < 3) {
+	return TCL_ERROR;
     }
 
-    varTokenPtr = parsePtr->tokenPtr
-	+ (parsePtr->tokenPtr->numComponents + 1);
-    
     /*
-     * Push the operands onto the stack.
+     * Generate code to push list being taken apart by [lassign].
      */
-	
-    for ( i = 1 ; i < numWords ; i++ ) {
-	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush(
-		    TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
-		    varTokenPtr[1].size), envPtr);
-	} else {
-	    SetLineInformation (i);
-	    code = TclCompileTokens(interp, varTokenPtr+1,
-				    varTokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		return code;
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+
+    /*
+     * Generate code to assign values from the list to variables.
+     */
+
+    for (idx=0 ; idx<numWords-2 ; idx++) {
+	tokenPtr = TokenAfter(tokenPtr);
+
+	/*
+	 * Generate the next variable name.
+	 */
+
+	PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+			&simpleVarName, &isScalar, idx+2);
+
+	/*
+	 * Emit instructions to get the idx'th item out of the list value on
+	 * the stack and assign it to the variable.
+	 */
+
+	if (simpleVarName) {
+	    if (isScalar) {
+		if (localIndex >= 0) {
+		    TclEmitOpcode(INST_DUP, envPtr);
+		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+		    if (localIndex <= 255) {
+			TclEmitInstInt1(INST_STORE_SCALAR1,localIndex,envPtr);
+		    } else {
+			TclEmitInstInt4(INST_STORE_SCALAR4,localIndex,envPtr);
+		    }
+		} else {
+		    TclEmitInstInt4(INST_OVER, 1, envPtr);
+		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+		    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
+		}
+	    } else {
+		if (localIndex >= 0) {
+		    TclEmitInstInt4(INST_OVER, 1, envPtr);
+		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+		    if (localIndex <= 255) {
+			TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
+		    } else {
+			TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
+		    }
+		} else {
+		    TclEmitInstInt4(INST_OVER, 2, envPtr);
+		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+		    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+		}
 	    }
+	} else {
+	    TclEmitInstInt4(INST_OVER, 1, envPtr);
+	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+	    TclEmitOpcode(INST_STORE_STK, envPtr);
 	}
-	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	TclEmitOpcode(INST_POP, envPtr);
     }
-	
+
     /*
-     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI
-     * if there are multiple index args.
+     * Generate code to leave the rest of the list on the stack.
      */
 
-    if ( numWords == 3 ) {
-	TclEmitOpcode( INST_LIST_INDEX, envPtr );
+    TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
+    TclEmitInt4(-2, envPtr);	/* -2 == "end" */
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLindexCmd --
+ *
+ *	Procedure called to compile the "lindex" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "lindex" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLindexCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *idxTokenPtr, *valTokenPtr;
+    int i, numWords = parsePtr->numWords;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * Quit if too few args.
+     */
+
+    if (numWords <= 1) {
+	return TCL_ERROR;
+    }
+
+    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (numWords != 3) {
+	goto emitComplexLindex;
+    }
+
+    idxTokenPtr = TokenAfter(valTokenPtr);
+    if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	Tcl_Obj *tmpObj;
+	int idx, result;
+
+	tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
+	result = TclGetIntFromObj(NULL, tmpObj, &idx);
+	TclDecrRefCount(tmpObj);
+
+	if (result == TCL_OK && idx >= 0) {
+	    /*
+	     * All checks have been completed, and we have exactly this
+	     * construct:
+	     *	 lindex <arbitraryValue> <posInt>
+	     * This is best compiled as a push of the arbitrary value followed
+	     * by an "immediate lindex" which is the most efficient variety.
+	     */
+
+	    CompileWord(envPtr, valTokenPtr, interp, 1);
+	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
+	    return TCL_OK;
+	}
+
+	/*
+	 * If the conversion failed or the value was negative, we just keep on
+	 * going with the more complex compilation.
+	 */
+    }
+
+    /*
+     * Push the operands onto the stack.
+     */
+
+  emitComplexLindex:
+    for (i=1 ; i<numWords ; i++) {
+	CompileWord(envPtr, valTokenPtr, interp, i);
+	valTokenPtr = TokenAfter(valTokenPtr);
+    }
+
+    /*
+     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
+     * multiple index args.
+     */
+
+    if (numWords == 3) {
+	TclEmitOpcode(INST_LIST_INDEX, envPtr);
     } else {
- 	TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr );
+ 	TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
     }
 
     return TCL_OK;
@@ -1909,67 +2817,55 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "list" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is normally TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message. If
- *	compilation fails because the command requires a second level of
- *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- *	command should be compiled "out of line" by emitting code to
- *	invoke its command procedure (Tcl_ListObjCmd) at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "list" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "list" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileListCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileListCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     /*
      * If we're not in a procedure, don't compile.
      */
+
     if (envPtr->procPtr == NULL) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     if (parsePtr->numWords == 1) {
 	/*
-	 * Empty args case
+	 * [list] without arguments just pushes an empty object.
 	 */
 
-	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+	PushLiteral(envPtr, "", 0);
     } else {
 	/*
 	 * Push the all values onto the stack.
 	 */
+
 	Tcl_Token *valueTokenPtr;
-	int i, code, numWords;
+	int i, numWords;
 
 	numWords = parsePtr->numWords;
 
-	valueTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
+	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
 	for (i = 1; i < numWords; i++) {
-	    if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		TclEmitPush(TclRegisterNewLiteral(envPtr,
-			valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
-	    } else {
-		SetLineInformation (i);
-		code = TclCompileTokens(interp, valueTokenPtr+1,
-			valueTokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    return code;
-		}
-	    }
-	    valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
+	    CompileWord(envPtr, valueTokenPtr, interp, i);
+	    valueTokenPtr = TokenAfter(valueTokenPtr);
 	}
 	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
     }
@@ -1985,54 +2881,34 @@ TclCompileListCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "llength" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if the
- *	compilation was successful.  If the command cannot be byte-compiled,
- *	TCL_OUT_LINE_COMPILE is returned.  If an error occurs then the
- *	interpreter's result contains an error message, and TCL_ERROR is
- *	returned.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "llength" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "llength" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLlengthCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileLlengthCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr;
-    int code;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
-	Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
-		TCL_STATIC);
 	return TCL_ERROR;
     }
-    varTokenPtr = parsePtr->tokenPtr
-	+ (parsePtr->tokenPtr->numComponents + 1);
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	/*
-	 * We could simply count the number of elements here and push
-	 * that value, but that is too rare a case to waste the code space.
-	 */
-	TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
-		varTokenPtr[1].size), envPtr);
-    } else {
-	SetLineInformation (1);
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-    }
+    CompileWord(envPtr, varTokenPtr, interp, 1);
     TclEmitOpcode(INST_LIST_LENGTH, envPtr);
     return TCL_OK;
 }
@@ -2045,197 +2921,175 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "lset" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	the compilation was successful.  If the "lset" command is too
- *	complex for this function, then TCL_OUT_LINE_COMPILE is returned,
- *	indicating that the command should be compiled "out of line"
- *	(that is, not byte-compiled).  If an error occurs, TCL_ERROR is
- *	returned, and the interpreter result contains an error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "lset" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "lset" command at
+ *	runtime.
  *
  * The general template for execution of the "lset" command is:
- *	(1) Instructions to push the variable name, unless the
- *	    variable is local to the stack frame.
- *	(2) If the variable is an array element, instructions
- *	    to push the array element name.
- *	(3) Instructions to push each of zero or more "index" arguments
- *	    to the stack, followed with the "newValue" element.
- *	(4) Instructions to duplicate the variable name and/or array
- *	    element name onto the top of the stack, if either was
- *	    pushed at steps (1) and (2).
- *	(5) The appropriate INST_LOAD_* instruction to place the
- *	    original value of the list variable at top of stack.
+ *	(1) Instructions to push the variable name, unless the variable is
+ *	    local to the stack frame.
+ *	(2) If the variable is an array element, instructions to push the
+ *	    array element name.
+ *	(3) Instructions to push each of zero or more "index" arguments to the
+ *	    stack, followed with the "newValue" element.
+ *	(4) Instructions to duplicate the variable name and/or array element
+ *	    name onto the top of the stack, if either was pushed at steps (1)
+ *	    and (2).
+ *	(5) The appropriate INST_LOAD_* instruction to place the original
+ *	    value of the list variable at top of stack.
  *	(6) At this point, the stack contains:
- *	     varName? arrayElementName? index1 index2 ... newValue oldList
+ *		varName? arrayElementName? index1 index2 ... newValue oldList
  *	    The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
- *	    according as whether there is exactly one index element (LIST)
- *	    or either zero or else two or more (FLAT).  This instruction
- *	    removes everything from the stack except for the two names
- *	    and pushes the new value of the variable.
- *	(7) Finally, INST_STORE_* stores the new value in the variable
- *	    and cleans up the stack.
+ *	    according as whether there is exactly one index element (LIST) or
+ *	    either zero or else two or more (FLAT). This instruction removes
+ *	    everything from the stack except for the two names and pushes the
+ *	    new value of the variable.
+ *	(7) Finally, INST_STORE_* stores the new value in the variable and
+ *	    cleans up the stack.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLsetCmd( interp, parsePtr, envPtr )
-    Tcl_Interp* interp;		/* Tcl interpreter for error reporting */
-    Tcl_Parse* parsePtr;	/* Points to a parse structure for
-				 * the command */
-    CompileEnv* envPtr;		/* Holds the resulting instructions */
+TclCompileLsetCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
-
-    int tempDepth;		/* Depth used for emitting one part
-				 * of the code burst. */
-    Tcl_Token* varTokenPtr;	/* Pointer to the Tcl_Token representing
-				 * the parse of the variable name */
-
-    int result;			/* Status return from library calls */
-
-    int localIndex;		/* Index of var in local var table */
-    int simpleVarName;		/* Flag == 1 if var name is simple */
-    int isScalar;		/* Flag == 1 if scalar, 0 if array */
-
+    int tempDepth;		/* Depth used for emitting one part of the
+				 * code burst. */
+    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
+				 * parse of the variable name. */
+    int localIndex;		/* Index of var in local var table. */
+    int simpleVarName;		/* Flag == 1 if var name is simple. */
+    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
     int i;
+    DefineLineInformation;	/* TIP #280 */
 
-    DefineLineInformation;
+    /*
+     * Check argument count.
+     */
 
-    /* Check argument count */
+    if (parsePtr->numWords < 3) {
+	/*
+	 * Fail at run time, not in compilation.
+	 */
 
-    if ( parsePtr->numWords < 3 ) {
-	/* Fail at run time, not in compilation */
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     /*
-     * Decide if we can use a frame slot for the var/array name or if we
-     * need to emit code to compute and push the name at runtime. We use a
-     * frame slot (entry in the array of local vars) if we are compiling a
-     * procedure body and if the name is simple text that does not include
-     * namespace qualifiers. 
+     * Decide if we can use a frame slot for the var/array name or if we need
+     * to emit code to compute and push the name at runtime. We use a frame
+     * slot (entry in the array of local vars) if we are compiling a procedure
+     * body and if the name is simple text that does not include namespace
+     * qualifiers.
      */
 
-    varTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-    result = TclPushVarNameWord( interp, varTokenPtr, envPtr, 
-            TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, 1);
-    if (result != TCL_OK) {
-	return result;
-    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+		    &localIndex, &simpleVarName, &isScalar, 1);
 
-    /* Push the "index" args and the new element value. */
-
-    for ( i = 2; i < parsePtr->numWords; ++i ) {
-
-	/* Advance to next arg */
-
-	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-
-	/* Push an arg */
+    /*
+     * Push the "index" args and the new element value.
+     */
 
-	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
-		    varTokenPtr[1].size), envPtr);
-	} else {
-	    SetLineInformation (i);
-	    result = TclCompileTokens(interp, varTokenPtr+1,
-				      varTokenPtr->numComponents, envPtr);
-	    if ( result != TCL_OK ) {
-		return result;
-	    }
-	}
+    for (i=2 ; i<parsePtr->numWords ; ++i) {
+	varTokenPtr = TokenAfter(varTokenPtr);
+	CompileWord(envPtr, varTokenPtr, interp, i);
     }
 
     /*
-     * Duplicate the variable name if it's been pushed.  
+     * Duplicate the variable name if it's been pushed.
      */
 
-    if ( !simpleVarName || localIndex < 0 ) {
-	if ( !simpleVarName || isScalar ) {
+    if (!simpleVarName || localIndex < 0) {
+	if (!simpleVarName || isScalar) {
 	    tempDepth = parsePtr->numWords - 2;
 	} else {
 	    tempDepth = parsePtr->numWords - 1;
 	}
-	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
     }
 
     /*
-     * Duplicate an array index if one's been pushed
+     * Duplicate an array index if one's been pushed.
      */
 
-    if ( simpleVarName && !isScalar ) {
-	if ( localIndex < 0 ) {
+    if (simpleVarName && !isScalar) {
+	if (localIndex < 0) {
 	    tempDepth = parsePtr->numWords - 1;
 	} else {
 	    tempDepth = parsePtr->numWords - 2;
 	}
-	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
     }
 
     /*
      * Emit code to load the variable's value.
      */
 
-    if ( !simpleVarName ) {
-	TclEmitOpcode( INST_LOAD_STK, envPtr );
-    } else if ( isScalar ) {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_LOAD_SCALAR1, localIndex, envPtr );
+    if (!simpleVarName) {
+	TclEmitOpcode(INST_LOAD_STK, envPtr);
+    } else if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_LOAD_SCALAR4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
 	}
     } else {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_LOAD_ARRAY1, localIndex, envPtr );
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_LOAD_ARRAY4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
 	}
     }
 
     /*
-     * Emit the correct variety of 'lset' instruction
+     * Emit the correct variety of 'lset' instruction.
      */
 
-    if ( parsePtr->numWords == 4 ) {
-	TclEmitOpcode( INST_LSET_LIST, envPtr );
+    if (parsePtr->numWords == 4) {
+	TclEmitOpcode(INST_LSET_LIST, envPtr);
     } else {
-	TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr );
+	TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
     }
 
     /*
-     * Emit code to put the value back in the variable
+     * Emit code to put the value back in the variable.
      */
 
-    if ( !simpleVarName ) {
-	TclEmitOpcode( INST_STORE_STK, envPtr );
-    } else if ( isScalar ) {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_STORE_SCALAR1, localIndex, envPtr );
+    if (!simpleVarName) {
+	TclEmitOpcode(INST_STORE_STK, envPtr);
+    } else if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_STORE_SCALAR4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
 	}
     } else {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_STORE_ARRAY1, localIndex, envPtr );
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_STORE_ARRAY4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
 	}
     }
-    
-    return TCL_OK;
 
+    return TCL_OK;
 }
 
 /*
@@ -2246,193 +3100,155 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
  *	Procedure called to compile the "regexp" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	the compilation was successful.  If the "regexp" command is too
- *	complex for this function, then TCL_OUT_LINE_COMPILE is returned,
- *	indicating that the command should be compiled "out of line"
- *	(that is, not byte-compiled).  If an error occurs, TCL_ERROR is
- *	returned, and the interpreter result contains an error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "regexp" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "regexp" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileRegexpCmd(interp, parsePtr, envPtr)
-    Tcl_Interp* interp;		/* Tcl interpreter for error reporting */
-    Tcl_Parse* parsePtr;	/* Points to a parse structure for
-				 * the command */
-    CompileEnv* envPtr;		/* Holds the resulting instructions */
-{
-    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing
-				 * the parse of the RE or string */
-    int i, len, code, nocase, anchorLeft, anchorRight, start;
+TclCompileRegexpCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
+{
+    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
+				 * parse of the RE or string. */
+    int i, len, nocase, exact, sawLast, simple;
     char *str;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     /*
-     * We are only interested in compiling simple regexp cases.
-     * Currently supported compile cases are:
+     * We are only interested in compiling simple regexp cases. Currently
+     * supported compile cases are:
      *   regexp ?-nocase? ?--? staticString $var
      *   regexp ?-nocase? ?--? {^staticString$} $var
      */
+
     if (parsePtr->numWords < 3) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
+    simple = 0;
     nocase = 0;
+    sawLast = 0;
     varTokenPtr = parsePtr->tokenPtr;
 
     /*
-     * We only look for -nocase and -- as options.  Everything else
-     * gets pushed to runtime execution.  This is different than regexp's
-     * runtime option handling, but satisfies our stricter needs.
+     * We only look for -nocase and -- as options. Everything else gets pushed
+     * to runtime execution. This is different than regexp's runtime option
+     * handling, but satisfies our stricter needs.
      */
+
     for (i = 1; i < parsePtr->numWords - 2; i++) {
-	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	varTokenPtr = TokenAfter(varTokenPtr);
 	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    /* Not a simple string - punt to runtime. */
-	    return TCL_OUT_LINE_COMPILE;
+	    /*
+	     * Not a simple string, so punt to runtime.
+	     */
+
+	    return TCL_ERROR;
 	}
 	str = (char *) varTokenPtr[1].start;
 	len = varTokenPtr[1].size;
 	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
+	    sawLast++;
 	    i++;
 	    break;
-	} else if ((len > 1)
-		&& (strncmp(str, "-nocase", (unsigned) len) == 0)) {
+	} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
 	    nocase = 1;
 	} else {
-	    /* Not an option we recognize. */
-	    return TCL_OUT_LINE_COMPILE;
+	    /*
+	     * Not an option we recognize.
+	     */
+
+	    return TCL_ERROR;
 	}
     }
 
     if ((parsePtr->numWords - i) != 2) {
-	/* We don't support capturing to variables */
-	return TCL_OUT_LINE_COMPILE;
+	/*
+	 * We don't support capturing to variables.
+	 */
+
+	return TCL_ERROR;
     }
 
     /*
-     * Get the regexp string.  If it is not a simple string, punt to runtime.
-     * If it has a '-', it could be an incorrectly formed regexp command.
+     * Get the regexp string. If it is not a simple string or can't be
+     * converted to a glob pattern, push the word for the INST_REGEXP.
+     * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
      */
-    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-    str = (char *) varTokenPtr[1].start;
-    len = varTokenPtr[1].size;
-    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
-	return TCL_OUT_LINE_COMPILE;
-    }
 
-    if (len == 0) {
+    varTokenPtr = TokenAfter(varTokenPtr);
+
+    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	Tcl_DString ds;
+
+	str = (char *) varTokenPtr[1].start;
+	len = varTokenPtr[1].size;
 	/*
-	 * The semantics of regexp are always match on re == "".
+	 * If it has a '-', it could be an incorrectly formed regexp command.
 	 */
-	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
-	return TCL_OK;
-    }
-
-    /*
-     * Make a copy of the string that is null-terminated for checks which
-     * require such.
-     */
-    str = (char *) ckalloc((unsigned) len + 1);
-    strncpy(str, varTokenPtr[1].start, (size_t) len);
-    str[len] = '\0';
-    start = 0;
 
-    /*
-     * Check for anchored REs (ie ^foo$), so we can use string equal if
-     * possible. Do not alter the start of str so we can free it correctly.
-     */
-    if (str[0] == '^') {
-	start++;
-	anchorLeft = 1;
-    } else {
-	anchorLeft = 0;
-    }
-    if ((str[len-1] == '$') && ((len == 1) || (str[len-2] != '\\'))) {
-	anchorRight = 1;
-	str[--len] = '\0';
-    } else {
-	anchorRight = 0;
-    }
+	if ((*str == '-') && !sawLast) {
+	    return TCL_ERROR;
+	}
 
-    /*
-     * On the first (pattern) arg, check to see if any RE special characters
-     * are in the word.  If not, this is the same as 'string equal'.
-     */
-    if ((len > (1+start)) && (str[start] == '.') && (str[start+1] == '*')) {
-	start += 2;
-	anchorLeft = 0;
-    }
-    if ((len > (2+start)) && (str[len-3] != '\\')
-	    && (str[len-2] == '.') && (str[len-1] == '*')) {
-	len -= 2;
-	str[len] = '\0';
-	anchorRight = 0;
-    }
+	if (len == 0) {
+	    /*
+	     * The semantics of regexp are always match on re == "".
+	     */
 
-    /*
-     * Don't do anything with REs with other special chars.  Also check if
-     * this is a bad RE (do this at the end because it can be expensive).
-     * If so, let it complain at runtime.
-     */
-    if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL)
-	    || (Tcl_RegExpCompile(NULL, str) == NULL)) {
-	ckfree((char *) str);
-	return TCL_OUT_LINE_COMPILE;
-    }
+	    PushLiteral(envPtr, "1", 1);
+	    return TCL_OK;
+	}
 
-    if (anchorLeft && anchorRight) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, str+start, len-start),
-		envPtr);
-    } else {
 	/*
-	 * This needs to find the substring anywhere in the string, so
-	 * use string match and *foo*, with appropriate anchoring.
+	 * Attempt to convert pattern to glob.  If successful, push the
+	 * converted pattern as a literal.
 	 */
-	char *newStr  = ckalloc((unsigned) len + 3);
-	len -= start;
-	if (anchorLeft) {
-	    strncpy(newStr, str + start, (size_t) len);
-	} else {
-	    newStr[0] = '*';
-	    strncpy(newStr + 1, str + start, (size_t) len++);
-	}
-	if (!anchorRight) {
-	    newStr[len++] = '*';
+
+	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
+		== TCL_OK) {
+	    simple = 1;
+	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+	    Tcl_DStringFree(&ds);
 	}
-	newStr[len] = '\0';
-	TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len), envPtr);
-	ckfree((char *) newStr);
     }
-    ckfree((char *) str);
+
+    if (!simple) {
+	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+    }
 
     /*
-     * Push the string arg
+     * Push the string arg.
      */
-    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr,
-		varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
-    } else {
-	SetLineInformation (parsePtr->numWords-1);
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-    }
 
-    if (anchorLeft && anchorRight && !nocase) {
-	TclEmitOpcode(INST_STR_EQ, envPtr);
+    varTokenPtr = TokenAfter(varTokenPtr);
+    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+
+    if (simple) {
+	if (exact && !nocase) {
+	    TclEmitOpcode(INST_STR_EQ, envPtr);
+	} else {
+	    TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+	}
     } else {
-	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+	/*
+	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
+	 * that handles all the flags we want to pass.
+	 * Don't use TCL_REG_NOSUB as we may have backrefs.
+	 */
+	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
+	TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
     }
 
     return TCL_OK;
@@ -2446,117 +3262,191 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "return" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if the
- *	compilation was successful.  If the particular return command is
- *	too complex for this function (ie, return with any flags like "-code"
- *	or "-errorinfo"), TCL_OUT_LINE_COMPILE is returned, indicating that
- *	the command should be compiled "out of line" (eg, not byte compiled).
- *	If an error occurs then the interpreter's result contains a standard
- *	error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "return" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "return" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileReturnCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileReturnCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr;
-    int code;
-    int index = envPtr->exceptArrayNext - 1;
-
-    DefineLineInformation;
+    /*
+     * General syntax: [return ?-option value ...? ?result?]
+     * An even number of words means an explicit result argument is present.
+     */
+    int level, code, objc, size, status = TCL_OK;
+    int numWords = parsePtr->numWords;
+    int explicitResult = (0 == (numWords % 2));
+    int numOptionWords = numWords - 1 - explicitResult;
+    Tcl_Obj *returnOpts, **objv;
+    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    DefineLineInformation;	/* TIP #280 */
 
     /*
-     * If we're not in a procedure, don't compile.
+     * Check for special case which can always be compiled:
+     *	    return -options <opts> <msg>
+     * Unlike the normal [return] compilation, this version does everything at
+     * runtime so it can handle arbitrary words and not just literals. Note
+     * that if INST_RETURN_STK wasn't already needed for something else
+     * ('finally' clause processing) this piece of code would not be present.
      */
 
-    if (envPtr->procPtr == NULL) {
-	return TCL_OUT_LINE_COMPILE;
+    if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
+	    && (wordTokenPtr[1].size == 8)
+	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
+	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
+	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);
+
+	CompileWord(envPtr, optsTokenPtr, interp, 2);
+	CompileWord(envPtr, msgTokenPtr,  interp, 3);
+	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	return TCL_OK;
     }
 
     /*
-     * Look back through the ExceptionRanges of the current CompileEnv,
-     * from exceptArrayPtr[(exceptArrayNext - 1)] down to 
-     * exceptArrayPtr[0] to see if any of them is an enclosing [catch].
-     * If there's an enclosing [catch], don't compile.
+     * Allocate some working space.
+     */
+
+    objv = (Tcl_Obj **) TclStackAlloc(interp,
+	    numOptionWords * sizeof(Tcl_Obj *));
+
+    /*
+     * Scan through the return options. If any are unknown at compile time,
+     * there is no value in bytecompiling. Save the option values known in an
+     * objv array for merging into a return options dictionary.
      */
 
-    while (index >= 0) {
-	ExceptionRange range = envPtr->exceptArrayPtr[index];
-	if ((range.type == CATCH_EXCEPTION_RANGE) 
-		&& (range.catchOffset == -1)) {
-	    return TCL_OUT_LINE_COMPILE;
+    for (objc = 0; objc < numOptionWords; objc++) {
+	objv[objc] = Tcl_NewObj();
+	Tcl_IncrRefCount(objv[objc]);
+	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
+	    objc++;
+	    status = TCL_ERROR;
+	    goto cleanup;
 	}
-	index--;
+	wordTokenPtr = TokenAfter(wordTokenPtr);
+    }
+    status = TclMergeReturnOptions(interp, objc, objv,
+	    &returnOpts, &code, &level);
+  cleanup:
+    while (--objc >= 0) {
+	TclDecrRefCount(objv[objc]);
     }
+    TclStackFree(interp, objv);
+    if (TCL_ERROR == status) {
+	/*
+	 * Something was bogus in the return options. Clear the error message,
+	 * and report back to the compiler that this must be interpreted at
+	 * runtime.
+	 */
 
-    switch (parsePtr->numWords) {
-	case 1: {
-	    /*
-	     * Simple case:  [return]
-	     * Just push the literal string "".
-	     */
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
-	    break;
-	}
-	case 2: {
-	    /*
-	     * More complex cases:
-	     * [return "foo"]
-	     * [return $value]
-	     * [return [otherCmd]]
-	     */
-	    varTokenPtr = parsePtr->tokenPtr
-		+ (parsePtr->tokenPtr->numComponents + 1);
-	    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		/*
-		 * [return "foo"] case:  the parse token is a simple word,
-		 * so just push it.
-		 */
-		TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
-			varTokenPtr[1].size), envPtr);
-	    } else {
-		/*
-		 * Parse token is more complex, so compile it; this handles the
-		 * variable reference and nested command cases.  If the
-		 * parse token can be byte-compiled, then this instance of
-		 * "return" will be byte-compiled; otherwise it will be
-		 * out line compiled.
-		 */
-		SetLineInformation (1);
-		code = TclCompileTokens(interp, varTokenPtr+1,
-			varTokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    return code;
-		}
+	Tcl_ResetResult(interp);
+	return TCL_ERROR;
+    }
+
+    /*
+     * All options are known at compile time, so we're going to bytecompile.
+     * Emit instructions to push the result on the stack.
+     */
+
+    if (explicitResult) {
+	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+    } else {
+	/*
+	 * No explict result argument, so default result is empty string.
+	 */
+
+	PushLiteral(envPtr, "", 0);
+    }
+
+    /*
+     * Check for optimization: When [return] is in a proc, and there's no
+     * enclosing [catch], and there are no return options, then the INST_DONE
+     * instruction is equivalent, and may be more efficient.
+     */
+
+    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
+	/*
+	 * We have default return options and we're in a proc ...
+	 */
+
+	int index = envPtr->exceptArrayNext - 1;
+	int enclosingCatch = 0;
+
+	while (index >= 0) {
+	    ExceptionRange range = envPtr->exceptArrayPtr[index];
+	    if ((range.type == CATCH_EXCEPTION_RANGE)
+		    && (range.catchOffset == -1)) {
+		enclosingCatch = 1;
+		break;
 	    }
-	    break;
+	    index--;
 	}
-	default: {
+	if (!enclosingCatch) {
 	    /*
-	     * Most complex return cases: everything else, including
-	     * [return -code error], etc.
+	     * ... and there is no enclosing catch. Issue the maximally
+	     * efficient exit instruction.
 	     */
-	    return TCL_OUT_LINE_COMPILE;
+
+	    Tcl_DecrRefCount(returnOpts);
+	    TclEmitOpcode(INST_DONE, envPtr);
+	    return TCL_OK;
 	}
     }
 
+    /* Optimize [return -level 0 $x]. */
+    Tcl_DictObjSize(NULL, returnOpts, &size);
+    if (size == 0 && level == 0 && code == TCL_OK) {
+	Tcl_DecrRefCount(returnOpts);
+	return TCL_OK;
+    }
+
     /*
-     * The INST_DONE opcode actually causes the branching out of the
-     * subroutine, and takes the top stack item as the return result
-     * (which is why we pushed the value above).
+     * Could not use the optimization, so we push the return options dict, and
+     * emit the INST_RETURN_IMM instruction with code and level as operands.
      */
-    TclEmitOpcode(INST_DONE, envPtr);
+
+    CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
     return TCL_OK;
 }
+
+static void
+CompileReturnInternal(
+    CompileEnv *envPtr,
+    unsigned char op,
+    int code,
+    int level,
+    Tcl_Obj *returnOpts)
+{
+    TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
+    TclEmitInstInt4(op, code, envPtr);
+    TclEmitInt4(level, envPtr);
+}
+
+void
+TclCompileSyntaxError(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr)
+{
+    Tcl_Obj *msg = Tcl_GetObjResult(interp);
+    int numBytes;
+    const char *bytes = TclGetStringFromObj(msg, &numBytes);
+
+    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
+    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
+	    Tcl_GetReturnOptions(interp, TCL_ERROR));
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2566,77 +3456,54 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "set" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is normally TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message. If
- *	compilation fails because the set command requires a second level of
- *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- *	set command should be compiled "out of line" by emitting code to
- *	invoke its command procedure (Tcl_SetCmd) at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "set" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "set" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileSetCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileSetCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int isAssignment, isScalar, simpleVarName, localIndex, numWords;
-    int code = TCL_OK;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
     if ((numWords != 2) && (numWords != 3)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"set varName ?newValue?\"", -1);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     isAssignment = (numWords == 3);
 
     /*
-     * Decide if we can use a frame slot for the var/array name or if we
-     * need to emit code to compute and push the name at runtime. We use a
-     * frame slot (entry in the array of local vars) if we are compiling a
-     * procedure body and if the name is simple text that does not include
-     * namespace qualifiers. 
+     * Decide if we can use a frame slot for the var/array name or if we need
+     * to emit code to compute and push the name at runtime. We use a frame
+     * slot (entry in the array of local vars) if we are compiling a procedure
+     * body and if the name is simple text that does not include namespace
+     * qualifiers.
      */
 
-    varTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-
-    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-	    &localIndex, &simpleVarName, &isScalar, 1);
-    if (code != TCL_OK) {
-	goto done;
-    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+		    &localIndex, &simpleVarName, &isScalar, 1);
 
     /*
      * If we are doing an assignment, push the new value.
      */
 
     if (isAssignment) {
-	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-	if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
-		    valueTokenPtr[1].size), envPtr);
-	} else {
-	    SetLineInformation (2);
-	    code = TclCompileTokens(interp, valueTokenPtr+1,
-	            valueTokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-	}
+	valueTokenPtr = TokenAfter(varTokenPtr);
+	CompileWord(envPtr, valueTokenPtr, interp, 2);
     }
 
     /*
@@ -2645,351 +3512,1158 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 
     if (simpleVarName) {
 	if (isScalar) {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1((isAssignment?
-		            INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
-			    localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4((isAssignment?
-			    INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
-			    localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode((isAssignment?
-		        INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
+			INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1((isAssignment?
+			INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+			localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4((isAssignment?
+			INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+			localIndex, envPtr);
 	    }
 	} else {
-	    if (localIndex >= 0) {
-		if (localIndex <= 255) {
-		    TclEmitInstInt1((isAssignment?
-		            INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
-			    localIndex, envPtr);
-		} else {
-		    TclEmitInstInt4((isAssignment?
-			    INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
-			    localIndex, envPtr);
-		}
-	    } else {
+	    if (localIndex < 0) {
 		TclEmitOpcode((isAssignment?
-		        INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
+			INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
+	    } else if (localIndex <= 255) {
+		TclEmitInstInt1((isAssignment?
+			INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+			localIndex, envPtr);
+	    } else {
+		TclEmitInstInt4((isAssignment?
+			INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+			localIndex, envPtr);
 	    }
 	}
     } else {
 	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
     }
-	
-    done:
-    return code;
+
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileStringCmd --
+ * TclCompileStringCmpCmd --
  *
- *	Procedure called to compile the "string" command.
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string compare" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if the
- *	compilation was successful.  If the command cannot be byte-compiled,
- *	TCL_OUT_LINE_COMPILE is returned.  If an error occurs then the
- *	interpreter's result contains an error message, and TCL_ERROR is
- *	returned.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "string" command
+ *	Instructions are added to envPtr to execute the "string compare"
+ *	command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringCmpCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    /*
+     * We don't support any flags; the bytecode isn't that sophisticated.
+     */
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the two operands onto the stack and then the test.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    TclEmitOpcode(INST_STR_CMP, envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileStringEqualCmd --
+ *
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string equal" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "string equal" command
  *	at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileStringCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
-{
-    Tcl_Token *opTokenPtr, *varTokenPtr;
-    Tcl_Obj *opObj;
-    int index;
-    int code;
-    
-    static CONST char *options[] = {
-	"bytelength",	"compare",	"equal",	"first",
-	"index",	"is",		"last",		"length",
-	"map",		"match",	"range",	"repeat",
-	"replace",	"tolower",	"toupper",	"totitle",
-	"trim",		"trimleft",	"trimright",
-	"wordend",	"wordstart",	(char *) NULL
-    };
-    enum options {
-	STR_BYTELENGTH,	STR_COMPARE,	STR_EQUAL,	STR_FIRST,
-	STR_INDEX,	STR_IS,		STR_LAST,	STR_LENGTH,
-	STR_MAP,	STR_MATCH,	STR_RANGE,	STR_REPEAT,
-	STR_REPLACE,	STR_TOLOWER,	STR_TOUPPER,	STR_TOTITLE,
-	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
-	STR_WORDEND,	STR_WORDSTART
-    };	  
-
-    DefineLineInformation;
+TclCompileStringEqualCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
 
-    if (parsePtr->numWords < 2) {
-	/* Fail at run time, not in compilation */
-	return TCL_OUT_LINE_COMPILE;
+    /*
+     * We don't support any flags; the bytecode isn't that sophisticated.
+     */
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
     }
-    opTokenPtr = parsePtr->tokenPtr
-	+ (parsePtr->tokenPtr->numComponents + 1);
 
-    opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
-    if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
-	    &index) != TCL_OK) {
-	Tcl_DecrRefCount(opObj);
-	Tcl_ResetResult(interp);
-	return TCL_OUT_LINE_COMPILE;
-    }
-    Tcl_DecrRefCount(opObj);
-
-    varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1);
-
-    switch ((enum options) index) {
-	case STR_BYTELENGTH:
-	case STR_FIRST:
-	case STR_IS:
-	case STR_LAST:
-	case STR_MAP:
-	case STR_RANGE:
-	case STR_REPEAT:
-	case STR_REPLACE:
-	case STR_TOLOWER:
-	case STR_TOUPPER:
-	case STR_TOTITLE:
-	case STR_TRIM:
-	case STR_TRIMLEFT:
-	case STR_TRIMRIGHT:
-	case STR_WORDEND:
-	case STR_WORDSTART:
+    /*
+     * Push the two operands onto the stack and then the test.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    TclEmitOpcode(INST_STR_EQ, envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileStringIndexCmd --
+ *
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string index" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "string index" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringIndexCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the two operands onto the stack and then the index operation.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    TclEmitOpcode(INST_STR_INDEX, envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileStringMatchCmd --
+ *
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string match" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "string match" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringMatchCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    int i, length, exactMatch = 0, nocase = 0;
+    const char *str;
+
+    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Check if we have a -nocase flag.
+     */
+
+    if (parsePtr->numWords == 4) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	str = tokenPtr[1].start;
+	length = tokenPtr[1].size;
+	if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
+	    /*
+	     * Fail at run time, not in compilation.
+	     */
+
+	    return TCL_ERROR;
+	}
+	nocase = 1;
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    /*
+     * Push the strings to match against each other.
+     */
+
+    for (i = 0; i < 2; i++) {
+	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    str = tokenPtr[1].start;
+	    length = tokenPtr[1].size;
+	    if (!nocase && (i == 0)) {
+		/*
+		 * Trivial matches can be done by 'string equal'. If -nocase
+		 * was specified, we can't do this because INST_STR_EQ has no
+		 * support for nocase.
+		 */
+
+		Tcl_Obj *copy = Tcl_NewStringObj(str, length);
+
+		Tcl_IncrRefCount(copy);
+		exactMatch = TclMatchIsTrivial(TclGetString(copy));
+		TclDecrRefCount(copy);
+	    }
+	    PushLiteral(envPtr, str, length);
+	} else {
+	    SetLineInformation (i+1+nocase);
+	    CompileTokens(envPtr, tokenPtr, interp);
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    /*
+     * Push the matcher.
+     */
+
+    if (exactMatch) {
+	TclEmitOpcode(INST_STR_EQ, envPtr);
+    } else {
+	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileStringLenCmd --
+ *
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string length" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "string length"
+ *	command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringLenCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	/*
+	 * Here someone is asking for the length of a static string. Just push
+	 * the actual character (not byte) length.
+	 */
+
+	char buf[TCL_INTEGER_SPACE];
+	int len = Tcl_NumUtfChars(tokenPtr[1].start, tokenPtr[1].size);
+
+	len = sprintf(buf, "%d", len);
+	PushLiteral(envPtr, buf, len);
+    } else {
+	SetLineInformation (1);
+	CompileTokens(envPtr, tokenPtr, interp);
+	TclEmitOpcode(INST_STR_LEN, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSwitchCmd --
+ *
+ *	Procedure called to compile the "switch" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for successful compile, or TCL_ERROR to defer
+ * 	evaluation to runtime (either when it is too complex to get the
+ * 	semantics right, or when we know for sure that it is an error but need
+ * 	the error to happen at the right time).
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "switch" command at
+ *	runtime.
+ *
+ * FIXME:
+ *	Stack depths are probably not calculated correctly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSwitchCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
+    int numWords;		/* Number of words in command. */
+
+    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */
+    enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
+				/* What kind of switch are we doing? */
+
+    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
+    Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
+    int *bodyLines;		/* Array of line numbers for body list
+				 * items. */
+    int** bodyNext;
+    int foundDefault;		/* Flag to indicate whether a "default" clause
+				 * is present. */
+
+    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
+    int *fixupTargetArray;	/* Array of places for fixups to point at. */
+    int fixupCount;		/* Number of places to fix up. */
+    int contFixIndex;		/* Where the first of the jumps due to a group
+				 * of continuation bodies starts, or -1 if
+				 * there aren't any. */
+    int contFixCount;		/* Number of continuation bodies pointing to
+				 * the current (or next) real body. */
+
+    int savedStackDepth = envPtr->currStackDepth;
+    int noCase;			/* Has the -nocase flag been given? */
+    int foundMode = 0;		/* Have we seen a mode flag yet? */
+    int i, valueIndex;
+    DefineLineInformation;	/* TIP #280 */
+    int* clNext = envPtr->clNext;
+
+    /*
+     * Only handle the following versions:
+     *   switch         ?--? word {pattern body ...}
+     *   switch -exact  ?--? word {pattern body ...}
+     *   switch -glob   ?--? word {pattern body ...}
+     *   switch -regexp ?--? word {pattern body ...}
+     *   switch         --   word simpleWordPattern simpleWordBody ...
+     *   switch -exact  --   word simpleWordPattern simpleWordBody ...
+     *   switch -glob   --   word simpleWordPattern simpleWordBody ...
+     *   switch -regexp --   word simpleWordPattern simpleWordBody ...
+     * When the mode is -glob, can also handle a -nocase flag.
+     *
+     * First off, we don't care how the command's word was generated; we're
+     * compiling it anyway! So skip it...
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    valueIndex = 1;
+    numWords = parsePtr->numWords-1;
+
+    /*
+     * Check for options.
+     */
+
+    noCase = 0;
+    mode = Switch_Exact;
+    if (numWords == 2) {
+	/*
+	 * There's just the switch value and the bodies list. In that case, we
+	 * can skip all option parsing and move on to consider switch values
+	 * and the body list.
+	 */
+
+	goto finishedOptionParse;
+    }
+
+    /*
+     * There must be at least one option, --, because without that there is no
+     * way to statically avoid the problems you get from strings-to-be-matched
+     * that start with a - (the interpreted code falls apart if it encounters
+     * them, so we punt if we *might* encounter them as that is the easiest
+     * way of emulating the behaviour).
+     */
+
+    for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
+	register unsigned size = tokenPtr[1].size;
+	register const char *chrs = tokenPtr[1].start;
+
+	/*
+	 * We only process literal options, and we assume that -e, -g and -n
+	 * are unique prefixes of -exact, -glob and -nocase respectively (true
+	 * at time of writing). Note that -exact and -glob may only be given
+	 * at most once or we bail out (error case).
+	 */
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
+	    return TCL_ERROR;
+	}
+
+	if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
+	    if (foundMode) {
+		return TCL_ERROR;
+	    }
+	    mode = Switch_Exact;
+	    foundMode = 1;
+	    valueIndex++;
+	    continue;
+	} else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
+	    if (foundMode) {
+		return TCL_ERROR;
+	    }
+	    mode = Switch_Glob;
+	    foundMode = 1;
+	    valueIndex++;
+	    continue;
+	} else if ((size <= 7) && !memcmp(chrs, "-regexp", size)) {
+	    if (foundMode) {
+		return TCL_ERROR;
+	    }
+	    mode = Switch_Regexp;
+	    foundMode = 1;
+	    valueIndex++;
+	    continue;
+	} else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
+	    noCase = 1;
+	    valueIndex++;
+	    continue;
+	} else if ((size == 2) && !memcmp(chrs, "--", 2)) {
+	    valueIndex++;
+	    break;
+	}
+
+	/*
+	 * The switch command has many flags we cannot compile at all (e.g.
+	 * all the RE-related ones) which we must have encountered. Either
+	 * that or we have run off the end. The action here is the same: punt
+	 * to interpreted version.
+	 */
+
+	return TCL_ERROR;
+    }
+    if (numWords < 3) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(tokenPtr);
+    numWords--;
+    if (noCase && (mode == Switch_Exact)) {
+	/*
+	 * Can't compile this case; no opcode for case-insensitive equality!
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * The value to test against is going to always get pushed on the stack.
+     * But not yet; we need to verify that the rest of the command is
+     * compilable too.
+     */
+
+  finishedOptionParse:
+    valueTokenPtr = tokenPtr;
+    /* For valueIndex, see previous loop. */
+    tokenPtr = TokenAfter(tokenPtr);
+    numWords--;
+
+    /*
+     * Build an array of tokens for the matcher terms and script bodies. Note
+     * that in the case of the quoted bodies, this is tricky as we cannot use
+     * copies of the string from the input token for the generated tokens (it
+     * causes a crash during exception handling). When multiple tokens are
+     * available at this point, this is pretty easy.
+     */
+
+    if (numWords == 1) {
+	CONST char *bytes;
+	int maxLen, numBytes;
+	int bline;		/* TIP #280: line of the pattern/action list,
+				 * and start of list for when tracking the
+				 * location. This list comes immediately after
+				 * the value we switch on. */
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	bytes = tokenPtr[1].start;
+	numBytes = tokenPtr[1].size;
+
+	/* Allocate enough space to work in. */
+	maxLen = TclMaxListLength(bytes, numBytes, NULL);
+	if (maxLen < 2) {
+	    return TCL_ERROR;
+	}
+	bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * maxLen);
+	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * maxLen);
+	bodyLines = (int *) ckalloc(sizeof(int) * maxLen);
+	bodyNext  = (int **) ckalloc(sizeof(int*) * maxLen);
+
+	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
+	numWords = 0;
+
+	while (numBytes > 0) {
+	    CONST char *prevBytes = bytes;
+	    int literal;
+
+	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
+		    &(bodyTokenArray[numWords].start), &bytes,
+		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
+		goto abort;
+	    }
+
+	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
+	    bodyTokenArray[numWords].numComponents = 0;
+	    bodyToken[numWords] = bodyTokenArray + numWords;
+
 	    /*
-	     * All other cases: compile out of line.
+	     * TIP #280: Now determine the line the list element starts on
+	     * (there is no need to do it earlier, due to the possibility of
+	     * aborting, see above).
 	     */
-	    return TCL_OUT_LINE_COMPILE;
 
-	case STR_COMPARE: 
-	case STR_EQUAL: {
-	    int i;
+	    TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
+	    TclAdvanceContinuations (&bline, &clNext,
+		    bodyTokenArray[numWords].start - envPtr->source);
+	    bodyLines[numWords] = bline;
+	    bodyNext[numWords] = clNext;
+	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
+	    TclAdvanceContinuations (&bline, &clNext, bytes - envPtr->source);
+
+	    numBytes -= (bytes - prevBytes);
+	    numWords++;
+	}
+	if (numWords % 2) {
+	abort:
+	    ckfree((char *) bodyToken);
+	    ckfree((char *) bodyTokenArray);
+	    ckfree((char *) bodyLines);
+	    ckfree((char *) bodyNext);
+	    return TCL_ERROR;
+	}
+    } else if (numWords % 2 || numWords == 0) {
+	/*
+	 * Odd number of words (>1) available, or no words at all available.
+	 * Both are error cases, so punt and let the interpreted-version
+	 * generate the error message. Note that the second case probably
+	 * should get caught earlier, but it's easy to check here again anyway
+	 * because it'd cause a nasty crash otherwise.
+	 */
+
+	return TCL_ERROR;
+    } else {
+	/*
+	 * Multi-word definition of patterns & actions.
+	 */
+
+	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
+	bodyLines = (int *) ckalloc(sizeof(int) * numWords);
+	bodyNext  = (int **) ckalloc(sizeof(int*) * numWords);
+	bodyTokenArray = NULL;
+	for (i=0 ; i<numWords ; i++) {
 	    /*
-	     * If there are any flags to the command, we can't byte compile it
-	     * because the INST_STR_EQ bytecode doesn't support flags.
+	     * We only handle the very simplest case. Anything more complex is
+	     * a good reason to go to the interpreted case anyway due to
+	     * traces, etc.
 	     */
 
-	    if (parsePtr->numWords != 4) {
-		return TCL_OUT_LINE_COMPILE;
+	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		ckfree((char *) bodyToken);
+		ckfree((char *) bodyLines);
+		ckfree((char *) bodyNext);
+		return TCL_ERROR;
 	    }
+	    bodyToken[i] = tokenPtr+1;
 
 	    /*
-	     * Push the two operands onto the stack.
+	     * TIP #280: Copy line information from regular cmd info.
 	     */
 
-	    for (i = 0; i < 2; i++) {
-		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		    TclEmitPush(TclRegisterNewLiteral(envPtr,
-			    varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
-		} else {
-		    SetLineInformation (i);
-		    code = TclCompileTokens(interp, varTokenPtr+1,
-			    varTokenPtr->numComponents, envPtr);
-		    if (code != TCL_OK) {
-			return code;
-		    }
-		}
-		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-	    }
+	    bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
+	    bodyNext[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
+	    tokenPtr = TokenAfter(tokenPtr);
+	}
+    }
 
-	    TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
-		    INST_STR_CMP : INST_STR_EQ), envPtr);
-	    return TCL_OK;
+    /*
+     * Fall back to interpreted if the last body is a continuation (it's
+     * illegal, but this makes the error happen at the right time).
+     */
+
+    if (bodyToken[numWords-1]->size == 1 &&
+	    bodyToken[numWords-1]->start[0] == '-') {
+	ckfree((char *) bodyToken);
+	ckfree((char *) bodyLines);
+	ckfree((char *) bodyNext);
+	if (bodyTokenArray != NULL) {
+	    ckfree((char *) bodyTokenArray);
 	}
-	case STR_INDEX: {
-	    int i;
+	return TCL_ERROR;
+    }
 
-	    if (parsePtr->numWords != 4) {
-		/* Fail at run time, not in compilation */
-		return TCL_OUT_LINE_COMPILE;
-	    }
+    /*
+     * Now we commit to generating code; the parsing stage per se is done.
+     * First, we push the value we're matching against on the stack.
+     */
+
+    SetLineInformation (valueIndex);
+    CompileTokens(envPtr, valueTokenPtr, interp);
+
+    /*
+     * Check if we can generate a jump table, since if so that's faster than
+     * doing an explicit compare with each body. Note that we're definitely
+     * over-conservative with determining whether we can do the jump table,
+     * but it handles the most common case well enough.
+     */
+
+    if (mode == Switch_Exact) {
+	JumptableInfo *jtPtr;
+	int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
+	int mustGenerate, jumpToDefault;
+	Tcl_DString buffer;
+	Tcl_HashEntry *hPtr;
 
+	/*
+	 * Compile the switch by using a jump table, which is basically a
+	 * hashtable that maps from literal values to match against to the
+	 * offset (relative to the INST_JUMP_TABLE instruction) to jump to.
+	 * The jump table itself is independent of any invokation of the
+	 * bytecode, and as such is stored in an auxData block.
+	 *
+	 * Start by allocating the jump table itself, plus some workspace.
+	 */
+
+	jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo));
+	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
+	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
+	finalFixups = (int *) ckalloc(sizeof(int) * (numWords/2));
+	foundDefault = 0;
+	mustGenerate = 1;
+
+	/*
+	 * Next, issue the instruction to do the jump, together with what we
+	 * want to do if things do not work out (jump to either the default
+	 * clause or the "default" default, which just sets the result to
+	 * empty). Note that we will come back and rewrite the jump's offset
+	 * parameter when we know what it should be, and that all jumps we
+	 * issue are of the wide kind because that makes the code much easier
+	 * to debug!
+	 */
+
+	jumpLocation = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr);
+	jumpToDefault = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+
+	for (i=0 ; i<numWords ; i+=2) {
 	    /*
-	     * Push the two operands onto the stack.
+	     * For each arm, we must first work out what to do with the match
+	     * term.
 	     */
 
-	    for (i = 0; i < 2; i++) {
-		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		    TclEmitPush(TclRegisterNewLiteral(envPtr,
-			    varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
-		} else {
-		    SetLineInformation (i);
-		    code = TclCompileTokens(interp, varTokenPtr+1,
-			    varTokenPtr->numComponents, envPtr);
-		    if (code != TCL_OK) {
-			return code;
-		    }
+	    if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
+		    memcmp(bodyToken[numWords-2]->start, "default", 7)) {
+		/*
+		 * This is not a default clause, so insert the current
+		 * location as a target in the jump table (assuming it isn't
+		 * already there, which would indicate that this clause is
+		 * probably masked by an earlier one). Note that we use a
+		 * Tcl_DString here simply because the hash API does not let
+		 * us specify the string length.
+		 */
+
+		Tcl_DStringInit(&buffer);
+		Tcl_DStringAppend(&buffer, bodyToken[i]->start,
+			bodyToken[i]->size);
+		hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
+			Tcl_DStringValue(&buffer), &isNew);
+		if (isNew) {
+		    /*
+		     * First time we've encountered this match clause, so it
+		     * must point to here.
+		     */
+
+		    Tcl_SetHashValue(hPtr, (ClientData)
+			    (CurrentOffset(envPtr) - jumpLocation));
 		}
-		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+		Tcl_DStringFree(&buffer);
+	    } else {
+		/*
+		 * This is a default clause, so patch up the fallthrough from
+		 * the INST_JUMP_TABLE instruction to here.
+		 */
+
+		foundDefault = 1;
+		isNew = 1;
+		TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+			envPtr->codeStart+jumpToDefault+1);
 	    }
 
-	    TclEmitOpcode(INST_STR_INDEX, envPtr);
-	    return TCL_OK;
-	}
-	case STR_LENGTH: {
-	    if (parsePtr->numWords != 3) {
-		/* Fail at run time, not in compilation */
-		return TCL_OUT_LINE_COMPILE;
+	    /*
+	     * Now, for each arm we must deal with the body of the clause.
+	     *
+	     * If this is a continuation body (never true of a final clause,
+	     * whether default or not) we're done because the next jump target
+	     * will also point here, so we advance to the next clause.
+	     */
+
+	    if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
+		mustGenerate = 1;
+		continue;
+	    }
+
+	    /*
+	     * Also skip this arm if its only match clause is masked. (We
+	     * could probably be more aggressive about this, but that would be
+	     * much more difficult to get right.)
+	     */
+
+	    if (!isNew && !mustGenerate) {
+		continue;
 	    }
+	    mustGenerate = 0;
+
+	    /*
+	     * Compile the body of the arm.
+	     */
+
+	    envPtr->line = bodyLines[i+1];	/* TIP #280 */
+	    envPtr->clNext = bodyNext[i+1];	/* TIP #280 */
+	    TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
+
+	    /*
+	     * Compile a jump in to the end of the command if this body is
+	     * anything other than a user-supplied default arm (to either skip
+	     * over the remaining bodies or the code that generates an empty
+	     * result).
+	     */
+
+	    if (i+2 < numWords || !foundDefault) {
+		finalFixups[numRealBodies++] = CurrentOffset(envPtr);
 
-	    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 		/*
-		 * Here someone is asking for the length of a static string.
-		 * Just push the actual character (not byte) length.
+		 * Easier by far to issue this jump as a fixed-width jump.
+		 * Otherwise we'd need to do a lot more (and more awkward)
+		 * rewriting when we fixed this all up.
 		 */
-		char buf[TCL_INTEGER_SPACE];
-		int len = Tcl_NumUtfChars(varTokenPtr[1].start,
-			varTokenPtr[1].size);
-		len = sprintf(buf, "%d", len);
-		TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
-		return TCL_OK;
-	    } else {
-		SetLineInformation (2);
-		code = TclCompileTokens(interp, varTokenPtr+1,
-			varTokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    return code;
-		}
+
+		TclEmitInstInt4(INST_JUMP4, 0, envPtr);
 	    }
-	    TclEmitOpcode(INST_STR_LEN, envPtr);
-	    return TCL_OK;
 	}
-	case STR_MATCH: {
-	    int i, length, exactMatch = 0, nocase = 0;
-	    CONST char *str;
 
-	    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
-		/* Fail at run time, not in compilation */
-		return TCL_OUT_LINE_COMPILE;
-	    }
+	/*
+	 * We're at the end. If we've not already done so through the
+	 * processing of a user-supplied default clause, add in a "default"
+	 * default clause now.
+	 */
 
-	    if (parsePtr->numWords == 5) {
-		if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		    return TCL_OUT_LINE_COMPILE;
-		}
-		str    = varTokenPtr[1].start;
-		length = varTokenPtr[1].size;
-		if ((length > 1) &&
-			strncmp(str, "-nocase", (size_t) length) == 0) {
-		    nocase = 1;
-		} else {
-		    /* Fail at run time, not in compilation */
-		    return TCL_OUT_LINE_COMPILE;
-		}
-		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
-	    }
+	if (!foundDefault) {
+	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+		    envPtr->codeStart+jumpToDefault+1);
+	    PushLiteral(envPtr, "", 0);
+	}
 
-	    for (i = 0; i < 2; i++) {
-		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		    str = varTokenPtr[1].start;
-		    length = varTokenPtr[1].size;
-		    if (!nocase && (i == 0)) {
+	/*
+	 * No more instructions to be issued; everything that needs to jump to
+	 * the end of the command is fixed up at this point.
+	 */
+
+	for (i=0 ; i<numRealBodies ; i++) {
+	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
+		    envPtr->codeStart+finalFixups[i]+1);
+	}
+
+	/*
+	 * Clean up all our temporary space and return.
+	 */
+
+	ckfree((char *) finalFixups);
+	ckfree((char *) bodyToken);
+	ckfree((char *) bodyLines);
+	ckfree((char *) bodyNext);
+	if (bodyTokenArray != NULL) {
+	    ckfree((char *) bodyTokenArray);
+	}
+	return TCL_OK;
+    }
+
+    /*
+     * Generate a test for each arm.
+     */
+
+    contFixIndex = -1;
+    contFixCount = 0;
+    fixupArray = (JumpFixup *) ckalloc(sizeof(JumpFixup) * numWords);
+    fixupTargetArray = (int *) ckalloc(sizeof(int) * numWords);
+    memset(fixupTargetArray, 0, numWords * sizeof(int));
+    fixupCount = 0;
+    foundDefault = 0;
+    for (i=0 ; i<numWords ; i+=2) {
+	int nextArmFixupIndex = -1;
+
+	envPtr->currStackDepth = savedStackDepth + 1;
+	if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
+		memcmp(bodyToken[numWords-2]->start, "default", 7)) {
+	    /*
+	     * Generate the test for the arm.
+	     */
+
+	    switch (mode) {
+	    case Switch_Exact:
+		TclEmitOpcode(INST_DUP, envPtr);
+		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+		TclEmitOpcode(INST_STR_EQ, envPtr);
+		break;
+	    case Switch_Glob:
+		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+		TclEmitInstInt4(INST_OVER, 1, envPtr);
+		TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
+		break;
+	    case Switch_Regexp: {
+		int simple = 0, exact = 0;
+
+		/*
+		 * Keep in sync with TclCompileRegexpCmd.
+		 */
+
+		if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
+		    Tcl_DString ds;
+
+		    if (bodyToken[i]->size == 0) {
 			/*
-			 * On the first (pattern) arg, check to see if any
-			 * glob special characters are in the word '*[]?\\'.
-			 * If not, this is the same as 'string equal'.  We
-			 * can use strpbrk here because the glob chars are all
-			 * in the ascii-7 range.  If -nocase was specified,
-			 * we can't do this because INST_STR_EQ has no support
-			 * for nocase.
+			 * The semantics of regexps are that they always match
+			 * when the RE == "".
 			 */
-			Tcl_Obj *copy = Tcl_NewStringObj(str, length);
-			Tcl_IncrRefCount(copy);
-			exactMatch = (strpbrk(Tcl_GetString(copy),
-				"*[]?\\") == NULL);
-			Tcl_DecrRefCount(copy);
+
+			PushLiteral(envPtr, "1", 1);
+			break;
 		    }
-		    TclEmitPush(
-			    TclRegisterNewLiteral(envPtr, str, length), envPtr);
-		} else {
-		    SetLineInformation (i);
-		    code = TclCompileTokens(interp, varTokenPtr+1,
-			    varTokenPtr->numComponents, envPtr);
-		    if (code != TCL_OK) {
-			return code;
+
+		    /*
+		     * Attempt to convert pattern to glob. If successful, push
+		     * the converted pattern.
+		     */
+
+		    if (TclReToGlob(NULL, bodyToken[i]->start,
+			    bodyToken[i]->size, &ds, &exact) == TCL_OK) {
+			simple = 1;
+			PushLiteral(envPtr, Tcl_DStringValue(&ds),
+				Tcl_DStringLength(&ds));
+			Tcl_DStringFree(&ds);
+		    }
+		}
+		if (!simple) {
+		    TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+		}
+
+		TclEmitInstInt4(INST_OVER, 1, envPtr);
+		if (simple) {
+		    if (exact && !noCase) {
+			TclEmitOpcode(INST_STR_EQ, envPtr);
+		    } else {
+			TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
 		    }
+		} else {
+		    /*
+		     * Pass correct RE compile flags. We use only Int1
+		     * (8-bit), but that handles all the flags we want to
+		     * pass. Don't use TCL_REG_NOSUB as we may have backrefs
+		     * or capture vars.
+		     */
+
+		    int cflags = TCL_REG_ADVANCED
+			    | (noCase ? TCL_REG_NOCASE : 0);
+
+		    TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
 		}
-		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+		break;
+	    }
+	    default:
+		Tcl_Panic("unknown switch mode: %d", mode);
 	    }
 
-	    if (exactMatch) {
-		TclEmitOpcode(INST_STR_EQ, envPtr);
-	    } else {
-		TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+	    /*
+	     * In a fall-through case, we will jump on _true_ to the place
+	     * where the body starts (generated later, with guarantee of this
+	     * ensured earlier; the final body is never a fall-through).
+	     */
+
+	    if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
+		if (contFixIndex == -1) {
+		    contFixIndex = fixupCount;
+		    contFixCount = 0;
+		}
+		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
+			fixupArray+contFixIndex+contFixCount);
+		fixupCount++;
+		contFixCount++;
+		continue;
 	    }
-	    return TCL_OK;
+
+	    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, fixupArray+fixupCount);
+	    nextArmFixupIndex = fixupCount;
+	    fixupCount++;
+	} else {
+	    /*
+	     * Got a default clause; set a flag to inhibit the generation of
+	     * the jump after the body and the cleanup of the intermediate
+	     * value that we are switching against.
+	     *
+	     * Note that default clauses (which are always terminal clauses)
+	     * cannot be fall-through clauses as well, since the last clause
+	     * is never a fall-through clause (which we have already
+	     * verified).
+	     */
+
+	    foundDefault = 1;
+	}
+
+	/*
+	 * Generate the body for the arm. This is guaranteed not to be a
+	 * fall-through case, but it might have preceding fall-through cases,
+	 * so we must process those first.
+	 */
+
+	if (contFixIndex != -1) {
+	    int j;
+
+	    for (j=0 ; j<contFixCount ; j++) {
+		fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
+	    }
+	    contFixIndex = -1;
+	}
+
+	/*
+	 * Now do the actual compilation. Note that we do not use CompileBody
+	 * because we may have synthesized the tokens in a non-standard
+	 * pattern.
+	 */
+
+	TclEmitOpcode(INST_POP, envPtr);
+	envPtr->currStackDepth = savedStackDepth + 1;
+	envPtr->line = bodyLines[i+1];		/* TIP #280 */
+	envPtr->clNext = bodyNext[i+1];		/* TIP #280 */
+	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
+
+	if (!foundDefault) {
+	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+		    fixupArray+fixupCount);
+	    fixupCount++;
+	    fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
+	}
+    }
+
+    /*
+     * Clean up all our temporary space and return.
+     */
+
+    ckfree((char *) bodyToken);
+    ckfree((char *) bodyLines);
+    ckfree((char *) bodyNext);
+    if (bodyTokenArray != NULL) {
+	ckfree((char *) bodyTokenArray);
+    }
+
+    /*
+     * Discard the value we are matching against unless we've had a default
+     * clause (in which case it will already be gone due to the code at the
+     * start of processing an arm, guaranteed) and make the result of the
+     * command an empty string.
+     */
+
+    if (!foundDefault) {
+	TclEmitOpcode(INST_POP, envPtr);
+	PushLiteral(envPtr, "", 0);
+    }
+
+    /*
+     * Do jump fixups for arms that were executed. First, fill in the jumps of
+     * all jumps that don't point elsewhere to point to here.
+     */
+
+    for (i=0 ; i<fixupCount ; i++) {
+	if (fixupTargetArray[i] == 0) {
+	    fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
 	}
     }
 
+    /*
+     * Now scan backwards over all the jumps (all of which are forward jumps)
+     * doing each one. When we do one and there is a size changes, we must
+     * scan back over all the previous ones and see if they need adjusting
+     * before proceeding with further jump fixups (the interleaved nature of
+     * all the jumps makes this impossible to do without nested loops).
+     */
+
+    for (i=fixupCount-1 ; i>=0 ; i--) {
+	if (TclFixupForwardJump(envPtr, &fixupArray[i],
+		fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
+	    int j;
+
+	    for (j=i-1 ; j>=0 ; j--) {
+		if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
+		    fixupTargetArray[j] += 3;
+		}
+	    }
+	}
+    }
+    ckfree((char *) fixupArray);
+    ckfree((char *) fixupTargetArray);
+
+    envPtr->currStackDepth = savedStackDepth + 1;
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileVariableCmd --
+ * DupJumptableInfo, FreeJumptableInfo --
  *
- *	Procedure called to reserve the local variables for the 
- *      "variable" command. The command itself is *not* compiled.
+ *	Functions to duplicate, release and print a jump-table created for use
+ *	with the INST_JUMP_TABLE instruction.
  *
  * Results:
- *      Always returns TCL_OUT_LINE_COMPILE.
+ *	DupJumptableInfo: a copy of the jump-table
+ *	FreeJumptableInfo: none
+ *	PrintJumptableInfo: none
  *
  * Side effects:
- *      Indexed local variables are added to the environment.
+ *	DupJumptableInfo: allocates memory
+ *	FreeJumptableInfo: releases memory
+ *	PrintJumptableInfo: none
  *
  *----------------------------------------------------------------------
  */
-int
-TclCompileVariableCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+
+static ClientData
+DupJumptableInfo(
+    ClientData clientData)
 {
-    Tcl_Token *varTokenPtr;
-    int i, numWords;
-    CONST char *varName, *tail;
-    
-    if (envPtr->procPtr == NULL) {
-	return TCL_OUT_LINE_COMPILE;
+    JumptableInfo *jtPtr = clientData;
+    JumptableInfo *newJtPtr = (JumptableInfo *)
+	    ckalloc(sizeof(JumptableInfo));
+    Tcl_HashEntry *hPtr, *newHPtr;
+    Tcl_HashSearch search;
+    int isNew;
+
+    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
+    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+    while (hPtr != NULL) {
+	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
+		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
+	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
     }
+    return newJtPtr;
+}
 
-    numWords = parsePtr->numWords;
-    
-    varTokenPtr = parsePtr->tokenPtr
-	+ (parsePtr->tokenPtr->numComponents + 1);
-    for (i = 1; i < numWords; i += 2) {
-	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    varName = varTokenPtr[1].start;
-	    tail = varName + varTokenPtr[1].size - 1;
-	    if ((*tail == ')') || (tail < varName)) continue;
-	    while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
-		tail--;
-	    }
-	    if ((*tail == ':') && (tail > varName)) {
-		tail++;
+static void
+FreeJumptableInfo(
+    ClientData clientData)
+{
+    JumptableInfo *jtPtr = clientData;
+
+    Tcl_DeleteHashTable(&jtPtr->hashTable);
+    ckfree((char *) jtPtr);
+}
+
+static void
+PrintJumptableInfo(
+    ClientData clientData,
+    Tcl_Obj *appendObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register JumptableInfo *jtPtr = clientData;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    const char *keyPtr;
+    int offset, i = 0;
+
+    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+	offset = PTR2INT(Tcl_GetHashValue(hPtr));
+
+	if (i++) {
+	    Tcl_AppendToObj(appendObj, ", ", -1);
+	    if (i%4==0) {
+		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
 	    }
-	    (void) TclFindCompiledLocal(tail, (tail-varName+1),
-		    /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
-	    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	}
+	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
+		keyPtr, pcOffset + offset);
     }
-    return TCL_OUT_LINE_COMPILE;
 }
 
 /*
@@ -3000,99 +4674,87 @@ TclCompileVariableCmd(interp, parsePtr, envPtr)
  *	Procedure called to compile the "while" command.
  *
  * Results:
- *	The return value is a standard Tcl result, which is TCL_OK if
- *	compilation was successful. If an error occurs then the
- *	interpreter's result contains a standard error message and TCL_ERROR
- *	is returned. If compilation failed because the command is too
- *	complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
- *	indicating that the while command should be compiled "out of line"
- *	by emitting code to invoke its command procedure at runtime.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "while" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "while" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileWhileCmd(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Points to a parse structure for the
-				 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+TclCompileWhileCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *testTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
-    int testCodeOffset, bodyCodeOffset, jumpDist;
-    int range, code;
-    char buffer[32 + TCL_INTEGER_SPACE];
+    int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
     int savedStackDepth = envPtr->currStackDepth;
-    int loopMayEnd = 1;         /* This is set to 0 if it is recognized as
-				 * an infinite loop. */
+    int loopMayEnd = 1;		/* This is set to 0 if it is recognized as an
+				 * infinite loop. */
     Tcl_Obj *boolObj;
-    int boolVal;
-
-    DefineLineInformation;
+    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 3) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "wrong # args: should be \"while test command\"", -1);
 	return TCL_ERROR;
     }
 
     /*
-     * If the test expression requires substitutions, don't compile the
-     * while command inline. E.g., the expression might cause the loop to
-     * never execute or execute forever, as in "while "$x < 5" {}".
+     * If the test expression requires substitutions, don't compile the while
+     * command inline. E.g., the expression might cause the loop to never
+     * execute or execute forever, as in "while "$x < 5" {}".
      *
-     * Bail out also if the body expression requires substitutions
-     * in order to insure correct behaviour [Bug 219166]
+     * Bail out also if the body expression requires substitutions in order to
+     * insure correct behaviour [Bug 219166]
      */
 
-    testTokenPtr = parsePtr->tokenPtr
-	    + (parsePtr->tokenPtr->numComponents + 1);
-    bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+    testTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    bodyTokenPtr = TokenAfter(testTokenPtr);
+
     if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
 	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
-	return TCL_OUT_LINE_COMPILE;
+	return TCL_ERROR;
     }
 
     /*
-     * Find out if the condition is a constant. 
+     * Find out if the condition is a constant.
      */
 
     boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
     Tcl_IncrRefCount(boolObj);
     code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
-    Tcl_DecrRefCount(boolObj);
+    TclDecrRefCount(boolObj);
     if (code == TCL_OK) {
 	if (boolVal) {
 	    /*
-	     * it is an infinite loop 
+	     * It is an infinite loop; flag it so that we generate a more
+	     * efficient body.
 	     */
 
-	    loopMayEnd = 0;  
+	    loopMayEnd = 0;
 	} else {
 	    /*
-	     * This is an empty loop: "while 0 {...}" or such.
-	     * Compile no bytecodes.
+	     * This is an empty loop: "while 0 {...}" or such. Compile no
+	     * bytecodes.
 	     */
 
 	    goto pushResult;
 	}
     }
 
-    /* 
+    /*
      * Create a ExceptionRange record for the loop body. This is used to
      * implement break and continue.
      */
 
-    envPtr->exceptDepth++;
-    envPtr->maxExceptDepth =
-	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
 
     /*
      * Jump to the evaluation of the condition. This code uses the "loop
@@ -3110,31 +4772,26 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
 
     if (loopMayEnd) {
 	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
-	testCodeOffset = 0; /* avoid compiler warning */
+	testCodeOffset = 0;	/* Avoid compiler warning. */
     } else {
-	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	/*
+	 * Make sure that the first command in the body is preceded by an
+	 * INST_START_CMD, and hence counted properly. [Bug 1752146]
+	 */
+
+	envPtr->atCmdStart = 0;
+	testCodeOffset = CurrentOffset(envPtr);
     }
-    
 
     /*
      * Compile the loop body.
      */
 
     SetLineInformation (2);
-    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
-	    bodyTokenPtr->numComponents, envPtr);
+    bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
+    CompileBody(envPtr, bodyTokenPtr, interp);
+    ExceptionRangeEnds(envPtr, range);
     envPtr->currStackDepth = savedStackDepth + 1;
-    if (code != TCL_OK) {
-	if (code == TCL_ERROR) {
-	    sprintf(buffer, "\n    (\"while\" body line %d)",
-		    interp->errorLine);
-            Tcl_AddObjErrorInfo(interp, buffer, -1);
-        }
-	goto error;
-    }
-    envPtr->exceptArrayPtr[range].numCodeBytes =
-	    (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -3143,7 +4800,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
      */
 
     if (loopMayEnd) {
-	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	testCodeOffset = CurrentOffset(envPtr);
 	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
 	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
 	    bodyCodeOffset += 3;
@@ -3151,113 +4808,86 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
 	}
 	envPtr->currStackDepth = savedStackDepth;
 	SetLineInformation (1);
-	code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-	if (code != TCL_OK) {
-	    if (code == TCL_ERROR) {
-		Tcl_AddObjErrorInfo(interp,
-				    "\n    (\"while\" test expression)", -1);
-	    }
-	    goto error;
-	}
+	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 	envPtr->currStackDepth = savedStackDepth + 1;
-    
-	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+
+	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {
 	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
 	} else {
 	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
 	}
     } else {
-	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {
 	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
 	} else {
 	    TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
-	}	
+	}
     }
 
-
     /*
      * Set the loop's body, continue and break offsets.
      */
 
     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
     envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
-    envPtr->exceptArrayPtr[range].breakOffset =
-	    (envPtr->codeNext - envPtr->codeStart);
-    
+    ExceptionRangeTarget(envPtr, range, breakOffset);
+
     /*
      * The while command's result is an empty string.
      */
 
-    pushResult:
+  pushResult:
     envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
-    envPtr->exceptDepth--;
+    PushLiteral(envPtr, "", 0);
     return TCL_OK;
-
-    error:
-    envPtr->exceptDepth--;
-    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclPushVarName --
+ * PushVarName --
  *
- *	Procedure used in the compiling where pushing a variable name
- *	is necessary (append, lappend, set).
+ *	Procedure used in the compiling where pushing a variable name is
+ *	necessary (append, lappend, set).
  *
  * Results:
- *	The return value is a standard Tcl result, which is normally TCL_OK
- *	unless there was an error while parsing string. If an error occurs
- *	then the interpreter's result contains a standard error message.
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "set" command
- *	at runtime.
+ *	Instructions are added to envPtr to execute the "set" command at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
-#ifndef TCL_TIP280
-	simpleVarNamePtr, isScalarPtr)
-#else
-	simpleVarNamePtr, isScalarPtr, line, clNext)
-#endif
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Token *varTokenPtr;	/* Points to a variable token. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
-    int flags;			/* takes TCL_CREATE_VAR or
-				 * TCL_NO_LARGE_INDEX */
-    int *localIndexPtr;		/* must not be NULL */
-    int *simpleVarNamePtr;	/* must not be NULL */
-    int *isScalarPtr;		/* must not be NULL */
-#ifdef TCL_TIP280
-    int line;                   /* line the token starts on */
-    int* clNext;
-#endif
-{
-    register CONST char *p;
-    CONST char *name, *elName;
+PushVarName(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
+    CompileEnv *envPtr,		/* Holds resulting instructions. */
+    int flags,			/* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX. */
+    int *localIndexPtr,		/* Must not be NULL. */
+    int *simpleVarNamePtr,	/* Must not be NULL. */
+    int *isScalarPtr,		/* Must not be NULL. */
+    int line,                   /* Line the token starts on. */
+    int* clNext)                /* Reference to offset of next hidden cont. line */
+{
+    register const char *p;
+    const char *name, *elName;
     register int i, n;
-    int nameChars, elNameChars, simpleVarName, localIndex;
-    int code = TCL_OK;
-
     Tcl_Token *elemTokenPtr = NULL;
-    int elemTokenCount = 0;
-    int allocedTokens = 0;
-    int removedParen = 0;
+    int nameChars, elNameChars, simpleVarName, localIndex;
+    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;
 
     /*
-     * Decide if we can use a frame slot for the var/array name or if we
-     * need to emit code to compute and push the name at runtime. We use a
-     * frame slot (entry in the array of local vars) if we are compiling a
-     * procedure body and if the name is simple text that does not include
-     * namespace qualifiers. 
+     * Decide if we can use a frame slot for the var/array name or if we need
+     * to emit code to compute and push the name at runtime. We use a frame
+     * slot (entry in the array of local vars) if we are compiling a procedure
+     * body and if the name is simple text that does not include namespace
+     * qualifiers.
      */
 
     simpleVarName = 0;
@@ -3267,8 +4897,8 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 
     /*
      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-     * curly braces surround the variable name.
-     * This really matters for array elements to handle things like
+     * curly braces surround the variable name. This really matters for array
+     * elements to handle things like
      *    set {x($foo)} 5
      * which raises an undefined var error if we are not careful here.
      */
@@ -3279,31 +4909,33 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	 * A simple variable name. Divide it up into "name" and "elName"
 	 * strings. If it is not a local variable, look it up at runtime.
 	 */
+
 	simpleVarName = 1;
 
 	name = varTokenPtr[1].start;
 	nameChars = varTokenPtr[1].size;
-	if ( *(name + nameChars - 1) == ')') {
-	    /* 
+	if (name[nameChars-1] == ')') {
+	    /*
 	     * last char is ')' => potential array reference.
 	     */
 
-	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
+	    for (i=0,p=name ; i<nameChars ; i++,p++) {
 		if (*p == '(') {
 		    elName = p + 1;
 		    elNameChars = nameChars - i - 2;
-		    nameChars = i ;
+		    nameChars = i;
 		    break;
 		}
 	    }
 
 	    if ((elName != NULL) && elNameChars) {
 		/*
-		 * An array element, the element name is a simple
-		 * string: assemble the corresponding token.
+		 * An array element, the element name is a simple string:
+		 * assemble the corresponding token.
 		 */
 
-		elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
+		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
+			sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -3314,28 +4946,28 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	}
     } else if (((n = varTokenPtr->numComponents) > 1)
 	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+	    && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
 
-        /*
-	 * Check for parentheses inside first token
+	/*
+	 * Check for parentheses inside first token.
 	 */
 
-        simpleVarName = 0;
-        for (i = 0, p = varTokenPtr[1].start; 
-	     i < varTokenPtr[1].size; i++, p++) {
-            if (*p == '(') {
-                simpleVarName = 1;
-                break;
-            }
-        }
-        if (simpleVarName) {
+	simpleVarName = 0;
+	for (i = 0, p = varTokenPtr[1].start;
+		i < varTokenPtr[1].size; i++, p++) {
+	    if (*p == '(') {
+		simpleVarName = 1;
+		break;
+	    }
+	}
+	if (simpleVarName) {
 	    int remainingChars;
 
 	    /*
-	     * Check the last token: if it is just ')', do not count
-	     * it. Otherwise, remove the ')' and flag so that it is
-	     * restored at the end.
+	     * Check the last token: if it is just ')', do not count it.
+	     * Otherwise, remove the ')' and flag so that it is restored at
+	     * the end.
 	     */
 
 	    if (varTokenPtr[n].size == 1) {
@@ -3345,39 +4977,40 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 		removedParen = n;
 	    }
 
-            name = varTokenPtr[1].start;
-            nameChars = p - varTokenPtr[1].start;
-            elName = p + 1;
-            remainingChars = (varTokenPtr[2].start - p) - 1;
-            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+	    name = varTokenPtr[1].start;
+	    nameChars = p - varTokenPtr[1].start;
+	    elName = p + 1;
+	    remainingChars = (varTokenPtr[2].start - p) - 1;
+	    elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
 
 	    if (remainingChars) {
 		/*
-		 * Make a first token with the extra characters in the first 
+		 * Make a first token with the extra characters in the first
 		 * token.
 		 */
 
-		elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
+		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
+			n * sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
 		elemTokenPtr->size = remainingChars;
 		elemTokenPtr->numComponents = 0;
 		elemTokenCount = n;
-		
+
 		/*
 		 * Copy the remaining tokens.
 		 */
-		
-		memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
-		       ((n-1) * sizeof(Tcl_Token)));
+
+		memcpy(elemTokenPtr+1, varTokenPtr+2,
+			(n-1) * sizeof(Tcl_Token));
 	    } else {
 		/*
 		 * Use the already available tokens.
 		 */
-		
+
 		elemTokenPtr = &varTokenPtr[2];
-		elemTokenCount = n - 1;	    
+		elemTokenCount = n - 1;
 	    }
 	}
     }
@@ -3396,23 +5029,25 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	}
 
 	/*
-	 * Look up the var name's index in the array of local vars in the
-	 * proc frame. If retrieving the var's value and it doesn't already
-	 * exist, push its name and look it up at runtime.
+	 * Look up the var name's index in the array of local vars in the proc
+	 * frame. If retrieving the var's value and it doesn't already exist,
+	 * push its name and look it up at runtime.
 	 */
 
 	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
 	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    /*create*/ (flags & TCL_CREATE_VAR),
-                    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
+		    /*create*/ flags & TCL_CREATE_VAR,
 		    envPtr->procPtr);
 	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
-		/* we'll push the name */
+		/*
+		 * We'll push the name.
+		 */
+
 		localIndex = -1;
 	    }
 	}
 	if (localIndex < 0) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
+	    PushLiteral(envPtr, name, nameChars);
 	}
 
 	/*
@@ -3421,17 +5056,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 
 	if (elName != NULL) {
 	    if (elNameChars) {
-#ifdef TCL_TIP280
-	        envPtr->line   = line;
-	        envPtr->clNext = clNext;
-#endif
-		code = TclCompileTokens(interp, elemTokenPtr,
-                        elemTokenCount, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
+		envPtr->line = line;
+		envPtr->clNext = clNext;
+		TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
 	    } else {
-		TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+		PushLiteral(envPtr, "", 0);
 	    }
 	}
     } else {
@@ -3439,28 +5068,1406 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	 * The var name isn't simple: compile and push it.
 	 */
 
-#ifdef TCL_TIP280
-        envPtr->line   = line;
-        envPtr->clNext = clNext;
-#endif
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    goto done;
-	}
+	envPtr->line = line;
+	envPtr->clNext = clNext;
+	CompileTokens(envPtr, varTokenPtr, interp);
     }
 
-    done:
     if (removedParen) {
 	++varTokenPtr[removedParen].size;
     }
     if (allocedTokens) {
-        ckfree((char *) elemTokenPtr);
+	TclStackFree(interp, elemTokenPtr);
     }
-    *localIndexPtr	= localIndex;
-    *simpleVarNamePtr	= simpleVarName;
-    *isScalarPtr	= (elName == NULL);
-    return code;
+    *localIndexPtr = localIndex;
+    *simpleVarNamePtr = simpleVarName;
+    *isScalarPtr = (elName == NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileUnaryOpCmd --
+ *
+ *	Utility routine to compile the unary operator commands.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the compiled command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileUnaryOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    int instruction,
+    CompileEnv *envPtr)
+{
+    Tcl_Token *tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    TclEmitOpcode(instruction, envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileAssociativeBinaryOpCmd --
+ *
+ *	Utility routine to compile the binary operator commands that accept an
+ *	arbitrary number of arguments, and that are associative operations.
+ *	Because of the associativity, we may combine operations from right to
+ *	left, saving us any effort of re-ordering the arguments on the stack
+ *	after substitutions are completed.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the compiled command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileAssociativeBinaryOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    const char *identity,
+    int instruction,
+    CompileEnv *envPtr)
+{
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int words;
+
+    for (words=1 ; words<parsePtr->numWords ; words++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, words);
+    }
+    if (parsePtr->numWords <= 2) {
+	PushLiteral(envPtr, identity, -1);
+	words++;
+    }
+    if (words > 3) {
+	/*
+	 * Reverse order of arguments to get precise agreement with
+	 * [expr] in calcuations, including roundoff errors.
+	 */
+	TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+    }
+    while (--words > 1) {
+	TclEmitOpcode(instruction, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileStrictlyBinaryOpCmd --
+ *
+ *	Utility routine to compile the binary operator commands, that strictly
+ *	accept exactly two arguments.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the compiled command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileStrictlyBinaryOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    int instruction,
+    CompileEnv *envPtr)
+{
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr,
+	    NULL, instruction, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileComparisonOpCmd --
+ *
+ *	Utility routine to compile the n-ary comparison operator commands.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the compiled command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileComparisonOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    int instruction,
+    CompileEnv *envPtr)
+{
+    Tcl_Token *tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords < 3) {
+	PushLiteral(envPtr, "1", 1);
+    } else if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(parsePtr->tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 1);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	TclEmitOpcode(instruction, envPtr);
+    } else if (envPtr->procPtr == NULL) {
+	/*
+	 * No local variable space!
+	 */
+
+	return TCL_ERROR;
+    } else {
+	int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr->procPtr);
+	int words;
+
+	tokenPtr = TokenAfter(parsePtr->tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 1);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	if (tmpIndex <= 255) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
+	} else {
+	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
+	}
+	TclEmitOpcode(instruction, envPtr);
+	for (words=3 ; words<parsePtr->numWords ;) {
+	    if (tmpIndex <= 255) {
+		TclEmitInstInt1(INST_LOAD_SCALAR1, tmpIndex, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr);
+	    }
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, words);
+	    if (++words < parsePtr->numWords) {
+		if (tmpIndex <= 255) {
+		    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
+		}
+	    }
+	    TclEmitOpcode(instruction, envPtr);
+	}
+	for (; words>3 ; words--) {
+	    TclEmitOpcode(INST_BITAND, envPtr);
+	}
+
+	/*
+	 * Drop the value from the temp variable; retaining that reference
+	 * might be expensive elsewhere.
+	 */
+
+	PushLiteral(envPtr, "", 0);
+	if (tmpIndex <= 255) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
+	} else {
+	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompile*OpCmd --
+ *
+ *	Procedures called to compile the corresponding "::tcl::mathop::*"
+ *	commands. These are all wrappers around the utility operator command
+ *	compiler functions, except for the compilers for subtraction and
+ *	division, which are special.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the compiled command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInvertOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
+}
+
+int
+TclCompileNotOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
+}
+
+int
+TclCompileAddOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
+	    envPtr);
+}
+
+int
+TclCompileMulOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
+	    envPtr);
+}
+
+int
+TclCompileAndOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
+	    envPtr);
+}
+
+int
+TclCompileOrOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
+	    envPtr);
+}
+
+int
+TclCompileXorOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
+	    envPtr);
+}
+
+int
+TclCompilePowOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    /*
+     * This one has its own implementation because the ** operator is
+     * the only one with right associativity.
+     */
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int words;
+
+    for (words=1 ; words<parsePtr->numWords ; words++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, words);
+    }
+    if (parsePtr->numWords <= 2) {
+	PushLiteral(envPtr, "1", 1);
+	words++;
+    }
+    while (--words > 1) {
+	TclEmitOpcode(INST_EXPON, envPtr);
+    }
+    return TCL_OK;
+}
+
+int
+TclCompileLshiftOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
+}
+
+int
+TclCompileRshiftOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
+}
+
+int
+TclCompileModOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
+}
+
+int
+TclCompileNeqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
+}
+
+int
+TclCompileStrneqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
+}
+
+int
+TclCompileInOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
+}
+
+int
+TclCompileNiOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
+	    envPtr);
+}
+
+int
+TclCompileLessOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
+}
+
+int
+TclCompileLeqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
+}
+
+int
+TclCompileGreaterOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
+}
+
+int
+TclCompileGeqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
+}
+
+int
+TclCompileEqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
+}
+
+int
+TclCompileStreqOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
+}
+
+int
+TclCompileMinusOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int words;
+
+    if (parsePtr->numWords == 1) {
+	/* Fallback to direct eval to report syntax error */
+	return TCL_ERROR;
+    }
+    for (words=1 ; words<parsePtr->numWords ; words++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, words);
+    }
+    if (words == 2) {
+	TclEmitOpcode(INST_UMINUS, envPtr);
+	return TCL_OK;
+    }
+    if (words == 3) {
+	TclEmitOpcode(INST_SUB, envPtr);
+	return TCL_OK;
+    }
+    /*
+     * Reverse order of arguments to get precise agreement with
+     * [expr] in calcuations, including roundoff errors.
+     */
+    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+    while (--words > 1) {
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+	TclEmitOpcode(INST_SUB, envPtr);
+    }
+    return TCL_OK;
+}
+
+int
+TclCompileDivOpCmd(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)
+{
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int words;
+
+    if (parsePtr->numWords == 1) {
+	/* Fallback to direct eval to report syntax error */
+	return TCL_ERROR;
+    }
+    if (parsePtr->numWords == 2) {
+	PushLiteral(envPtr, "1.0", 3);
+    }
+    for (words=1 ; words<parsePtr->numWords ; words++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, words);
+    }
+    if (words <= 3) {
+	TclEmitOpcode(INST_DIV, envPtr);
+	return TCL_OK;
+    }
+    /*
+     * Reverse order of arguments to get precise agreement with
+     * [expr] in calcuations, including roundoff errors.
+     */
+    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+    while (--words > 1) {
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+	TclEmitOpcode(INST_DIV, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IndexTailVarIfKnown --
+ *
+ *	Procedure used in compiling [global] and [variable] commands. It
+ *	inspects the variable name described by varTokenPtr and, if the tail
+ *	is known at compile time, defines a corresponding local variable.
+ *
+ * Results:
+ * 	Returns the variable's index in the table of compiled locals if the
+ *      tail is known at compile time, or -1 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IndexTailVarIfKnown(
+    Tcl_Interp *interp,
+    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Obj *tailPtr;
+    const char *tailName, *p;
+    int len, n = varTokenPtr->numComponents;
+    Tcl_Token *lastTokenPtr;
+    int full, localIndex;
+
+    /*
+     * Determine if the tail is (a) known at compile time, and (b) not an
+     * array element. Should any of these fail, return an error so that
+     * the non-compiled command will be called at runtime.
+     * In order for the tail to be known at compile time, the last token
+     * in the word has to be constant and contain "::" if it is not the
+     * only one.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return -1;
+    }
+
+    TclNewObj(tailPtr);
+    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
+	full = 1;
+	lastTokenPtr = varTokenPtr;
+    } else {
+	full = 0;
+	lastTokenPtr = varTokenPtr + n;
+	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+    }
+
+    tailName = TclGetStringFromObj(tailPtr, &len);
+
+    if (len) {
+	if (*(tailName+len-1) == ')') {
+	    /*
+	     * Possible array: bail out
+	     */
+
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+
+	/*
+	 * Get the tail: immediately after the last '::'
+	 */
+
+	for(p = tailName + len -1; p > tailName; p--) {
+	    if ((*p == ':') && (*(p-1) == ':')) {
+		p++;
+		break;
+	    }
+	}
+	if (!full && (p == tailName)) {
+	    /*
+	     * No :: in the last component
+	     */
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+	len -= p - tailName;
+	tailName = p;
+    }
+
+    localIndex = TclFindCompiledLocal(tailName, len,
+	    /*create*/ TCL_CREATE_VAR,
+	    envPtr->procPtr);
+    Tcl_DecrRefCount(tailPtr);
+    return localIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileUpvarCmd --
+ *
+ *	Procedure called to compile the "upvar" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "upvar" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUpvarCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    if (envPtr->procPtr == NULL) {
+	Tcl_DecrRefCount(objPtr);
+	return TCL_ERROR;
+    }
+
+    numWords = parsePtr->numWords;
+    if (numWords < 3) {
+	Tcl_DecrRefCount(objPtr);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the frame index if it is known at compile time
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if(TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	CallFrame *framePtr;
+	Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;
+
+	/*
+	 * Attempt to convert to a level reference. Note that TclObjGetFrame
+	 * only changes the obj type when a conversion was successful.
+	 */
+
+	TclObjGetFrame(interp, objPtr, &framePtr);
+	newTypePtr = objPtr->typePtr;
+	Tcl_DecrRefCount(objPtr);
+
+	if (newTypePtr != typePtr) {
+	    if(numWords%2) {
+		return TCL_ERROR;
+	    }
+	    CompileWord(envPtr, tokenPtr, interp, 1);
+	    otherTokenPtr = TokenAfter(tokenPtr);
+	    i = 4;
+	} else {
+	    if(!(numWords%2)) {
+		return TCL_ERROR;
+	    }
+	    PushLiteral(envPtr, "1", 1);
+	    otherTokenPtr = tokenPtr;
+	    i = 3;
+	}
+    } else {
+	Tcl_DecrRefCount(objPtr);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+     * local variable, return an error so that the non-compiled command will
+     * be called at runtime.
+     */
+
+    for(; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
+	localTokenPtr = TokenAfter(otherTokenPtr);
+
+	CompileWord(envPtr, otherTokenPtr, interp, 1);
+	PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+			&localIndex, &simpleVarName, &isScalar, 1);
+
+	if((localIndex < 0) || !isScalar) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+    }
+
+    /*
+     * Pop the frame index, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNamespaceCmd --
+ *
+ *	Procedure called to compile the "namespace" command; currently, only
+ *	the subcommand "namespace upvar" is compiled to bytecodes.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "namespace upvar"
+ *      command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNamespaceCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Only compile [namespace upvar ...]: needs an odd number of args, >=5
+     */
+
+    numWords = parsePtr->numWords;
+    if (!(numWords%2) || (numWords < 5)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check if the second argument is "upvar"
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if ((tokenPtr->size != 5)  /* 5 == strlen("upvar") */
+	    || strncmp(tokenPtr->start, "upvar", 5)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the namespace
+     */
+
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+
+    /*
+     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+     * local variable, return an error so that the non-compiled command will
+     * be called at runtime.
+     */
+
+    localTokenPtr = tokenPtr;
+    for(i=4; i<=numWords; i+=2) {
+	otherTokenPtr = TokenAfter(localTokenPtr);
+	localTokenPtr = TokenAfter(otherTokenPtr);
+
+	CompileWord(envPtr, otherTokenPtr, interp, 1);
+	PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+			&localIndex, &simpleVarName, &isScalar, 1);
+
+	if((localIndex < 0) || !isScalar) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+    }
+
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileGlobalCmd --
+ *
+ *	Procedure called to compile the "global" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "global" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileGlobalCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *varTokenPtr;
+    int localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    numWords = parsePtr->numWords;
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * 'global' has no effect outside of proc bodies; handle that at runtime
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the namespace
+     */
+
+    PushLiteral(envPtr, "::", 2);
+
+    /*
+     * Loop over the variables.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for(i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if(localIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	CompileWord(envPtr, varTokenPtr, interp, 1);
+	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+    }
+
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ *	Procedure called to compile the "variable" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "variable" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileVariableCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    numWords = parsePtr->numWords;
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Bail out if not compiling a proc body
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Loop over the (var, value) pairs.
+     */
+
+    valueTokenPtr = parsePtr->tokenPtr;
+    for(i=2; i<=numWords; i+=2) {
+	varTokenPtr = TokenAfter(valueTokenPtr);
+	valueTokenPtr = TokenAfter(varTokenPtr);
+
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if(localIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	CompileWord(envPtr, varTokenPtr, interp, 1);
+	TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);
+
+	if (i != numWords) {
+	    /*
+	     * A value has been given: set the variable, pop the value
+	     */
+
+	    CompileWord(envPtr, valueTokenPtr, interp, 1);
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	    TclEmitOpcode(INST_POP, envPtr);
+	}
+    }
+
+    /*
+     * Set the result to empty
+     */
+
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileEnsemble --
+ *
+ *	Procedure called to compile an ensemble command. Note that most
+ *	ensembles are not compiled, since modifying a compiled ensemble causes
+ *	a invalidation of all existing bytecode (expensive!) which is not
+ *	normally warranted.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the subcommands of the
+ *	ensemble at runtime if a compile-time mapping is possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileEnsemble(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
+    Tcl_Parse synthetic;
+    int len, numBytes, result, flags = 0, i;
+    const char *word;
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	/*
+	 * Too hard.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    word = tokenPtr[1].start;
+    numBytes = tokenPtr[1].size;
+
+    /*
+     * There's a sporting chance we'll be able to compile this. But now we
+     * must check properly. To do that, check that we're compiling an ensemble
+     * that has a compilable command as its appropriate subcommand.
+     */
+
+    if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
+	    || mapObj == NULL) {
+	/*
+	 * Either not an ensemble or a mapping isn't installed. Crud. Too hard
+	 * to proceed.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Next, get the flags. We need them on several code paths.
+     */
+
+    (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);
+
+    /*
+     * Check to see if there's also a subcommand list; must check to see if
+     * the subcommand we are calling is in that list if it exists, since that
+     * list filters the entries in the map.
+     */
+
+    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
+    if (listObj != NULL) {
+	int sclen;
+	const char *str;
+	Tcl_Obj *matchObj = NULL;
+
+	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	for (i=0 ; i<len ; i++) {
+	    str = Tcl_GetStringFromObj(elems[i], &sclen);
+	    if (sclen==numBytes && !memcmp(word, str, (unsigned) numBytes)) {
+		/*
+		 * Exact match! Excellent!
+		 */
+
+		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
+		if (result != TCL_OK || targetCmdObj == NULL) {
+		    return TCL_ERROR;
+		}
+		goto doneMapLookup;
+	    }
+
+	    /*
+	     * Check to see if we've got a prefix match. A single prefix match
+	     * is fine, and allows us to refine our dictionary lookup, but
+	     * multiple prefix matches is a Bad Thing and will prevent us from
+	     * making progress. Note that we cannot do the lookup immediately
+	     * in the prefix case; might be another entry later in the list
+	     * that causes things to fail.
+	     */
+
+	    if ((flags & TCL_ENSEMBLE_PREFIX)
+		    && strncmp(word, str, (unsigned) numBytes) == 0) {
+		if (matchObj != NULL) {
+		    return TCL_ERROR;
+		}
+		matchObj = elems[i];
+	    }
+	}
+	if (matchObj != NULL) {
+	    result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
+	    if (result != TCL_OK || targetCmdObj == NULL) {
+		return TCL_ERROR;
+	    }
+	    goto doneMapLookup;
+	}
+	return TCL_ERROR;
+    } else {
+	/*
+	 * No map, so check the dictionary directly.
+	 */
+
+	TclNewStringObj(subcmdObj, word, numBytes);
+	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
+	TclDecrRefCount(subcmdObj);
+	if (result == TCL_OK && targetCmdObj != NULL) {
+	    /*
+	     * Got it. Skip the fiddling around with prefixes.
+	     */
+
+	    goto doneMapLookup;
+	}
+
+	/*
+	 * We've not literally got a valid subcommand. But maybe we have a
+	 * prefix. Check if prefix matches are allowed.
+	 */
+
+	if (flags & TCL_ENSEMBLE_PREFIX) {
+	    Tcl_DictSearch s;
+	    int done, matched;
+	    Tcl_Obj *tmpObj;
+
+	    /*
+	     * Iterate over the keys in the dictionary, checking to see if
+	     * we're a prefix.
+	     */
+
+	    Tcl_DictObjFirst(NULL,mapObj,&s,&subcmdObj,&tmpObj,&done);
+	    matched = 0;
+	    while (!done) {
+		if (strncmp(TclGetString(subcmdObj), word,
+			(unsigned) numBytes) == 0) {
+		    if (matched++) {
+			/*
+			 * Must have matched twice! Not unique, so no point
+			 * looking further.
+			 */
+
+			break;
+		    }
+		    targetCmdObj = tmpObj;
+		}
+		Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
+	    }
+	    Tcl_DictObjDone(&s);
+
+	    /*
+	     * If we have anything other than a single match, we've failed the
+	     * unique prefix check.
+	     */
+
+	    if (matched != 1) {
+		return TCL_ERROR;
+	    }
+	} else {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * OK, we definitely map to something. But what?
+     *
+     * The command we map to is the first word out of the map element. Note
+     * that we also reject dealing with multi-element rewrites if we are in a
+     * safe interpreter, as there is otherwise a (highly gnarly!) way to make
+     * Tcl crash open to exploit.
+     */
+
+  doneMapLookup:
+    if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (len > 1 && Tcl_IsSafe(interp)) {
+	return TCL_ERROR;
+    }
+    targetCmdObj = elems[0];
+
+    Tcl_IncrRefCount(targetCmdObj);
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+    TclDecrRefCount(targetCmdObj);
+    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
+	    || cmdPtr->flags & CMD_HAS_EXEC_TRACES
+	    || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
+	/*
+	 * Maps to an undefined command or a command without a compiler.
+	 * Cannot compile.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now we've done the mapping process, can now actually try to compile.
+     * We do this by handing off to the subcommand's actual compiler. But to
+     * do that, we have to perform some trickery to rewrite the arguments.
+     */
+
+    TclParseInit(interp, NULL, 0, &synthetic);
+    synthetic.numWords = parsePtr->numWords - 2 + len;
+    TclGrowParseTokenArray(&synthetic, 2*len);
+    synthetic.numTokens = 2*len;
+
+    /*
+     * Now we have the space to work in, install something rewritten. Note
+     * that we are here praying for all our might that none of these words are
+     * a script; the error detection code will crash if that happens and there
+     * is nothing we can do to avoid it!
+     */
+
+    for (i=0 ; i<len ; i++) {
+	int sclen;
+	const char *str = Tcl_GetStringFromObj(elems[i], &sclen);
+
+	synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD;
+	synthetic.tokenPtr[2*i].start = str;
+	synthetic.tokenPtr[2*i].size = sclen;
+	synthetic.tokenPtr[2*i].numComponents = 1;
+
+	synthetic.tokenPtr[2*i+1].type = TCL_TOKEN_TEXT;
+	synthetic.tokenPtr[2*i+1].start = str;
+	synthetic.tokenPtr[2*i+1].size = sclen;
+	synthetic.tokenPtr[2*i+1].numComponents = 0;
+    }
+
+    /*
+     * Copy over the real argument tokens.
+     */
+
+    for (i=len; i<synthetic.numWords; i++) {
+	int toCopy;
+	tokenPtr = TokenAfter(tokenPtr);
+	toCopy = tokenPtr->numComponents + 1;
+	TclGrowParseTokenArray(&synthetic, toCopy);
+	memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
+		sizeof(Tcl_Token) * toCopy);
+	synthetic.numTokens += toCopy;
+    }
+
+    /*
+     * Hand off compilation to the subcommand compiler. At last!
+     */
+
+    result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
+
+    /*
+     * Clean up if necessary.
+     */
+
+    Tcl_FreeParse(&synthetic);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileInfoExistsCmd --
+ *
+ *	Procedure called to compile the "info exists" subcommand.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "info exists"
+ *	subcommand at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInfoExistsCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int isScalar, simpleVarName, localIndex;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Decide if we can use a frame slot for the var/array name or if we need
+     * to emit code to compute and push the name at runtime. We use a frame
+     * slot (entry in the array of local vars) if we are compiling a procedure
+     * body and if the name is simple text that does not include namespace
+     * qualifiers.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+		    &simpleVarName, &isScalar, 1);
+
+    /*
+     * Emit instruction to check the variable for existence.
+     */
+
+    if (simpleVarName) {
+	if (isScalar) {
+	    if (localIndex < 0) {
+		TclEmitOpcode(INST_EXIST_STK, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_EXIST_SCALAR, localIndex, envPtr);
+	    }
+	} else {
+	    if (localIndex < 0) {
+		TclEmitOpcode(INST_EXIST_ARRAY_STK, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_EXIST_ARRAY, localIndex, envPtr);
+	    }
+	}
+    } else {
+	TclEmitOpcode(INST_EXIST_STK, envPtr);
+    }
+
+    return TCL_OK;
 }
 
 /*
@@ -3470,4 +6477,3 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 6bac221..9142e2b 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1,578 +1,2020 @@
-/* 
+/*
  * tclCompExpr.c --
  *
- *	This file contains the code to compile Tcl expressions.
+ *	This file contains the code to parse and compile Tcl expressions
+ *	and implementations of the Tcl commands corresponding to expression
+ *	operators, such as the command ::tcl::mathop::+ .
  *
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclCompile.h"
+#include "tclCompile.h"		/* CompileEnv */
 
 /*
- * 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 arrange to use
- * the errno from tclExecute.c here.
+ * Expression parsing takes place in the routine ParseExpr().  It takes a
+ * string as input, parses that string, and generates a representation of
+ * the expression in the form of a tree of operators, a list of literals,
+ * a list of function names, and an array of Tcl_Token's within a Tcl_Parse
+ * struct.  The tree is composed of OpNodes.
  */
 
-#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#else
-#define NO_ERRNO_H
-#endif
+typedef struct OpNode {
+    int left;			/* "Pointer" to the left operand. */
+    int right;			/* "Pointer" to the right operand. */
+    union {
+	int parent;		/* "Pointer" to the parent operand. */
+	int prev;		/* "Pointer" joining incomplete tree stack */
+    } p;
+    unsigned char lexeme;	/* Code that identifies the operator. */
+    unsigned char precedence;	/* Precedence of the operator */
+    unsigned char mark;		/* Mark used to control traversal. */
+    unsigned char constant;	/* Flag marking constant subexpressions. */
+} OpNode;
+
+/*
+ * The storage for the tree is dynamically allocated array of OpNodes.  The
+ * array is grown as parsing needs dictate according to a scheme similar to
+ * Tcl's string growth algorithm, so that the resizing costs are O(N) and so
+ * that we use at least half the memory allocated as expressions get large.
+ *
+ * Each OpNode in the tree represents an operator in the expression, either
+ * unary or binary.  When parsing is completed successfully, a binary operator
+ * OpNode will have its left and right fields filled with "pointers" to its
+ * left and right operands.  A unary operator OpNode will have its right field
+ * filled with a pointer to its single operand.  When an operand is a
+ * subexpression the "pointer" takes the form of the index -- a non-negative
+ * integer -- into the OpNode storage array where the root of that
+ * subexpression parse tree is found.
+ *
+ * Non-operator elements of the expression do not get stored in the OpNode
+ * tree.  They are stored in the other structures according to their type.
+ * Literal values get appended to the literal list.  Elements that denote
+ * forms of quoting or substitution known to the Tcl parser get stored as
+ * Tcl_Tokens.  These non-operator elements of the expression are the
+ * leaves of the completed parse tree.  When an operand of an OpNode is
+ * one of these leaf elements, the following negative integer codes are used
+ * to indicate which kind of elements it is.
+ */
 
-#ifdef NO_ERRNO_H
-extern int errno;			/* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
+enum OperandTypes {
+    OT_LITERAL = -3,	/* Operand is a literal in the literal list */
+    OT_TOKENS = -2,	/* Operand is sequence of Tcl_Tokens */
+    OT_EMPTY = -1	/* "Operand" is an empty string.  This is a
+			 * special case used only to represent the
+			 * EMPTY lexeme.  See below. */
+};
 
 /*
- * Boolean variable that controls whether expression compilation tracing
- * is enabled.
+ * Readable macros to test whether a "pointer" value points to an operator.
+ * They operate on the "non-negative integer -> operator; negative integer ->
+ * a non-operator OperandType" distinction.
  */
 
-#ifdef TCL_COMPILE_DEBUG
-static int traceExprComp = 0;
-#endif /* TCL_COMPILE_DEBUG */
+#define IsOperator(l)	((l) >= 0)
+#define NotOperator(l)	((l) < 0)
 
 /*
- * The ExprInfo structure describes the state of compiling an expression.
- * A pointer to an ExprInfo record is passed among the routines in
- * this module.
+ * Note that it is sufficient to store in the tree just the type of leaf
+ * operand, without any explicit pointer to which leaf.  This is true because
+ * the traversals of the completed tree we perform are known to visit
+ * the leaves in the same order as the original parse.
+ *
+ * In a completed parse tree, those OpNodes that are themselves (roots of
+ * subexpression trees that are) operands of some operator store in their
+ * p.parent field a "pointer" to the OpNode of that operator.  The p.parent
+ * field permits a traversal of the tree within a * non-recursive routine
+ * (ConvertTreeToTokens() and CompileExprTree()).  This means that even
+ * expression trees of great depth pose no risk of blowing the C stack.
+ *
+ * While the parse tree is being constructed, the same memory space is used
+ * to hold the p.prev field which chains together a stack of incomplete
+ * trees awaiting their right operands.
+ *
+ * The lexeme field is filled in with the lexeme of the operator that is
+ * returned by the ParseLexeme() routine.  Only lexemes for unary and
+ * binary operators get stored in an OpNode.  Other lexmes get different
+ * treatement.
+ *
+ * The precedence field provides a place to store the precedence of the
+ * operator, so it need not be looked up again and again.
+ *
+ * The mark field is use to control the traversal of the tree, so
+ * that it can be done non-recursively.  The mark values are:
  */
 
-typedef struct ExprInfo {
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Parse *parsePtr;	/* Structure filled with information about
-				 * the parsed expression. */
-    CONST char *expr;		/* The expression that was originally passed
-				 * to TclCompileExpr. */
-    CONST char *lastChar;	/* Points just after last byte of expr. */
-    int hasOperators;		/* Set 1 if the expr has operators; 0 if
-				 * expr is only a primary. If 1 after
-				 * compiling an expr, a tryCvtToNumeric
-				 * instruction is emitted to convert the
-				 * primary to a number if possible. */
-} ExprInfo;
+enum Marks {
+    MARK_LEFT,		/* Next step of traversal is to visit left subtree */
+    MARK_RIGHT,		/* Next step of traversal is to visit right subtree */
+    MARK_PARENT		/* Next step of traversal is to return to parent */
+};
 
 /*
- * Definitions of numeric codes representing each expression operator.
- * The order of these must match the entries in the operatorTable below.
- * Also the codes for the relational operators (OP_LESS, OP_GREATER, 
- * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.
- * Note that OP_PLUS and OP_MINUS represent both unary and binary operators.
+ * The constant field is a boolean flag marking which subexpressions are
+ * completely known at compile time, and are eligible for computing then
+ * rather than waiting until run time.
  */
 
-#define OP_MULT		0
-#define OP_DIVIDE	1
-#define OP_MOD		2
-#define OP_PLUS		3
-#define OP_MINUS	4
-#define OP_LSHIFT	5
-#define OP_RSHIFT	6
-#define OP_LESS		7
-#define OP_GREATER	8
-#define OP_LE		9
-#define OP_GE		10
-#define OP_EQ		11
-#define OP_NEQ		12
-#define OP_BITAND	13
-#define OP_BITXOR	14
-#define OP_BITOR	15
-#define OP_LAND		16
-#define OP_LOR		17
-#define OP_QUESTY	18
-#define OP_LNOT		19
-#define OP_BITNOT	20
-#define OP_STREQ	21
-#define OP_STRNEQ	22
+/*
+ * Each lexeme belongs to one of four categories, which determine
+ * its place in the parse tree.  We use the two high bits of the
+ * (unsigned char) value to store a NODE_TYPE code.
+ */
+
+#define NODE_TYPE	0xC0
+
+/*
+ * The four category values are LEAF, UNARY, and BINARY, explained below,
+ * and "uncategorized", which is used either temporarily, until context
+ * determines which of the other three categories is correct, or for
+ * lexemes like INVALID, which aren't really lexemes at all, but indicators
+ * of a parsing error.  Note that the codes must be distinct to distinguish
+ * categories, but need not take the form of a bit array.
+ */
 
+#define BINARY		0x40	/* This lexeme is a binary operator.  An
+				 * OpNode representing it should go into the
+				 * parse tree, and two operands should be
+				 * parsed for it in the expression.  */
+#define UNARY		0x80	/* This lexeme is a unary operator.  An OpNode
+				 * representing it should go into the parse
+				 * tree, and one operand should be parsed for
+				 * it in the expression. */
+#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
+				 * tree.  No OpNode will be placed in the tree
+				 * for it.  Either a literal value will be
+				 * appended to the list of literals in this
+				 * expression, or appropriate Tcl_Tokens will
+				 * be appended in a Tcl_Parse struct to
+				 * represent those leaves that require some
+				 * form of substitution.
+				 */
+
+/* Uncategorized lexemes */
+
+#define PLUS		1	/* Ambiguous.  Resolves to UNARY_PLUS or
+				 * BINARY_PLUS according to context. */
+#define MINUS		2	/* Ambiguous.  Resolves to UNARY_MINUS or
+				 * BINARY_MINUS according to context. */
+#define BAREWORD	3	/* Ambigous.  Resolves to BOOLEAN or to
+				 * FUNCTION or a parse error according to
+				 * context and value. */
+#define INCOMPLETE	4	/* A parse error.  Used only when the single
+				 * "=" is encountered.  */
+#define INVALID		5	/* A parse error.  Used when any punctuation
+				 * appears that's not a supported operator. */
+
+/* Leaf lexemes */
+
+#define NUMBER		( LEAF | 1)	/* For literal numbers */
+#define SCRIPT		( LEAF | 2)	/* Script substitution; [foo] */
+#define BOOLEAN		( LEAF | BAREWORD)	/* For literal booleans */
+#define BRACED		( LEAF | 4)	/* Braced string; {foo bar} */
+#define VARIABLE	( LEAF | 5)	/* Variable substitution; $x */
+#define QUOTED		( LEAF | 6)	/* Quoted string; "foo $bar [soom]" */
+#define EMPTY		( LEAF | 7)	/* Used only for an empty argument
+					 * list to a function.  Represents
+					 * the empty string within parens in
+					 * the expression: rand() */
+
+/* Unary operator lexemes */
+
+#define UNARY_PLUS	( UNARY | PLUS)
+#define UNARY_MINUS	( UNARY | MINUS)
+#define FUNCTION	( UNARY | BAREWORD)	/* This is a bit of "creative
+					 * interpretation" on the part of the
+					 * parser.  A function call is parsed
+					 * into the parse tree according to
+					 * the perspective that the function
+					 * name is a unary operator and its
+					 * argument list, enclosed in parens,
+					 * is its operand.  The additional
+					 * requirements not implied generally
+					 * by treatment as a unary operator --
+					 * for example, the requirement that
+					 * the operand be enclosed in parens --
+					 * are hard coded in the relevant
+					 * portions of ParseExpr().  We trade
+					 * off the need to include such
+					 * exceptional handling in the code
+					 * against the need we would otherwise
+					 * have for more lexeme categories. */
+#define START		( UNARY | 4)	/* This lexeme isn't parsed from the
+					 * expression text at all.  It
+					 * represents the start of the
+					 * expression and sits at the root of
+					 * the parse tree where it serves as
+					 * the start/end point of traversals. */
+#define OPEN_PAREN	( UNARY | 5)	/* Another bit of creative
+					 * interpretation, where we treat "("
+					 * as a unary operator with the
+					 * sub-expression between it and its
+					 * matching ")" as its operand. See
+					 * CLOSE_PAREN below. */
+#define NOT		( UNARY | 6)
+#define BIT_NOT		( UNARY | 7)
+
+/* Binary operator lexemes */
+
+#define BINARY_PLUS	( BINARY |  PLUS)
+#define BINARY_MINUS	( BINARY |  MINUS)
+#define COMMA		( BINARY |  3)	/* The "," operator is a low precedence
+					 * binary operator that separates the
+					 * arguments in a function call.  The
+					 * additional constraint that this
+					 * operator can only legally appear
+					 * at the right places within a
+					 * function call argument list are
+					 * hard coded within ParseExpr().  */
+#define MULT		( BINARY |  4)
+#define DIVIDE		( BINARY |  5)
+#define MOD		( BINARY |  6)
+#define LESS		( BINARY |  7)
+#define GREATER		( BINARY |  8)
+#define BIT_AND		( BINARY |  9)
+#define BIT_XOR		( BINARY | 10)
+#define BIT_OR		( BINARY | 11)
+#define QUESTION	( BINARY | 12)	/* These two lexemes make up the */
+#define COLON		( BINARY | 13)	/* ternary conditional operator,
+					 * $x ? $y : $z .  We treat them as
+					 * two binary operators to avoid
+					 * another lexeme category, and
+					 * code the additional constraints
+					 * directly in ParseExpr().  For
+					 * instance, the right operand of
+					 * a "?" operator must be a ":"
+					 * operator. */
+#define LEFT_SHIFT	( BINARY | 14)
+#define RIGHT_SHIFT	( BINARY | 15)
+#define LEQ		( BINARY | 16)
+#define GEQ		( BINARY | 17)
+#define EQUAL		( BINARY | 18)
+#define NEQ		( BINARY | 19)
+#define AND		( BINARY | 20)
+#define OR		( BINARY | 21)
+#define STREQ		( BINARY | 22)
+#define STRNEQ		( BINARY | 23)
+#define EXPON		( BINARY | 24)	/* Unlike the other binary operators,
+					 * EXPON is right associative and this
+					 * distinction is coded directly in
+					 * ParseExpr(). */
+#define IN_LIST		( BINARY | 25)
+#define NOT_IN_LIST	( BINARY | 26)
+#define CLOSE_PAREN	( BINARY | 27)	/* By categorizing the CLOSE_PAREN
+					 * lexeme as a BINARY operator, the
+					 * normal parsing rules for binary
+					 * operators assure that a close paren
+					 * will not directly follow another
+					 * operator, and the machinery already
+					 * in place to connect operands to
+					 * operators according to precedence
+					 * performs most of the work of
+					 * matching open and close parens for
+					 * us.  In the end though, a close
+					 * paren is not really a binary
+					 * operator, and some special coding
+					 * in ParseExpr() make sure we never
+					 * put an actual CLOSE_PAREN node
+					 * in the parse tree.   The
+					 * sub-expression between parens
+					 * becomes the single argument of
+					 * the matching OPEN_PAREN unary
+					 * operator. */
+#define END		( BINARY | 28)	/* This lexeme represents the end of
+					 * the string being parsed.  Treating
+					 * it as a binary operator follows the
+					 * same logic as the CLOSE_PAREN lexeme
+					 * and END pairs with START, in the
+					 * same way that CLOSE_PAREN pairs with
+					 * OPEN_PAREN. */
 /*
- * Table describing the expression operators. Entries in this table must
- * correspond to the definitions of numeric codes for operators just above.
+ * When ParseExpr() builds the parse tree it must choose which operands to
+ * connect to which operators.  This is done according to operator precedence.
+ * The greater an operator's precedence the greater claim it has to link to
+ * an available operand.  The Precedence enumeration lists the precedence
+ * values used by Tcl expression operators, from lowest to highest claim.
+ * Each precedence level is commented with the operators that hold that
+ * precedence.
  */
 
-static int opTableInitialized = 0; /* 0 means not yet initialized. */
-
-TCL_DECLARE_MUTEX(opMutex)
-
-typedef struct OperatorDesc {
-    CONST char *name;			/* Name of the operator. */
-    int numOperands;		/* Number of operands. 0 if the operator
-				 * requires special handling. */
-    int instruction;		/* Instruction opcode for the operator.
-				 * Ignored if numOperands is 0. */
-} OperatorDesc;
-
-static CONST OperatorDesc operatorTable[] = {
-    {"*",   2,  INST_MULT},
-    {"/",   2,  INST_DIV},
-    {"%",   2,  INST_MOD},
-    {"+",   0,  0},
-    {"-",   0,  0},
-    {"<<",  2,  INST_LSHIFT},
-    {">>",  2,  INST_RSHIFT},
-    {"<",   2,  INST_LT},
-    {">",   2,  INST_GT},
-    {"<=",  2,  INST_LE},
-    {">=",  2,  INST_GE},
-    {"==",  2,  INST_EQ},
-    {"!=",  2,  INST_NEQ},
-    {"&",   2,  INST_BITAND},
-    {"^",   2,  INST_BITXOR},
-    {"|",   2,  INST_BITOR},
-    {"&&",  0,  0},
-    {"||",  0,  0},
-    {"?",   0,  0},
-    {"!",   1,  INST_LNOT},
-    {"~",   1,  INST_BITNOT},
-    {"eq",  2,  INST_STR_EQ},
-    {"ne",  2,  INST_STR_NEQ},
-    {NULL,  0,  0}
+enum Precedence {
+    PREC_END = 1,	/* END */
+    PREC_START,		/* START */
+    PREC_CLOSE_PAREN,	/* ")" */
+    PREC_OPEN_PAREN,	/* "(" */
+    PREC_COMMA,		/* "," */
+    PREC_CONDITIONAL,	/* "?", ":" */
+    PREC_OR,		/* "||" */
+    PREC_AND,		/* "&&" */
+    PREC_BIT_OR,	/* "|" */
+    PREC_BIT_XOR,	/* "^" */
+    PREC_BIT_AND,	/* "&" */
+    PREC_EQUAL,		/* "==", "!=", "eq", "ne", "in", "ni" */
+    PREC_COMPARE,	/* "<", ">", "<=", ">=" */
+    PREC_SHIFT,		/* "<<", ">>" */
+    PREC_ADD,		/* "+", "-" */
+    PREC_MULT,		/* "*", "/", "%" */
+    PREC_EXPON,		/* "**" */
+    PREC_UNARY		/* "+", "-", FUNCTION, "!", "~" */
 };
 
 /*
- * Hashtable used to map the names of expression operators to the index
- * of their OperatorDesc description.
+ * Here the same information contained in the comments above is stored
+ * in inverted form, so that given a lexeme, one can quickly look up
+ * its precedence value.
  */
 
-static Tcl_HashTable opHashTable;
+static const unsigned char prec[] = {
+    /* Non-operator lexemes */
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,
+    /* Binary operator lexemes */
+    PREC_ADD,		/* BINARY_PLUS */
+    PREC_ADD,		/* BINARY_MINUS */
+    PREC_COMMA,		/* COMMA */
+    PREC_MULT,		/* MULT */
+    PREC_MULT,		/* DIVIDE */
+    PREC_MULT,		/* MOD */
+    PREC_COMPARE,	/* LESS */
+    PREC_COMPARE,	/* GREATER */
+    PREC_BIT_AND,	/* BIT_AND */
+    PREC_BIT_XOR,	/* BIT_XOR */
+    PREC_BIT_OR,	/* BIT_OR */
+    PREC_CONDITIONAL,	/* QUESTION */
+    PREC_CONDITIONAL,	/* COLON */
+    PREC_SHIFT,		/* LEFT_SHIFT */
+    PREC_SHIFT,		/* RIGHT_SHIFT */
+    PREC_COMPARE,	/* LEQ */
+    PREC_COMPARE,	/* GEQ */
+    PREC_EQUAL,		/* EQUAL */
+    PREC_EQUAL,		/* NEQ */
+    PREC_AND,		/* AND */
+    PREC_OR,		/* OR */
+    PREC_EQUAL,		/* STREQ */
+    PREC_EQUAL,		/* STRNEQ */
+    PREC_EXPON,		/* EXPON */
+    PREC_EQUAL,		/* IN_LIST */
+    PREC_EQUAL,		/* NOT_IN_LIST */
+    PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
+    PREC_END,		/* END */
+    /* Expansion room for more binary operators */
+    0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,
+    /* Unary operator lexemes */
+    PREC_UNARY,		/* UNARY_PLUS */
+    PREC_UNARY,		/* UNARY_MINUS */
+    PREC_UNARY,		/* FUNCTION */
+    PREC_START,		/* START */
+    PREC_OPEN_PAREN,	/* OPEN_PAREN */
+    PREC_UNARY,		/* NOT*/
+    PREC_UNARY,		/* BIT_NOT*/
+};
 
 /*
- * Declarations for local procedures to this file:
+ * A table mapping lexemes to bytecode instructions, used by CompileExprTree().
  */
 
-static int		CompileCondExpr _ANSI_ARGS_((
-			    Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
-			    CompileEnv *envPtr, Tcl_Token **endPtrPtr));
-static int		CompileLandOrLorExpr _ANSI_ARGS_((
-			    Tcl_Token *exprTokenPtr, int opIndex,
-			    ExprInfo *infoPtr, CompileEnv *envPtr,
-			    Tcl_Token **endPtrPtr));
-static int		CompileMathFuncCall _ANSI_ARGS_((
-			    Tcl_Token *exprTokenPtr, CONST char *funcName,
-			    ExprInfo *infoPtr, CompileEnv *envPtr,
-			    Tcl_Token **endPtrPtr));
-static int		CompileSubExpr _ANSI_ARGS_((
-			    Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
-			    CompileEnv *envPtr));
-static void		LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
+static const unsigned char instruction[] = {
+    /* Non-operator lexemes */
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,
+    /* Binary operator lexemes */
+    INST_ADD,		/* BINARY_PLUS */
+    INST_SUB,		/* BINARY_MINUS */
+    0,			/* COMMA */
+    INST_MULT,		/* MULT */
+    INST_DIV,		/* DIVIDE */
+    INST_MOD,		/* MOD */
+    INST_LT,		/* LESS */
+    INST_GT,		/* GREATER */
+    INST_BITAND,	/* BIT_AND */
+    INST_BITXOR,	/* BIT_XOR */
+    INST_BITOR,		/* BIT_OR */
+    0,			/* QUESTION */
+    0,			/* COLON */
+    INST_LSHIFT,	/* LEFT_SHIFT */
+    INST_RSHIFT,	/* RIGHT_SHIFT */
+    INST_LE,		/* LEQ */
+    INST_GE,		/* GEQ */
+    INST_EQ,		/* EQUAL */
+    INST_NEQ,		/* NEQ */
+    0,			/* AND */
+    0,			/* OR */
+    INST_STR_EQ,	/* STREQ */
+    INST_STR_NEQ,	/* STRNEQ */
+    INST_EXPON,		/* EXPON */
+    INST_LIST_IN,	/* IN_LIST */
+    INST_LIST_NOT_IN,	/* NOT_IN_LIST */
+    0,			/* CLOSE_PAREN */
+    0,			/* END */
+    /* Expansion room for more binary operators */
+    0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
+    0,
+    /* Unary operator lexemes */
+    INST_UPLUS,		/* UNARY_PLUS */
+    INST_UMINUS,	/* UNARY_MINUS */
+    0,			/* FUNCTION */
+    0,			/* START */
+    0,			/* OPEN_PAREN */
+    INST_LNOT,		/* NOT*/
+    INST_BITNOT,	/* BIT_NOT*/
+};
 
 /*
- * Macro used to debug the execution of the expression compiler.
+ * A table mapping a byte value to the corresponding lexeme for use by
+ * ParseLexeme().
  */
 
-#ifdef TCL_COMPILE_DEBUG
-#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
-    if (traceExprComp) { \
-	fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
-	        (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
-    }
-#else
-#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
-#endif /* TCL_COMPILE_DEBUG */
+static const unsigned char Lexeme[] = {
+	INVALID		/* NUL */,	INVALID		/* SOH */,
+	INVALID		/* STX */,	INVALID		/* ETX */,
+	INVALID		/* EOT */,	INVALID		/* ENQ */,
+	INVALID		/* ACK */,	INVALID		/* BEL */,
+	INVALID		/* BS */,	INVALID		/* HT */,
+	INVALID		/* LF */,	INVALID		/* VT */,
+	INVALID		/* FF */,	INVALID		/* CR */,
+	INVALID		/* SO */,	INVALID		/* SI */,
+	INVALID		/* DLE */,	INVALID		/* DC1 */,
+	INVALID		/* DC2 */,	INVALID		/* DC3 */,
+	INVALID		/* DC4 */,	INVALID		/* NAK */,
+	INVALID		/* SYN */,	INVALID		/* ETB */,
+	INVALID		/* CAN */,	INVALID		/* EM */,
+	INVALID		/* SUB */,	INVALID		/* ESC */,
+	INVALID		/* FS */,	INVALID		/* GS */,
+	INVALID		/* RS */,	INVALID		/* US */,
+	INVALID		/* SPACE */,	0 		/* ! or != */,
+	QUOTED		/* " */,	INVALID		/* # */,
+	VARIABLE	/* $ */,	MOD		/* % */,
+	0		/* & or && */,	INVALID		/* ' */,
+	OPEN_PAREN	/* ( */,	CLOSE_PAREN	/* ) */,
+	0		/* * or ** */,	PLUS		/* + */,
+	COMMA		/* , */,	MINUS		/* - */,
+	0		/* . */,	DIVIDE		/* / */,
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */
+	COLON		/* : */,	INVALID		/* ; */,
+	0		/* < or << or <= */,
+	0		/* == or INVALID */,
+	0		/* > or >> or >= */,
+	QUESTION	/* ? */,	INVALID		/* @ */,
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* A-M */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* N-Z */
+	SCRIPT		/* [ */,	INVALID		/* \ */,
+	INVALID		/* ] */,	BIT_XOR		/* ^ */,
+	INVALID		/* _ */,	INVALID		/* ` */,
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* a-m */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* n-z */
+	BRACED		/* { */,	0		/* | or || */,
+	INVALID		/* } */,	BIT_NOT		/* ~ */,
+	INVALID		/* DEL */
+};
+
+/*
+ * The JumpList struct is used to create a stack of data needed for the
+ * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
+ * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
+ * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
+ */
+
+typedef struct JumpList {
+    JumpFixup jump;		/* Pass this argument to matching calls of
+				 * TclEmitForwardJump() and
+				 * TclFixupForwardJump(). */
+    int depth;			/* Remember the currStackDepth of the
+				 * CompileEnv here. */
+    int offset;			/* Data used to compute jump lengths to pass
+				 * to TclFixupForwardJump() */
+    int convert;		/* Temporary storage used to compute whether
+				 * numeric conversion will be needed following
+				 * the operator we're compiling. */
+    struct JumpList *next;	/* Point to next item on the stack */
+} JumpList;
+
+/*
+ * Declarations for local functions to this file:
+ */
+
+static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
+			    int index, Tcl_Obj *const **litObjvPtr,
+			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
+			    CompileEnv *envPtr, int optimize);
+static void		ConvertTreeToTokens(const char *start, int numBytes,
+			    OpNode *nodes, Tcl_Token *tokenPtr,
+			    Tcl_Parse *parsePtr);
+static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
+			    int index, Tcl_Obj * const **litObjvPtr);
+static int		ParseExpr(Tcl_Interp *interp, const char *start,
+			    int numBytes, OpNode **opTreePtr,
+			    Tcl_Obj *litList, Tcl_Obj *funcList,
+			    Tcl_Parse *parsePtr, int parseOnly);
+static int		ParseLexeme(const char *start, int numBytes,
+			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);
+
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileExpr --
+ * ParseExpr --
  *
- *	This procedure compiles a string containing a Tcl expression into
- *	Tcl bytecodes. This procedure is the top-level interface to the
- *	the expression compilation module, and is used by such public
- *	procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
- *	Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
+ *	Given a string, the numBytes bytes starting at start, this function
+ *	parses it as a Tcl expression and constructs a tree representing
+ *	the structure of the expression.  The caller must pass in empty
+ * 	lists as the funcList and litList arguments.  The elements of the
+ *	parsed expression are returned to the caller as that tree, a list of
+ *	literal values, a list of function names, and in Tcl_Tokens
+ *	added to a Tcl_Parse struct passed in by the caller.
  *
  * Results:
- *	The return value is TCL_OK on a successful compilation and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
+ *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
+ *	is returned, and data about the expression structure is written to
+ *	the last four arguments.  If the string cannot be parsed as a valid
+ *	Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, an
+ *	error message is written to interp.
  *
  * Side effects:
- *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *	Memory will be allocated.  If TCL_OK is returned, the caller must
+ *	clean up the returned data structures.  The (OpNode *) value written
+ *	to opTreePtr should be passed to ckfree() and the parsePtr argument
+ *	should be passed to Tcl_FreeParse().  The elements appended to the
+ *	litList and funcList will automatically be freed whenever the
+ *	refcount on those lists indicates they can be freed.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompileExpr(interp, script, numBytes, envPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    CONST char *script;		/* The source script to compile. */
-    int numBytes;		/* Number of bytes in script. If < 0, the
-				 * string consists of all bytes up to the
-				 * first null character. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+static int
+ParseExpr(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    const char *start,		/* Start of source string to parse. */
+    int numBytes,		/* Number of bytes in string. */
+    OpNode **opTreePtr,		/* Points to space where a pointer to the
+				 * allocated OpNode tree should go. */
+    Tcl_Obj *litList,		/* List to append literals to. */
+    Tcl_Obj *funcList,		/* List to append function names to. */
+    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
+				 * those operands that require run time
+				 * substitutions. */
+    int parseOnly)		/* A boolean indicating whether the caller's
+				 * aim is just a parse, or whether it will go
+				 * on to compile the expression.  Different
+				 * optimizations are appropriate for the
+				 * two scenarios. */
 {
-    ExprInfo info;
-    Tcl_Parse parse;
-    Tcl_HashEntry *hPtr;
-    int new, i, code;
+    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
+				 * we build the parse tree. */
+    int nodesAvailable = 64;	/* Initial size of the storage array.  This
+				 * value establishes a minimum tree memory cost
+				 * of only about 1 kibyte, and is large enough
+				 * for most expressions to parse with no need
+				 * for array growth and reallocation. */
+    int nodesUsed = 0;		/* Number of OpNodes filled. */
+    int scanned = 0;		/* Capture number of byte scanned by
+				 * parsing routines. */
+    int lastParsed;		/* Stores info about what the lexeme parsed
+				 * the previous pass through the parsing loop
+				 * was.  If it was an operator, lastParsed is
+				 * the index of the OpNode for that operator.
+				 * If it was not an operator, lastParsed holds
+				 * an OperandTypes value encoding what we
+				 * need to know about it. */
+    int incomplete;		/* Index of the most recent incomplete tree
+				 * in the OpNode array.  Heads a stack of
+				 * incomplete trees linked by p.prev. */
+    int complete = OT_EMPTY;	/* "Index" of the complete tree (that is, a
+				 * complete subexpression) determined at the
+				 * moment.   OT_EMPTY is a nonsense value
+				 * used only to silence compiler warnings.
+				 * During a parse, complete will always hold
+				 * an index or an OperandTypes value pointing
+				 * to an actual leaf at the time the complete
+				 * tree is needed. */
+
+    /* These variables control generation of the error message. */
+    Tcl_Obj *msg = NULL;	/* The error message. */
+    Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
+				 * for the error message, supplying more
+				 * information after the error msg and
+				 * location have been reported. */
+    const char *mark = "_@_";	/* In the portion of the complete error message
+				 * where the error location is reported, this
+				 * "mark" substring is inserted into the
+				 * string being parsed to aid in pinpointing
+				 * the location of the syntax error in the
+				 * expression. */
+    int insertMark = 0;		/* A boolean controlling whether the "mark"
+				 * should be inserted. */
+    const int limit = 25;	/* Portions of the error message are
+				 * constructed out of substrings of the
+				 * original expression.  In order to keep the
+				 * error message readable, we impose this limit
+				 * on the substring size we extract. */
+
+    TclParseInit(interp, start, numBytes, parsePtr);
+
+    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
+    if (nodes == NULL) {
+	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
+	goto error;
+    }
+
+    /* Initialize the parse tree with the special "START" node. */
+    nodes->lexeme = START;
+    nodes->precedence = prec[START];
+    nodes->mark = MARK_RIGHT;
+    nodes->constant = 1;
+    incomplete = lastParsed = nodesUsed;
+    nodesUsed++;
 
     /*
-     * If this is the first time we've been called, initialize the table
-     * of expression operators.
+     * Main parsing loop parses one lexeme per iteration.  We exit the
+     * loop only when there's a syntax error with a "goto error" which
+     * takes us to the error handling code following the loop, or when
+     * we've successfully completed the parse and we return to the caller.
      */
 
-    if (numBytes < 0) {
-	numBytes = (script? strlen(script) : 0);
-    }
-    if (!opTableInitialized) {
-	Tcl_MutexLock(&opMutex);
-	if (!opTableInitialized) {
-	    Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
-	    for (i = 0;  operatorTable[i].name != NULL;  i++) {
-		hPtr = Tcl_CreateHashEntry(&opHashTable,
-			operatorTable[i].name, &new);
-		if (new) {
-		    Tcl_SetHashValue(hPtr, (ClientData) i);
-		}
+    while (1) {
+	OpNode *nodePtr;	/* Points to the OpNode we may fill this
+				 * pass through the loop. */
+	unsigned char lexeme;	/* The lexeme we parse this iteration. */
+	Tcl_Obj *literal;	/* Filled by the ParseLexeme() call when
+				 * a literal is parsed that has a Tcl_Obj
+				 * rep worth preserving. */
+
+	/*
+	 * Each pass through this loop adds up to one more OpNode. Allocate
+	 * space for one if required.
+	 */
+
+	if (nodesUsed >= nodesAvailable) {
+	    int size = nodesUsed * 2;
+	    OpNode *newPtr;
+
+	    do {
+		newPtr = (OpNode *) attemptckrealloc((char *) nodes,
+			(unsigned int) size * sizeof(OpNode));
+	    } while ((newPtr == NULL)
+		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
+	    if (newPtr == NULL) {
+		TclNewLiteralStringObj(msg,
+			"not enough memory to parse expression");
+		goto error;
 	    }
-	    opTableInitialized = 1;
+	    nodesAvailable = size;
+	    nodes = newPtr;
 	}
-	Tcl_MutexUnlock(&opMutex);
-    }
+	nodePtr = nodes + nodesUsed;
+
+	/* Skip white space between lexemes. */
+	scanned = TclParseAllWhiteSpace(start, numBytes);
+	start += scanned;
+	numBytes -= scanned;
+
+	scanned = ParseLexeme(start, numBytes, &lexeme, &literal);
+
+	/* Use context to categorize the lexemes that are ambiguous. */
+	if ((NODE_TYPE & lexeme) == 0) {
+	    switch (lexeme) {
+	    case INVALID:
+		msg = Tcl_ObjPrintf(
+			"invalid character \"%.*s\"", scanned, start);
+		goto error;
+	    case INCOMPLETE:
+		msg = Tcl_ObjPrintf(
+			"incomplete operator \"%.*s\"", scanned, start);
+		goto error;
+	    case BAREWORD:
+
+		/*
+		 * Most barewords in an expression are a syntax error.
+		 * The exceptions are that when a bareword is followed by
+		 * an open paren, it might be a function call, and when the
+		 * bareword is a legal literal boolean value, we accept that
+		 * as well.
+		 */
+
+		if (start[scanned+TclParseAllWhiteSpace(
+			start+scanned, numBytes-scanned)] == '(') {
+		    lexeme = FUNCTION;
 
-    /*
-     * Initialize the structure containing information abvout this
-     * expression compilation.
-     */
+		    /*
+		     * When we compile the expression we'll need the function
+		     * name, and there's no place in the parse tree to store
+		     * it, so we keep a separate list of all the function
+		     * names we've parsed in the order we found them.
+		     */
 
-    info.interp = interp;
-    info.parsePtr = &parse;
-    info.expr = script;
-    info.lastChar = (script + numBytes); 
-    info.hasOperators = 0;
+		    Tcl_ListObjAppendElement(NULL, funcList, literal);
+		} else {
+		    int b;
+		    if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
+			lexeme = BOOLEAN;
+		    } else {
+			Tcl_DecrRefCount(literal);
+			msg = Tcl_ObjPrintf(
+				"invalid bareword \"%.*s%s\"",
+				(scanned < limit) ? scanned : limit - 3, start,
+				(scanned < limit) ? "" : "...");
+			post = Tcl_ObjPrintf(
+				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
+			Tcl_AppendPrintfToObj(post,
+				" or \"%.*s%s(...)\" or ...",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
+			if (start[0] == '0') {
+			    const char *stop;
+			    TclParseNumber(NULL, NULL, NULL, start, scanned,
+				    &stop, TCL_PARSE_NO_WHITESPACE);
+
+			    if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
+				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+
+				switch (start[1]) {
+				case 'b':
+				    Tcl_AppendToObj(post,
+					    " (invalid binary number?)", -1);
+				    break;
+				case 'o':
+				    Tcl_AppendToObj(post,
+					    " (invalid octal number?)", -1);
+				    break;
+				default:
+				    if (isdigit(UCHAR(start[1]))) {
+				        Tcl_AppendToObj(post,
+						" (invalid octal number?)", -1);
+				    }
+				    break;
+				}
+			    }
+			}
+			goto error;
+		    }
+		}
+		break;
+	    case PLUS:
+	    case MINUS:
+		if (IsOperator(lastParsed)) {
+
+		    /*
+		     * A "+" or "-" coming just after another operator
+		     * must be interpreted as a unary operator.
+		     */
+
+		    lexeme |= UNARY;
+		} else {
+		    lexeme |= BINARY;
+		}
+	    }
+	}	/* Uncategorized lexemes */
+
+	/* Handle lexeme based on its category. */
+	switch (NODE_TYPE & lexeme) {
+
+	/*
+	 * Each LEAF results in either a literal getting appended to the
+	 * litList, or a sequence of Tcl_Tokens representing a Tcl word
+	 * getting appended to the parsePtr->tokens.  No OpNode is filled
+	 * for this lexeme.
+	 */
+
+	case LEAF: {
+	    Tcl_Token *tokenPtr;
+	    const char *end = start;
+	    int wordIndex;
+	    int code = TCL_OK;
+
+	    /*
+	     * A leaf operand appearing just after something that's not an
+	     * operator is a syntax error.
+	     */
+
+	    if (NotOperator(lastParsed)) {
+		msg = Tcl_ObjPrintf("missing operator at %s", mark);
+		scanned = 0;
+		insertMark = 1;
+
+		/* Free any literal to avoid a memleak. */
+		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
+		    Tcl_DecrRefCount(literal);
+		}
+		goto error;
+	    }
+
+	    switch (lexeme) {
+	    case NUMBER:
+	    case BOOLEAN:
+		/*
+		 * TODO: Consider using a dict or hash to collapse all
+		 * duplicate literals into a single representative value.
+		 * (Like what is done with [split $s {}]).
+		 * Pro:	~75% memory saving on expressions like
+		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
+		 *	to "pointer" cost only)
+		 * Con:	Cost of the dict store/retrieve on every literal
+		 *	in every expression when expressions like the above
+		 *	tend to be uncommon.
+		 *	The memory savings is temporary; Compiling to bytecode
+		 *	will collapse things as literals are registered
+		 * 	anyway, so the savings applies only to the time
+		 *	between parsing and compiling.  Possibly important
+		 *	due to high-water mark nature of memory allocation.
+		 */
+		Tcl_ListObjAppendElement(NULL, litList, literal);
+		complete = lastParsed = OT_LITERAL;
+		start += scanned;
+		numBytes -= scanned;
+		continue;
+
+	    default:
+		break;
+	    }
+
+	    /*
+	     * Remaining LEAF cases may involve filling Tcl_Tokens, so
+	     * make room for at least 2 more tokens.
+	     */
+
+	    TclGrowParseTokenArray(parsePtr, 2);
+	    wordIndex = parsePtr->numTokens;
+	    tokenPtr = parsePtr->tokenPtr + wordIndex;
+	    tokenPtr->type = TCL_TOKEN_WORD;
+	    tokenPtr->start = start;
+	    parsePtr->numTokens++;
+
+	    switch (lexeme) {
+	    case QUOTED:
+		code = Tcl_ParseQuotedString(NULL, start, numBytes,
+			parsePtr, 1, &end);
+		scanned = end - start;
+		break;
+
+	    case BRACED:
+		code = Tcl_ParseBraces(NULL, start, numBytes,
+			    parsePtr, 1, &end);
+		scanned = end - start;
+		break;
+
+	    case VARIABLE:
+		code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1);
+
+		/*
+		 * Handle the quirk that Tcl_ParseVarName reports a successful
+		 * parse even when it gets only a "$" with no variable name.
+		 */
+
+		tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
+		if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
+		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
+		    goto error;
+		}
+		scanned = tokenPtr->size;
+		break;
+
+	    case SCRIPT: {
+		Tcl_Parse *nestedPtr =
+			(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+
+		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		tokenPtr->type = TCL_TOKEN_COMMAND;
+		tokenPtr->start = start;
+		tokenPtr->numComponents = 0;
+
+		end = start + numBytes;
+		start++;
+		while (1) {
+		    code = Tcl_ParseCommand(interp, start, (end - start), 1,
+			    nestedPtr);
+		    if (code != TCL_OK) {
+			parsePtr->term = nestedPtr->term;
+			parsePtr->errorType = nestedPtr->errorType;
+			parsePtr->incomplete = nestedPtr->incomplete;
+			break;
+		    }
+		    start = (nestedPtr->commandStart + nestedPtr->commandSize);
+		    Tcl_FreeParse(nestedPtr);
+		    if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
+			    && !(nestedPtr->incomplete)) {
+			break;
+		    }
+
+		    if (start == end) {
+			TclNewLiteralStringObj(msg, "missing close-bracket");
+			parsePtr->term = tokenPtr->start;
+			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
+			parsePtr->incomplete = 1;
+			code = TCL_ERROR;
+			break;
+		    }
+		}
+		TclStackFree(interp, nestedPtr);
+		end = start;
+		start = tokenPtr->start;
+		scanned = end - start;
+		tokenPtr->size = scanned;
+		parsePtr->numTokens++;
+		break;
+	    }
+	    }
+	    if (code != TCL_OK) {
+
+		/*
+		 * Here we handle all the syntax errors generated by
+		 * the Tcl_Token generating parsing routines called in the
+		 * switch just above.  If the value of parsePtr->incomplete
+		 * is 1, then the error was an unbalanced '[', '(', '{',
+		 * or '"' and parsePtr->term is pointing to that unbalanced
+		 * character.  If the value of parsePtr->incomplete is 0,
+		 * then the error is one of lacking whitespace following a
+		 * quoted word, for example: expr {[an error {foo}bar]},
+		 * and parsePtr->term points to where the whitespace is
+		 * missing.  We reset our values of start and scanned so that
+		 * when our error message is constructed, the location of
+		 * the syntax error is sure to appear in it, even if the
+		 * quoted expression is truncated.
+		 */
+
+		start = parsePtr->term;
+		scanned = parsePtr->incomplete;
+		goto error;
+	    }
+
+	    tokenPtr = parsePtr->tokenPtr + wordIndex;
+	    tokenPtr->size = scanned;
+	    tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1;
+	    if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) {
+
+		/*
+		 * When this expression is destined to be compiled, and a
+		 * braced or quoted word within an expression is known at
+		 * compile time (no runtime substitutions in it), we can
+		 * store it as a literal rather than in its tokenized form.
+		 * This is an advantage since the compiled bytecode is going
+		 * to need the argument in Tcl_Obj form eventually, so it's
+		 * just as well to get there now.  Another advantage is that
+		 * with this conversion, larger constant expressions might
+		 * be grown and optimized.
+		 *
+		 * On the contrary, if the end goal of this parse is to
+		 * fill a Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
+		 * wasteful to convert to a literal only to convert back again
+		 * later.
+		 */
+
+		literal = Tcl_NewObj();
+		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
+		    Tcl_ListObjAppendElement(NULL, litList, literal);
+		    complete = lastParsed = OT_LITERAL;
+		    parsePtr->numTokens = wordIndex;
+		    break;
+		}
+		Tcl_DecrRefCount(literal);
+	    }
+	    complete = lastParsed = OT_TOKENS;
+	    break;
+	} /* case LEAF */
+
+	case UNARY:
+
+	    /*
+	     * A unary operator appearing just after something that's not an
+	     * operator is a syntax error -- something trying to be the left
+	     * operand of an operator that doesn't take one.
+	     */
+
+	    if (NotOperator(lastParsed)) {
+		msg = Tcl_ObjPrintf("missing operator at %s", mark);
+		scanned = 0;
+		insertMark = 1;
+		goto error;
+	    }
+
+	    /* Create an OpNode for the unary operator */
+	    nodePtr->lexeme = lexeme;
+	    nodePtr->precedence = prec[lexeme];
+	    nodePtr->mark = MARK_RIGHT;
+
+	    /*
+	     * A FUNCTION cannot be a constant expression, because Tcl allows
+	     * functions to return variable results with the same arguments;
+	     * for example, rand().  Other unary operators can root a constant
+	     * expression, so long as the argument is a constant expression.
+	     */
+
+	    nodePtr->constant = (lexeme != FUNCTION);
+
+	    /*
+	     * This unary operator is a new incomplete tree, so push it
+	     * onto our stack of incomplete trees.  Also remember it as
+	     * the last lexeme we parsed.
+	     */
+
+	    nodePtr->p.prev = incomplete;
+	    incomplete = lastParsed = nodesUsed;
+	    nodesUsed++;
+	    break;
+
+	case BINARY: {
+	    OpNode *incompletePtr;
+	    unsigned char precedence = prec[lexeme];
+
+	    /*
+	     * A binary operator appearing just after another operator is a
+	     * syntax error -- one of the two operators is missing an operand.
+	     */
+
+	    if (IsOperator(lastParsed)) {
+		if ((lexeme == CLOSE_PAREN)
+			&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
+		    if (nodePtr[-2].lexeme == FUNCTION) {
+
+			/*
+			 * Normally, "()" is a syntax error, but as a special
+			 * case accept it as an argument list for a function.
+			 * Treat this as a special LEAF lexeme, and restart
+			 * the parsing loop with zero characters scanned.
+			 * We'll parse the ")" again the next time through,
+			 * but with the OT_EMPTY leaf as the subexpression
+			 * between the parens.
+			 */
+
+			scanned = 0;
+			complete = lastParsed = OT_EMPTY;
+			break;
+		    }
+		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		    goto error;
+		}
+
+		if (nodePtr[-1].precedence > precedence) {
+		    if (nodePtr[-1].lexeme == OPEN_PAREN) {
+			TclNewLiteralStringObj(msg, "unbalanced open paren");
+			parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+		    } else if (nodePtr[-1].lexeme == COMMA) {
+			msg = Tcl_ObjPrintf(
+				"missing function argument at %s", mark);
+			scanned = 0;
+			insertMark = 1;
+		    } else if (nodePtr[-1].lexeme == START) {
+			TclNewLiteralStringObj(msg, "empty expression");
+		    }
+		} else {
+		    if (lexeme == CLOSE_PAREN) {
+			TclNewLiteralStringObj(msg, "unbalanced close paren");
+		    } else if ((lexeme == COMMA)
+			    && (nodePtr[-1].lexeme == OPEN_PAREN)
+			    && (nodePtr[-2].lexeme == FUNCTION)) {
+			msg = Tcl_ObjPrintf(
+				"missing function argument at %s", mark);
+			scanned = 0;
+			insertMark = 1;
+		    }
+		}
+		if (msg == NULL) {
+		    msg = Tcl_ObjPrintf("missing operand at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		}
+		goto error;
+	    }
+
+	    /*
+	     * Here is where the tree comes together.  At this point, we
+	     * have a stack of incomplete trees corresponding to
+	     * substrings that are incomplete expressions, followed by
+	     * a complete tree corresponding to a substring that is itself
+	     * a complete expression, followed by the binary operator we have
+	     * just parsed.  The incomplete trees can each be completed by
+	     * adding a right operand.
+	     *
+	     * To illustrate with an example, when we parse the expression
+	     * "1+2*3-4" and we reach this point having just parsed the "-"
+	     * operator, we have these incomplete trees: START, "1+", and
+	     * "2*".  Next we have the complete subexpression "3".  Last is
+	     * the "-" we've just parsed.
+	     *
+	     * The next step is to join our complete tree to an operator.
+	     * The choice is governed by the precedence and associativity
+	     * of the competing operators.  If we connect it as the right
+	     * operand of our most recent incomplete tree, we get a new
+	     * complete tree, and we can repeat the process.  The while
+	     * loop following repeats this until precedence indicates it
+	     * is time to join the complete tree as the left operand of
+	     * the just parsed binary operator.
+	     *
+	     * Continuing the example, the first pass through the loop
+	     * will join "3" to "2*"; the next pass will join "2*3" to
+	     * "1+".  Then we'll exit the loop and join "1+2*3" to "-".
+	     * When we return to parse another lexeme, our stack of
+	     * incomplete trees is START and "1+2*3-".
+	     */
+
+	    while (1) {
+		incompletePtr = nodes + incomplete;
+
+		if (incompletePtr->precedence < precedence) {
+		    break;
+		}
+
+		if (incompletePtr->precedence == precedence) {
+
+		    /* Right association rules for exponentiation. */
+		    if (lexeme == EXPON) {
+			break;
+		    }
+
+		    /*
+		     * Special association rules for the conditional operators.
+		     * The "?" and ":" operators have equal precedence, but
+		     * must be linked up in sensible pairs.
+		     */
+
+		    if ((incompletePtr->lexeme == QUESTION)
+			    && (NotOperator(complete)
+			    || (nodes[complete].lexeme != COLON))) {
+			break;
+		    }
+		    if ((incompletePtr->lexeme == COLON)
+			    && (lexeme == QUESTION)) {
+			break;
+		    }
+		}
+
+		/* Some special syntax checks... */
+
+		/* Parens must balance */
+		if ((incompletePtr->lexeme == OPEN_PAREN)
+			&& (lexeme != CLOSE_PAREN)) {
+		    TclNewLiteralStringObj(msg, "unbalanced open paren");
+		    parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+		    goto error;
+		}
+
+		/* Right operand of "?" must be ":" */
+		if ((incompletePtr->lexeme == QUESTION)
+			&& (NotOperator(complete)
+			|| (nodes[complete].lexeme != COLON))) {
+		    msg = Tcl_ObjPrintf(
+			    "missing operator \":\" at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		    goto error;
+		}
+
+		/* Operator ":" may only be right operand of "?" */
+		if (IsOperator(complete)
+			&& (nodes[complete].lexeme == COLON)
+			&& (incompletePtr->lexeme != QUESTION)) {
+		    TclNewLiteralStringObj(msg,
+			    "unexpected operator \":\" "
+			    "without preceding \"?\"");
+		    goto error;
+		}
+
+		/*
+		 * Attach complete tree as right operand of most recent
+		 * incomplete tree.
+		 */
+
+		incompletePtr->right = complete;
+		if (IsOperator(complete)) {
+		    nodes[complete].p.parent = incomplete;
+		    incompletePtr->constant = incompletePtr->constant
+			    && nodes[complete].constant;
+		} else {
+		    incompletePtr->constant = incompletePtr->constant
+			    && (complete == OT_LITERAL);
+		}
+
+		/*
+		 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each
+		 * make up a single operator.  Force them to agree whether they
+		 * have a constant expression.
+		 */
+
+		if ((incompletePtr->lexeme == QUESTION)
+			|| (incompletePtr->lexeme == FUNCTION)) {
+		    nodes[complete].constant = incompletePtr->constant;
+		}
+
+		if (incompletePtr->lexeme == START) {
+
+		    /*
+		     * Completing the START tree indicates we're done.
+		     * Transfer the parse tree to the caller and return.
+		     */
+
+		    *opTreePtr = nodes;
+		    return TCL_OK;
+		}
+
+		/*
+		 * With a right operand attached, last incomplete tree has
+		 * become the complete tree.  Pop it from the incomplete
+		 * tree stack.
+		 */
+
+		complete = incomplete;
+		incomplete = incompletePtr->p.prev;
+
+		/* CLOSE_PAREN can only close one OPEN_PAREN. */
+		if (incompletePtr->lexeme == OPEN_PAREN) {
+		    break;
+		}
+	    }
+
+	    /* More syntax checks... */
+
+	    /* Parens must balance. */
+	    if (lexeme == CLOSE_PAREN) {
+		if (incompletePtr->lexeme != OPEN_PAREN) {
+		    TclNewLiteralStringObj(msg, "unbalanced close paren");
+		    goto error;
+		}
+	    }
+
+	    /* Commas must appear only in function argument lists. */
+	    if (lexeme == COMMA) {
+		if  ((incompletePtr->lexeme != OPEN_PAREN)
+			|| (incompletePtr[-1].lexeme != FUNCTION)) {
+		    TclNewLiteralStringObj(msg,
+			    "unexpected \",\" outside function argument list");
+		    goto error;
+		}
+	    }
+
+	    /* Operator ":" may only be right operand of "?" */
+	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
+		TclNewLiteralStringObj(msg,
+			"unexpected operator \":\" without preceding \"?\"");
+		goto error;
+	    }
+
+	    /* Create no node for a CLOSE_PAREN lexeme. */
+	    if (lexeme == CLOSE_PAREN) {
+		break;
+	    }
+
+	    /* Link complete tree as left operand of new node. */
+	    nodePtr->lexeme = lexeme;
+	    nodePtr->precedence = precedence;
+	    nodePtr->mark = MARK_LEFT;
+	    nodePtr->left = complete;
+
+	    /*
+	     * The COMMA operator cannot be optimized, since the function
+	     * needs all of its arguments, and optimization would reduce
+	     * the number.  Other binary operators root constant expressions
+	     * when both arguments are constant expressions.
+	     */
+
+	    nodePtr->constant = (lexeme != COMMA);
+
+	    if (IsOperator(complete)) {
+		nodes[complete].p.parent = nodesUsed;
+		nodePtr->constant = nodePtr->constant
+			&& nodes[complete].constant;
+	    } else {
+		nodePtr->constant = nodePtr->constant
+			&& (complete == OT_LITERAL);
+	    }
+
+	    /*
+	     * With a left operand attached and a right operand missing,
+	     * the just-parsed binary operator is root of a new incomplete
+	     * tree.  Push it onto the stack of incomplete trees.
+	     */
+
+	    nodePtr->p.prev = incomplete;
+	    incomplete = lastParsed = nodesUsed;
+	    nodesUsed++;
+	    break;
+	}	/* case BINARY */
+	}	/* lexeme handler */
+
+	/* Advance past the just-parsed lexeme */
+	start += scanned;
+	numBytes -= scanned;
+    }	/* main parsing loop */
+
+  error:
 
     /*
-     * Parse the expression then compile it.
+     * We only get here if there's been an error.
+     * Any errors that didn't get a suitable parsePtr->errorType,
+     * get recorded as syntax errors.
      */
 
-    code = Tcl_ParseExpr(interp, script, numBytes, &parse);
-    if (code != TCL_OK) {
-	goto done;
+    if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
+	parsePtr->errorType = TCL_PARSE_SYNTAX;
     }
 
-#ifdef TCL_TIP280
-    /* TIP #280 : Track Lines within the expression */
-    TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);
-#endif
-
-    code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
-    if (code != TCL_OK) {
-	Tcl_FreeParse(&parse);
-	goto done;
+    /* Free any partial parse tree we've built. */
+    if (nodes != NULL) {
+	ckfree((char*) nodes);
     }
-    
-    if (!info.hasOperators) {
+
+    if (interp == NULL) {
+
+	/* Nowhere to report an error message, so just free it */
+	if (msg) {
+	    Tcl_DecrRefCount(msg);
+	}
+    } else {
+
 	/*
-	 * Attempt to convert the primary's object to an int or double.
-	 * This is done in order to support Tcl's policy of interpreting
-	 * operands if at all possible as first integers, else
-	 * floating-point numbers.
+	 * Construct the complete error message.  Start with the simple
+	 * error message, pulled from the interp result if necessary...
 	 */
-	
-	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+
+	if (msg == NULL) {
+	    msg = Tcl_GetObjResult(interp);
+	}
+
+	/*
+	 * Add a detailed quote from the bad expression, displaying and
+	 * sometimes marking the precise location of the syntax error.
+	 */
+
+	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+		((start - limit) < parsePtr->string) ? "" : "...",
+		((start - limit) < parsePtr->string)
+			? (int) (start - parsePtr->string) : limit - 3,
+		((start - limit) < parsePtr->string)
+			? parsePtr->string : start - limit + 3,
+		(scanned < limit) ? scanned : limit - 3, start,
+		(scanned < limit) ? "" : "...", insertMark ? mark : "",
+		(start + scanned + limit > parsePtr->end)
+			? (int) (parsePtr->end - start) - scanned : limit-3,
+		start + scanned,
+		(start + scanned + limit > parsePtr->end) ? "" : "...");
+
+	/* Next, append any postscript message. */
+	if (post != NULL) {
+	    Tcl_AppendToObj(msg, ";\n", -1);
+	    Tcl_AppendObjToObj(msg, post);
+	    Tcl_DecrRefCount(post);
+	}
+	Tcl_SetObjResult(interp, msg);
+
+	/* Finally, place context information in the errorInfo. */
+	numBytes = parsePtr->end - parsePtr->string;
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (parsing expression \"%.*s%s\")",
+		(numBytes < limit) ? numBytes : limit - 3,
+		parsePtr->string, (numBytes < limit) ? "" : "..."));
     }
-    Tcl_FreeParse(&parse);
 
-    done:
-    return code;
+    return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclFinalizeCompilation --
+ * ConvertTreeToTokens --
  *
- *	Clean up the compilation environment so it can later be
- *	properly reinitialized. This procedure is called by Tcl_Finalize().
+ *	Given a string, the numBytes bytes starting at start, and an OpNode
+ *	tree and Tcl_Token array created by passing that same string to
+ *	ParseExpr(), this function writes into *parsePtr the sequence of
+ * 	Tcl_Tokens needed so to satisfy the historical interface provided
+ * 	by Tcl_ParseExpr().  Note that this routine exists only for the sake
+ *	of the public Tcl_ParseExpr() routine.  It is not used by Tcl itself
+ * 	at all.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Cleans up the compilation environment. At the moment, just the
- *	table of expression operators is freed.
+ *	The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
+ *	parsed expression.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclFinalizeCompilation()
+static void
+ConvertTreeToTokens(
+    const char *start,
+    int numBytes,
+    OpNode *nodes,
+    Tcl_Token *tokenPtr,
+    Tcl_Parse *parsePtr)
 {
-    Tcl_MutexLock(&opMutex);
-    if (opTableInitialized) {
-        Tcl_DeleteHashTable(&opHashTable);
-        opTableInitialized = 0;
+    int subExprTokenIdx = 0;
+    OpNode *nodePtr = nodes;
+    int next = nodePtr->right;
+
+    while (1) {
+	Tcl_Token *subExprTokenPtr;
+	int scanned, parentIdx;
+	unsigned char lexeme;
+
+	/*
+	 * Advance the mark so the next exit from this node won't retrace
+	 * steps over ground already covered.
+	 */
+
+	nodePtr->mark++;
+
+	/* Handle next child node or leaf */
+	switch (next) {
+	case OT_EMPTY:
+
+	    /* No tokens and no characters for the OT_EMPTY leaf. */
+	    break;
+
+	case OT_LITERAL:
+
+	    /* Skip any white space that comes before the literal */
+	    scanned = TclParseAllWhiteSpace(start, numBytes);
+	    start +=scanned;
+	    numBytes -= scanned;
+
+	    /* Reparse the literal to get pointers into source string */
+	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
+
+	    TclGrowParseTokenArray(parsePtr, 2);
+	    subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+	    subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+	    subExprTokenPtr->start = start;
+	    subExprTokenPtr->size = scanned;
+	    subExprTokenPtr->numComponents = 1;
+	    subExprTokenPtr[1].type = TCL_TOKEN_TEXT;
+	    subExprTokenPtr[1].start = start;
+	    subExprTokenPtr[1].size = scanned;
+	    subExprTokenPtr[1].numComponents = 0;
+
+	    parsePtr->numTokens += 2;
+	    start +=scanned;
+	    numBytes -= scanned;
+	    break;
+
+	case OT_TOKENS: {
+
+	    /*
+	     * tokenPtr points to a token sequence that came from parsing
+	     * a Tcl word.  A Tcl word is made up of a sequence of one or
+	     * more elements.  When the word is only a single element, it's
+	     * been the historical practice to replace the TCL_TOKEN_WORD
+	     * token directly with a TCL_TOKEN_SUB_EXPR token.  However,
+	     * when the word has multiple elements, a TCL_TOKEN_WORD token
+	     * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR
+	     * always has only one element.  Wise or not, these are the
+	     * rules the Tcl expr parser has followed, and for the sake
+	     * of those few callers of Tcl_ParseExpr() we do not change
+	     * them now.  Internally, we can do better.
+	     */
+
+	    int toCopy = tokenPtr->numComponents + 1;
+
+	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
+
+		/*
+		 * Single element word.  Copy tokens and convert the leading
+		 * token to TCL_TOKEN_SUB_EXPR.
+		 */
+
+		TclGrowParseTokenArray(parsePtr, toCopy);
+		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		memcpy(subExprTokenPtr, tokenPtr,
+			(size_t) toCopy * sizeof(Tcl_Token));
+		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+		parsePtr->numTokens += toCopy;
+	    } else {
+
+		/*
+		 * Multiple element word.  Create a TCL_TOKEN_SUB_EXPR
+		 * token to lead, with fields initialized from the leading
+		 * token, then copy entire set of word tokens.
+		 */
+
+		TclGrowParseTokenArray(parsePtr, toCopy+1);
+		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		*subExprTokenPtr = *tokenPtr;
+		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+		subExprTokenPtr->numComponents++;
+		subExprTokenPtr++;
+		memcpy(subExprTokenPtr, tokenPtr,
+			(size_t) toCopy * sizeof(Tcl_Token));
+		parsePtr->numTokens += toCopy + 1;
+	    }
+
+	    scanned = tokenPtr->start + tokenPtr->size - start;
+	    start +=scanned;
+	    numBytes -= scanned;
+	    tokenPtr += toCopy;
+	    break;
+	}
+
+	default:
+
+	    /* Advance to the child node, which is an operator. */
+	    nodePtr = nodes + next;
+
+	    /* Skip any white space that comes before the subexpression */
+	    scanned = TclParseAllWhiteSpace(start, numBytes);
+	    start +=scanned;
+	    numBytes -= scanned;
+
+	    /* Generate tokens for the operator / subexpression... */
+	    switch (nodePtr->lexeme) {
+	    case OPEN_PAREN:
+	    case COMMA:
+	    case COLON:
+
+		/*
+		 * Historical practice has been to have no Tcl_Tokens for
+		 * these operators.
+		 */
+
+		break;
+
+	    default: {
+
+		/*
+		 * Remember the index of the last subexpression we were
+		 * working on -- that of our parent.  We'll stack it later.
+		 */
+
+		parentIdx = subExprTokenIdx;
+
+		/*
+		 * Verify space for the two leading Tcl_Tokens representing
+		 * the subexpression rooted by this operator.  The first
+		 * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second
+		 * of type TCL_TOKEN_OPERATOR.
+		 */
+
+		TclGrowParseTokenArray(parsePtr, 2);
+		subExprTokenIdx = parsePtr->numTokens;
+		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+		parsePtr->numTokens += 2;
+		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+		subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR;
+
+		/*
+		 * Our current position scanning the string is the starting
+		 * point for this subexpression.
+		 */
+
+		subExprTokenPtr->start = start;
+
+		/*
+		 * Eventually, we know that the numComponents field of the
+		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0.  This means
+		 * we can make other use of this field for now to track the
+		 * stack of subexpressions we have pending.
+		 */
+
+		subExprTokenPtr[1].numComponents = parentIdx;
+		break;
+	    }
+	    }
+	    break;
+	}
+
+	/* Determine which way to exit the node on this pass. */
+    router:
+	switch (nodePtr->mark) {
+	case MARK_LEFT:
+	    next = nodePtr->left;
+	    break;
+
+	case MARK_RIGHT:
+	    next = nodePtr->right;
+
+	    /* Skip any white space that comes before the operator */
+	    scanned = TclParseAllWhiteSpace(start, numBytes);
+	    start +=scanned;
+	    numBytes -= scanned;
+
+	    /*
+	     * Here we scan from the string the operator corresponding to
+	     * nodePtr->lexeme.
+	     */
+
+	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
+
+	    switch(nodePtr->lexeme) {
+	    case OPEN_PAREN:
+	    case COMMA:
+	    case COLON:
+
+		/* No tokens for these lexemes -> nothing to do. */
+		break;
+
+	    default:
+
+		/*
+		 * Record in the TCL_TOKEN_OPERATOR token the pointers into
+		 * the string marking where the operator is.
+		 */
+
+		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+		subExprTokenPtr[1].start = start;
+		subExprTokenPtr[1].size = scanned;
+		break;
+	    }
+
+	    start +=scanned;
+	    numBytes -= scanned;
+	    break;
+
+	case MARK_PARENT:
+	    switch (nodePtr->lexeme) {
+	    case START:
+
+		/* When we get back to the START node, we're done. */
+		return;
+
+	    case COMMA:
+	    case COLON:
+
+		/* No tokens for these lexemes -> nothing to do. */
+		break;
+
+	    case OPEN_PAREN:
+
+		/* Skip past matching close paren. */
+		scanned = TclParseAllWhiteSpace(start, numBytes);
+		start +=scanned;
+		numBytes -= scanned;
+		scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
+		start +=scanned;
+		numBytes -= scanned;
+		break;
+
+	    default: {
+
+		/*
+		 * Before we leave this node/operator/subexpression for the
+		 * last time, finish up its tokens....
+		 *
+		 * Our current position scanning the string is where the
+		 * substring for the subexpression ends.
+		 */
+
+		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
+		subExprTokenPtr->size = start - subExprTokenPtr->start;
+
+		/*
+		 * All the Tcl_Tokens allocated and filled belong to
+		 * this subexpresion.  The first token is the leading
+		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
+		 * are its components.
+		 */
+
+		subExprTokenPtr->numComponents =
+			(parsePtr->numTokens - subExprTokenIdx) - 1;
+
+		/*
+		 * Finally, as we return up the tree to our parent, pop the
+		 * parent subexpression off our subexpression stack, and
+		 * fill in the zero numComponents for the operator Tcl_Token.
+		 */
+
+		parentIdx = subExprTokenPtr[1].numComponents;
+		subExprTokenPtr[1].numComponents = 0;
+		subExprTokenIdx = parentIdx;
+		break;
+	    }
+	    }
+
+	    /* Since we're returning to parent, skip child handling code. */
+	    nodePtr = nodes + nodePtr->p.parent;
+	    goto router;
+	}
     }
-    Tcl_MutexUnlock(&opMutex);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CompileSubExpr --
+ * Tcl_ParseExpr --
  *
- *	Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
- *	subexpression, this procedure emits instructions to evaluate the
- *	subexpression at runtime.
+ *	Given a string, the numBytes bytes starting at start, this function
+ *	parses it as a Tcl expression and stores information about the
+ *	structure of the expression in the Tcl_Parse struct indicated by the
+ *	caller.
  *
  * Results:
- *	The return value is TCL_OK on a successful compilation and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
+ *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
+ *	is returned, and data about the expression structure is written to
+ *	*parsePtr. If the string cannot be parsed as a valid Tcl expression,
+ *	TCL_ERROR is returned, and if interp is non-NULL, an error message is
+ *	written to interp.
  *
  * Side effects:
- *	Adds instructions to envPtr to evaluate the subexpression.
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the expression, then additional space is malloc-ed. If the
+ *	function returns TCL_OK then the caller must eventually invoke
+ *	Tcl_FreeParse to release any additional space that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseExpr(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    const char *start,		/* Start of source string to parse. */
+    int numBytes,		/* Number of bytes in string. If < 0, the
+				 * string consists of all bytes up to the
+				 * first null character. */
+    Tcl_Parse *parsePtr)	/* Structure to fill with information about
+				 * the parsed expression; any previous
+				 * information in the structure is ignored. */
+{
+    int code;
+    OpNode *opTree = NULL;	/* Will point to the tree of operators */
+    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
+    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
+    Tcl_Parse *exprParsePtr =
+	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+				/* Holds the Tcl_Tokens of substitutions */
+
+    if (numBytes < 0) {
+	numBytes = (start ? strlen(start) : 0);
+    }
+
+    code = ParseExpr(interp, start, numBytes, &opTree, litList,
+	    funcList, exprParsePtr, 1 /* parseOnly */);
+    Tcl_DecrRefCount(funcList);
+    Tcl_DecrRefCount(litList);
+
+    TclParseInit(interp, start, numBytes, parsePtr);
+    if (code == TCL_OK) {
+	ConvertTreeToTokens(start, numBytes,
+		opTree, exprParsePtr->tokenPtr, parsePtr);
+    } else {
+	parsePtr->term = exprParsePtr->term;
+	parsePtr->errorType = exprParsePtr->errorType;
+    }
+
+    Tcl_FreeParse(exprParsePtr);
+    TclStackFree(interp, exprParsePtr);
+    ckfree((char *) opTree);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseLexeme --
+ *
+ *	Parse a single lexeme from the start of a string, scanning no more
+ *	than numBytes bytes.
+ *
+ * Results:
+ *	Returns the number of bytes scanned to produce the lexeme.
+ *
+ * Side effects:
+ *	Code identifying lexeme parsed is writen to *lexemePtr.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
-    Tcl_Token *exprTokenPtr;	/* Points to TCL_TOKEN_SUB_EXPR token
-				 * to compile. */
-    ExprInfo *infoPtr;		/* Describes the compilation state for the
-				 * expression being compiled. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+ParseLexeme(
+    const char *start,		/* Start of lexeme to parse. */
+    int numBytes,		/* Number of bytes in string. */
+    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
+				 * storage. */
+    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
+				   storage, if non-NULL. */
 {
-    Tcl_Interp *interp = infoPtr->interp;
-    Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */
-    Tcl_Token *afterSubexprPtr;
-    CONST OperatorDesc *opDescPtr;
-    Tcl_HashEntry *hPtr;
-    CONST char *operator;
-    Tcl_DString opBuf;
-    int objIndex, opIndex, length, code;
-    char buffer[TCL_UTF_MAX];
-
-    if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
-	panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
-	        exprTokenPtr->type);
+    const char *end;
+    int scanned;
+    Tcl_UniChar ch;
+    Tcl_Obj *literal = NULL;
+    unsigned char byte;
+
+    if (numBytes == 0) {
+	*lexemePtr = END;
+	return 0;
     }
-    code = TCL_OK;
+    byte = (unsigned char)(*start);
+    if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
+	*lexemePtr = Lexeme[byte];
+	return 1;
+    }
+    switch (byte) {
+    case '*':
+	if ((numBytes > 1) && (start[1] == '*')) {
+	    *lexemePtr = EXPON;
+	    return 2;
+	}
+	*lexemePtr = MULT;
+	return 1;
 
-    /*
-     * Switch on the type of the first token after the subexpression token.
-     * After processing it, advance tokenPtr to point just after the
-     * subexpression's last token.
-     */
-    
-    tokenPtr = exprTokenPtr+1;
-    TRACE(exprTokenPtr->start, exprTokenPtr->size,
-	    tokenPtr->start, tokenPtr->size);
-    switch (tokenPtr->type) {
-        case TCL_TOKEN_WORD:
-	    code = TclCompileTokens(interp, tokenPtr+1,
-	            tokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-	    tokenPtr += (tokenPtr->numComponents + 1);
-	    break;
-	    
-        case TCL_TOKEN_TEXT:
-	    if (tokenPtr->size > 0) {
-		objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
-	                tokenPtr->size);
-	    } else {
-		objIndex = TclRegisterNewLiteral(envPtr, "", 0);
-	    }
-	    TclEmitPush(objIndex, envPtr);
-	    tokenPtr += 1;
-	    break;
-	    
-        case TCL_TOKEN_BS:
-	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
-		    (int *) NULL, buffer);
-	    if (length > 0) {
-		objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
-	    } else {
-		objIndex = TclRegisterNewLiteral(envPtr, "", 0);
-	    }
-	    TclEmitPush(objIndex, envPtr);
-	    tokenPtr += 1;
-	    break;
-	    
-        case TCL_TOKEN_COMMAND:
-	    code = TclCompileScript(interp, tokenPtr->start+1,
-		    tokenPtr->size-2, /*nested*/ 0, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
-	    }
-	    tokenPtr += 1;
-	    break;
-	    
-        case TCL_TOKEN_VARIABLE:
-	    code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
+    case '=':
+	if ((numBytes > 1) && (start[1] == '=')) {
+	    *lexemePtr = EQUAL;
+	    return 2;
+	}
+	*lexemePtr = INCOMPLETE;
+	return 1;
+
+    case '!':
+	if ((numBytes > 1) && (start[1] == '=')) {
+	    *lexemePtr = NEQ;
+	    return 2;
+	}
+	*lexemePtr = NOT;
+	return 1;
+
+    case '&':
+	if ((numBytes > 1) && (start[1] == '&')) {
+	    *lexemePtr = AND;
+	    return 2;
+	}
+	*lexemePtr = BIT_AND;
+	return 1;
+
+    case '|':
+	if ((numBytes > 1) && (start[1] == '|')) {
+	    *lexemePtr = OR;
+	    return 2;
+	}
+	*lexemePtr = BIT_OR;
+	return 1;
+
+    case '<':
+	if (numBytes > 1) {
+	    switch (start[1]) {
+	    case '<':
+		*lexemePtr = LEFT_SHIFT;
+		return 2;
+	    case '=':
+		*lexemePtr = LEQ;
+		return 2;
 	    }
-	    tokenPtr += (tokenPtr->numComponents + 1);
-	    break;
-	    
-        case TCL_TOKEN_SUB_EXPR:
-	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
+	}
+	*lexemePtr = LESS;
+	return 1;
+
+    case '>':
+	if (numBytes > 1) {
+	    switch (start[1]) {
+	    case '>':
+		*lexemePtr = RIGHT_SHIFT;
+		return 2;
+	    case '=':
+		*lexemePtr = GEQ;
+		return 2;
 	    }
-	    tokenPtr += (tokenPtr->numComponents + 1);
-	    break;
-	    
-        case TCL_TOKEN_OPERATOR:
+	}
+	*lexemePtr = GREATER;
+	return 1;
+
+    case 'i':
+	if ((numBytes > 1) && (start[1] == 'n')
+		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+
 	    /*
-	     * Look up the operator.  If the operator isn't found, treat it
-	     * as a math function.
+	     * Must make this check so we can tell the difference between
+	     * the "in" operator and the "int" function name and the
+	     * "infinity" numeric value.
 	     */
-	    Tcl_DStringInit(&opBuf);
-	    operator = Tcl_DStringAppend(&opBuf, 
-		    tokenPtr->start, tokenPtr->size);
-	    hPtr = Tcl_FindHashEntry(&opHashTable, operator);
-	    if (hPtr == NULL) {
-		code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
-			envPtr, &endPtr);
-		Tcl_DStringFree(&opBuf);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		tokenPtr = endPtr;
-		break;
+
+	    *lexemePtr = IN_LIST;
+	    return 2;
+	}
+	break;
+
+    case 'e':
+	if ((numBytes > 1) && (start[1] == 'q')
+		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    *lexemePtr = STREQ;
+	    return 2;
+	}
+	break;
+
+    case 'n':
+	if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    switch (start[1]) {
+	    case 'e':
+		*lexemePtr = STRNEQ;
+		return 2;
+	    case 'i':
+		*lexemePtr = NOT_IN_LIST;
+		return 2;
+	    }
+	}
+    }
+
+    literal = Tcl_NewObj();
+    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
+	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
+	if (end < start + numBytes && !isalnum(UCHAR(*end))
+		&& UCHAR(*end) != '_') {
+	
+	number:
+	    TclInitStringRep(literal, start, end-start);
+	    *lexemePtr = NUMBER;
+	    if (literalPtr) {
+		*literalPtr = literal;
+	    } else {
+		Tcl_DecrRefCount(literal);
 	    }
-	    Tcl_DStringFree(&opBuf);
-	    opIndex = (int) Tcl_GetHashValue(hPtr);
-	    opDescPtr = &(operatorTable[opIndex]);
+	    return (end-start);
+	} else {
+	    unsigned char lexeme;
 
 	    /*
-	     * If the operator is "normal", compile it using information
-	     * from the operator table.
+	     * We have a number followed directly by bareword characters
+	     * (alpha, digit, underscore).  Is this a number followed by
+	     * bareword syntax error?  Or should we join into one bareword?
+	     * Example: Inf + luence + () becomes a valid function call.
+	     * [Bug 3401704]
 	     */
-
-	    if (opDescPtr->numOperands > 0) {
-		tokenPtr++;
-		code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		tokenPtr += (tokenPtr->numComponents + 1);
-
-		if (opDescPtr->numOperands == 2) {
-		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-		    if (code != TCL_OK) {
-			goto done;
+	    if (literal->typePtr == &tclDoubleType) {
+		const char *p = start;
+		while (p < end) {
+		    if (!isalnum(UCHAR(*p++))) {
+			/*
+			 * The number has non-bareword characters, so we 
+			 * must treat it as a number.
+			 */
+			goto number;
 		    }
-		    tokenPtr += (tokenPtr->numComponents + 1);
 		}
-		TclEmitOpcode(opDescPtr->instruction, envPtr);
-		infoPtr->hasOperators = 1;
-		break;
 	    }
-	    
+	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
+	    if ((NODE_TYPE & lexeme) == BINARY) {
+		/*
+		 * The bareword characters following the number take the
+		 * form of an operator (eq, ne, in, ni, ...) so we treat
+		 * as number + operator.
+		 */
+		goto number;
+	    }
 	    /*
-	     * The operator requires special treatment, and is either
-	     * "+" or "-", or one of "&&", "||" or "?".
+	     * Otherwise, fall through and parse the whole as a bareword.
 	     */
-	    
-	    switch (opIndex) {
-	        case OP_PLUS:
-	        case OP_MINUS:
-		    tokenPtr++;
-		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    tokenPtr += (tokenPtr->numComponents + 1);
-		    
-		    /*
-		     * Check whether the "+" or "-" is unary.
-		     */
-		    
-		    afterSubexprPtr = exprTokenPtr
-			    + exprTokenPtr->numComponents+1;
-		    if (tokenPtr == afterSubexprPtr) {
-			TclEmitOpcode(((opIndex==OP_PLUS)?
-			        INST_UPLUS : INST_UMINUS),
-			        envPtr);
-			break;
-		    }
-		    
-		    /*
-		     * The "+" or "-" is binary.
-		     */
-		    
-		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    tokenPtr += (tokenPtr->numComponents + 1);
-		    TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
-			    envPtr);
-		    break;
-
-	        case OP_LAND:
-	        case OP_LOR:
-		    code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
-			    infoPtr, envPtr, &endPtr);
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    tokenPtr = endPtr;
-		    break;
-			
-	        case OP_QUESTY:
-		    code = CompileCondExpr(exprTokenPtr, infoPtr,
-			    envPtr, &endPtr);
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    tokenPtr = endPtr;
-		    break;
-		    
-		default:
-		    panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
-		        opIndex);
-	    } /* end switch on operator requiring special treatment */
-	    infoPtr->hasOperators = 1;
-	    break;
-
-        default:
-	    panic("CompileSubExpr: unexpected token type %d\n",
-	            tokenPtr->type);
+	}
     }
 
-    /*
-     * Verify that the subexpression token had the required number of
-     * subtokens: that we've advanced tokenPtr just beyond the
-     * subexpression's last token. For example, a "*" subexpression must
-     * contain the tokens for exactly two operands.
-     */
-    
-    if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
-	LogSyntaxError(infoPtr);
-	code = TCL_ERROR;
+    if (Tcl_UtfCharComplete(start, numBytes)) {
+	scanned = Tcl_UtfToUniChar(start, &ch);
+    } else {
+	char utfBytes[TCL_UTF_MAX];
+	memcpy(utfBytes, start, (size_t) numBytes);
+	utfBytes[numBytes] = '\0';
+	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
     }
-    
-    done:
-    return code;
+    if (!isalnum(UCHAR(ch))) {
+	*lexemePtr = INVALID;
+	Tcl_DecrRefCount(literal);
+	return scanned;
+    }
+    end = start;
+    while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
+	end += scanned;
+	numBytes -= scanned;
+	if (Tcl_UtfCharComplete(end, numBytes)) {
+	    scanned = Tcl_UtfToUniChar(end, &ch);
+	} else {
+	    char utfBytes[TCL_UTF_MAX];
+	    memcpy(utfBytes, end, (size_t) numBytes);
+	    utfBytes[numBytes] = '\0';
+	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
+	}
+    }
+    *lexemePtr = BAREWORD;
+    if (literalPtr) {
+	Tcl_SetStringObj(literal, start, (int) (end-start));
+	*literalPtr = literal;
+    } else {
+	Tcl_DecrRefCount(literal);
+    }
+    return (end-start);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CompileLandOrLorExpr --
+ * TclCompileExpr --
  *
- *	This procedure compiles a Tcl logical and ("&&") or logical or
- *	("||") subexpression.
+ *	This procedure compiles a string containing a Tcl expression into Tcl
+ *	bytecodes.
  *
  * Results:
- *	The return value is TCL_OK on a successful compilation and TCL_ERROR
- *	on failure. If TCL_OK is returned, a pointer to the token just after
- *	the last one in the subexpression is stored at the address in
- *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
+ *	None.
  *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the expression at runtime.
@@ -580,387 +2022,680 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
  *----------------------------------------------------------------------
  */
 
-static int
-CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
-    Tcl_Token *exprTokenPtr;	 /* Points to TCL_TOKEN_SUB_EXPR token
-				  * containing the "&&" or "||" operator. */
-    int opIndex;		 /* A code describing the expression
-				  * operator: either OP_LAND or OP_LOR. */
-    ExprInfo *infoPtr;		 /* Describes the compilation state for the
-				  * expression being compiled. */
-    CompileEnv *envPtr;		 /* Holds resulting instructions. */
-    Tcl_Token **endPtrPtr;	 /* If successful, a pointer to the token
-				  * just after the last token in the
-				  * subexpression is stored here. */
+void
+TclCompileExpr(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    const char *script,		/* The source script to compile. */
+    int numBytes,		/* Number of bytes in script. */
+    CompileEnv *envPtr,		/* Holds resulting instructions. */
+    int optimize)               /* 0 for one-off expressions */
 {
-    JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
-				  * after the first subexpression. */
-    JumpFixup lhsTrueFixup, lhsEndFixup;
-    				 /* Used to fix up jumps used to convert the
-				  * first operand to 0 or 1. */
-    Tcl_Token *tokenPtr;
-    int dist, code;
-    int savedStackDepth = envPtr->currStackDepth;
+    OpNode *opTree = NULL;	/* Will point to the tree of operators */
+    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
+    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
+    Tcl_Parse *parsePtr =
+	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+				/* Holds the Tcl_Tokens of substitutions */
+
+    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
+	    funcList, parsePtr, 0 /* parseOnly */);
+
+    if (code == TCL_OK) {
+
+	/* Valid parse; compile the tree. */
+	int objc;
+	Tcl_Obj *const *litObjv;
+	Tcl_Obj **funcObjv;
+
+	/* TIP #280 : Track Lines within the expression */
+	TclAdvanceLines(&envPtr->line, script,
+		script + TclParseAllWhiteSpace(script, numBytes));
+
+	TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
+	TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
+	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
+		parsePtr->tokenPtr, envPtr, optimize);
+    } else {
+	TclCompileSyntaxError(interp, envPtr);
+    }
 
-    /*
-     * Emit code for the first operand.
-     */
+    Tcl_FreeParse(parsePtr);
+    TclStackFree(interp, parsePtr);
+    Tcl_DecrRefCount(funcList);
+    Tcl_DecrRefCount(litList);
+    ckfree((char *) opTree);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExecConstantExprTree --
+ *	Compiles and executes bytecode for the subexpression tree at index
+ *	in the nodes array.  This subexpression must be constant, made up
+ *	of only constant operators (not functions) and literals.
+ *
+ * Results:
+ *	A standard Tcl return code and result left in interp.
+ *
+ * Side effects:
+ *	Consumes subtree of nodes rooted at index.  Advances the pointer
+ *	*litObjvPtr.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    tokenPtr = exprTokenPtr+2;
-    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-    if (code != TCL_OK) {
-	goto done;
-    }
-    tokenPtr += (tokenPtr->numComponents + 1);
+static int
+ExecConstantExprTree(
+    Tcl_Interp *interp,
+    OpNode *nodes,
+    int index,
+    Tcl_Obj *const **litObjvPtr)
+{
+    CompileEnv *envPtr;
+    ByteCode *byteCodePtr;
+    int code;
+    Tcl_Obj *byteCodeObj = Tcl_NewObj();
 
     /*
-     * Convert the first operand to the result that Tcl requires:
-     * "0" or "1". Eventually we'll use a new instruction for this.
+     * Note we are compiling an expression with literal arguments. This means
+     * there can be no [info frame] calls when we execute the resulting
+     * bytecode, so there's no need to tend to TIP 280 issues.
      */
-    
-    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
-    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
-    dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
-        badDist:
-	panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
-    }
-    envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
-    dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
-	goto badDist;
-    }
 
-    /*
-     * Emit the "short circuit" jump around the rest of the expression.
-     * Duplicate the "0" or "1" on top of the stack first to keep the
-     * jump from consuming it.
-     */
+    envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv));
+    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
+    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
+	    0 /* optimize */);
+    TclEmitOpcode(INST_DONE, envPtr);
+    Tcl_IncrRefCount(byteCodeObj);
+    TclInitByteCodeObj(byteCodeObj, envPtr);
+    TclFreeCompileEnv(envPtr);
+    TclStackFree(interp, envPtr);
+    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.twoPtrValue.ptr1;
+    code = TclExecuteByteCode(interp, byteCodePtr);
+    Tcl_DecrRefCount(byteCodeObj);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileExprTree --
+ *	Compiles and writes to envPtr instructions for the subexpression
+ *	tree at index in the nodes array.  (*litObjvPtr) must point to the
+ *	proper location in a corresponding literals list.  Likewise, when
+ *	non-NULL, funcObjv and tokenPtr must point into matching arrays of
+ * 	function names and Tcl_Token's derived from earlier call to
+ *	ParseExpr().  When optimize is true, any constant subexpressions
+ *	will be precomputed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
+ *	Consumes subtree of nodes rooted at index.  Advances the pointer
+ *	*litObjvPtr.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    TclEmitOpcode(INST_DUP, envPtr);
-    TclEmitForwardJump(envPtr,
-	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
-	    &shortCircuitFixup);
+static void
+CompileExprTree(
+    Tcl_Interp *interp,
+    OpNode *nodes,
+    int index,
+    Tcl_Obj *const **litObjvPtr,
+    Tcl_Obj *const *funcObjv,
+    Tcl_Token *tokenPtr,
+    CompileEnv *envPtr,
+    int optimize)
+{
+    OpNode *nodePtr = nodes + index;
+    OpNode *rootPtr = nodePtr;
+    int numWords = 0;
+    JumpList *jumpPtr = NULL;
+    int convert = 1;
+
+    while (1) {
+	int next;
+	JumpList *freePtr, *newJump;
+
+	if (nodePtr->mark == MARK_LEFT) {
+	    next = nodePtr->left;
+
+	    switch (nodePtr->lexeme) {
+	    case QUESTION:
+		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		jumpPtr->depth = envPtr->currStackDepth;
+		convert = 1;
+		break;
+	    case AND:
+	    case OR:
+		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		jumpPtr->depth = envPtr->currStackDepth;
+		break;
+	    }
+	} else if (nodePtr->mark == MARK_RIGHT) {
+	    next = nodePtr->right;
+
+	    switch (nodePtr->lexeme) {
+	    case FUNCTION: {
+		Tcl_DString cmdName;
+		const char *p;
+		int length;
+
+		Tcl_DStringInit(&cmdName);
+		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
+		p = TclGetStringFromObj(*funcObjv, &length);
+		funcObjv++;
+		Tcl_DStringAppend(&cmdName, p, length);
+		TclEmitPush(TclRegisterNewNSLiteral(envPtr,
+			Tcl_DStringValue(&cmdName),
+			Tcl_DStringLength(&cmdName)), envPtr);
+		Tcl_DStringFree(&cmdName);
+
+		/*
+		 * Start a count of the number of words in this function
+		 * command invocation.  In case there's already a count
+		 * in progress (nested functions), save it in our unused
+		 * "left" field for restoring later.
+		 */
+
+		nodePtr->left = numWords;
+		numWords = 2;	/* Command plus one argument */
+		break;
+	    }
+	    case QUESTION:
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+		break;
+	    case COLON:
+		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+			&(jumpPtr->next->jump));
+		envPtr->currStackDepth = jumpPtr->depth;
+		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
+		jumpPtr->convert = convert;
+		convert = 1;
+		break;
+	    case AND:
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+		break;
+	    case OR:
+		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
+		break;
+	    }
+	} else {
+	    switch (nodePtr->lexeme) {
+	    case START:
+	    case QUESTION:
+		if (convert && (nodePtr == rootPtr)) {
+		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+		}
+		break;
+	    case OPEN_PAREN:
 
-    /*
-     * Emit code for the second operand.
-     */
+		/* do nothing */
+		break;
+	    case FUNCTION:
 
-    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-    if (code != TCL_OK) {
-	goto done;
-    }
-    tokenPtr += (tokenPtr->numComponents + 1);
+		/*
+		 * Use the numWords count we've kept to invoke the
+		 * function command with the correct number of arguments.
+		 */
 
-    /*
-     * Emit a "logical and" or "logical or" instruction. This does not try
-     * to "short- circuit" the evaluation of both operands, but instead
-     * ensures that we either have a "1" or a "0" result.
-     */
+		if (numWords < 255) {
+		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
+		}
 
-    TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
+		/* Restore any saved numWords value. */
+		numWords = nodePtr->left;
+		convert = 1;
+		break;
+	    case COMMA:
 
-    /*
-     * Now that we know the target of the forward jump, update it with the
-     * correct distance.
-     */
+		/* Each comma implies another function argument. */
+		numWords++;
+		break;
+	    case COLON:
+		if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
+			(envPtr->codeNext - envPtr->codeStart)
+			- jumpPtr->next->jump.codeOffset, 127)) {
+		    jumpPtr->offset += 3;
+		}
+		TclFixupForwardJump(envPtr, &(jumpPtr->jump),
+			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
+		convert |= jumpPtr->convert;
+		envPtr->currStackDepth = jumpPtr->depth + 1;
+		freePtr = jumpPtr;
+		jumpPtr = jumpPtr->next;
+		TclStackFree(interp, freePtr);
+		freePtr = jumpPtr;
+		jumpPtr = jumpPtr->next;
+		TclStackFree(interp, freePtr);
+		break;
+	    case AND:
+	    case OR:
+		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
+			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
+			&(jumpPtr->next->jump));
+		TclEmitPush(TclRegisterNewLiteral(envPtr,
+			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
+		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+			&(jumpPtr->next->next->jump));
+		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
+		if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
+		    jumpPtr->next->next->jump.codeOffset += 3;
+		}
+		TclEmitPush(TclRegisterNewLiteral(envPtr,
+			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
+		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
+			127);
+		convert = 0;
+		envPtr->currStackDepth = jumpPtr->depth + 1;
+		freePtr = jumpPtr;
+		jumpPtr = jumpPtr->next;
+		TclStackFree(interp, freePtr);
+		freePtr = jumpPtr;
+		jumpPtr = jumpPtr->next;
+		TclStackFree(interp, freePtr);
+		freePtr = jumpPtr;
+		jumpPtr = jumpPtr->next;
+		TclStackFree(interp, freePtr);
+		break;
+	    default:
+		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
+		convert = 0;
+		break;
+	    }
+	    if (nodePtr == rootPtr) {
 
-    dist = (envPtr->codeNext - envPtr->codeStart)
-	    - shortCircuitFixup.codeOffset;
-    TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
-    *endPtrPtr = tokenPtr;
+		/* We're done */
+		return;
+	    }
+	    nodePtr = nodes + nodePtr->p.parent;
+	    continue;
+	}
 
-    done:
-    envPtr->currStackDepth = savedStackDepth + 1;
-    return code;
+	nodePtr->mark++;
+	switch (next) {
+	case OT_EMPTY:
+	    numWords = 1;	/* No arguments, so just the command */
+	    break;
+	case OT_LITERAL: {
+	    Tcl_Obj *const *litObjv = *litObjvPtr;
+	    Tcl_Obj *literal = *litObjv;
+
+	    if (optimize) {
+		int length, index;
+		const char *bytes = TclGetStringFromObj(literal, &length);
+		LiteralEntry *lePtr;
+		Tcl_Obj *objPtr;
+
+		index = TclRegisterNewLiteral(envPtr, bytes, length);
+		lePtr = envPtr->literalArrayPtr + index;
+		objPtr = lePtr->objPtr;
+		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
+		    /*
+		     * Would like to do this:
+		     *
+		     * lePtr->objPtr = literal;
+		     * Tcl_IncrRefCount(literal);
+		     * Tcl_DecrRefCount(objPtr);
+		     *
+		     * However, the design of the "global" and "local"
+		     * LiteralTable does not permit the value of lePtr->objPtr
+		     * to change.  So rather than replace lePtr->objPtr, we
+		     * do surgery to transfer our desired intrep into it.
+		     *
+		     */
+		    objPtr->typePtr = literal->typePtr;
+		    objPtr->internalRep = literal->internalRep;
+		    literal->typePtr = NULL;
+		}
+		TclEmitPush(index, envPtr);
+	    } else {
+		/*
+		 * When optimize==0, we know the expression is a one-off
+		 * and there's nothing to be gained from sharing literals
+		 * when they won't live long, and the copies we have already
+		 * have an appropriate intrep.  In this case, skip literal
+		 * registration that would enable sharing, and use the routine
+		 * that preserves intreps.
+		 */
+		TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+	    }
+	    (*litObjvPtr)++;
+	    break;
+	}
+	case OT_TOKENS:
+	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
+		    envPtr);
+	    tokenPtr += tokenPtr->numComponents + 1;
+	    break;
+	default:
+	    if (optimize && nodes[next].constant) {
+		Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);
+		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
+			== TCL_OK) {
+		    TclEmitPush(TclAddLiteralObj(envPtr,
+			    Tcl_GetObjResult(interp), NULL), envPtr);
+		} else {
+		    TclCompileSyntaxError(interp, envPtr);
+		}
+		Tcl_RestoreInterpState(interp, save);
+		convert = 0;
+	    } else {
+		nodePtr = nodes + next;
+	    }
+	}
+    }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CompileCondExpr --
- *
- *	This procedure compiles a Tcl conditional expression:
- *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
+ * TclSingleOpCmd --
+ *	Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
+ *	in the ::tcl::mathop namespace.  These commands have no
+ *	extension to arbitrary arguments; they accept only exactly one
+ *	or exactly two arguments as suitable for the operator.
  *
  * Results:
- *	The return value is TCL_OK on a successful compilation and TCL_ERROR
- *	on failure. If TCL_OK is returned, a pointer to the token just after
- *	the last one in the subexpression is stored at the address in
- *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
+ *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- *	Adds instructions to envPtr to evaluate the expression at runtime.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
-    Tcl_Token *exprTokenPtr;	/* Points to TCL_TOKEN_SUB_EXPR token
-				 * containing the "?" operator. */
-    ExprInfo *infoPtr;		/* Describes the compilation state for the
-				 * expression being compiled. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
-    Tcl_Token **endPtrPtr;	/* If successful, a pointer to the token
-				 * just after the last token in the
-				 * subexpression is stored here. */
+int
+TclSingleOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
-				/* Used to update or replace one-byte jumps
-				 * around the then and else expressions when
-				 * their target PCs are determined. */
-    Tcl_Token *tokenPtr;
-    int elseCodeOffset, dist, code;
-    int savedStackDepth = envPtr->currStackDepth;
-
-    /*
-     * Emit code for the test.
-     */
+    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    unsigned char lexeme;
+    OpNode nodes[2];
+    Tcl_Obj *const *litObjv = objv + 1;
+
+    if (objc != 1+occdPtr->i.numArgs) {
+	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+	return TCL_ERROR;
+    }
 
-    tokenPtr = exprTokenPtr+2;
-    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-    if (code != TCL_OK) {
-	goto done;
+    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+    nodes[0].lexeme = START;
+    nodes[0].mark = MARK_RIGHT;
+    nodes[0].right = 1;
+    nodes[1].lexeme = lexeme;
+    if (objc == 2) {
+	nodes[1].mark = MARK_RIGHT;
+    } else {
+	nodes[1].mark = MARK_LEFT;
+	nodes[1].left = OT_LITERAL;
     }
-    tokenPtr += (tokenPtr->numComponents + 1);
-    
-    /*
-     * Emit the jump to the "else" expression if the test was false.
-     */
-    
-    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
+    nodes[1].right = OT_LITERAL;
+    nodes[1].p.parent = 0;
 
-    /*
-     * Compile the "then" expression. Note that if a subexpression is only
-     * a primary, we need to try to convert it to numeric. We do this to
-     * support Tcl's policy of interpreting operands if at all possible as
-     * first integers, else floating-point numbers.
-     */
+    return ExecConstantExprTree(interp, nodes, 0, &litObjv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSortingOpCmd --
+ *	Implements the commands: <, <=, >, >=, ==, eq
+ *	in the ::tcl::mathop namespace.  These commands are defined for
+ *	arbitrary number of arguments by computing the AND of the base
+ * 	operator applied to all neighbor argument pairs.
+ *
+ * Results:
+ *	A standard Tcl return code and result left in interp.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    infoPtr->hasOperators = 0;
-    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-    if (code != TCL_OK) {
-	goto done;
-    }
-    tokenPtr += (tokenPtr->numComponents + 1);
-    if (!infoPtr->hasOperators) {
-	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
-    }
+int
+TclSortingOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int code = TCL_OK;
 
-    /*
-     * Emit an unconditional jump around the "else" condExpr.
-     */
-    
-    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-	    &jumpAroundElseFixup);
+    if (objc < 3) {
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+    } else {
+	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+	Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
+		2*(objc-2)*sizeof(Tcl_Obj *));
+	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
+		2*(objc-2)*sizeof(OpNode));
+	unsigned char lexeme;
+	int i, lastAnd = 1;
+	Tcl_Obj *const *litObjPtrPtr = litObjv;
+
+	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+
+	litObjv[0] = objv[1];
+	nodes[0].lexeme = START;
+	nodes[0].mark = MARK_RIGHT;
+	for (i=2; i<objc-1; i++) {
+	    litObjv[2*(i-1)-1] = objv[i];
+	    nodes[2*(i-1)-1].lexeme = lexeme;
+	    nodes[2*(i-1)-1].mark = MARK_LEFT;
+	    nodes[2*(i-1)-1].left = OT_LITERAL;
+	    nodes[2*(i-1)-1].right = OT_LITERAL;
+
+	    litObjv[2*(i-1)] = objv[i];
+	    nodes[2*(i-1)].lexeme = AND;
+	    nodes[2*(i-1)].mark = MARK_LEFT;
+	    nodes[2*(i-1)].left = lastAnd;
+	    nodes[lastAnd].p.parent = 2*(i-1);
+
+	    nodes[2*(i-1)].right = 2*(i-1)+1;
+	    nodes[2*(i-1)+1].p.parent= 2*(i-1);
+
+	    lastAnd = 2*(i-1);
+	}
+	litObjv[2*(objc-2)-1] = objv[objc-1];
 
-    /*
-     * Compile the "else" expression.
-     */
+	nodes[2*(objc-2)-1].lexeme = lexeme;
+	nodes[2*(objc-2)-1].mark = MARK_LEFT;
+	nodes[2*(objc-2)-1].left = OT_LITERAL;
+	nodes[2*(objc-2)-1].right = OT_LITERAL;
 
-    envPtr->currStackDepth = savedStackDepth;
-    elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-    infoPtr->hasOperators = 0;
-    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-    if (code != TCL_OK) {
-	goto done;
-    }
-    tokenPtr += (tokenPtr->numComponents + 1);
-    if (!infoPtr->hasOperators) {
-	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
-    }
+	nodes[0].right = lastAnd;
+	nodes[lastAnd].p.parent = 0;
 
-    /*
-     * Fix up the second jump around the "else" expression.
-     */
+	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
 
-    dist = (envPtr->codeNext - envPtr->codeStart)
-	    - jumpAroundElseFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
-	/*
-	 * Update the else expression's starting code offset since it
-	 * moved down 3 bytes too.
-	 */
-	
-	elseCodeOffset += 3;
+	TclStackFree(interp, nodes);
+	TclStackFree(interp, litObjv);
     }
-	
-    /*
-     * Fix up the first jump to the "else" expression if the test was false.
-     */
-    
-    dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
-    TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
-    *endPtrPtr = tokenPtr;
-
-    done:
-    envPtr->currStackDepth = savedStackDepth + 1;
     return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CompileMathFuncCall --
- *
- *	This procedure compiles a call on a math function in an expression:
- *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
+ * TclVariadicOpCmd --
+ *	Implements the commands: +, *, &, |, ^, **
+ *	in the ::tcl::mathop namespace.  These commands are defined for
+ *	arbitrary number of arguments by repeatedly applying the base
+ *	operator with suitable associative rules.  When fewer than two
+ *	arguments are provided, suitable identity values are returned.
  *
  * Results:
- *	The return value is TCL_OK on a successful compilation and TCL_ERROR
- *	on failure. If TCL_OK is returned, a pointer to the token just after
- *	the last one in the subexpression is stored at the address in
- *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
+ *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- *	Adds instructions to envPtr to evaluate the math function at
- *	runtime.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
-    Tcl_Token *exprTokenPtr;	/* Points to TCL_TOKEN_SUB_EXPR token
-				 * containing the math function call. */
-    CONST char *funcName;	/* Name of the math function. */
-    ExprInfo *infoPtr;		/* Describes the compilation state for the
-				 * expression being compiled. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
-    Tcl_Token **endPtrPtr;	/* If successful, a pointer to the token
-				 * just after the last token in the
-				 * subexpression is stored here. */
+int
+TclVariadicOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    Tcl_Interp *interp = infoPtr->interp;
-    Interp *iPtr = (Interp *) interp;
-    MathFunc *mathFuncPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_Token *tokenPtr, *afterSubexprPtr;
-    int code, i;
-
-    /*
-     * Look up the MathFunc record for the function.
-     */
+    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    unsigned char lexeme;
+    int code;
 
-    code = TCL_OK;
-    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
-    if (hPtr == NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"unknown math function \"", funcName, "\"", (char *) NULL);
-	code = TCL_ERROR;
-	goto done;
+    if (objc < 2) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
+	return TCL_OK;
     }
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-    /*
-     * If not a builtin function, push an object with the function's name.
-     */
-
-    if (mathFuncPtr->builtinFuncIndex < 0) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
-    }
+    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
+    lexeme |= BINARY;
+
+    if (objc == 2) {
+	Tcl_Obj *litObjv[2];
+	OpNode nodes[2];
+	int decrMe = 0;
+	Tcl_Obj *const *litObjPtrPtr = litObjv;
+
+	if (lexeme == EXPON) {
+	    litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
+	    Tcl_IncrRefCount(litObjv[1]);
+	    decrMe = 1;
+	    litObjv[0] = objv[1];
+	    nodes[0].lexeme = START;
+	    nodes[0].mark = MARK_RIGHT;
+	    nodes[0].right = 1;
+	    nodes[1].lexeme = lexeme;
+	    nodes[1].mark = MARK_LEFT;
+	    nodes[1].left = OT_LITERAL;
+	    nodes[1].right = OT_LITERAL;
+	    nodes[1].p.parent = 0;
+	} else {
+	    if (lexeme == DIVIDE) {
+		litObjv[0] = Tcl_NewDoubleObj(1.0);
+	    } else {
+		litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
+	    }
+	    Tcl_IncrRefCount(litObjv[0]);
+	    litObjv[1] = objv[1];
+	    nodes[0].lexeme = START;
+	    nodes[0].mark = MARK_RIGHT;
+	    nodes[0].right = 1;
+	    nodes[1].lexeme = lexeme;
+	    nodes[1].mark = MARK_LEFT;
+	    nodes[1].left = OT_LITERAL;
+	    nodes[1].right = OT_LITERAL;
+	    nodes[1].p.parent = 0;
+	}
 
-    /*
-     * Compile any arguments for the function.
-     */
+	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
 
-    tokenPtr = exprTokenPtr+2;
-    afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
-    if (mathFuncPtr->numArgs > 0) {
-	for (i = 0;  i < mathFuncPtr->numArgs;  i++) {
-	    if (tokenPtr == afterSubexprPtr) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		        "too few arguments for math function", -1);
-		code = TCL_ERROR;
-		goto done;
-	    }
-	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
-	    if (code != TCL_OK) {
-		goto done;
+	Tcl_DecrRefCount(litObjv[decrMe]);
+	return code;
+    } else {
+	Tcl_Obj *const *litObjv = objv + 1;
+	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
+		(objc-1)*sizeof(OpNode));
+	int i, lastOp = OT_LITERAL;
+
+	nodes[0].lexeme = START;
+	nodes[0].mark = MARK_RIGHT;
+	if (lexeme == EXPON) {
+	    for (i=objc-2; i>0; i-- ) {
+		nodes[i].lexeme = lexeme;
+		nodes[i].mark = MARK_LEFT;
+		nodes[i].left = OT_LITERAL;
+		nodes[i].right = lastOp;
+		if (lastOp >= 0) {
+		    nodes[lastOp].p.parent = i;
+		}
+		lastOp = i;
+	    }
+	} else {
+	    for (i=1; i<objc-1; i++ ) {
+		nodes[i].lexeme = lexeme;
+		nodes[i].mark = MARK_LEFT;
+		nodes[i].left = lastOp;
+		if (lastOp >= 0) {
+		    nodes[lastOp].p.parent = i;
+		}
+		nodes[i].right = OT_LITERAL;
+		lastOp = i;
 	    }
-	    tokenPtr += (tokenPtr->numComponents + 1);
 	}
-	if (tokenPtr != afterSubexprPtr) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		    "too many arguments for math function", -1);
-	    code = TCL_ERROR;
-	    goto done;
-	} 
-    } else if (tokenPtr != afterSubexprPtr) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"too many arguments for math function", -1);
-	code = TCL_ERROR;
-	goto done;
-    }
-    
-    /*
-     * Compile the call on the math function. Note that the "objc" argument
-     * count for non-builtin functions is incremented by 1 to include the
-     * function name itself.
-     */
+	nodes[0].right = lastOp;
+	nodes[lastOp].p.parent = 0;
 
-    if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
-	/*
-	 * Adjust the current stack depth by the number of arguments
-	 * of the builtin function. This cannot be handled by the 
-	 * TclEmitInstInt1 macro as the number of arguments is not
-	 * passed as an operand.
-	 */
+	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
 
-	if (envPtr->maxStackDepth < envPtr->currStackDepth) {
-	    envPtr->maxStackDepth = envPtr->currStackDepth;
-	}
-	TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
-	        mathFuncPtr->builtinFuncIndex, envPtr);
-	envPtr->currStackDepth -= mathFuncPtr->numArgs;
-    } else {
-	TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
-    }
-    *endPtrPtr = afterSubexprPtr;
+	TclStackFree(interp, nodes);
 
-    done:
-    return code;
+	return code;
+    }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * LogSyntaxError --
- *
- *	This procedure is invoked after an error occurs when compiling an
- *	expression. It sets the interpreter result to an error message
- *	describing the error.
+ * TclNoIdentOpCmd --
+ *	Implements the commands: -, /
+ *	in the ::tcl::mathop namespace.  These commands are defined for
+ *	arbitrary non-zero number of arguments by repeatedly applying
+ *	the base operator with suitable associative rules.  When no
+ *	arguments are provided, an error is raised.
  *
  * Results:
- *	None.
+ *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- *	Sets the interpreter result to an error message describing the
- *	expression that was being compiled when the error occurred.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-LogSyntaxError(infoPtr)
-    ExprInfo *infoPtr;		/* Describes the compilation state for the
-				 * expression being compiled. */
+int
+TclNoIdentOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    int numBytes = (infoPtr->lastChar - infoPtr->expr);
-    char buffer[100];
-
-    sprintf(buffer, "syntax error in expression \"%.*s\"",
-	    ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
-    Tcl_ResetResult(infoPtr->interp);
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
-	    buffer, (char *) NULL);
+    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
+	return TCL_ERROR;
+    }
+    return TclVariadicOpCmd(clientData, interp, objc, objv);
 }
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1ec7c58..3bedf39 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1,15 +1,15 @@
-/* 
+/*
  * tclCompile.c --
  *
- *	This file contains procedures that compile Tcl commands or parts
- *	of commands (like quoted strings or nested sub-commands) into a
- *	sequence of instructions ("bytecodes"). 
+ *	This file contains procedures that compile Tcl commands or parts of
+ *	commands (like quoted strings or nested sub-commands) into a sequence
+ *	of instructions ("bytecodes").
  *
  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -18,7 +18,7 @@
 /*
  * Table of all AuxData types.
  */
- 
+
 static Tcl_HashTable auxDataTypeTable;
 static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */
 
@@ -40,10 +40,10 @@ static int traceInitialized = 0;
 
 /*
  * A table describing the Tcl bytecode instructions. Entries in this table
- * must correspond to the instruction opcode definitions in tclCompile.h.
- * The names "op1" and "op4" refer to an instruction's one or four byte
- * first operand. Similarly, "stktop" and "stknext" refer to the topmost
- * and next to topmost stack elements.
+ * must correspond to the instruction opcode definitions in tclCompile.h. The
+ * names "op1" and "op4" refer to an instruction's one or four byte first
+ * operand. Similarly, "stktop" and "stknext" refer to the topmost and next to
+ * topmost stack elements.
  *
  * Note that the load, store, and incr instructions do not distinguish local
  * from global variables; the bytecode interpreter at runtime uses the
@@ -51,276 +51,398 @@ static int traceInitialized = 0;
  */
 
 InstructionDesc tclInstructionTable[] = {
-   /* Name	      Bytes stackEffect #Opnds Operand types	Stack top, next	  */
-    {"done",		  1,   -1,        0,   {OPERAND_NONE}},
+    /* Name	      Bytes stackEffect #Opnds  Operand types */
+    {"done",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Finish ByteCode execution and return stktop (top stack item) */
-    {"push1",		  2,   +1,         1,   {OPERAND_UINT1}},
+    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
 	/* Push object at ByteCode objArray[op1] */
-    {"push4",		  5,   +1,         1,   {OPERAND_UINT4}},
+    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
 	/* Push object at ByteCode objArray[op4] */
-    {"pop",		  1,   -1,        0,   {OPERAND_NONE}},
+    {"pop",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Pop the topmost stack object */
-    {"dup",		  1,   +1,         0,   {OPERAND_NONE}},
+    {"dup",		  1,   +1,         0,	{OPERAND_NONE}},
 	/* Duplicate the topmost stack object and push the result */
-    {"concat1",		  2,   INT_MIN,    1,   {OPERAND_UINT1}},
+    {"concat1",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Concatenate the top op1 items and push result */
-    {"invokeStk1",	  2,   INT_MIN,    1,   {OPERAND_UINT1}},
+    {"invokeStk1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
-    {"invokeStk4",	  5,   INT_MIN,    1,   {OPERAND_UINT4}},
+    {"invokeStk4",	  5,   INT_MIN,    1,	{OPERAND_UINT4}},
 	/* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
-    {"evalStk",		  1,   0,          0,   {OPERAND_NONE}},
+    {"evalStk",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Evaluate command in stktop using Tcl_EvalObj. */
-    {"exprStk",		  1,   0,          0,   {OPERAND_NONE}},
+    {"exprStk",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Execute expression in stktop using Tcl_ExprStringObj. */
-    
-    {"loadScalar1",	  2,   1,          1,   {OPERAND_UINT1}},
+
+    {"loadScalar1",	  2,   1,          1,	{OPERAND_LVT1}},
 	/* Load scalar variable at index op1 <= 255 in call frame */
-    {"loadScalar4",	  5,   1,          1,   {OPERAND_UINT4}},
+    {"loadScalar4",	  5,   1,          1,	{OPERAND_LVT4}},
 	/* Load scalar variable at index op1 >= 256 in call frame */
-    {"loadScalarStk",	  1,   0,          0,   {OPERAND_NONE}},
+    {"loadScalarStk",	  1,   0,          0,	{OPERAND_NONE}},
 	/* Load scalar variable; scalar's name is stktop */
-    {"loadArray1",	  2,   0,          1,   {OPERAND_UINT1}},
+    {"loadArray1",	  2,   0,          1,	{OPERAND_LVT1}},
 	/* Load array element; array at slot op1<=255, element is stktop */
-    {"loadArray4",	  5,   0,          1,   {OPERAND_UINT4}},
+    {"loadArray4",	  5,   0,          1,	{OPERAND_LVT4}},
 	/* Load array element; array at slot op1 > 255, element is stktop */
-    {"loadArrayStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"loadArrayStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Load array element; element is stktop, array name is stknext */
-    {"loadStk",		  1,   0,          0,   {OPERAND_NONE}},
+    {"loadStk",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Load general variable; unparsed variable name is stktop */
-    {"storeScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
+    {"storeScalar1",	  2,   0,          1,	{OPERAND_LVT1}},
 	/* Store scalar variable at op1<=255 in frame; value is stktop */
-    {"storeScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
+    {"storeScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
 	/* Store scalar variable at op1 > 255 in frame; value is stktop */
-    {"storeScalarStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"storeScalarStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Store scalar; value is stktop, scalar name is stknext */
-    {"storeArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
+    {"storeArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
 	/* Store array element; array at op1<=255, value is top then elem */
-    {"storeArray4",	  5,   -1,          1,   {OPERAND_UINT4}},
+    {"storeArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
 	/* Store array element; array at op1>=256, value is top then elem */
-    {"storeArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
+    {"storeArrayStk",	  1,   -2,         0,	{OPERAND_NONE}},
 	/* Store array element; value is stktop, then elem, array names */
-    {"storeStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"storeStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Store general variable; value is stktop, then unparsed name */
-    
-    {"incrScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
+
+    {"incrScalar1",	  2,   0,          1,	{OPERAND_LVT1}},
 	/* Incr scalar at index op1<=255 in frame; incr amount is stktop */
-    {"incrScalarStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"incrScalarStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Incr scalar; incr amount is stktop, scalar's name is stknext */
-    {"incrArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
+    {"incrArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
 	/* Incr array elem; arr at slot op1<=255, amount is top then elem */
-    {"incrArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
+    {"incrArrayStk",	  1,   -2,         0,	{OPERAND_NONE}},
 	/* Incr array element; amount is top then elem then array names */
-    {"incrStk",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"incrStk",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Incr general variable; amount is stktop then unparsed var name */
-    {"incrScalar1Imm",	  3,   +1,         2,   {OPERAND_UINT1, OPERAND_INT1}},
+    {"incrScalar1Imm",	  3,   +1,         2,	{OPERAND_LVT1, OPERAND_INT1}},
 	/* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
-    {"incrScalarStkImm",  2,   0,          1,   {OPERAND_INT1}},
+    {"incrScalarStkImm",  2,   0,          1,	{OPERAND_INT1}},
 	/* Incr scalar; scalar name is stktop; incr amount is op1 */
-    {"incrArray1Imm",	  3,   0,         2,   {OPERAND_UINT1, OPERAND_INT1}},
+    {"incrArray1Imm",	  3,   0,          2,	{OPERAND_LVT1, OPERAND_INT1}},
 	/* Incr array elem; array at slot op1 <= 255, elem is stktop,
 	 * amount is 2nd operand byte */
-    {"incrArrayStkImm",	  2,   -1,         1,   {OPERAND_INT1}},
+    {"incrArrayStkImm",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Incr array element; elem is top then array name, amount is op1 */
-    {"incrStkImm",	  2,   0,         1,   {OPERAND_INT1}},
+    {"incrStkImm",	  2,   0,	   1,	{OPERAND_INT1}},
 	/* Incr general variable; unparsed name is top, amount is op1 */
-    
-    {"jump1",		  2,   0,          1,   {OPERAND_INT1}},
+
+    {"jump1",		  2,   0,          1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) */
-    {"jump4",		  5,   0,          1,   {OPERAND_INT4}},
+    {"jump4",		  5,   0,          1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) */
-    {"jumpTrue1",	  2,   -1,         1,   {OPERAND_INT1}},
+    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) if stktop expr object is true */
-    {"jumpTrue4",	  5,   -1,         1,   {OPERAND_INT4}},
+    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) if stktop expr object is true */
-    {"jumpFalse1",	  2,   -1,         1,   {OPERAND_INT1}},
+    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) if stktop expr object is false */
-    {"jumpFalse4",	  5,   -1,         1,   {OPERAND_INT4}},
+    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) if stktop expr object is false */
 
-    {"lor",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"lor",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Logical or:	push (stknext || stktop) */
-    {"land",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"land",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Logical and:	push (stknext && stktop) */
-    {"bitor",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"bitor",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Bitwise or:	push (stknext | stktop) */
-    {"bitxor",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"bitxor",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Bitwise xor	push (stknext ^ stktop) */
-    {"bitand",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"bitand",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Bitwise and:	push (stknext & stktop) */
-    {"eq",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"eq",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Equal:	push (stknext == stktop) */
-    {"neq",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"neq",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Not equal:	push (stknext != stktop) */
-    {"lt",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"lt",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Less:	push (stknext < stktop) */
-    {"gt",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"gt",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Greater:	push (stknext || stktop) */
-    {"le",		  1,   -1,         0,   {OPERAND_NONE}},
-	/* Logical or:	push (stknext || stktop) */
-    {"ge",		  1,   -1,         0,   {OPERAND_NONE}},
-	/* Logical or:	push (stknext || stktop) */
-    {"lshift",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"le",		  1,   -1,         0,	{OPERAND_NONE}},
+	/* Less or equal: push (stknext || stktop) */
+    {"ge",		  1,   -1,         0,	{OPERAND_NONE}},
+	/* Greater or equal: push (stknext || stktop) */
+    {"lshift",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Left shift:	push (stknext << stktop) */
-    {"rshift",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"rshift",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Right shift:	push (stknext >> stktop) */
-    {"add",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"add",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Add:		push (stknext + stktop) */
-    {"sub",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"sub",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Sub:		push (stkext - stktop) */
-    {"mult",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"mult",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Multiply:	push (stknext * stktop) */
-    {"div",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"div",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Divide:	push (stknext / stktop) */
-    {"mod",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"mod",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Mod:		push (stknext % stktop) */
-    {"uplus",		  1,   0,          0,   {OPERAND_NONE}},
+    {"uplus",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Unary plus:	push +stktop */
-    {"uminus",		  1,   0,          0,   {OPERAND_NONE}},
+    {"uminus",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Unary minus:	push -stktop */
-    {"bitnot",		  1,   0,          0,   {OPERAND_NONE}},
+    {"bitnot",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Bitwise not:	push ~stktop */
-    {"not",		  1,   0,          0,   {OPERAND_NONE}},
+    {"not",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Logical not:	push !stktop */
-    {"callBuiltinFunc1",  2,   1,          1,   {OPERAND_UINT1}},
+    {"callBuiltinFunc1",  2,   1,          1,	{OPERAND_UINT1}},
 	/* Call builtin math function with index op1; any args are on stk */
-    {"callFunc1",	  2,   INT_MIN,    1,   {OPERAND_UINT1}},
-	/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
-    {"tryCvtToNumeric",	  1,   0,          0,   {OPERAND_NONE}},
+    {"callFunc1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
+	/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
+    {"tryCvtToNumeric",	  1,   0,          0,	{OPERAND_NONE}},
 	/* Try converting stktop to first int then double if possible. */
 
-    {"break",		  1,   0,          0,   {OPERAND_NONE}},
+    {"break",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Abort closest enclosing loop; if none, return TCL_BREAK code. */
-    {"continue",	  1,   0,          0,   {OPERAND_NONE}},
-	/* Skip to next iteration of closest enclosing loop; if none,
-	 * return TCL_CONTINUE code. */
+    {"continue",	  1,   0,          0,	{OPERAND_NONE}},
+	/* Skip to next iteration of closest enclosing loop; if none, return
+	 * TCL_CONTINUE code. */
 
-    {"foreach_start4",	  5,   0,          1,   {OPERAND_UINT4}},
+    {"foreach_start4",	  5,   0,          1,	{OPERAND_AUX4}},
 	/* Initialize execution of a foreach loop. Operand is aux data index
 	 * of the ForeachInfo structure for the foreach command. */
-    {"foreach_step4",	  5,   +1,         1,   {OPERAND_UINT4}},
+    {"foreach_step4",	  5,   +1,         1,	{OPERAND_AUX4}},
 	/* "Step" or begin next iteration of foreach loop. Push 0 if to
-	 *  terminate loop, else push 1. */
+	 * terminate loop, else push 1. */
 
-    {"beginCatch4",	  5,   0,          1,   {OPERAND_UINT4}},
-	/* Record start of catch with the operand's exception index.
-	 * Push the current stack depth onto a special catch stack. */
-    {"endCatch",	  1,   0,          0,   {OPERAND_NONE}},
+    {"beginCatch4",	  5,   0,          1,	{OPERAND_UINT4}},
+	/* Record start of catch with the operand's exception index. Push the
+	 * current stack depth onto a special catch stack. */
+    {"endCatch",	  1,   0,          0,	{OPERAND_NONE}},
 	/* End of last catch. Pop the bytecode interpreter's catch stack. */
-    {"pushResult",	  1,   +1,         0,   {OPERAND_NONE}},
+    {"pushResult",	  1,   +1,         0,	{OPERAND_NONE}},
 	/* Push the interpreter's object result onto the stack. */
-    {"pushReturnCode",	  1,   +1,         0,   {OPERAND_NONE}},
-	/* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
-	 * a new object onto the stack. */
-    {"streq",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"pushReturnCode",	  1,   +1,         0,	{OPERAND_NONE}},
+	/* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as a new
+	 * object onto the stack. */
+
+    {"streq",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Str Equal:	push (stknext eq stktop) */
-    {"strneq",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"strneq",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Str !Equal:	push (stknext neq stktop) */
-    {"strcmp",		  1,   -1,         0,   {OPERAND_NONE}},
+    {"strcmp",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Str Compare:	push (stknext cmp stktop) */
-    {"strlen",		  1,   0,          0,   {OPERAND_NONE}},
+    {"strlen",		  1,   0,          0,	{OPERAND_NONE}},
 	/* Str Length:	push (strlen stktop) */
-    {"strindex",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"strindex",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Str Index:	push (strindex stknext stktop) */
-    {"strmatch",	  2,   -1,         1,   {OPERAND_INT1}},
+    {"strmatch",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Str Match:	push (strmatch stknext stktop) opnd == nocase */
-    {"list",		  5,   INT_MIN,    1,   {OPERAND_UINT4}},
+
+    {"list",		  5,   INT_MIN,    1,	{OPERAND_UINT4}},
 	/* List:	push (stk1 stk2 ... stktop) */
-    {"listindex",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"listIndex",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* List Index:	push (listindex stknext stktop) */
-    {"listlength",	  1,   0,          0,   {OPERAND_NONE}},
+    {"listLength",	  1,   0,          0,	{OPERAND_NONE}},
 	/* List Len:	push (listlength stktop) */
-    {"appendScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
+
+    {"appendScalar1",	  2,   0,          1,	{OPERAND_LVT1}},
 	/* Append scalar variable at op1<=255 in frame; value is stktop */
-    {"appendScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
+    {"appendScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
 	/* Append scalar variable at op1 > 255 in frame; value is stktop */
-    {"appendArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
+    {"appendArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
 	/* Append array element; array at op1<=255, value is top then elem */
-    {"appendArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
+    {"appendArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
 	/* Append array element; array at op1>=256, value is top then elem */
-    {"appendArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
+    {"appendArrayStk",	  1,   -2,         0,	{OPERAND_NONE}},
 	/* Append array element; value is stktop, then elem, array names */
-    {"appendStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"appendStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Append general variable; value is stktop, then unparsed name */
-    {"lappendScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
+    {"lappendScalar1",	  2,   0,          1,	{OPERAND_LVT1}},
 	/* Lappend scalar variable at op1<=255 in frame; value is stktop */
-    {"lappendScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
+    {"lappendScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
 	/* Lappend scalar variable at op1 > 255 in frame; value is stktop */
-    {"lappendArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
+    {"lappendArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
 	/* Lappend array element; array at op1<=255, value is top then elem */
-    {"lappendArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
+    {"lappendArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
 	/* Lappend array element; array at op1>=256, value is top then elem */
-    {"lappendArrayStk",	  1,   -2,         0,   {OPERAND_NONE}},
+    {"lappendArrayStk",	  1,   -2,         0,	{OPERAND_NONE}},
 	/* Lappend array element; value is stktop, then elem, array names */
-    {"lappendStk",	  1,   -1,         0,   {OPERAND_NONE}},
+    {"lappendStk",	  1,   -1,         0,	{OPERAND_NONE}},
 	/* Lappend general variable; value is stktop, then unparsed name */
-    {"lindexMulti",	  5,   INT_MIN,   1,   {OPERAND_UINT4}},
-        /* Lindex with generalized args, operand is number of stacked objs 
-	 * used: (operand-1) entries from stktop are the indices; then list 
-	 * to process. */
-    {"over",		  5,   +1,         1,   {OPERAND_UINT4}},
-        /* Duplicate the arg-th element from top of stack (TOS=0) */
-    {"lsetList",          1,   -2,         0,   {OPERAND_NONE}},
-        /* Four-arg version of 'lset'. stktop is old value; next is
-         * new element value, next is the index list; pushes new value */
-    {"lsetFlat",          5,   INT_MIN,   1,   {OPERAND_UINT4}},
-        /* Three- or >=5-arg version of 'lset', operand is number of 
-	 * stacked objs: stktop is old value, next is new element value, next 
-	 * come (operand-2) indices; pushes the new value.
+
+    {"lindexMulti",	  5,   INT_MIN,    1,	{OPERAND_UINT4}},
+	/* Lindex with generalized args, operand is number of stacked objs
+	 * used: (operand-1) entries from stktop are the indices; then list to
+	 * process. */
+    {"over",		  5,   +1,         1,	{OPERAND_UINT4}},
+	/* Duplicate the arg-th element from top of stack (TOS=0) */
+    {"lsetList",          1,   -2,         0,	{OPERAND_NONE}},
+	/* Four-arg version of 'lset'. stktop is old value; next is new
+	 * element value, next is the index list; pushes new value */
+    {"lsetFlat",          5,   INT_MIN,    1,	{OPERAND_UINT4}},
+	/* Three- or >=5-arg version of 'lset', operand is number of stacked
+	 * objs: stktop is old value, next is new element value, next come
+	 * (operand-2) indices; pushes the new value.
 	 */
-    {0, 0, 0, 0, {OPERAND_NONE}}
+
+    {"returnImm",	  9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
+	/* Compiled [return], code, level are operands; options and result
+	 * are on the stack. */
+    {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
+	/* Binary exponentiation operator: push (stknext ** stktop) */
+
+    /*
+     * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong -
+     * but it cannot be done right at compile time, the stack effect is only
+     * known at run time. The value for invokeExpanded is estimated better at
+     * compile time.
+     * See the comments further down in this file, where INST_INVOKE_EXPANDED
+     * is emitted.
+     */
+    {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
+	/* Start of command with {*} (expanded) arguments */
+    {"expandStkTop",      5,    0,          1,	{OPERAND_UINT4}},
+	/* Expand the list at stacktop: push its elements on the stack */
+    {"invokeExpanded",    1,    0,          0,	{OPERAND_NONE}},
+	/* Invoke the command marked by the last 'expandStart' */
+
+    {"listIndexImm",	  5,	0,	   1,	{OPERAND_IDX4}},
+	/* List Index:	push (lindex stktop op4) */
+    {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
+	/* List Range:	push (lrange stktop op4 op4) */
+    {"startCommand",	  9,	0,	   2,	{OPERAND_INT4,OPERAND_UINT4}},
+	/* Start of bytecoded command: op is the length of the cmd's code, op2
+	 * is number of commands here */
+
+    {"listIn",		  1,	-1,	   0,	{OPERAND_NONE}},
+	/* List containment: push [lsearch stktop stknext]>=0) */
+    {"listNotIn",	  1,	-1,	   0,	{OPERAND_NONE}},
+	/* List negated containment: push [lsearch stktop stknext]<0) */
+
+    {"pushReturnOpts",	  1,	+1,	   0,	{OPERAND_NONE}},
+	/* Push the interpreter's return option dictionary as an object on the
+	 * stack. */
+    {"returnStk",	  1,	-2,	   0,	{OPERAND_NONE}},
+	/* Compiled [return]; options and result are on the stack, code and
+	 * level are in the options. */
+
+    {"dictGet",		  5,	INT_MIN,   1,	{OPERAND_UINT4}},
+	/* The top op4 words (min 1) are a key path into the dictionary just
+	 * below the keys on the stack, and all those values are replaced by
+	 * the value read out of that key-path (like [dict get]).
+	 * Stack:  ... dict key1 ... keyN => ... value */
+    {"dictSet",		  9,	INT_MIN,   2,	{OPERAND_UINT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the keys are a path pointing to
+	 * the value. op4#1 = numKeys, op4#2 = LVTindex
+	 * Stack:  ... key1 ... keyN value => ... newDict */
+    {"dictUnset",	  9,	INT_MIN,   2,	{OPERAND_UINT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the keys are not a path pointing
+	 * to any value. op4#1 = numKeys, op4#2 = LVTindex
+	 * Stack:  ... key1 ... keyN => ... newDict */
+    {"dictIncrImm",	  9,	0,	   2,	{OPERAND_INT4, OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key is
+	 * incremented by some value (or set to it if the key isn't in the
+	 * dictionary at all). op4#1 = incrAmount, op4#2 = LVTindex
+	 * Stack:  ... key => ... newDict */
+    {"dictAppend",	  5,	-1,	   1,	{OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key has
+	 * some value string-concatenated onto it. op4 = LVTindex
+	 * Stack:  ... key valueToAppend => ... newDict */
+    {"dictLappend",	  5,	-1,	   1,	{OPERAND_LVT4}},
+	/* Update a dictionary value such that the value pointed to by key has
+	 * some value list-appended onto it. op4 = LVTindex
+	 * Stack:  ... key valueToAppend => ... newDict */
+    {"dictFirst",	  5,	+2,	   1,	{OPERAND_LVT4}},
+	/* Begin iterating over the dictionary, using the local scalar
+	 * indicated by op4 to hold the iterator state. If doneBool is true,
+	 * dictDone *must* be called later on.
+	 * Stack:  ... dict => ... value key doneBool */
+    {"dictNext",	  5,	+3,	   1,	{OPERAND_LVT4}},
+	/* Get the next iteration from the iterator in op4's local scalar.
+	 * Stack:  ... => ... value key doneBool */
+    {"dictDone",	  5,	0,	   1,	{OPERAND_LVT4}},
+	/* Terminate the iterator in op4's local scalar. */
+    {"dictUpdateStart",   9,    0,	   2,	{OPERAND_LVT4, OPERAND_AUX4}},
+	/* Create the variables (described in the aux data referred to by the
+	 * second immediate argument) to mirror the state of the dictionary in
+	 * the variable referred to by the first immediate argument. The list
+	 * of keys (popped from the stack) must be the same length as the list
+	 * of variables.
+	 * Stack:  ... keyList => ... */
+    {"dictUpdateEnd",	  9,    -1,	   2,	{OPERAND_LVT4, OPERAND_AUX4}},
+	/* Reflect the state of local variables (described in the aux data
+	 * referred to by the second immediate argument) back to the state of
+	 * the dictionary in the variable referred to by the first immediate
+	 * argument. The list of keys (popped from the stack) must be the same
+	 * length as the list of variables.
+	 * Stack:  ... keyList => ... */
+    {"jumpTable",	  5,	-1,	   1,	{OPERAND_AUX4}},
+	/* Jump according to the jump-table (in AuxData as indicated by the
+	 * operand) and the argument popped from the list. Always executes the
+	 * next instruction if no match against the table's entries was found.
+	 * Stack:  ... value => ...
+	 * Note that the jump table contains offsets relative to the PC when
+	 * it points to this instruction; the code is relocatable. */
+    {"upvar",            5,     0,        1,   {OPERAND_LVT4}},
+         /* finds level and otherName in stack, links to local variable at
+	  * index op1. Leaves the level on stack. */
+    {"nsupvar",          5,     0,        1,   {OPERAND_LVT4}},
+         /* finds namespace and otherName in stack, links to local variable at
+	  * index op1. Leaves the namespace on stack. */
+    {"variable",         5,     0,        1,   {OPERAND_LVT4}},
+         /* finds namespace and otherName in stack, links to local variable at
+	  * index op1. Leaves the namespace on stack. */
+    {"syntax",	 	 9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
+	/* Compiled bytecodes to signal syntax error. */
+    {"reverse",		 5,    0,         1,	{OPERAND_UINT4}},
+	/* Reverse the order of the arg elements at the top of stack */
+
+    {"regexp",		 2,   -1,         1,	{OPERAND_INT1}},
+	/* Regexp:	push (regexp stknext stktop) opnd == nocase */
+
+    {"existScalar",	 5,    1,         1,	{OPERAND_LVT4}},
+	/* Test if scalar variable at index op1 in call frame exists */
+    {"existArray",	 5,    0,         1,	{OPERAND_LVT4}},
+	/* Test if array element exists; array at slot op1, element is
+	 * stktop */
+    {"existArrayStk",	 1,    -1,        0,	{OPERAND_NONE}},
+	/* Test if array element exists; element is stktop, array name is
+	 * stknext */
+    {"existStk",	 1,    0,         0,	{OPERAND_NONE}},
+	/* Test if general variable exists; unparsed variable name is stktop*/
+    {0, 0, 0, 0, {0}}
 };
 
 /*
  * Prototypes for procedures defined later in this file:
  */
 
-static void		DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static unsigned char *	EncodeCmdLocMap _ANSI_ARGS_((
-			    CompileEnv *envPtr, ByteCode *codePtr,
-			    unsigned char *startPtr));
-static void		EnterCmdExtentData _ANSI_ARGS_((
-    			    CompileEnv *envPtr, int cmdNumber,
-			    int numSrcBytes, int numCodeBytes));
-static void		EnterCmdStartData _ANSI_ARGS_((
-    			    CompileEnv *envPtr, int cmdNumber,
-			    int srcOffset, int codeOffset));
-static void		FreeByteCodeInternalRep _ANSI_ARGS_((
-    			    Tcl_Obj *objPtr));
-static int		GetCmdLocEncodingSize _ANSI_ARGS_((
-			    CompileEnv *envPtr));
-static void		LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
-        		    CONST char *script, CONST char *command,
-			    int length));
+static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
+static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
+			    ByteCode *codePtr, unsigned char *startPtr);
+static void		EnterCmdExtentData(CompileEnv *envPtr,
+			    int cmdNumber, int numSrcBytes, int numCodeBytes);
+static void		EnterCmdStartData(CompileEnv *envPtr,
+			    int cmdNumber, int srcOffset, int codeOffset);
+static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
+static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
 #ifdef TCL_COMPILE_STATS
-static void		RecordByteCodeStats _ANSI_ARGS_((
-			    ByteCode *codePtr));
+static void		RecordByteCodeStats(ByteCode *codePtr);
 #endif /* TCL_COMPILE_STATS */
-static int		SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-
-#ifdef TCL_TIP280
-/* TIP #280 : Helper for building the per-word line information of all
- * compiled commands */
-static void		EnterCmdWordData _ANSI_ARGS_((
-    			    ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr,
-			    CONST char* cmd, int len, int numWords, int line,
-			    int* clNext, int** lines, CompileEnv* envPtr));
-static void             ReleaseCmdWordData _ANSI_ARGS_((ExtCmdLoc* eclPtr));
-#endif
-
+static int		SetByteCodeFromAny(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+static int		FormatInstruction(ByteCode *codePtr,
+			    unsigned char *pc, Tcl_Obj *bufferObj);
+static void		PrintSourceToObj(Tcl_Obj *appendObj,
+			    const char *stringPtr, int maxChars);
+/*
+ * TIP #280: Helper for building the per-word line information of all compiled
+ * commands.
+ */
+static void		EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
+			    Tcl_Token *tokenPtr, const char *cmd, int len,
+			    int numWords, int line, int* clNext, int **lines,
+			    CompileEnv* envPtr);
 
 /*
- * The structure below defines the bytecode Tcl object type by
- * means of procedures that can be invoked by generic object code.
+ * The structure below defines the bytecode Tcl object type by means of
+ * procedures that can be invoked by generic object code.
  */
 
 Tcl_ObjType tclByteCodeType = {
-    "bytecode",				/* name */
-    FreeByteCodeInternalRep,		/* freeIntRepProc */
-    DupByteCodeInternalRep,		/* dupIntRepProc */
-    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
-    SetByteCodeFromAny			/* setFromAnyProc */
+    "bytecode",			/* name */
+    FreeByteCodeInternalRep,	/* freeIntRepProc */
+    DupByteCodeInternalRep,	/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    SetByteCodeFromAny		/* setFromAnyProc */
 };
 
 /*
@@ -330,10 +452,10 @@ Tcl_ObjType tclByteCodeType = {
  *
  *	Part of the bytecode Tcl object type implementation. Attempts to
  *	generate an byte code internal form for the Tcl object "objPtr" by
- *	compiling its string representation.  This function also takes
- *	a hook procedure that will be invoked to perform any needed post
- *	processing on the compilation results before generating byte
- *	codes.  interp is compilation context and may not be NULL.
+ *	compiling its string representation. This function also takes a hook
+ *	procedure that will be invoked to perform any needed post processing
+ *	on the compilation results before generating byte codes. interp is
+ *	compilation context and may not be NULL.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -342,61 +464,51 @@ Tcl_ObjType tclByteCodeType = {
  *
  * Side effects:
  *	Frees the old internal representation. If no error occurs, then the
- *	compiled code is stored as "objPtr"s bytecode representation.
- *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
- *	used to trace compilations.
+ *	compiled code is stored as "objPtr"s bytecode representation. Also, if
+ *	debugging, initializes the "tcl_traceCompile" Tcl variable used to
+ *	trace compilations.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
-    Tcl_Interp *interp;		/* The interpreter for which the code is
-				 * being compiled.  Must not be NULL. */
-    Tcl_Obj *objPtr;		/* The object to make a ByteCode object. */
-    CompileHookProc *hookProc;	/* Procedure to invoke after compilation. */
-    ClientData clientData;	/* Hook procedure private data. */
+TclSetByteCodeFromAny(
+    Tcl_Interp *interp,		/* The interpreter for which the code is being
+				 * compiled. Must not be NULL. */
+    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
+    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
+    ClientData clientData)	/* Hook procedure private data. */
 {
     Interp *iPtr = (Interp *) interp;
-    CompileEnv compEnv;		/* Compilation environment structure
-				 * allocated in frame. */
-    LiteralTable *localTablePtr = &(compEnv.localLitTable);
+    CompileEnv compEnv;		/* Compilation environment structure allocated
+				 * in frame. */
     register AuxData *auxDataPtr;
     LiteralEntry *entryPtr;
     register int i;
-    int length, nested, result;
-    char *string;
-#ifdef TCL_TIP280
+    int length, result = TCL_OK;
+    const char *stringPtr;
     ContLineLoc* clLocPtr;
-#endif
+
 #ifdef TCL_COMPILE_DEBUG
     if (!traceInitialized) {
-        if (Tcl_LinkVar(interp, "tcl_traceCompile",
-	            (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
-            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
-        }
-        traceInitialized = 1;
+	if (Tcl_LinkVar(interp, "tcl_traceCompile",
+		(char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
+	    Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
+	}
+	traceInitialized = 1;
     }
 #endif
 
-    if (iPtr->evalFlags & TCL_BRACKET_TERM) {
-	nested = 1;
-    } else {
-	nested = 0;
-    }
-    string = Tcl_GetStringFromObj(objPtr, &length);
-#ifndef TCL_TIP280
-    TclInitCompileEnv(interp, &compEnv, string, length);
-#else
+    stringPtr = TclGetStringFromObj(objPtr, &length);
+
     /*
-     * TIP #280. Pick up the CmdFrame in which the BC compiler was invoked
-     * and use to initialize the tracking in the compiler. This information
-     * was stored by TclCompEvalObj (tclExecute.c), and ProcCompileProc
-     * (tclProc.c).
+     * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
+     * use to initialize the tracking in the compiler. This information was
+     * stored by TclCompEvalObj and ProcCompileProc.
      */
 
-    TclInitCompileEnv(interp, &compEnv, string, length,
-		      iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+    TclInitCompileEnv(interp, &compEnv, stringPtr, length,
+	    iPtr->invokeCmdFramePtr, iPtr->invokeWord);
     /*
      * Now we check if we have data about invisible continuation lines for the
      * script, and make it available to the compile environment, if so.
@@ -415,45 +527,43 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
 	compEnv.clNext = &compEnv.clLoc->loc[0];
 	Tcl_Preserve (compEnv.clLoc);
     }
-#endif
-    result = TclCompileScript(interp, string, length, nested, &compEnv);
 
-    if (result == TCL_OK) {
-	/*
-	 * Successful compilation. Add a "done" instruction at the end.
-	 */
+    TclCompileScript(interp, stringPtr, length, &compEnv);
 
-	compEnv.numSrcBytes = iPtr->termOffset;
-	TclEmitOpcode(INST_DONE, &compEnv);
+    /*
+     * Successful compilation. Add a "done" instruction at the end.
+     */
 
-	/*
-	 * Invoke the compilation hook procedure if one exists.
-	 */
+    TclEmitOpcode(INST_DONE, &compEnv);
 
-	if (hookProc) {
-	    result = (*hookProc)(interp, &compEnv, clientData);
-	}
+    /*
+     * Invoke the compilation hook procedure if one exists.
+     */
+
+    if (hookProc) {
+	result = (*hookProc)(interp, &compEnv, clientData);
+    }
+
+    /*
+     * Change the object into a ByteCode object. Ownership of the literal
+     * objects and aux data items is given to the ByteCode object.
+     */
 
-	/*
-	 * Change the object into a ByteCode object. Ownership of the literal
-	 * objects and aux data items is given to the ByteCode object.
-	 */
-    
 #ifdef TCL_COMPILE_DEBUG
-	TclVerifyLocalLiteralTable(&compEnv);
+    TclVerifyLocalLiteralTable(&compEnv);
 #endif /*TCL_COMPILE_DEBUG*/
 
-	TclInitByteCodeObj(objPtr, &compEnv);
+    TclInitByteCodeObj(objPtr, &compEnv);
 #ifdef TCL_COMPILE_DEBUG
-	if (tclTraceCompile >= 2) {
-	    TclPrintByteCodeObj(interp, objPtr);
-	}
-#endif /* TCL_COMPILE_DEBUG */
+    if (tclTraceCompile >= 2) {
+	TclPrintByteCodeObj(interp, objPtr);
+	fflush(stdout);
     }
-	
+#endif /* TCL_COMPILE_DEBUG */
+
     if (result != TCL_OK) {
 	/*
-	 * Compilation errors. 
+	 * Handle any error from the hookProc
 	 */
 
 	entryPtr = compEnv.literalArrayPtr;
@@ -474,14 +584,6 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
 	}
     }
 
-
-    /*
-     * Free storage allocated during compilation.
-     */
-    
-    if (localTablePtr->buckets != localTablePtr->staticBuckets) {
-	ckfree((char *) localTablePtr->buckets);
-    }
     TclFreeCompileEnv(&compEnv);
     return result;
 }
@@ -502,24 +604,24 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
  *
  * Side effects:
  *	Frees the old internal representation. If no error occurs, then the
- *	compiled code is stored as "objPtr"s bytecode representation.
- *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
- *	used to trace compilations.
+ *	compiled code is stored as "objPtr"s bytecode representation. Also, if
+ *	debugging, initializes the "tcl_traceCompile" Tcl variable used to
+ *	trace compilations.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetByteCodeFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* The interpreter for which the code is
-				 * being compiled.  Must not be NULL. */
-    Tcl_Obj *objPtr;		/* The object to make a ByteCode object. */
+SetByteCodeFromAny(
+    Tcl_Interp *interp,		/* The interpreter for which the code is being
+				 * compiled. Must not be NULL. */
+    Tcl_Obj *objPtr)		/* The object to make a ByteCode object. */
 {
     if (interp == NULL) {
 	return TCL_ERROR;
     }
-    return TclSetByteCodeFromAny(interp, objPtr,
-	    (CompileHookProc *) NULL, (ClientData) NULL);
+    (void) TclSetByteCodeFromAny(interp, objPtr, NULL, (ClientData) NULL);
+    return TCL_OK;
 }
 
 /*
@@ -527,8 +629,8 @@ SetByteCodeFromAny(interp, objPtr)
  *
  * DupByteCodeInternalRep --
  *
- *	Part of the bytecode Tcl object type implementation. However, it
- *	does not copy the internal representation of a bytecode Tcl_Obj, but
+ *	Part of the bytecode Tcl object type implementation. However, it does
+ *	not copy the internal representation of a bytecode Tcl_Obj, but
  *	instead leaves the new object untyped (with a NULL type pointer).
  *	Code will be compiled for the new object only if necessary.
  *
@@ -542,9 +644,9 @@ SetByteCodeFromAny(interp, objPtr)
  */
 
 static void
-DupByteCodeInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+DupByteCodeInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
     return;
 }
@@ -554,35 +656,33 @@ DupByteCodeInternalRep(srcPtr, copyPtr)
  *
  * FreeByteCodeInternalRep --
  *
- *	Part of the bytecode Tcl object type implementation. Frees the
- *	storage associated with a bytecode object's internal representation
- *	unless its code is actively being executed.
+ *	Part of the bytecode Tcl object type implementation. Frees the storage
+ *	associated with a bytecode object's internal representation unless its
+ *	code is actively being executed.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The bytecode object's internal rep is marked invalid and its
- *	code gets freed unless the code is actively being executed.
- *	In that case the cleanup is delayed until the last execution
- *	of the code completes.
+ *	The bytecode object's internal rep is marked invalid and its code gets
+ *	freed unless the code is actively being executed. In that case the
+ *	cleanup is delayed until the last execution of the code completes.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeByteCodeInternalRep(objPtr)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to free. */
+FreeByteCodeInternalRep(
+    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
 {
-    register ByteCode *codePtr =
-	    (ByteCode *) objPtr->internalRep.otherValuePtr;
+    register ByteCode *codePtr = (ByteCode *)
+	    objPtr->internalRep.twoPtrValue.ptr1;
 
     codePtr->refCount--;
     if (codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
     objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
 }
 
 /*
@@ -598,24 +698,21 @@ FreeByteCodeInternalRep(objPtr)
  *	None.
  *
  * Side effects:
- *	Frees objPtr's bytecode internal representation and sets its type
- *	and objPtr->internalRep.otherValuePtr NULL. Also releases its
- *	literals and frees its auxiliary data items.
+ *	Frees objPtr's bytecode internal representation and sets its type NULL
+ *	Also releases its literals and frees its auxiliary data items.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclCleanupByteCode(codePtr)
-    register ByteCode *codePtr;	/* Points to the ByteCode to free. */
+TclCleanupByteCode(
+    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
-#ifdef TCL_TIP280
-    Interp* iPtr = (Interp*) interp;
-#endif
+    Interp *iPtr = (Interp *) interp;
     int numLitObjects = codePtr->numLitObjects;
     int numAuxDataItems = codePtr->numAuxDataItems;
-    register Tcl_Obj **objArrayPtr;
+    register Tcl_Obj **objArrayPtr, *objPtr;
     register AuxData *auxDataPtr;
     int i;
 #ifdef TCL_COMPILE_STATS
@@ -631,13 +728,13 @@ TclCleanupByteCode(codePtr)
 	statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
 	statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
 
-	statsPtr->currentInstBytes   -= (double) codePtr->numCodeBytes;
-	statsPtr->currentLitBytes    -=
-		(double) (codePtr->numLitObjects * sizeof(Tcl_Obj *)); 
-	statsPtr->currentExceptBytes -=
-		(double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
-	statsPtr->currentAuxBytes    -=
-		(double) (codePtr->numAuxDataItems * sizeof(AuxData));
+	statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes;
+	statsPtr->currentLitBytes -= (double)
+		codePtr->numLitObjects * sizeof(Tcl_Obj *);
+	statsPtr->currentExceptBytes -= (double)
+		codePtr->numExceptRanges * sizeof(ExceptionRange);
+	statsPtr->currentAuxBytes -= (double)
+		codePtr->numAuxDataItems * sizeof(AuxData);
 	statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
 
 	Tcl_GetTime(&destroyTime);
@@ -645,9 +742,9 @@ TclCleanupByteCode(codePtr)
 	if (lifetimeSec > 2000) {	/* avoid overflow */
 	    lifetimeSec = 2000;
 	}
-	lifetimeMicroSec =
-	    1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
-	
+	lifetimeMicroSec = 1000000 * lifetimeSec +
+		(destroyTime.usec - codePtr->createTime.usec);
+
 	log2 = TclLog2(lifetimeMicroSec);
 	if (log2 > 31) {
 	    log2 = 31;
@@ -657,21 +754,28 @@ TclCleanupByteCode(codePtr)
 #endif /* TCL_COMPILE_STATS */
 
     /*
-     * A single heap object holds the ByteCode structure and its code,
-     * object, command location, and auxiliary data arrays. This means we
-     * only need to 1) decrement the ref counts of the LiteralEntry's in
-     * its literal array, 2) call the free procs for the auxiliary data
-     * items, and 3) free the ByteCode structure's heap object.
+     * A single heap object holds the ByteCode structure and its code, object,
+     * command location, and auxiliary data arrays. This means we only need to
+     * 1) decrement the ref counts of the LiteralEntry's in its literal array,
+     * 2) call the free procs for the auxiliary data items, 3) free the
+     * localCache if it is unused, and finally 4) free the ByteCode
+     * structure's heap object.
+     *
+     * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like
+     * those generated from tbcload) is special, as they doesn't make use of
+     * the global literal table. They instead maintain private references to
+     * their literals which must be decremented.
      *
-     * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
-     * like those generated from tbcload) is special, as they doesn't
-     * make use of the global literal table.  They instead maintain
-     * private references to their literals which must be decremented.
+     * In order to insure a proper and efficient cleanup of the literal array
+     * when it contains non-shared literals [Bug 983660], we also distinguish
+     * the case of an interpreter being deleted (signaled by interp == NULL).
+     * Also, as the interp deletion will remove the global literal table
+     * anyway, we avoid the extra cost of updating it for each literal being
+     * released.
      */
 
-    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-	register Tcl_Obj *objPtr;
- 
+    if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {
+
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
 	    objPtr = *objArrayPtr;
@@ -681,36 +785,30 @@ TclCleanupByteCode(codePtr)
 	    objArrayPtr++;
 	}
 	codePtr->numLitObjects = 0;
-    } else if (interp != NULL) {
-	/*
-	 * If the interp has already been freed, then Tcl will have already 
-	 * forcefully released all the literals used by ByteCodes compiled
-	 * with respect to that interp.
-	 */
-	 
+    } else {
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
 	    /*
 	     * TclReleaseLiteral sets a ByteCode's object array entry NULL to
 	     * indicate that it has already freed the literal.
 	     */
-	    
-	    if (*objArrayPtr != NULL) {
-		TclReleaseLiteral(interp, *objArrayPtr);
+
+	    objPtr = *objArrayPtr;
+	    if (objPtr != NULL) {
+		TclReleaseLiteral(interp, objPtr);
 	    }
 	    objArrayPtr++;
 	}
     }
-    
+
     auxDataPtr = codePtr->auxDataArrayPtr;
     for (i = 0;  i < numAuxDataItems;  i++) {
 	if (auxDataPtr->type->freeProc != NULL) {
-	    (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
+	    (auxDataPtr->type->freeProc)(auxDataPtr->clientData);
 	}
 	auxDataPtr++;
     }
 
-#ifdef TCL_TIP280
     /*
      * TIP #280. Release the location data associated with this byte code
      * structure, if any. NOTE: The interp we belong to may be gone already,
@@ -720,43 +818,37 @@ TclCleanupByteCode(codePtr)
      */
 
     if (iPtr) {
-	Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
+		(char *) codePtr);
 	if (hePtr) {
-	    ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	    ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
+	    int i;
 
-	    ReleaseCmdWordData (eclPtr);
-	    Tcl_DeleteHashEntry (hePtr);
-	}
-    }
-#endif
+	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
+		Tcl_DecrRefCount(eclPtr->path);
+	    }
+	    for (i=0 ; i<eclPtr->nuloc ; i++) {
+		ckfree((char *) eclPtr->loc[i].line);
+	    }
 
-    TclHandleRelease(codePtr->interpHandle);
-    ckfree((char *) codePtr);
-}
+	    if (eclPtr->loc != NULL) {
+		ckfree((char *) eclPtr->loc);
+	    }
 
-#ifdef TCL_TIP280
-static void
-ReleaseCmdWordData (eclPtr)
-     ExtCmdLoc* eclPtr;
-{
-    int        i;
+	    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
-    if (eclPtr->type == TCL_LOCATION_SOURCE) {
-	Tcl_DecrRefCount (eclPtr->path);
-    }
-    for (i=0; i < eclPtr->nuloc; i++) {
-	ckfree ((char*) eclPtr->loc[i].line);
+	    ckfree((char *) eclPtr);
+	    Tcl_DeleteHashEntry(hePtr);
+	}
     }
 
-    if (eclPtr->loc != NULL) {
-	ckfree ((char*) eclPtr->loc);
+    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
+	TclFreeLocalCache(interp, codePtr->localCachePtr);
     }
 
-    Tcl_DeleteHashTable (&eclPtr->litInfo);
-
-    ckfree ((char*) eclPtr);
+    TclHandleRelease(codePtr->interpHandle);
+    ckfree((char *) codePtr);
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -776,27 +868,21 @@ ReleaseCmdWordData (eclPtr)
  */
 
 void
-#ifndef TCL_TIP280
-TclInitCompileEnv(interp, envPtr, string, numBytes)
-#else
-TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
-#endif
-    Tcl_Interp *interp;		 /* The interpreter for which a CompileEnv
-				  * structure is initialized. */
-    register CompileEnv *envPtr; /* Points to the CompileEnv structure to
-				  * initialize. */
-    char *string;		 /* The source string to be compiled. */
-    int numBytes;		 /* Number of bytes in source string. */
-#ifdef TCL_TIP280
-    CONST CmdFrame* invoker;     /* Location context invoking the bcc */
-    int word;                    /* Index of the word in that context
-				  * getting compiled */
-#endif
+TclInitCompileEnv(
+    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
+				 * structure is initialized. */
+    register CompileEnv *envPtr,/* Points to the CompileEnv structure to
+				 * initialize. */
+    const char *stringPtr,	/* The source string to be compiled. */
+    int numBytes,		/* Number of bytes in source string. */
+    const CmdFrame *invoker,	/* Location context invoking the bcc */
+    int word)			/* Index of the word in that context getting
+				 * compiled */
 {
     Interp *iPtr = (Interp *) interp;
-    
+
     envPtr->iPtr = iPtr;
-    envPtr->source = string;
+    envPtr->source = stringPtr;
     envPtr->numSrcBytes = numBytes;
     envPtr->procPtr = iPtr->compiledProcPtr;
     iPtr->compiledProcPtr = NULL;
@@ -816,17 +902,17 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
     envPtr->literalArrayNext = 0;
     envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
     envPtr->mallocedLiteralArray = 0;
-    
+
     envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
     envPtr->exceptArrayNext = 0;
     envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
     envPtr->mallocedExceptArray = 0;
-    
+
     envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
     envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
     envPtr->mallocedCmdMap = 0;
+    envPtr->atCmdStart = 1;
 
-#ifdef TCL_TIP280
     /*
      * TIP #280: Set up the extended command location information, based on
      * the context invoking the byte code compiler. This structure is used to
@@ -836,11 +922,11 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
      * non-compiling evaluator
      */
 
-    envPtr->extCmdMapPtr        = (ExtCmdLoc*) ckalloc (sizeof (ExtCmdLoc));
-    envPtr->extCmdMapPtr->loc   = NULL;
-    envPtr->extCmdMapPtr->nloc  = 0;
+    envPtr->extCmdMapPtr = (ExtCmdLoc *) ckalloc(sizeof(ExtCmdLoc));
+    envPtr->extCmdMapPtr->loc = NULL;
+    envPtr->extCmdMapPtr->nloc = 0;
     envPtr->extCmdMapPtr->nuloc = 0;
-    envPtr->extCmdMapPtr->path  = NULL;
+    envPtr->extCmdMapPtr->path = NULL;
     Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS);
 
     if (invoker == NULL ||
@@ -850,61 +936,75 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
 	 * dynamic context.
 	 */
 
-	envPtr->line               = 1;
-	envPtr->extCmdMapPtr->type = (envPtr->procPtr
-				      ? TCL_LOCATION_PROC
-				      : TCL_LOCATION_BC);
+	envPtr->line = 1;
+	envPtr->extCmdMapPtr->type =
+		(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
     } else {
-        /* Initialize the compiler using the context, making counting absolute
-	 * to that context. Note that the context can be byte code
-	 * execution. In that case we have to fill out the missing pieces
-	 * (line, path, ...). Which may make change the type as well.
+        /*
+	 * Initialize the compiler using the context, making counting absolute
+	 * to that context. Note that the context can be byte code execution.
+	 * In that case we have to fill out the missing pieces (line, path,
+	 * ...) which may make change the type as well.
 	 */
 
-	CmdFrame ctx = *invoker;
-	int      pc  = 0;
+	CmdFrame* ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+	int pc = 0;
+
+	*ctxPtr = *invoker;
 
 	if (invoker->type == TCL_LOCATION_BC) {
-	    /* Note: Type BC => ctx.data.eval.path    is not used.
+	    /*
+	     * Note: Type BC => ctx.data.eval.path    is not used.
 	     *                  ctx.data.tebc.codePtr is used instead.
-		 */
-	    TclGetSrcInfoForPc (&ctx);
+	     */
+
+	    TclGetSrcInfoForPc(ctxPtr);
 	    pc = 1;
 	}
 
-	if ((ctx.nline <= word) || (ctx.line[word] < 0)) {
-	    /* Word is not a literal, relative counting */
+	if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
+	    /*
+	     * Word is not a literal, relative counting.
+	     */
 
-	    envPtr->line               = 1;
-	    envPtr->extCmdMapPtr->type = (envPtr->procPtr
-					  ? TCL_LOCATION_PROC
-					  : TCL_LOCATION_BC);
+	    envPtr->line = 1;
+	    envPtr->extCmdMapPtr->type =
+		    (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
 
-	    if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
+	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
 		/*
 		 * The reference made by 'TclGetSrcInfoForPc' is dead.
 		 */
-		Tcl_DecrRefCount(ctx.data.eval.path);
+		Tcl_DecrRefCount(ctxPtr->data.eval.path);
 	    }
 	} else {
-	    envPtr->line               = ctx.line [word];
-	    envPtr->extCmdMapPtr->type = ctx.type;
-	    envPtr->extCmdMapPtr->path = ctx.data.eval.path;
+	    envPtr->line = ctxPtr->line[word];
+	    envPtr->extCmdMapPtr->type = ctxPtr->type;
+
+	    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+		envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path;
 
-	    if (ctx.type == TCL_LOCATION_SOURCE) {
 		if (pc) {
-		    /* The reference 'TclGetSrcInfoForPc' made is transfered */
-		    ctx.data.eval.path = NULL;
+		    /*
+		     * The reference 'TclGetSrcInfoForPc' made is transfered.
+		     */
+
+		    ctxPtr->data.eval.path = NULL;
 		} else {
-		    /* We have a new reference here */
-		    Tcl_IncrRefCount (ctx.data.eval.path);
+		    /*
+		     * We have a new reference here.
+		     */
+
+		    Tcl_IncrRefCount(ctxPtr->data.eval.path);
 		}
 	    }
 	}
 
-	/* ctx going out of scope */
+	TclStackFree(interp, ctxPtr);
     }
 
+    envPtr->extCmdMapPtr->start = envPtr->line;
+
     /*
      * Initialize the data about invisible continuation lines as empty,
      * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if
@@ -913,7 +1013,6 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
 
     envPtr->clLoc  = NULL;
     envPtr->clNext = NULL;
-#endif
 
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
     envPtr->auxDataArrayNext = 0;
@@ -931,22 +1030,26 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
  *
  * Results:
  *	None.
- * 
+ *
  * Side effects:
- *	Allocated storage in the CompileEnv structure is freed. Note that
- *	its local literal table is not deleted and its literal objects are
- *	not released. In addition, storage referenced by its auxiliary data
- *	items is not freed. This is done so that, when compilation is
- *	successful, "ownership" of these objects and aux data items is
- *	handed over to the corresponding ByteCode structure.
+ *	Allocated storage in the CompileEnv structure is freed. Note that its
+ *	local literal table is not deleted and its literal objects are not
+ *	released. In addition, storage referenced by its auxiliary data items
+ *	is not freed. This is done so that, when compilation is successful,
+ *	"ownership" of these objects and aux data items is handed over to the
+ *	corresponding ByteCode structure.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclFreeCompileEnv(envPtr)
-    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
+TclFreeCompileEnv(
+    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
 {
+    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) {
+	ckfree((char *) envPtr->localLitTable.buckets);
+	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
+    }
     if (envPtr->mallocedCodeArray) {
 	ckfree((char *) envPtr->codeStart);
     }
@@ -962,7 +1065,10 @@ TclFreeCompileEnv(envPtr)
     if (envPtr->mallocedAuxDataArray) {
 	ckfree((char *) envPtr->auxDataArrayPtr);
     }
-#ifdef TCL_TIP280
+    if (envPtr->extCmdMapPtr) {
+	ckfree((char *) envPtr->extCmdMapPtr);
+    }
+
     /*
      * If we used data about invisible continuation lines, then now is the
      * time to release on our hold on it. The lock was set in function
@@ -972,13 +1078,8 @@ TclFreeCompileEnv(envPtr)
     if (envPtr->clLoc) {
 	Tcl_Release (envPtr->clLoc);
     }
-    if (envPtr->extCmdMapPtr) {
-	ReleaseCmdWordData (envPtr->extCmdMapPtr);
-    }
-#endif
 }
 
-#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  *
@@ -996,35 +1097,67 @@ TclFreeCompileEnv(envPtr)
  *	it is worthwhile to compile at all.
  *
  * Side effects:
- *	None.
+ *	When returning true, appends the known value of the word to the
+ *	unshared Tcl_Obj (*valuePtr), unless valuePtr is NULL.
  *
- * TIP #280
  *----------------------------------------------------------------------
  */
 
 int
-TclWordKnownAtCompileTime (tokenPtr)
-     Tcl_Token* tokenPtr;
+TclWordKnownAtCompileTime(
+    Tcl_Token *tokenPtr,	/* Points to Tcl_Token we should check */
+    Tcl_Obj *valuePtr)		/* If not NULL, points to an unshared Tcl_Obj
+				 * to which we should append the known value
+				 * of the word. */
 {
-    int        i;
-    Tcl_Token* sub;
+    int numComponents = tokenPtr->numComponents;
+    Tcl_Obj *tempPtr = NULL;
 
-    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {return 1;};
-    if (tokenPtr->type != TCL_TOKEN_WORD)        {return 0;};
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	if (valuePtr != NULL) {
+	    Tcl_AppendToObj(valuePtr, tokenPtr[1].start, tokenPtr[1].size);
+	}
+	return 1;
+    }
+    if (tokenPtr->type != TCL_TOKEN_WORD) {
+	return 0;
+    }
+    tokenPtr++;
+    if (valuePtr != NULL) {
+	tempPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(tempPtr);
+    }
+    while (numComponents--) {
+	switch (tokenPtr->type) {
+	case TCL_TOKEN_TEXT:
+	    if (tempPtr != NULL) {
+		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
+	    }
+	    break;
 
-    /* Check the sub tokens of the word. It is a literal if we find
-     * only BS and TEXT tokens */
+	case TCL_TOKEN_BS:
+	    if (tempPtr != NULL) {
+		char utfBuf[TCL_UTF_MAX];
+		int length = TclParseBackslash(tokenPtr->start,
+			tokenPtr->size, NULL, utfBuf);
+		Tcl_AppendToObj(tempPtr, utfBuf, length);
+	    }
+	    break;
 
-    for (i=0, sub = tokenPtr + 1;
-	 i < tokenPtr->numComponents;
-	 i++, sub ++) {
-      if (sub->type == TCL_TOKEN_TEXT) continue;
-      if (sub->type == TCL_TOKEN_BS)   continue;
-      return 0;
+	default:
+	    if (tempPtr != NULL) {
+		Tcl_DecrRefCount(tempPtr);
+	    }
+	    return 0;
+	}
+	tokenPtr++;
+    }
+    if (valuePtr != NULL) {
+	Tcl_AppendObjToObj(valuePtr, tempPtr);
+	Tcl_DecrRefCount(tempPtr);
     }
     return 1;
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1038,55 +1171,44 @@ TclWordKnownAtCompileTime (tokenPtr)
  *	on failure. If TCL_ERROR is returned, then the interpreter's result
  *	contains an error message.
  *
- *	interp->termOffset is set to the offset of the character in the
- *	script just after the last one successfully processed; this will be
- *	the offset of the ']' if (flags & TCL_BRACKET_TERM).
- *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the script at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompileScript(interp, script, numBytes, nested, envPtr)
-    Tcl_Interp *interp;		/* Used for error and status reporting.
-				 * Also serves as context for finding and
-				 * compiling commands.  May not be NULL. */
-    CONST char *script;		/* The source script to compile. */
-    int numBytes;		/* Number of bytes in script. If < 0, the
+void
+TclCompileScript(
+    Tcl_Interp *interp,		/* Used for error and status reporting. Also
+				 * serves as context for finding and compiling
+				 * commands. May not be NULL. */
+    const char *script,		/* The source script to compile. */
+    int numBytes,		/* Number of bytes in script. If < 0, the
 				 * script consists of all bytes up to the
 				 * first null character. */
-    int nested;			/* Non-zero means this is a nested command:
-				 * close bracket ']' should be considered a
-				 * command terminator. If zero, close
-				 * bracket has no special meaning. */
-    CompileEnv *envPtr;		/* Holds resulting instructions. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Parse parse;
     int lastTopLevelCmdIndex = -1;
     				/* Index of most recent toplevel command in
- 				 * the command location table. Initialized
-				 * to avoid compiler warning. */
+ 				 * the command location table. Initialized to
+ 				 * avoid compiler warning. */
     int startCodeOffset = -1;	/* Offset of first byte of current command's
-                                 * code. Init. to avoid compiler warning. */
+				 * code. Init. to avoid compiler warning. */
     unsigned char *entryCodeNext = envPtr->codeNext;
-    CONST char *p, *next;
+    const char *p, *next;
     Namespace *cmdNsPtr;
     Command *cmdPtr;
     Tcl_Token *tokenPtr;
-    int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
-    int commandLength, objIndex, code;
+    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex;
+    int commandLength, objIndex;
     Tcl_DString ds;
-
-#ifdef TCL_TIP280
     /* TIP #280 */
-    ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
-    int* wlines = NULL;
-    int  wlineat, cmdLine;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    int *wlines, wlineat, cmdLine;
     int* clNext;
-#endif
+    Tcl_Parse *parsePtr = (Tcl_Parse *)
+	    TclStackAlloc(interp, sizeof(Tcl_Parse));
 
     Tcl_DStringInit(&ds);
 
@@ -1096,70 +1218,39 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     Tcl_ResetResult(interp);
     isFirstCmd = 1;
 
+    if (envPtr->procPtr != NULL) {
+	cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+    } else {
+	cmdNsPtr = NULL;	/* use current NS */
+    }
+
     /*
-     * Each iteration through the following loop compiles the next
-     * command from the script.
+     * Each iteration through the following loop compiles the next command
+     * from the script.
      */
 
     p = script;
     bytesLeft = numBytes;
-    gotParse = 0;
-#ifdef TCL_TIP280
     cmdLine = envPtr->line;
-    clNext  = envPtr->clNext;
-#endif
-
+    clNext = envPtr->clNext;
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
-	    code = TCL_ERROR;
-	    goto error;
-	}
-	gotParse = 1;
-	if (nested) {
+	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
 	    /*
-	     * This is an unusual situation where the caller has passed us
-	     * a non-zero value for "nested".  How unusual?  Well, this
-	     * procedure, TclCompileScript, is internal to Tcl, so all
-	     * callers should be within Tcl itself.  All but one of those
-	     * callers explicitly pass in (nested = 0).  The exceptional
-	     * caller is TclSetByteCodeFromAny, which will pass in
-	     * (nested = 1) if and only if the flag TCL_BRACKET_TERM
-	     * is set in the evalFlags field of interp.
-	     *
-	     * It appears that the TCL_BRACKET_TERM flag is only ever set
-	     * by Tcl_SubstObj, and it immediately calls Tcl_EvalEx
-	     * which clears the flag before passing the interp along.
-	     * So, I don't think this procedure, TclCompileScript, is
-	     * **ever** called with (nested != 0). 
-	     * (The testsuite indeed doesn't exercise this code. MS)
-	     *
-	     * This means that the branches in this procedure that are
-	     * only active when (nested != 0) are probably never exercised.
-	     * This means that any bugs in them go unnoticed, and any bug
-	     * fixes in them have a semi-theoretical nature.
-	     *
-	     * All that said, the spec for this procedure says it should
-	     * handle the (nested != 0) case, so here's an attempt to fix
-	     * bugs (Tcl Bug 681841) in that case.  Just in case some
-	     * callers eventually come along and expect it to work...
+	     * Compile bytecodes to report the parse error at runtime.
 	     */
 
-	    if (parse.term == (script + numBytes)) {
-		/* 
-		 * The (nested != 0) case is meant to indicate that the
-		 * caller found an open bracket ([) and asked us to
-		 * parse and compile Tcl commands up to the matching
-		 * close bracket (]).  We have to detect and handle
-		 * the case where the close bracket is missing.
-		 */
-
-		Tcl_SetObjResult(interp,
-			Tcl_NewStringObj("missing close-bracket", -1));
-		code = TCL_ERROR;
-		goto error;
-	    }
+	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+		    /* Drop the command terminator (";","]") if appropriate */
+		    (parsePtr->term ==
+		    parsePtr->commandStart + parsePtr->commandSize - 1)?
+		    parsePtr->commandSize - 1 : parsePtr->commandSize);
+	    TclCompileSyntaxError(interp, envPtr);
+	    break;
 	}
-	if (parse.numWords > 0) {
+	if (parsePtr->numWords > 0) {
+	    int expand = 0;	/* Set if there are dynamic expansions to
+				 * handle */
+
 	    /*
 	     * If not the first command, pop the previous command's result
 	     * and, if we're compiling a top level command, update the last
@@ -1168,195 +1259,294 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 
 	    if (!isFirstCmd) {
 		TclEmitOpcode(INST_POP, envPtr);
-		if (!nested) {
-		    envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
-			   (envPtr->codeNext - envPtr->codeStart)
-			   - startCodeOffset;
-		}
+		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
+			(envPtr->codeNext - envPtr->codeStart)
+			- startCodeOffset;
 	    }
 
 	    /*
 	     * Determine the actual length of the command.
 	     */
 
-	    commandLength = parse.commandSize;
-	    if (parse.term == parse.commandStart + commandLength - 1) {
+	    commandLength = parsePtr->commandSize;
+	    if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
 		/*
-		 * The command terminator character (such as ; or ]) is
-		 * the last character in the parsed command.  Reduce the
-		 * length by one so that the trace message doesn't include
-		 * the terminator character.
+		 * The command terminator character (such as ; or ]) is the
+		 * last character in the parsed command. Reduce the length by
+		 * one so that the trace message doesn't include the
+		 * terminator character.
 		 */
-		
+
 		commandLength -= 1;
 	    }
 
 #ifdef TCL_COMPILE_DEBUG
 	    /*
-             * If tracing, print a line for each top level command compiled.
-             */
+	     * If tracing, print a line for each top level command compiled.
+	     */
 
-	    if ((tclTraceCompile >= 1)
-		    && !nested && (envPtr->procPtr == NULL)) {
+	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
 		fprintf(stdout, "  Compiling: ");
-		TclPrintSource(stdout, parse.commandStart,
+		TclPrintSource(stdout, parsePtr->commandStart,
 			TclMin(commandLength, 55));
 		fprintf(stdout, "\n");
 	    }
 #endif
+
 	    /*
-	     * Each iteration of the following loop compiles one word
-	     * from the command.
+	     * Check whether expansion has been requested for any of the
+	     * words.
 	     */
-	    
+
+	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
+		    wordIdx < parsePtr->numWords;
+		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		    expand = 1;
+		    break;
+		}
+	    }
+
 	    envPtr->numCommands++;
 	    currCmdIndex = (envPtr->numCommands - 1);
-	    if (!nested) {
-		lastTopLevelCmdIndex = currCmdIndex;
-	    }
+	    lastTopLevelCmdIndex = currCmdIndex;
 	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 	    EnterCmdStartData(envPtr, currCmdIndex,
-	            (parse.commandStart - envPtr->source), startCodeOffset);
+		    parsePtr->commandStart - envPtr->source, startCodeOffset);
 
-#ifdef TCL_TIP280
-	    /* TIP #280. Scan the words and compute the extended location
+	    /*
+	     * Should only start issuing instructions after the "command has
+	     * started" so that the command range is correct in the bytecode.
+	     */
+
+	    if (expand) {
+		TclEmitOpcode(INST_EXPAND_START, envPtr);
+	    }
+
+	    /*
+	     * TIP #280. Scan the words and compute the extended location
 	     * information. The map first contain full per-word line
 	     * information for use by the compiler. This is later replaced by
 	     * a reduced form which signals non-literal words, stored in
 	     * 'wlines'.
 	     */
 
-	    TclAdvanceLines         (&cmdLine, p, parse.commandStart);
+	    TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
 	    TclAdvanceContinuations (&cmdLine, &clNext,
-				     parse.commandStart - envPtr->source);
-	    EnterCmdWordData (eclPtr, (parse.commandStart - envPtr->source),
-			      parse.tokenPtr, parse.commandStart,
-			      parse.commandSize, parse.numWords,
-			      cmdLine, clNext, &wlines, envPtr);
+				     parsePtr->commandStart - envPtr->source);
+	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+			     parsePtr->tokenPtr, parsePtr->commandStart,
+			     parsePtr->commandSize, parsePtr->numWords, cmdLine,
+			     clNext, &wlines, envPtr);
 	    wlineat = eclPtr->nuloc - 1;
-#endif
 
-	    for (wordIdx = 0, tokenPtr = parse.tokenPtr;
-		    wordIdx < parse.numWords;
-		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
-#ifdef TCL_TIP280
-	        envPtr->line   = eclPtr->loc [wlineat].line [wordIdx];
+	    /*
+	     * Each iteration of the following loop compiles one word from the
+	     * command.
+	     */
+
+	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
+		    wordIdx < parsePtr->numWords; wordIdx++,
+		    tokenPtr += (tokenPtr->numComponents + 1)) {
+
+		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
 		envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
-#endif
-		if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+
+		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 		    /*
-		     * If this is the first word and the command has a
-		     * compile procedure, let it compile the command.
+		     * The word is not a simple string of characters.
 		     */
 
-		    if (wordIdx == 0) {
-			if (envPtr->procPtr != NULL) {
-			    cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
-			} else {
-			    cmdNsPtr = NULL; /* use current NS */
-			}
+		    TclCompileTokens(interp, tokenPtr+1,
+			    tokenPtr->numComponents, envPtr);
+		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+			TclEmitInstInt4(INST_EXPAND_STKTOP,
+				envPtr->currStackDepth, envPtr);
+		    }
+		    continue;
+		}
+
+		/*
+		 * This is a simple string of literal characters (i.e. we know
+		 * it absolutely and can use it directly). If this is the
+		 * first word and the command has a compile procedure, let it
+		 * compile the command.
+		 */
+
+		if ((wordIdx == 0) && !expand) {
+		    /*
+		     * We copy the string before trying to find the command by
+		     * name. We used to modify the string in place, but this
+		     * is not safe because the name resolution handlers could
+		     * have side effects that rely on the unmodified string.
+		     */
+
+		    Tcl_DStringSetLength(&ds, 0);
+		    Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);
+
+		    cmdPtr = (Command *) Tcl_FindCommand(interp,
+			    Tcl_DStringValue(&ds),
+			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+
+		    if ((cmdPtr != NULL)
+			    && (cmdPtr->compileProc != NULL)
+			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
+			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+			int savedNumCmds = envPtr->numCommands;
+			unsigned savedCodeNext =
+				envPtr->codeNext - envPtr->codeStart;
+			int update = 0, code;
 
 			/*
-			 * We copy the string before trying to find the command
-			 * by name.  We used to modify the string in place, but
-			 * this is not safe because the name resolution
-			 * handlers could have side effects that rely on the
-			 * unmodified string.
+			 * Mark the start of the command; the proper bytecode
+			 * length will be updated later. There is no need to
+			 * do this for the first bytecode in the compile env,
+			 * as the check is done before calling
+			 * TclExecuteByteCode(). Do emit an INST_START_CMD in
+			 * special cases where the first bytecode is in a
+			 * loop, to insure that the corresponding command is
+			 * counted properly. Compilers for commands able to
+			 * produce such a beast (currently 'while 1' only) set
+			 * envPtr->atCmdStart to 0 in order to signal this
+			 * case. [Bug 1752146]
+			 *
+			 * Note that the environment is initialised with
+			 * atCmdStart=1 to avoid emitting ISC for the first
+			 * command.
 			 */
 
-			Tcl_DStringSetLength(&ds, 0);
-			Tcl_DStringAppend(&ds, tokenPtr[1].start,
-				tokenPtr[1].size);
-
-			cmdPtr = (Command *) Tcl_FindCommand(interp,
-				Tcl_DStringValue(&ds),
-			        (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
-
-			if ((cmdPtr != NULL)
-			        && (cmdPtr->compileProc != NULL)
-			        && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
-			        && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
-			    int savedNumCmds = envPtr->numCommands;
-			    unsigned int savedCodeNext =
-				    envPtr->codeNext - envPtr->codeStart;
-
-			    code = (*(cmdPtr->compileProc))(interp, &parse,
-			            envPtr);
-			    if (code == TCL_OK) {
-				goto finishCommand;
-			    } else if (code == TCL_OUT_LINE_COMPILE) {
+			if (envPtr->atCmdStart) {
+			    if (savedCodeNext != 0) {
 				/*
-				 * Restore numCommands and codeNext to their correct 
-				 * values, removing any commands compiled before 
-				 * TCL_OUT_LINE_COMPILE [Bugs 705406 and 735055]
+				 * Increase the number of commands being
+				 * started at the current point. Note that
+				 * this depends on the exact layout of the
+				 * INST_START_CMD's operands, so be careful!
 				 */
-				envPtr->numCommands = savedNumCmds;
-				envPtr->codeNext = envPtr->codeStart + savedCodeNext;
-			    } else { /* an error */
+
+				unsigned char *fixPtr = envPtr->codeNext - 4;
+
+				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
+					fixPtr);
+			    }
+			} else {
+			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+			    TclEmitInt4(1, envPtr);
+			    update = 1;
+			}
+
+			code = (cmdPtr->compileProc)(interp, parsePtr,
+				cmdPtr, envPtr);
+
+			if (code == TCL_OK) {
+			    if (update) {
 				/*
-				 * There was a compilation error, the last
-				 * command did not get compiled into (*envPtr).
-				 * Decrement the number of commands
-				 * claimed to be in (*envPtr).
+				 * Fix the bytecode length.
 				 */
-				envPtr->numCommands--;
-				goto log;
+
+				unsigned char *fixPtr = envPtr->codeStart
+					+ savedCodeNext + 1;
+				unsigned fixLen = envPtr->codeNext
+					- envPtr->codeStart - savedCodeNext;
+
+				TclStoreInt4AtPtr(fixLen, fixPtr);
 			    }
-			}
+			    goto finishCommand;
+			} else {
+			    if (envPtr->atCmdStart && savedCodeNext != 0) {
+				/*
+				 * Decrease the number of commands being
+				 * started at the current point. Note that
+				 * this depends on the exact layout of the
+				 * INST_START_CMD's operands, so be careful!
+				 */
 
-			/*
-			 * No compile procedure so push the word. If the
-			 * command was found, push a CmdName object to
-			 * reduce runtime lookups.
-			 */
+				unsigned char *fixPtr = envPtr->codeNext - 4;
+
+				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)-1,
+					fixPtr);
+			    }
+
+			    /*
+			     * Restore numCommands and codeNext to their
+			     * correct values, removing any commands compiled
+			     * before the failure to produce bytecode got
+			     * reported. [Bugs 705406 and 735055]
+			     */
 
-			objIndex = TclRegisterNewLiteral(envPtr,
-				tokenPtr[1].start, tokenPtr[1].size);
-			if (cmdPtr != NULL) {
-			    TclSetCmdNameObj(interp,
-			           envPtr->literalArrayPtr[objIndex].objPtr,
-				   cmdPtr);
+			    envPtr->numCommands = savedNumCmds;
+			    envPtr->codeNext = envPtr->codeStart+savedCodeNext;
 			}
-		    } else {
-			/* Simple argument word of a command. We reach this if
-			 * and only if the command word was not compiled for
-			 * whatever reason. Register the literal's location
-			 * for use by uplevel, etc. commands, should they
-			 * encounter it unmodified. We care only if the we are
-			 * in a context which already allows absolute
-			 * counting.
+		    }
+
+		    /*
+		     * No compile procedure so push the word. If the command
+		     * was found, push a CmdName object to reduce runtime
+		     * lookups. Avoid sharing this literal among different
+		     * namespaces to reduce shimmering.
+		     */
+
+		    objIndex = TclRegisterNewNSLiteral(envPtr,
+			    tokenPtr[1].start, tokenPtr[1].size);
+		    if (cmdPtr != NULL) {
+			TclSetCmdNameObj(interp,
+			      envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr);
+		    }
+		    if ((wordIdx == 0) && (parsePtr->numWords == 1)) {
+			/*
+			 * Single word script: unshare the command name to
+			 * avoid shimmering between bytecode and cmdName
+			 * representations [Bug 458361]
 			 */
 
-			objIndex = TclRegisterNewLiteral(envPtr,
-				tokenPtr[1].start, tokenPtr[1].size);
-#ifdef TCL_TIP280
-			if (envPtr->clNext) {
-			    TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
-							  tokenPtr[1].start - envPtr->source,
-							  eclPtr->loc [wlineat].next [wordIdx]);
-			}
-#endif
+			TclHideLiteral(interp, envPtr, objIndex);
 		    }
-		    TclEmitPush(objIndex, envPtr);
 		} else {
 		    /*
-		     * The word is not a simple string of characters.
+		     * Simple argument word of a command. We reach this if and
+		     * only if the command word was not compiled for whatever
+		     * reason. Register the literal's location for use by
+		     * uplevel, etc. commands, should they encounter it
+		     * unmodified. We care only if the we are in a context
+		     * which already allows absolute counting.
 		     */
-		    code = TclCompileTokens(interp, tokenPtr+1,
-			    tokenPtr->numComponents, envPtr);
-		    if (code != TCL_OK) {
-			goto log;
+		    objIndex = TclRegisterNewLiteral(envPtr,
+			    tokenPtr[1].start, tokenPtr[1].size);
+
+		    if (envPtr->clNext) {
+			TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
+						      tokenPtr[1].start - envPtr->source,
+						      eclPtr->loc [wlineat].next [wordIdx]);
 		    }
 		}
-	    }
+		TclEmitPush(objIndex, envPtr);
+	    } /* for loop */
 
 	    /*
-	     * Emit an invoke instruction for the command. We skip this
-	     * if a compile procedure was found for the command.
+	     * Emit an invoke instruction for the command. We skip this if a
+	     * compile procedure was found for the command.
 	     */
-	    
-	    if (wordIdx > 0) {
-#ifdef TCL_TIP280
+
+	    if (expand) {
+		/*
+		 * The stack depth during argument expansion can only be
+		 * managed at runtime, as the number of elements in the
+		 * expanded lists is not known at compile time. We adjust here
+		 * the stack depth estimate so that it is correct after the
+		 * command with expanded arguments returns.
+		 *
+		 * The end effect of this command's invocation is that all the
+		 * words of the command are popped from the stack, and the
+		 * result is pushed: the stack top changes by (1-wordIdx).
+		 *
+		 * Note that the estimates are not correct while the command
+		 * is being prepared and run, INST_EXPAND_STKTOP is not
+		 * stack-neutral in general.
+		 */
+
+		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+		TclAdjustStackDepth((1-wordIdx), envPtr);
+	    } else if (wordIdx > 0) {
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
 		 */
@@ -1364,8 +1554,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 		int isnew;
 		Tcl_HashEntry* hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
 			   (char*) (envPtr->codeNext - envPtr->codeStart), &isnew);
-		Tcl_SetHashValue(hePtr, (char*) wlineat);
-#endif
+		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
+
 		if (wordIdx <= 255) {
 		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
 		} else {
@@ -1378,115 +1568,57 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	     * offsets of the source and code for the command.
 	     */
 
-	    finishCommand:
+	finishCommand:
 	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
 		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 	    isFirstCmd = 0;
 
-#ifdef TCL_TIP280
-	    /* TIP #280: Free full form of per-word line data and insert
-	     * the reduced form now
+	    /*
+	     * TIP #280: Free full form of per-word line data and insert the
+	     * reduced form now
 	     */
-	    ckfree ((char*) eclPtr->loc [wlineat].line);
-	    ckfree ((char*) eclPtr->loc [wlineat].next);
-	    eclPtr->loc [wlineat].line = wlines;
-	    eclPtr->loc [wlineat].next = NULL;
-	    wlines = NULL;
-#endif
-	} /* end if parse.numWords > 0 */
+
+	    ckfree((char *) eclPtr->loc[wlineat].line);
+	    ckfree((char *) eclPtr->loc[wlineat].next);
+	    eclPtr->loc[wlineat].line = wlines;
+	    eclPtr->loc[wlineat].next = NULL;
+	} /* end if parsePtr->numWords > 0 */
 
 	/*
 	 * Advance to the next command in the script.
 	 */
 
-	next = parse.commandStart + parse.commandSize;
-	bytesLeft -= (next - p);
+	next = parsePtr->commandStart + parsePtr->commandSize;
+	bytesLeft -= next - p;
 	p = next;
-#ifdef TCL_TIP280
-	/* TIP #280 : Track lines in the just compiled command */
-	TclAdvanceLines         (&cmdLine, parse.commandStart, p);
+
+	/*
+	 * TIP #280: Track lines in the just compiled command.
+	 */
+
+	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
 	TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
-#endif
-	Tcl_FreeParse(&parse);
-	gotParse = 0;
-	if (nested && (*parse.term == ']')) {
-	    /*
-	     * We get here in the special case where TCL_BRACKET_TERM was
-	     * set in the interpreter and the latest parsed command was
-	     * terminated by the matching close-bracket we were looking for.
-	     * Stop compilation.
-	     */
-	    
-	    break;
-	}
+	Tcl_FreeParse(parsePtr);
     } while (bytesLeft > 0);
 
     /*
      * If the source script yielded no instructions (e.g., if it was empty),
      * push an empty string as the command's result.
-     */
-    
-    if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
-	        envPtr);
-    }
-    
-    if (nested) {
-	/*
-	 * When (nested != 0) back up 1 character to have 
-	 * iPtr->termOffset indicate the offset to the matching
-	 * close-bracket.
-	 */
-
-	iPtr->termOffset = (p - 1) - script;
-    } else {
-	iPtr->termOffset = (p - script);
-    }
-    Tcl_DStringFree(&ds);
-    return TCL_OK;
-	
-    error:
-    /*
-     * Generate various pieces of error information, such as the line
-     * number where the error occurred and information to add to the
-     * errorInfo variable. Then free resources that had been allocated
-     * to the command.
+     *
+     * WARNING: push an unshared object! If the script being compiled is a
+     * shared empty string, it will otherwise be self-referential and cause
+     * difficulties with literal management [Bugs 467523, 983660]. We used to
+     * have special code in TclReleaseLiteral to handle this particular
+     * self-reference, but now opt for avoiding its creation altogether.
      */
 
-    commandLength = parse.commandSize;
-    if (parse.term == parse.commandStart + commandLength - 1) {
-	/*
-	 * The terminator character (such as ; or ]) of the command where
-	 * the error occurred is the last character in the parsed command.
-	 * Reduce the length by one so that the error message doesn't
-	 * include the terminator character.
-	 */
-
-	commandLength -= 1;
-    }
-
- log:
-#ifdef TCL_TIP280
-    /* TIP #280: Free the per-word line data left over from parsing an
-     * erroneous command, if any.
-     */
-    if (wlines) {
-	ckfree ((char*) eclPtr->loc [wlineat].line);
-	ckfree ((char*) eclPtr->loc [wlineat].next);
-	ckfree ((char*) wlines);
-	eclPtr->loc [wlineat].line = NULL;
-	eclPtr->loc [wlineat].next = NULL;
-	wlines = NULL;
+    if (envPtr->codeNext == entryCodeNext) {
+	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr);
     }
-#endif
 
-    LogCompilationInfo(interp, script, parse.commandStart, commandLength);
-    if (gotParse) {
-	Tcl_FreeParse(&parse);
-    }
-    iPtr->termOffset = (p - script);
+    envPtr->numSrcBytes = (p - script);
+    TclStackFree(interp, parsePtr);
     Tcl_DStringFree(&ds);
-    return code;
 }
 
 /*
@@ -1495,38 +1627,37 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
  * TclCompileTokens --
  *
  *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
- *	that make up a word) this procedure emits instructions to evaluate
- *	the tokens and concatenate their values to form a single result
- *	value on the interpreter's runtime evaluation stack.
+ *	that make up a word) this procedure emits instructions to evaluate the
+ *	tokens and concatenate their values to form a single result value on
+ *	the interpreter's runtime evaluation stack.
  *
  * Results:
  *	The return value is a standard Tcl result. If an error occurs, an
  *	error message is left in the interpreter's result.
- *	
+ *
  * Side effects:
- *	Instructions are added to envPtr to push and evaluate the tokens
- *	at runtime.
+ *	Instructions are added to envPtr to push and evaluate the tokens at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompileTokens(interp, tokenPtr, count, envPtr)
-    Tcl_Interp *interp;		/* Used for error and status reporting. */
-    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
-				 * to compile. */
-    int count;			/* Number of tokens to consider at tokenPtr.
+void
+TclCompileTokens(
+    Tcl_Interp *interp,		/* Used for error and status reporting. */
+    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
+				 * compile. */
+    int count,			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
-    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
 				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
     char buffer[TCL_UTF_MAX];
-    CONST char *name, *p;
+    const char *name, *p;
     int numObjsToConcat, nameBytes, localVarName, localVar;
-    int length, i, code;
+    int length, i;
     unsigned char *entryCodeNext = envPtr->codeNext;
-#ifdef TCL_TIP280
 #define NUM_STATIC_POS 20
     int isLiteral, maxNumCL, numCL;
     int* clPosition = NULL;
@@ -1539,7 +1670,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
      * any. The table is extended if needed.
      *
      * Note: Different to the equivalent code in function
-     * 'EvalTokensStandard()' (see file "tclBasic.c") we do not seem to need
+     * 'TclSubstTokens()' (see file "tclParse.c") we do not seem to need
      * the 'adjust' variable. We also do not seem to need code which merges
      * continuation line information of multiple words which concat'd at
      * runtime. Either that or I have not managed to find a test case for
@@ -1562,186 +1693,166 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
 	maxNumCL   = NUM_STATIC_POS;
 	clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
     }
-#endif
 
     Tcl_DStringInit(&textBuffer);
     numObjsToConcat = 0;
     for ( ;  count > 0;  count--, tokenPtr++) {
 	switch (tokenPtr->type) {
-	    case TCL_TOKEN_TEXT:
-		Tcl_DStringAppend(&textBuffer, tokenPtr->start,
-			tokenPtr->size);
-		break;
+	case TCL_TOKEN_TEXT:
+	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
+	    break;
 
-	    case TCL_TOKEN_BS:
-		length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
-			(int *) NULL, buffer);
-		Tcl_DStringAppend(&textBuffer, buffer, length);
+	case TCL_TOKEN_BS:
+	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
+		    NULL, buffer);
+	    Tcl_DStringAppend(&textBuffer, buffer, length);
 
-#ifdef TCL_TIP280
-		/*
-		 * If the backslash sequence we found is in a literal, and
-		 * represented a continuation line, we compute and store its
-		 * location (as char offset to the beginning of the _result_
-		 * script). We may have to extend the table of locations.
-		 *
-		 * Note that the continuation line information is relevant
-		 * even if the word we are processing is not a literal, as it
-		 * can affect nested commands. See the branch for
-		 * TCL_TOKEN_COMMAND below, where the adjustment we are
-		 * tracking here is taken into account. The good thing is that
-		 * we do not need a table of everything, just the number of
-		 * lines we have to add as correction.
-		 */
+	    /*
+	     * If the backslash sequence we found is in a literal, and
+	     * represented a continuation line, we compute and store its
+	     * location (as char offset to the beginning of the _result_
+	     * script). We may have to extend the table of locations.
+	     *
+	     * Note that the continuation line information is relevant even if
+	     * the word we are processing is not a literal, as it can affect
+	     * nested commands. See the branch for TCL_TOKEN_COMMAND below,
+	     * where the adjustment we are tracking here is taken into
+	     * account. The good thing is that we do not need a table of
+	     * everything, just the number of lines we have to add as
+	     * correction.
+	     */
 
-		if ((length == 1) && (buffer[0] == ' ') &&
-		    (tokenPtr->start[1] == '\n')) {
-		    if (isLiteral) {
-			int clPos = Tcl_DStringLength (&textBuffer);
+	    if ((length == 1) && (buffer[0] == ' ') &&
+		(tokenPtr->start[1] == '\n')) {
+		if (isLiteral) {
+		    int clPos = Tcl_DStringLength (&textBuffer);
 
-			if (numCL >= maxNumCL) {
-			    maxNumCL *= 2;
-			    clPosition = (int*) ckrealloc ((char*)clPosition,
-							   maxNumCL*sizeof(int));
-			}
-			clPosition[numCL] = clPos;
-			numCL ++;
+		    if (numCL >= maxNumCL) {
+			maxNumCL *= 2;
+			clPosition = (int*) ckrealloc ((char*)clPosition,
+						       maxNumCL*sizeof(int));
 		    }
+		    clPosition[numCL] = clPos;
+		    numCL ++;
 		}
-#endif
-		break;
+	    }
+	    break;
 
-	    case TCL_TOKEN_COMMAND:
-		/*
-		 * Push any accumulated chars appearing before the command.
-		 */
-		
-		if (Tcl_DStringLength(&textBuffer) > 0) {
-		    int literal;
-		    
-		    literal = TclRegisterLiteral(envPtr,
-			    Tcl_DStringValue(&textBuffer),
-			    Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
-		    TclEmitPush(literal, envPtr);
-		    numObjsToConcat++;
-		    Tcl_DStringFree(&textBuffer);
-#ifdef TCL_TIP280
-		    if (numCL) {
-			TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
-					      numCL, clPosition);
-		    }
-		    numCL = 0;
-#endif
-		}
-		
-		code = TclCompileScript(interp, tokenPtr->start+1,
-			tokenPtr->size-2, /*nested*/ 0,	envPtr);
-		if (code != TCL_OK) {
-		    goto error;
-		}
+	case TCL_TOKEN_COMMAND:
+	    /*
+	     * Push any accumulated chars appearing before the command.
+	     */
+
+	    if (Tcl_DStringLength(&textBuffer) > 0) {
+		int literal = TclRegisterNewLiteral(envPtr,
+			Tcl_DStringValue(&textBuffer),
+			Tcl_DStringLength(&textBuffer));
+
+		TclEmitPush(literal, envPtr);
 		numObjsToConcat++;
-		break;
+		Tcl_DStringFree(&textBuffer);
 
-	    case TCL_TOKEN_VARIABLE:
-		/*
-		 * Push any accumulated chars appearing before the $<var>.
-		 */
-		
-		if (Tcl_DStringLength(&textBuffer) > 0) {
-		    int literal;
-		    
-		    literal = TclRegisterLiteral(envPtr,
-			    Tcl_DStringValue(&textBuffer),
-			    Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
-		    TclEmitPush(literal, envPtr);
-		    numObjsToConcat++;
-		    Tcl_DStringFree(&textBuffer);
+		if (numCL) {
+		    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+					  numCL, clPosition);
 		}
-		
-		/*
-		 * Determine how the variable name should be handled: if it contains 
-		 * any namespace qualifiers it is not a local variable (localVarName=-1);
-		 * if it looks like an array element and the token has a single component, 
-		 * it should not be created here [Bug 569438] (localVarName=0); otherwise, 
-		 * the local variable can safely be created (localVarName=1).
-		 */
-		
-		name = tokenPtr[1].start;
-		nameBytes = tokenPtr[1].size;
-		localVarName = -1;
-		if (envPtr->procPtr != NULL) {
-		    localVarName = 1;
-		    for (i = 0, p = name;  i < nameBytes;  i++, p++) {
-			if ((*p == ':') && (i < (nameBytes-1))
-			        && (*(p+1) == ':')) {
-			    localVarName = -1;
-			    break;
-			} else if ((*p == '(')
-			        && (tokenPtr->numComponents == 1) 
-				&& (*(name + nameBytes - 1) == ')')) {
-			    localVarName = 0;
-			    break;
-			}
+		numCL = 0;
+	    }
+
+	    TclCompileScript(interp, tokenPtr->start+1,
+		    tokenPtr->size-2, envPtr);
+	    numObjsToConcat++;
+	    break;
+
+	case TCL_TOKEN_VARIABLE:
+	    /*
+	     * Push any accumulated chars appearing before the $<var>.
+	     */
+
+	    if (Tcl_DStringLength(&textBuffer) > 0) {
+		int literal;
+
+		literal = TclRegisterNewLiteral(envPtr,
+			Tcl_DStringValue(&textBuffer),
+			Tcl_DStringLength(&textBuffer));
+		TclEmitPush(literal, envPtr);
+		numObjsToConcat++;
+		Tcl_DStringFree(&textBuffer);
+	    }
+
+	    /*
+	     * Determine how the variable name should be handled: if it
+	     * contains any namespace qualifiers it is not a local variable
+	     * (localVarName=-1); if it looks like an array element and the
+	     * token has a single component, it should not be created here
+	     * [Bug 569438] (localVarName=0); otherwise, the local variable
+	     * can safely be created (localVarName=1).
+	     */
+
+	    name = tokenPtr[1].start;
+	    nameBytes = tokenPtr[1].size;
+	    localVarName = -1;
+	    if (envPtr->procPtr != NULL) {
+		localVarName = 1;
+		for (i = 0, p = name;  i < nameBytes;  i++, p++) {
+		    if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
+			localVarName = -1;
+			break;
+		    } else if ((*p == '(')
+			    && (tokenPtr->numComponents == 1)
+			    && (*(name + nameBytes - 1) == ')')) {
+			localVarName = 0;
+			break;
 		    }
 		}
+	    }
 
-		/*
-		 * Either push the variable's name, or find its index in
-		 * the array of local variables in a procedure frame. 
-		 */
+	    /*
+	     * Either push the variable's name, or find its index in the array
+	     * of local variables in a procedure frame.
+	     */
 
-		localVar = -1;
-		if (localVarName != -1) {
-		    localVar = TclFindCompiledLocal(name, nameBytes, 
-			        localVarName, /*flags*/ 0, envPtr->procPtr);
-		}
+	    localVar = -1;
+	    if (localVarName != -1) {
+		localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
+			envPtr->procPtr);
+	    }
+	    if (localVar < 0) {
+		TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
+			envPtr);
+	    }
+
+	    /*
+	     * Emit instructions to load the variable.
+	     */
+
+	    if (tokenPtr->numComponents == 1) {
 		if (localVar < 0) {
-		    TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
-			    envPtr); 
+		    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+		} else if (localVar <= 255) {
+		    TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
 		}
-
-		/*
-		 * Emit instructions to load the variable.
-		 */
-		
-		if (tokenPtr->numComponents == 1) {
-		    if (localVar < 0) {
-			TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
-		    } else if (localVar <= 255) {
-			TclEmitInstInt1(INST_LOAD_SCALAR1, localVar,
-			        envPtr);
-		    } else {
-			TclEmitInstInt4(INST_LOAD_SCALAR4, localVar,
-				envPtr);
-		    }
+	    } else {
+		TclCompileTokens(interp, tokenPtr+2,
+			tokenPtr->numComponents-1, envPtr);
+		if (localVar < 0) {
+		    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+		} else if (localVar <= 255) {
+		    TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
 		} else {
-		    code = TclCompileTokens(interp, tokenPtr+2,
-			    tokenPtr->numComponents-1, envPtr);
-		    if (code != TCL_OK) {
-			char errorBuffer[150];
-			sprintf(errorBuffer,
-			        "\n    (parsing index for array \"%.*s\")",
-				((nameBytes > 100)? 100 : nameBytes), name);
-			Tcl_AddObjErrorInfo(interp, errorBuffer, -1);
-			goto error;
-		    }
-		    if (localVar < 0) {
-			TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
-		    } else if (localVar <= 255) {
-			TclEmitInstInt1(INST_LOAD_ARRAY1, localVar,
-			        envPtr);
-		    } else {
-			TclEmitInstInt4(INST_LOAD_ARRAY4, localVar,
-			        envPtr);
-		    }
+		    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
 		}
-		numObjsToConcat++;
-		count -= tokenPtr->numComponents;
-		tokenPtr += tokenPtr->numComponents;
-		break;
+	    }
+	    numObjsToConcat++;
+	    count -= tokenPtr->numComponents;
+	    tokenPtr += tokenPtr->numComponents;
+	    break;
 
-	    default:
-		panic("Unexpected token type in TclCompileTokens");
+	default:
+	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
+		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
 	}
     }
 
@@ -1752,18 +1863,16 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
     if (Tcl_DStringLength(&textBuffer) > 0) {
 	int literal;
 
-	literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
-	        Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+	literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
+		Tcl_DStringLength(&textBuffer));
 	TclEmitPush(literal, envPtr);
 	numObjsToConcat++;
 
-#ifdef TCL_TIP280
 	if (numCL) {
 	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
 				  numCL, clPosition);
 	}
 	numCL = 0;
-#endif
     }
 
     /*
@@ -1781,16 +1890,12 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
     /*
      * If the tokens yielded no instructions, push an empty string.
      */
-    
+
     if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
-	        envPtr);
+	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
     }
-    code = TCL_OK;
-
-    error:
     Tcl_DStringFree(&textBuffer);
-#ifdef TCL_TIP280
+
     /*
      * Release the temp table we used to collect the locations of
      * continuation lines, if any.
@@ -1799,8 +1904,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
     if (maxNumCL) {
 	ckfree ((char*) clPosition);
     }
-#endif
-    return code;
 }
 
 /*
@@ -1811,53 +1914,45 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
  *	Given an array of parse tokens for a word containing one or more Tcl
  *	commands, emit inline instructions to execute them. This procedure
  *	differs from TclCompileTokens in that a simple word such as a loop
- *	body enclosed in braces is not just pushed as a string, but is
- *	itself parsed into tokens and compiled.
+ *	body enclosed in braces is not just pushed as a string, but is itself
+ *	parsed into tokens and compiled.
  *
  * Results:
  *	The return value is a standard Tcl result. If an error occurs, an
  *	error message is left in the interpreter's result.
- *	
+ *
  * Side effects:
  *	Instructions are added to envPtr to execute the tokens at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompileCmdWord(interp, tokenPtr, count, envPtr)
-    Tcl_Interp *interp;		/* Used for error and status reporting. */
-    Tcl_Token *tokenPtr;	/* Pointer to first in an array of tokens
-				 * for a command word to compile inline. */
-    int count;			/* Number of tokens to consider at tokenPtr.
+void
+TclCompileCmdWord(
+    Tcl_Interp *interp,		/* Used for error and status reporting. */
+    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens for
+				 * a command word to compile inline. */
+    int count,			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
-    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
-    int code;
-
-    /*
-     * Handle the common case: if there is a single text token, compile it
-     * into an inline sequence of instructions.
-     */
-    
     if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
-	code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
-	        /*nested*/ 0, envPtr);
-	return code;
-    }
+	/*
+	 * Handle the common case: if there is a single text token, compile it
+	 * into an inline sequence of instructions.
+	 */
 
-    /*
-     * Multiple tokens or the single token involves substitutions. Emit
-     * instructions to invoke the eval command procedure at runtime on the
-     * result of evaluating the tokens.
-     */
+	TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
+    } else {
+	/*
+	 * Multiple tokens or the single token involves substitutions. Emit
+	 * instructions to invoke the eval command procedure at runtime on the
+	 * result of evaluating the tokens.
+	 */
 
-    code = TclCompileTokens(interp, tokenPtr, count, envPtr);
-    if (code != TCL_OK) {
-	return code;
+	TclCompileTokens(interp, tokenPtr, count, envPtr);
+	TclEmitOpcode(INST_EVAL_STK, envPtr);
     }
-    TclEmitOpcode(INST_EVAL_STK, envPtr);
-    return TCL_OK;
 }
 
 /*
@@ -1874,42 +1969,37 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
  * Results:
  *	The return value is a standard Tcl result. If an error occurs, an
  *	error message is left in the interpreter's result.
- *	
+ *
  * Side effects:
  *	Instructions are added to envPtr to execute the expression.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
-    Tcl_Interp *interp;		/* Used for error and status reporting. */
-    Tcl_Token *tokenPtr;	/* Points to first in an array of word
-				 * tokens tokens for the expression to
-				 * compile inline. */
-    int numWords;		/* Number of word tokens starting at
-				 * tokenPtr. Must be at least 1. Each word
-				 * token contains one or more subtokens. */
-    CompileEnv *envPtr;		/* Holds the resulting instructions. */
+void
+TclCompileExprWords(
+    Tcl_Interp *interp,		/* Used for error and status reporting. */
+    Tcl_Token *tokenPtr,	/* Points to first in an array of word tokens
+				 * tokens for the expression to compile
+				 * inline. */
+    int numWords,		/* Number of word tokens starting at tokenPtr.
+				 * Must be at least 1. Each word token
+				 * contains one or more subtokens. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_Token *wordPtr;
-    int numBytes, i, code;
-    CONST char *script;
-
-    code = TCL_OK;
+    int i, concatItems;
 
     /*
-     * If the expression is a single word that doesn't require
-     * substitutions, just compile its string into inline instructions.
+     * If the expression is a single word that doesn't require substitutions,
+     * just compile its string into inline instructions.
      */
 
     if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
-	script = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-	code = TclCompileExpr(interp, script, numBytes, envPtr);
-	return code;
+	TclCompileExpr(interp, tokenPtr[1].start, tokenPtr[1].size, envPtr, 1);
+	return;
     }
-   
+
     /*
      * Emit code to call the expr command proc at runtime. Concatenate the
      * (already substituted once) expr tokens with a space between each.
@@ -1917,30 +2007,68 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
 
     wordPtr = tokenPtr;
     for (i = 0;  i < numWords;  i++) {
-	code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
-                envPtr);
-	if (code != TCL_OK) {
-	    break;
-	}
+	TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
 	if (i < (numWords - 1)) {
-	    TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
-	            envPtr);
+	    TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr);
 	}
 	wordPtr += (wordPtr->numComponents + 1);
     }
-    if (code == TCL_OK) {
-	int concatItems = 2*numWords - 1;
-	while (concatItems > 255) {
-	    TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
-	    concatItems -= 254;
-	}
-	if (concatItems > 1) {
-	    TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
-	}
-	TclEmitOpcode(INST_EXPR_STK, envPtr);
+    concatItems = 2*numWords - 1;
+    while (concatItems > 255) {
+	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+	concatItems -= 254;
+    }
+    if (concatItems > 1) {
+	TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
     }
+    TclEmitOpcode(INST_EXPR_STK, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNoOp --
+ *
+ *	Function called to compile no-op's
+ *
+ * Results:
+ *	The return value is TCL_OK, indicating successful compilation.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute a no-op at runtime. No
+ *      result is pushed onto the stack: the compiler has to take care of this
+ *      itself if the last compiled command is a NoOp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNoOp(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int i;
+    int savedStackDepth = envPtr->currStackDepth;
+
+    tokenPtr = parsePtr->tokenPtr;
+    for(i = 1; i < parsePtr->numWords; i++) {
+	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
+	envPtr->currStackDepth = savedStackDepth;
 
-    return code;
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
+		    envPtr);
+	    TclEmitOpcode(INST_POP, envPtr);
+	}
+    }
+    envPtr->currStackDepth = savedStackDepth;
+    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    return TCL_OK;
 }
 
 /*
@@ -1949,10 +2077,10 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
  * TclInitByteCodeObj --
  *
  *	Create a ByteCode structure and initialize it from a CompileEnv
- *	compilation environment structure. The ByteCode structure is
- *	smaller and contains just that information needed to execute
- *	the bytecode instructions resulting from compiling a Tcl script.
- *	The resulting structure is placed in the specified object.
+ *	compilation environment structure. The ByteCode structure is smaller
+ *	and contains just that information needed to execute the bytecode
+ *	instructions resulting from compiling a Tcl script. The resulting
+ *	structure is placed in the specified object.
  *
  * Results:
  *	A newly constructed ByteCode object is stored in the internal
@@ -1960,21 +2088,21 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
  *
  * Side effects:
  *	A single heap object is allocated to hold the new ByteCode structure
- *	and its code, object, command location, and aux data arrays. Note
- *	that "ownership" (i.e., the pointers to) the Tcl objects and aux
- *	data items will be handed over to the new ByteCode structure from
- *	the CompileEnv structure.
+ *	and its code, object, command location, and aux data arrays. Note that
+ *	"ownership" (i.e., the pointers to) the Tcl objects and aux data items
+ *	will be handed over to the new ByteCode structure from the CompileEnv
+ *	structure.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclInitByteCodeObj(objPtr, envPtr)
-    Tcl_Obj *objPtr;		 /* Points object that should be
-				  * initialized, and whose string rep
-				  * contains the source code. */
-    register CompileEnv *envPtr; /* Points to the CompileEnv structure from
-				  * which to create a ByteCode structure. */
+TclInitByteCodeObj(
+    Tcl_Obj *objPtr,		/* Points object that should be initialized,
+				 * and whose string rep contains the source
+				 * code. */
+    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+				 * which to create a ByteCode structure. */
 {
     register ByteCode *codePtr;
     size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
@@ -1985,10 +2113,7 @@ TclInitByteCodeObj(objPtr, envPtr)
 #endif
     int numLitObjects = envPtr->literalArrayNext;
     Namespace *namespacePtr;
-    int i;
-#ifdef TCL_TIP280
-    int new;
-#endif
+    int i, isNew;
     Interp *iPtr;
 
     iPtr = envPtr->iPtr;
@@ -1998,24 +2123,24 @@ TclInitByteCodeObj(objPtr, envPtr)
     exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
     auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
     cmdLocBytes = GetCmdLocEncodingSize(envPtr);
-    
+
     /*
      * Compute the total number of bytes needed for this bytecode.
      */
 
     structureSize = sizeof(ByteCode);
-    structureSize += TCL_ALIGN(codeBytes);        /* align object array */
-    structureSize += TCL_ALIGN(objArrayBytes);    /* align exc range arr */
+    structureSize += TCL_ALIGN(codeBytes);	  /* align object array */
+    structureSize += TCL_ALIGN(objArrayBytes);	  /* align exc range arr */
     structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
     structureSize += auxDataArrayBytes;
     structureSize += cmdLocBytes;
 
     if (envPtr->iPtr->varFramePtr != NULL) {
-        namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
+	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
     } else {
-        namespacePtr = envPtr->iPtr->globalNsPtr;
+	namespacePtr = envPtr->iPtr->globalNsPtr;
     }
-    
+
     p = (unsigned char *) ckalloc((size_t) structureSize);
     codePtr = (ByteCode *) p;
     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
@@ -2023,7 +2148,11 @@ TclInitByteCodeObj(objPtr, envPtr)
     codePtr->nsPtr = namespacePtr;
     codePtr->nsEpoch = namespacePtr->resolverEpoch;
     codePtr->refCount = 1;
-    codePtr->flags = 0;
+    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
+	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
+    } else {
+	codePtr->flags = 0;
+    }
     codePtr->source = envPtr->source;
     codePtr->procPtr = envPtr->procPtr;
 
@@ -2039,28 +2168,26 @@ TclInitByteCodeObj(objPtr, envPtr)
 
     p += sizeof(ByteCode);
     codePtr->codeStart = p;
-    memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
-    
-    p += TCL_ALIGN(codeBytes);	      /* align object array */
+    memcpy(p, envPtr->codeStart, (size_t) codeBytes);
+
+    p += TCL_ALIGN(codeBytes);		/* align object array */
     codePtr->objArrayPtr = (Tcl_Obj **) p;
     for (i = 0;  i < numLitObjects;  i++) {
 	codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
     }
 
-    p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
+    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
     if (exceptArrayBytes > 0) {
 	codePtr->exceptArrayPtr = (ExceptionRange *) p;
-	memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
-	        (size_t) exceptArrayBytes);
+	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
     } else {
 	codePtr->exceptArrayPtr = NULL;
     }
-    
-    p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+
+    p += TCL_ALIGN(exceptArrayBytes);	/* align AuxData array */
     if (auxDataArrayBytes > 0) {
 	codePtr->auxDataArrayPtr = (AuxData *) p;
-	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
-	        (size_t) auxDataArrayBytes);
+	memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
     } else {
 	codePtr->auxDataArrayPtr = NULL;
     }
@@ -2070,11 +2197,11 @@ TclInitByteCodeObj(objPtr, envPtr)
     EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
 #else
     nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
-    if (((size_t)(nextPtr - p)) != cmdLocBytes) {	
-	panic("TclInitByteCodeObj: encoded cmd location bytes %ld != expected size %ld\n", (nextPtr - p), cmdLocBytes);
+    if (((size_t)(nextPtr - p)) != cmdLocBytes) {
+	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d", (nextPtr - p), cmdLocBytes);
     }
 #endif
-    
+
     /*
      * Record various compilation-related statistics about the new ByteCode
      * structure. Don't include overhead for statistics-related fields.
@@ -2084,115 +2211,29 @@ TclInitByteCodeObj(objPtr, envPtr)
     codePtr->structureSize = structureSize
 	    - (sizeof(size_t) + sizeof(Tcl_Time));
     Tcl_GetTime(&(codePtr->createTime));
-    
+
     RecordByteCodeStats(codePtr);
 #endif /* TCL_COMPILE_STATS */
-    
+
     /*
-     * Free the old internal rep then convert the object to a
-     * bytecode object by making its internal rep point to the just
-     * compiled ByteCode.
+     * Free the old internal rep then convert the object to a bytecode object
+     * by making its internal rep point to the just compiled ByteCode.
      */
-	    
-    if ((objPtr->typePtr != NULL) &&
-	    (objPtr->typePtr->freeIntRepProc != NULL)) {
-	(*objPtr->typePtr->freeIntRepProc)(objPtr);
-    }
-    objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
+
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = (void *) codePtr;
     objPtr->typePtr = &tclByteCodeType;
 
-#ifdef TCL_TIP280
-    /* TIP #280. Associate the extended per-word line information with the
+    /*
+     * TIP #280. Associate the extended per-word line information with the
      * byte code object (internal rep), for use with the bc compiler.
      */
 
-    Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->lineBCPtr, (char*) codePtr, &new),
-		      envPtr->extCmdMapPtr);
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr,
+	    &isNew), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * LogCompilationInfo --
- *
- *	This procedure is invoked after an error occurs during compilation.
- *	It adds information to the "errorInfo" variable to describe the
- *	command that was being compiled when the error occurred.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Information about the command is added to errorInfo and the
- *	line number stored internally in the interpreter is set.  If this
- *	is the first call to this procedure or Tcl_AddObjErrorInfo since
- *	an error occurred, then old information in errorInfo is
- *	deleted.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-LogCompilationInfo(interp, script, command, length)
-    Tcl_Interp *interp;		/* Interpreter in which to log the
-				 * information. */
-    CONST char *script;		/* First character in script containing
-				 * command (must be <= command). */
-    CONST char *command;	/* First character in command that
-				 * generated the error. */
-    int length;			/* Number of bytes in command (-1 means
-				 * use all bytes up to first null byte). */
-{
-    char buffer[200];
-    register CONST char *p;
-    char *ellipsis = "";
-    Interp *iPtr = (Interp *) interp;
-
-    if (iPtr->flags & ERR_ALREADY_LOGGED) {
-	/*
-	 * Someone else has already logged error information for this
-	 * command; we shouldn't add anything more.
-	 */
-
-	return;
-    }
-
-    /*
-     * Compute the line number where the error occurred.
-     */
-
-    iPtr->errorLine = 1;
-    for (p = script; p != command; p++) {
-	if (*p == '\n') {
-	    iPtr->errorLine++;
-	}
-    }
-
-    /*
-     * Create an error message to add to errorInfo, including up to a
-     * maximum number of characters of the command.
-     */
-
-    if (length < 0) {
-	length = strlen(command);
-    }
-    if (length > 150) {
-	length = 150;
-	ellipsis = "...";
-    }
-    while ( (command[length] & 0xC0) == 0x80 ) {
-        /*
-	 * Back up truncation point so that we don't truncate in the
-	 * middle of a multi-byte character (in UTF-8)
-	 */
-	 length--;
-	 ellipsis = "...";
-    }
-    sprintf(buffer, "\n    while compiling\n\"%.*s%s\"",
-	    length, command, ellipsis);
-    Tcl_AddObjErrorInfo(interp, buffer, -1);
+    codePtr->localCachePtr = NULL;
 }
 
 /*
@@ -2209,30 +2250,26 @@ LogCompilationInfo(interp, script, command, length)
  * Results:
  *	If create is 0 and the name is non-NULL, then if the variable is
  *	found, the index of its entry in the procedure's array of local
- *	variables is returned; otherwise -1 is returned. If name is NULL,
- *	the index of a new temporary variable is returned. Finally, if
- *	create is 1 and name is non-NULL, the index of a new entry is
- *	returned.
+ *	variables is returned; otherwise -1 is returned. If name is NULL, the
+ *	index of a new temporary variable is returned. Finally, if create is 1
+ *	and name is non-NULL, the index of a new entry is returned.
  *
  * Side effects:
- *	Creates and registers a new local variable if create is 1 and
- *	the variable is unknown, or if the name is NULL.
+ *	Creates and registers a new local variable if create is 1 and the
+ *	variable is unknown, or if the name is NULL.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
-    register CONST char *name;	/* Points to first character of the name of
-				 * a scalar or array variable. If NULL, a
+TclFindCompiledLocal(
+    register const char *name,	/* Points to first character of the name of a
+				 * scalar or array variable. If NULL, a
 				 * temporary var should be created. */
-    int nameBytes;		/* Number of bytes in the name. */
-    int create;			/* If 1, allocate a local frame entry for
-				 * the variable if it is new. */
-    int flags;			/* Flag bits for the compiled local if
-				 * created. Only VAR_SCALAR, VAR_ARRAY, and
-				 * VAR_LINK make sense. */
-    register Proc *procPtr;	/* Points to structure describing procedure
+    int nameBytes,		/* Number of bytes in the name. */
+    int create,			/* If 1, allocate a local frame entry for the
+				 * variable if it is new. */
+    register Proc *procPtr)	/* Points to structure describing procedure
 				 * containing the variable reference. */
 {
     register CompiledLocal *localPtr;
@@ -2244,14 +2281,16 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
      * name already exist?
      */
 
-    if (name != NULL) {	
+    if (name != NULL) {
 	int localCt = procPtr->numCompiledLocals;
+
 	localPtr = procPtr->firstLocalPtr;
 	for (i = 0;  i < localCt;  i++) {
 	    if (!TclIsVarTemporary(localPtr)) {
 		char *localName = localPtr->name;
-		if ((nameBytes == localPtr->nameLength)
-	                && (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
+
+		if ((nameBytes == localPtr->nameLength) &&
+			(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
 		    return i;
 		}
 	    }
@@ -2262,12 +2301,12 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
     /*
      * Create a new variable if appropriate.
      */
-    
+
     if (create || (name == NULL)) {
 	localVar = procPtr->numCompiledLocals;
-	localPtr = (CompiledLocal *) ckalloc((unsigned) 
-	        (sizeof(CompiledLocal) - sizeof(localPtr->name)
-		+ nameBytes+1));
+	localPtr = (CompiledLocal *) ckalloc((unsigned)
+		(sizeof(CompiledLocal) - sizeof(localPtr->name)
+		+ nameBytes + 1));
 	if (procPtr->firstLocalPtr == NULL) {
 	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	} else {
@@ -2277,7 +2316,7 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
 	localPtr->nextPtr = NULL;
 	localPtr->nameLength = nameBytes;
 	localPtr->frameIndex = localVar;
-	localPtr->flags = flags | VAR_UNDEFINED;
+	localPtr->flags = 0;
 	if (name == NULL) {
 	    localPtr->flags |= VAR_TEMPORARY;
 	}
@@ -2285,8 +2324,7 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
 	localPtr->resolveInfo = NULL;
 
 	if (name != NULL) {
-	    memcpy((VOID *) localPtr->name, (VOID *) name,
-	            (size_t) nameBytes);
+	    memcpy(localPtr->name, name, (size_t) nameBytes);
 	}
 	localPtr->name[nameBytes] = '\0';
 	procPtr->numCompiledLocals++;
@@ -2297,167 +2335,56 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
 /*
  *----------------------------------------------------------------------
  *
- * TclInitCompiledLocals --
- *
- *	This routine is invoked in order to initialize the compiled
- *	locals table for a new call frame.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May invoke various name resolvers in order to determine which
- *	variables are being referenced at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitCompiledLocals(interp, framePtr, nsPtr)
-    Tcl_Interp *interp;		/* Current interpreter. */
-    CallFrame *framePtr;	/* Call frame to initialize. */
-    Namespace *nsPtr;		/* Pointer to current namespace. */
-{
-    register CompiledLocal *localPtr;
-    Interp *iPtr = (Interp*) interp;
-    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
-    Var *varPtr = framePtr->compiledLocals;
-    Var *resolvedVarPtr;
-    ResolverScheme *resPtr;
-    int result;
-
-    /*
-     * Initialize the array of local variables stored in the call frame.
-     * Some variables may have special resolution rules.  In that case,
-     * we call their "resolver" procs to get our hands on the variable,
-     * and we make the compiled local a link to the real variable.
-     */
-
-    for (localPtr = framePtr->procPtr->firstLocalPtr;
-	 localPtr != NULL;
-	 localPtr = localPtr->nextPtr) {
-
-	/*
-	 * Check to see if this local is affected by namespace or
-	 * interp resolvers.  The resolver to use is cached for the
-	 * next invocation of the procedure.
-	 */
-
-	if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
-		&& (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
-	    resPtr = iPtr->resolverPtr;
-
-	    if (nsPtr->compiledVarResProc) {
-		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
-			localPtr->name, localPtr->nameLength,
-			(Tcl_Namespace *) nsPtr, &vinfo);
-	    } else {
-		result = TCL_CONTINUE;
-	    }
-
-	    while ((result == TCL_CONTINUE) && resPtr) {
-		if (resPtr->compiledVarResProc) {
-		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
-			    localPtr->name, localPtr->nameLength,
-			    (Tcl_Namespace *) nsPtr, &vinfo);
-		}
-		resPtr = resPtr->nextPtr;
-	    }
-	    if (result == TCL_OK) {
-		localPtr->resolveInfo = vinfo;
-		localPtr->flags |= VAR_RESOLVED;
-	    }
-	}
-
-	/*
-	 * Now invoke the resolvers to determine the exact variables that
-	 * should be used.
-	 */
-
-        resVarInfo = localPtr->resolveInfo;
-        resolvedVarPtr = NULL;
-
-        if (resVarInfo && resVarInfo->fetchProc) {
-            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
-		    resVarInfo);
-        }
-
-        if (resolvedVarPtr) {
-	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
-	    varPtr->nsPtr = NULL;
-	    varPtr->hPtr = NULL;
-	    varPtr->refCount = 0;
-	    varPtr->tracePtr = NULL;
-	    varPtr->searchPtr = NULL;
-	    varPtr->flags = 0;
-            TclSetVarLink(varPtr);
-            varPtr->value.linkPtr = resolvedVarPtr;
-            resolvedVarPtr->refCount++;
-        } else {
-	    varPtr->value.objPtr = NULL;
-	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
-	    varPtr->nsPtr = NULL;
-	    varPtr->hPtr = NULL;
-	    varPtr->refCount = 0;
-	    varPtr->tracePtr = NULL;
-	    varPtr->searchPtr = NULL;
-	    varPtr->flags = localPtr->flags;
-        }
-	varPtr++;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclExpandCodeArray --
  *
- *	Procedure that uses malloc to allocate more storage for a
- *	CompileEnv's code array.
+ *	Procedure that uses malloc to allocate more storage for a CompileEnv's
+ *	code array.
  *
  * Results:
- *	None. 
+ *	None.
  *
  * Side effects:
- *	The byte code array in *envPtr is reallocated to a new array of
- *	double the size, and if envPtr->mallocedCodeArray is non-zero the
- *	old array is freed. Byte codes are copied from the old array to the
- *	new one.
+ *	The byte code array in *envPtr is reallocated to a new array of double
+ *	the size, and if envPtr->mallocedCodeArray is non-zero the old array
+ *	is freed. Byte codes are copied from the old array to the new one.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclExpandCodeArray(envArgPtr)
-    void *envArgPtr;		/* Points to the CompileEnv whose code array
+TclExpandCodeArray(
+    void *envArgPtr)		/* Points to the CompileEnv whose code array
 				 * must be enlarged. */
 {
-    CompileEnv *envPtr = (CompileEnv*) envArgPtr;	/* Points to the CompileEnv whose code array
-							 * must be enlarged. */
+    CompileEnv *envPtr = (CompileEnv *) envArgPtr;
+				/* The CompileEnv containing the code array to
+				 * be doubled in size. */
 
     /*
      * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
-     * code bytes are stored between envPtr->codeStart and
-     * (envPtr->codeNext - 1) [inclusive].
+     * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1
+     * [inclusive].
      */
-    
+
     size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
-    size_t newBytes  = 2*(envPtr->codeEnd  - envPtr->codeStart);
-    unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
+    size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
 
-    /*
-     * Copy from old code array to new, free old code array if needed, and
-     * mark new code array as malloced.
-     */
- 
-    memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
     if (envPtr->mallocedCodeArray) {
-        ckfree((char *) envPtr->codeStart);
+	envPtr->codeStart = (unsigned char *)
+		ckrealloc((char *)envPtr->codeStart, newBytes);
+    } else {
+	/*
+	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must
+	 * code a ckrealloc equivalent for ourselves.
+	 */
+	unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
+	memcpy(newPtr, envPtr->codeStart, currBytes);
+	envPtr->codeStart = newPtr;
+	envPtr->mallocedCodeArray = 1;
     }
-    envPtr->codeStart = newPtr;
-    envPtr->codeNext = (newPtr + currBytes);
-    envPtr->codeEnd  = (newPtr + newBytes);
-    envPtr->mallocedCodeArray = 1;
+
+    envPtr->codeNext = (envPtr->codeStart + currBytes);
+    envPtr->codeEnd = (envPtr->codeStart + newBytes);
 }
 
 /*
@@ -2465,37 +2392,37 @@ TclExpandCodeArray(envArgPtr)
  *
  * EnterCmdStartData --
  *
- *	Registers the starting source and bytecode location of a
- *	command. This information is used at runtime to map between
- *	instruction pc and source locations.
+ *	Registers the starting source and bytecode location of a command. This
+ *	information is used at runtime to map between instruction pc and
+ *	source locations.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	Inserts source and code location information into the compilation
- *	environment envPtr for the command at index cmdIndex. The
- *	compilation environment's CmdLocation array is grown if necessary.
+ *	environment envPtr for the command at index cmdIndex. The compilation
+ *	environment's CmdLocation array is grown if necessary.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
-    CompileEnv *envPtr;		/* Points to the compilation environment
+EnterCmdStartData(
+    CompileEnv *envPtr,		/* Points to the compilation environment
 				 * structure in which to enter command
 				 * location information. */
-    int cmdIndex;		/* Index of the command whose start data
-				 * is being set. */
-    int srcOffset;		/* Offset of first char of the command. */
-    int codeOffset;		/* Offset of first byte of command code. */
+    int cmdIndex,		/* Index of the command whose start data is
+				 * being set. */
+    int srcOffset,		/* Offset of first char of the command. */
+    int codeOffset)		/* Offset of first byte of command code. */
 {
     CmdLocation *cmdLocPtr;
-    
+
     if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
-	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+	Tcl_Panic("EnterCmdStartData: bad command index %d", cmdIndex);
     }
-    
+
     if (cmdIndex >= envPtr->cmdMapEnd) {
 	/*
 	 * Expand the command location array by allocating more storage from
@@ -2504,28 +2431,29 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
 	 */
 
 	size_t currElems = envPtr->cmdMapEnd;
-	size_t newElems  = 2*currElems;
+	size_t newElems = 2*currElems;
 	size_t currBytes = currElems * sizeof(CmdLocation);
-	size_t newBytes  = newElems  * sizeof(CmdLocation);
-	CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
-	
-	/*
-	 * Copy from old command location array to new, free old command
-	 * location array if needed, and mark new array as malloced.
-	 */
-	
-	memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
+	size_t newBytes = newElems * sizeof(CmdLocation);
+
 	if (envPtr->mallocedCmdMap) {
-	    ckfree((char *) envPtr->cmdMapPtr);
+	    envPtr->cmdMapPtr = (CmdLocation *)
+		    ckrealloc((char *) envPtr->cmdMapPtr, newBytes);
+	} else {
+	    /*
+	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must
+	     * code a ckrealloc equivalent for ourselves.
+	     */
+	    CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
+	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
+	    envPtr->cmdMapPtr = newPtr;
+	    envPtr->mallocedCmdMap = 1;
 	}
-	envPtr->cmdMapPtr = (CmdLocation *) newPtr;
 	envPtr->cmdMapEnd = newElems;
-	envPtr->mallocedCmdMap = 1;
     }
 
     if (cmdIndex > 0) {
 	if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
-	    panic("EnterCmdStartData: cmd map not sorted by code offset");
+	    Tcl_Panic("EnterCmdStartData: cmd map not sorted by code offset");
 	}
     }
 
@@ -2550,32 +2478,32 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
  *
  * Side effects:
  *	Inserts source and code length information into the compilation
- *	environment envPtr for the command at index cmdIndex. Starting
- *	source and bytecode information for the command must already
- *	have been registered.
+ *	environment envPtr for the command at index cmdIndex. Starting source
+ *	and bytecode information for the command must already have been
+ *	registered.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
-    CompileEnv *envPtr;		/* Points to the compilation environment
+EnterCmdExtentData(
+    CompileEnv *envPtr,		/* Points to the compilation environment
 				 * structure in which to enter command
 				 * location information. */
-    int cmdIndex;		/* Index of the command whose source and
-				 * code length data is being set. */
-    int numSrcBytes;		/* Number of command source chars. */
-    int numCodeBytes;		/* Offset of last byte of command code. */
+    int cmdIndex,		/* Index of the command whose source and code
+				 * length data is being set. */
+    int numSrcBytes,		/* Number of command source chars. */
+    int numCodeBytes)		/* Offset of last byte of command code. */
 {
     CmdLocation *cmdLocPtr;
 
     if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
-	panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
+	Tcl_Panic("EnterCmdExtentData: bad command index %d", cmdIndex);
     }
-    
+
     if (cmdIndex > envPtr->cmdMapEnd) {
-	panic("EnterCmdExtentData: missing start data for command %d\n",
-	        cmdIndex);
+	Tcl_Panic("EnterCmdExtentData: missing start data for command %d",
+		cmdIndex);
     }
 
     cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
@@ -2583,105 +2511,86 @@ EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
     cmdLocPtr->numCodeBytes = numCodeBytes;
 }
 
-#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  * TIP #280
  *
  * EnterCmdWordData --
  *
- *	Registers the lines for the words of a command. This information
- *	is used at runtime by 'info frame'.
+ *	Registers the lines for the words of a command. This information is
+ *	used at runtime by 'info frame'.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Inserts word location information into the compilation
- *	environment envPtr for the command at index cmdIndex. The
- *	compilation environment's ExtCmdLoc.ECL array is grown if necessary.
+ *	Inserts word location information into the compilation environment
+ *	envPtr for the command at index cmdIndex. The compilation
+ *	environment's ExtCmdLoc.ECL array is grown if necessary.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, clNext, wlines, envPtr)
-    ExtCmdLoc *eclPtr;		/* Points to the map environment
-				 * structure in which to enter command
-				 * location information. */
-    int srcOffset;		/* Offset of first char of the command. */
-    Tcl_Token* tokenPtr;
-    CONST char* cmd;
-    int         len;
-    int numWords;
-    int line;
-    int* clNext;
-    int** wlines;
-    CompileEnv* envPtr;
-{    
-    ECL*        ePtr;
-    int         wordIdx;
-    CONST char* last;
-    int         wordLine;
-    int*        wordNext;
-    int*        wwlines;
+EnterCmdWordData(
+    ExtCmdLoc *eclPtr,		/* Points to the map environment structure in
+				 * which to enter command location
+				 * information. */
+    int srcOffset,		/* Offset of first char of the command. */
+    Tcl_Token *tokenPtr,
+    const char *cmd,
+    int len,
+    int numWords,
+    int line,
+    int* clNext,
+    int **wlines,
+    CompileEnv* envPtr)
+{
+    ECL *ePtr;
+    const char *last;
+    int wordIdx, wordLine, *wwlines;
+    int* wordNext;
 
     if (eclPtr->nuloc >= eclPtr->nloc) {
 	/*
-	 * Expand the ECL array by allocating more storage from the
-	 * heap. The currently allocated ECL entries are stored from
-	 * eclPtr->loc[0] up to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
+	 * Expand the ECL array by allocating more storage from the heap. The
+	 * currently allocated ECL entries are stored from eclPtr->loc[0] up
+	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
 	 */
 
 	size_t currElems = eclPtr->nloc;
-	size_t newElems  = (currElems ? 2*currElems : 1);
-	size_t currBytes = currElems * sizeof(ECL);
-	size_t newBytes  = newElems  * sizeof(ECL);
-	ECL *  newPtr    = (ECL *) ckalloc((unsigned) newBytes);
+	size_t newElems = (currElems ? 2*currElems : 1);
+	size_t newBytes = newElems * sizeof(ECL);
 
-	/*
-	 * Copy from old ECL array to new, free old ECL array if
-	 * needed.
-	 */
-	
-	if (currBytes) {
-	    memcpy((VOID *) newPtr, (VOID *) eclPtr->loc, currBytes);
-	}
-	if (eclPtr->loc != NULL) {
-	    ckfree((char *) eclPtr->loc);
-	}
-	eclPtr->loc  = (ECL *) newPtr;
+	eclPtr->loc = (ECL *) ckrealloc((char *)(eclPtr->loc), newBytes);
 	eclPtr->nloc = newElems;
     }
 
-    ePtr            = &eclPtr->loc [eclPtr->nuloc];
+    ePtr = &eclPtr->loc[eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
-    ePtr->line      = (int*) ckalloc (numWords * sizeof (int));
-    ePtr->next      = (int**) ckalloc (numWords * sizeof (int*));
-    ePtr->nline     = numWords;
-    wwlines         = (int*) ckalloc (numWords * sizeof (int));
+    ePtr->line = (int *) ckalloc(numWords * sizeof(int));
+    ePtr->next = (int**) ckalloc (numWords * sizeof (int*));
+    ePtr->nline = numWords;
+    wwlines = (int *) ckalloc(numWords * sizeof(int));
 
-    last     = cmd;
+    last = cmd;
     wordLine = line;
     wordNext = clNext;
-    for (wordIdx = 0;
-	 wordIdx < numWords;
-	 wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+    for (wordIdx=0 ; wordIdx<numWords;
+	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
         TclAdvanceLines         (&wordLine, last, tokenPtr->start);
 	TclAdvanceContinuations (&wordLine, &wordNext,
 				 tokenPtr->start - envPtr->source);
-	wwlines    [wordIdx] = (TclWordKnownAtCompileTime (tokenPtr)
-				? wordLine
-				: -1);
-	ePtr->line [wordIdx] = wordLine;
-	ePtr->next [wordIdx] = wordNext;
+	wwlines[wordIdx] =
+		(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
+	ePtr->line[wordIdx] = wordLine;
+	ePtr->next[wordIdx] = wordNext;
 	last = tokenPtr->start;
     }
 
     *wlines = wwlines;
     eclPtr->nuloc ++;
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -2695,55 +2604,53 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, clNext,
  *	Returns the index for the newly created ExceptionRange.
  *
  * Side effects:
- *	If there is not enough room in the CompileEnv's ExceptionRange
- *	array, the array in expanded: a new array of double the size is
- *	allocated, if envPtr->mallocedExceptArray is non-zero the old
- *	array is freed, and ExceptionRange entries are copied from the old
- *	array to the new one.
+ *	If there is not enough room in the CompileEnv's ExceptionRange array,
+ *	the array in expanded: a new array of double the size is allocated, if
+ *	envPtr->mallocedExceptArray is non-zero the old array is freed, and
+ *	ExceptionRange entries are copied from the old array to the new one.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCreateExceptRange(type, envPtr)
-    ExceptionRangeType type;	/* The kind of ExceptionRange desired. */
-    register CompileEnv *envPtr;/* Points to CompileEnv for which to
-				 * create a new ExceptionRange structure. */
+TclCreateExceptRange(
+    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
+    register CompileEnv *envPtr)/* Points to CompileEnv for which to create a
+				 * new ExceptionRange structure. */
 {
     register ExceptionRange *rangePtr;
     int index = envPtr->exceptArrayNext;
-    
+
     if (index >= envPtr->exceptArrayEnd) {
-        /*
+	/*
 	 * Expand the ExceptionRange array. The currently allocated entries
 	 * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
 	 * [inclusive].
 	 */
-	
+
 	size_t currBytes =
-	        envPtr->exceptArrayNext * sizeof(ExceptionRange);
+		envPtr->exceptArrayNext * sizeof(ExceptionRange);
 	int newElems = 2*envPtr->exceptArrayEnd;
 	size_t newBytes = newElems * sizeof(ExceptionRange);
-	ExceptionRange *newPtr = (ExceptionRange *)
-	        ckalloc((unsigned) newBytes);
-	
-	/*
-	 * Copy from old ExceptionRange array to new, free old
-	 * ExceptionRange array if needed, and mark the new ExceptionRange
-	 * array as malloced.
-	 */
-	
-	memcpy((VOID *) newPtr, (VOID *) envPtr->exceptArrayPtr,
-	        currBytes);
+
 	if (envPtr->mallocedExceptArray) {
-	    ckfree((char *) envPtr->exceptArrayPtr);
+	    envPtr->exceptArrayPtr = (ExceptionRange *)
+		    ckrealloc((char *)(envPtr->exceptArrayPtr), newBytes);
+	} else {
+	    /*
+	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
+	     * code a ckrealloc equivalent for ourselves.
+	     */
+	    ExceptionRange *newPtr = (ExceptionRange *)
+		    ckalloc((unsigned) newBytes);
+	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
+	    envPtr->exceptArrayPtr = newPtr;
+	    envPtr->mallocedExceptArray = 1;
 	}
-	envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
 	envPtr->exceptArrayEnd = newElems;
-	envPtr->mallocedExceptArray = 1;
     }
     envPtr->exceptArrayNext++;
-    
+
     rangePtr = &(envPtr->exceptArrayPtr[index]);
     rangePtr->type = type;
     rangePtr->nestingLevel = envPtr->exceptDepth;
@@ -2760,8 +2667,8 @@ TclCreateExceptRange(type, envPtr)
  *
  * TclCreateAuxData --
  *
- *	Procedure that allocates and initializes a new AuxData structure in
- *	a CompileEnv's array of compilation auxiliary data records. These
+ *	Procedure that allocates and initializes a new AuxData structure in a
+ *	CompileEnv's array of compilation auxiliary data records. These
  *	AuxData records hold information created during compilation by
  *	CompileProcs and used by instructions during execution.
  *
@@ -2769,56 +2676,57 @@ TclCreateExceptRange(type, envPtr)
  *	Returns the index for the newly created AuxData structure.
  *
  * Side effects:
- *	If there is not enough room in the CompileEnv's AuxData array,
- *	the AuxData array in expanded: a new array of double the size
- *	is allocated, if envPtr->mallocedAuxDataArray is non-zero
- *	the old array is freed, and AuxData entries are copied from
- *	the old array to the new one.
+ *	If there is not enough room in the CompileEnv's AuxData array, the
+ *	AuxData array in expanded: a new array of double the size is
+ *	allocated, if envPtr->mallocedAuxDataArray is non-zero the old array
+ *	is freed, and AuxData entries are copied from the old array to the new
+ *	one.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCreateAuxData(clientData, typePtr, envPtr)
-    ClientData clientData;	/* The compilation auxiliary data to store
-				 * in the new aux data record. */
-    AuxDataType *typePtr;	/* Pointer to the type to attach to this AuxData */
-    register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
+TclCreateAuxData(
+    ClientData clientData,	/* The compilation auxiliary data to store in
+				 * the new aux data record. */
+    AuxDataType *typePtr,	/* Pointer to the type to attach to this
+				 * AuxData */
+    register CompileEnv *envPtr)/* Points to the CompileEnv for which a new
 				 * aux data structure is to be allocated. */
 {
     int index;			/* Index for the new AuxData structure. */
     register AuxData *auxDataPtr;
     				/* Points to the new AuxData structure */
-    
+
     index = envPtr->auxDataArrayNext;
     if (index >= envPtr->auxDataArrayEnd) {
-        /*
+	/*
 	 * Expand the AuxData array. The currently allocated entries are
 	 * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
 	 * [inclusive].
 	 */
-	
+
 	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
 	int newElems = 2*envPtr->auxDataArrayEnd;
 	size_t newBytes = newElems * sizeof(AuxData);
-	AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
-	
-	/*
-	 * Copy from old AuxData array to new, free old AuxData array if
-	 * needed, and mark the new AuxData array as malloced.
-	 */
-	
-	memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
-	        currBytes);
+
 	if (envPtr->mallocedAuxDataArray) {
-	    ckfree((char *) envPtr->auxDataArrayPtr);
+	    envPtr->auxDataArrayPtr = (AuxData *)
+		    ckrealloc((char *)(envPtr->auxDataArrayPtr), newBytes);
+	} else {
+	    /*
+	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
+	     * code a ckrealloc equivalent for ourselves.
+	     */
+	    AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
+	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
+	    envPtr->auxDataArrayPtr = newPtr;
+	    envPtr->mallocedAuxDataArray = 1;
 	}
-	envPtr->auxDataArrayPtr = newPtr;
 	envPtr->auxDataArrayEnd = newElems;
-	envPtr->mallocedAuxDataArray = 1;
     }
     envPtr->auxDataArrayNext++;
-    
+
     auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
     auxDataPtr->clientData = clientData;
     auxDataPtr->type = typePtr;
@@ -2830,8 +2738,8 @@ TclCreateAuxData(clientData, typePtr, envPtr)
  *
  * TclInitJumpFixupArray --
  *
- *	Initializes a JumpFixupArray structure to hold some number of
- *	jump fixup entries.
+ *	Initializes a JumpFixupArray structure to hold some number of jump
+ *	fixup entries.
  *
  * Results:
  *	None.
@@ -2843,10 +2751,10 @@ TclCreateAuxData(clientData, typePtr, envPtr)
  */
 
 void
-TclInitJumpFixupArray(fixupArrayPtr)
-    register JumpFixupArray *fixupArrayPtr;
-				 /* Points to the JumpFixupArray structure
-				  * to initialize. */
+TclInitJumpFixupArray(
+    register JumpFixupArray *fixupArrayPtr)
+				/* Points to the JumpFixupArray structure to
+				 * initialize. */
 {
     fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
     fixupArrayPtr->next = 0;
@@ -2859,8 +2767,8 @@ TclInitJumpFixupArray(fixupArrayPtr)
  *
  * TclExpandJumpFixupArray --
  *
- *	Procedure that uses malloc to allocate more storage for a
- *      jump fixup array.
+ *	Procedure that uses malloc to allocate more storage for a jump fixup
+ *	array.
  *
  * Results:
  *	None.
@@ -2868,41 +2776,42 @@ TclInitJumpFixupArray(fixupArrayPtr)
  * Side effects:
  *	The jump fixup array in *fixupArrayPtr is reallocated to a new array
  *	of double the size, and if fixupArrayPtr->mallocedArray is non-zero
- *	the old array is freed. Jump fixup structures are copied from the
- *	old array to the new one.
+ *	the old array is freed. Jump fixup structures are copied from the old
+ *	array to the new one.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclExpandJumpFixupArray(fixupArrayPtr)
-    register JumpFixupArray *fixupArrayPtr;
-				 /* Points to the JumpFixupArray structure
-				  * to enlarge. */
+TclExpandJumpFixupArray(
+    register JumpFixupArray *fixupArrayPtr)
+				/* Points to the JumpFixupArray structure
+				 * to enlarge. */
 {
     /*
-     * The currently allocated jump fixup entries are stored from fixup[0]
-     * up to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
+     * The currently allocated jump fixup entries are stored from fixup[0] up
+     * to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
      * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
      */
 
     size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
     int newElems = 2*(fixupArrayPtr->end + 1);
     size_t newBytes = newElems * sizeof(JumpFixup);
-    JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
 
-    /*
-     * Copy from the old array to new, free the old array if needed,
-     * and mark the new array as malloced.
-     */
- 
-    memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
     if (fixupArrayPtr->mallocedArray) {
-	ckfree((char *) fixupArrayPtr->fixup);
+	fixupArrayPtr->fixup = (JumpFixup *)
+		ckrealloc((char *)(fixupArrayPtr->fixup), newBytes);
+    } else {
+	/*
+	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must
+	 * code a ckrealloc equivalent for ourselves.
+	 */
+	JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
+	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
+	fixupArrayPtr->fixup = newPtr;
+	fixupArrayPtr->mallocedArray = 1;
     }
-    fixupArrayPtr->fixup = (JumpFixup *) newPtr;
     fixupArrayPtr->end = newElems;
-    fixupArrayPtr->mallocedArray = 1;
 }
 
 /*
@@ -2922,10 +2831,10 @@ TclExpandJumpFixupArray(fixupArrayPtr)
  */
 
 void
-TclFreeJumpFixupArray(fixupArrayPtr)
-    register JumpFixupArray *fixupArrayPtr;
-				 /* Points to the JumpFixupArray structure
-				  * to free. */
+TclFreeJumpFixupArray(
+    register JumpFixupArray *fixupArrayPtr)
+				/* Points to the JumpFixupArray structure to
+				 * free. */
 {
     if (fixupArrayPtr->mallocedArray) {
 	ckfree((char *) fixupArrayPtr->fixup);
@@ -2940,27 +2849,27 @@ TclFreeJumpFixupArray(fixupArrayPtr)
  *	Procedure to emit a two-byte forward jump of kind "jumpType". Since
  *	the jump may later have to be grown to five bytes if the jump target
  *	is more than, say, 127 bytes away, this procedure also initializes a
- *	JumpFixup record with information about the jump. 
+ *	JumpFixup record with information about the jump.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The JumpFixup record pointed to by "jumpFixupPtr" is initialized
- *	with information needed later if the jump is to be grown. Also,
- *	a two byte jump of the designated type is emitted at the current
- *	point in the bytecode stream.
+ *	The JumpFixup record pointed to by "jumpFixupPtr" is initialized with
+ *	information needed later if the jump is to be grown. Also, a two byte
+ *	jump of the designated type is emitted at the current point in the
+ *	bytecode stream.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
-    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+TclEmitForwardJump(
+    CompileEnv *envPtr,		/* Points to the CompileEnv structure that
 				 * holds the resulting instruction. */
-    TclJumpType jumpType;	/* Indicates the kind of jump: if true or
+    TclJumpType jumpType,	/* Indicates the kind of jump: if true or
 				 * false or unconditional. */
-    JumpFixup *jumpFixupPtr;	/* Points to the JumpFixup structure to
+    JumpFixup *jumpFixupPtr)	/* Points to the JumpFixup structure to
 				 * initialize with information about this
 				 * forward jump. */
 {
@@ -2968,15 +2877,15 @@ TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
      * Initialize the JumpFixup structure:
      *    - codeOffset is offset of first byte of jump below
      *    - cmdIndex is index of the command after the current one
-     *    - exceptIndex is the index of the first ExceptionRange after
-     *      the current one.
+     *    - exceptIndex is the index of the first ExceptionRange after the
+     *	    current one.
      */
-    
+
     jumpFixupPtr->jumpType = jumpType;
     jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
     jumpFixupPtr->cmdIndex = envPtr->numCommands;
     jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
-    
+
     switch (jumpType) {
     case TCL_UNCONDITIONAL_JUMP:
 	TclEmitInstInt1(INST_JUMP1, 0, envPtr);
@@ -2995,43 +2904,41 @@ TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
  *
  * TclFixupForwardJump --
  *
- *	Procedure that updates a previously-emitted forward jump to jump
- *	a specified number of bytes, "jumpDist". If necessary, the jump is
- *      grown from two to five bytes; this is done if the jump distance is
- *	greater than "distThreshold" (normally 127 bytes). The jump is
- *	described by a JumpFixup record previously initialized by
- *	TclEmitForwardJump.
+ *	Procedure that updates a previously-emitted forward jump to jump a
+ *	specified number of bytes, "jumpDist". If necessary, the jump is grown
+ *	from two to five bytes; this is done if the jump distance is greater
+ *	than "distThreshold" (normally 127 bytes). The jump is described by a
+ *	JumpFixup record previously initialized by TclEmitForwardJump.
  *
  * Results:
  *	1 if the jump was grown and subsequent instructions had to be moved;
- *	otherwise 0. This result is returned to allow callers to update
- *	any additional code offsets they may hold.
+ *	otherwise 0. This result is returned to allow callers to update any
+ *	additional code offsets they may hold.
  *
  * Side effects:
  *	The jump may be grown and subsequent instructions moved. If this
  *	happens, the code offsets for any commands and any ExceptionRange
- *	records	between the jump and the current code address will be
- *	updated to reflect the moved code. Also, the bytecode instruction
- *	array in the CompileEnv structure may be grown and reallocated.
+ *	records between the jump and the current code address will be updated
+ *	to reflect the moved code. Also, the bytecode instruction array in the
+ *	CompileEnv structure may be grown and reallocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
-    CompileEnv *envPtr;		/* Points to the CompileEnv structure that
+TclFixupForwardJump(
+    CompileEnv *envPtr,		/* Points to the CompileEnv structure that
 				 * holds the resulting instruction. */
-    JumpFixup *jumpFixupPtr;    /* Points to the JumpFixup structure that
+    JumpFixup *jumpFixupPtr,	/* Points to the JumpFixup structure that
 				 * describes the forward jump. */
-    int jumpDist;		/* Jump distance to set in jump
-				 * instruction. */
-    int distThreshold;		/* Maximum distance before the two byte
-				 * jump is grown to five bytes. */
+    int jumpDist,		/* Jump distance to set in jump instr. */
+    int distThreshold)		/* Maximum distance before the two byte jump
+				 * is grown to five bytes. */
 {
     unsigned char *jumpPc, *p;
     int firstCmd, lastCmd, firstRange, lastRange, k;
-    unsigned int numBytes;
-    
+    unsigned numBytes;
+
     if (jumpDist <= distThreshold) {
 	jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
 	switch (jumpFixupPtr->jumpType) {
@@ -3049,14 +2956,14 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
     }
 
     /*
-     * We must grow the jump then move subsequent instructions down.
-     * Note that if we expand the space for generated instructions,
-     * code addresses might change; be careful about updating any of
-     * these addresses held in variables.
+     * We must grow the jump then move subsequent instructions down. Note that
+     * if we expand the space for generated instructions, code addresses might
+     * change; be careful about updating any of these addresses held in
+     * variables.
      */
-    
+
     if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
-        TclExpandCodeArray(envPtr);
+	TclExpandCodeArray(envPtr);
     }
     jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
     numBytes = envPtr->codeNext-jumpPc-2;
@@ -3076,26 +2983,26 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
 	TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
 	break;
     }
-    
+
     /*
-     * Adjust the code offsets for any commands and any ExceptionRange
-     * records between the jump and the current code address.
+     * Adjust the code offsets for any commands and any ExceptionRange records
+     * between the jump and the current code address.
      */
-    
+
     firstCmd = jumpFixupPtr->cmdIndex;
-    lastCmd  = (envPtr->numCommands - 1);
+    lastCmd = (envPtr->numCommands - 1);
     if (firstCmd < lastCmd) {
 	for (k = firstCmd;  k <= lastCmd;  k++) {
 	    (envPtr->cmdMapPtr[k]).codeOffset += 3;
 	}
     }
-    
+
     firstRange = jumpFixupPtr->exceptIndex;
-    lastRange  = (envPtr->exceptArrayNext - 1);
+    lastRange = (envPtr->exceptArrayNext - 1);
     for (k = firstRange;  k <= lastRange;  k++) {
 	ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
 	rangePtr->codeOffset += 3;
-	
+
 	switch (rangePtr->type) {
 	case LOOP_EXCEPTION_RANGE:
 	    rangePtr->breakOffset += 3;
@@ -3107,10 +3014,74 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
 	    rangePtr->catchOffset += 3;
 	    break;
 	default:
-	    panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
-	            rangePtr->type);
+	    Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d",
+		    rangePtr->type);
 	}
     }
+
+    /*
+     * TIP #280: Adjust the mapping from PC values to the per-command
+     * information about arguments and their line numbers.
+     *
+     * Note: We cannot simply remove an out-of-date entry and then reinsert
+     * with the proper PC, because then we might overwrite another entry which
+     * was at that location. Therefore we pull (copy + delete) all effected
+     * entries (beyond the fixed PC) into an array, update them there, and at
+     * last reinsert them all.
+     */
+
+    {
+	ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+
+	/* A helper structure */
+
+	typedef struct {
+	    int pc;
+	    int cmd;
+	} MAP;
+
+	/*
+	 * And the helper array. At most the whole hashtable is placed into
+	 * this.
+	 */
+
+	MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
+
+	Tcl_HashSearch hSearch;
+	Tcl_HashEntry* hPtr;
+	int n, k, isnew;
+
+	/*
+	 * Phase I: Locate the affected entries, and save them in adjusted
+	 * form to the array. This removes them from the hash.
+	 */
+
+	for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
+	     hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+	    map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
+	    map [n].pc  = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));
+
+	    if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
+		Tcl_DeleteHashEntry(hPtr);
+		map [n].pc += 3;
+		n++;
+	    }
+	}
+
+	/*
+	 * Phase II: Re-insert the modified entries into the hash.
+	 */
+
+	for (k=0;k<n;k++) {
+	    hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
+	    Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
+	}
+
+	ckfree ((char *) map);
+    }
+
     return 1;			/* the jump was grown */
 }
 
@@ -3119,9 +3090,9 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
  *
  * TclGetInstructionTable --
  *
- *  Returns a pointer to the table describing Tcl bytecode instructions.
- *  This procedure is defined so that clients can access the pointer from
- *  outside the TCL DLLs.
+ *	Returns a pointer to the table describing Tcl bytecode instructions.
+ *	This procedure is defined so that clients can access the pointer from
+ *	outside the TCL DLLs.
  *
  * Results:
  *	Returns a pointer to the global instruction table, same as the
@@ -3134,7 +3105,7 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
  */
 
 void * /* == InstructionDesc* == */
-TclGetInstructionTable()
+TclGetInstructionTable(void)
 {
     return &tclInstructionTable[0];
 }
@@ -3144,32 +3115,32 @@ TclGetInstructionTable()
  *
  * TclRegisterAuxDataType --
  *
- *	This procedure is called to register a new AuxData type
- *	in the table of all AuxData types supported by Tcl.
+ *	This procedure is called to register a new AuxData type in the table
+ *	of all AuxData types supported by Tcl.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	The type is registered in the AuxData type table. If there was already
- *	a type with the same name as in typePtr, it is replaced with the
- *	new type.
+ *	a type with the same name as in typePtr, it is replaced with the new
+ *	type.
  *
  *--------------------------------------------------------------
  */
 
 void
-TclRegisterAuxDataType(typePtr)
-    AuxDataType *typePtr;	/* Information about object type;
-                             * storage must be statically
-                             * allocated (must live forever). */
+TclRegisterAuxDataType(
+    AuxDataType *typePtr)	/* Information about object type; storage must
+				 * be statically allocated (must live forever;
+				 * will not be deallocated). */
 {
     register Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
 
     Tcl_MutexLock(&tableMutex);
     if (!auxDataTypeTableInitialized) {
-        TclInitAuxDataTypeTable();
+	TclInitAuxDataTypeTable();
     }
 
     /*
@@ -3177,17 +3148,17 @@ TclRegisterAuxDataType(typePtr)
      */
 
     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
-    if (hPtr != (Tcl_HashEntry *) NULL) {
-        Tcl_DeleteHashEntry(hPtr);
+    if (hPtr != NULL) {
+	Tcl_DeleteHashEntry(hPtr);
     }
 
     /*
      * Now insert the new object type.
      */
 
-    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
-    if (new) {
-        Tcl_SetHashValue(hPtr, typePtr);
+    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
+    if (isNew) {
+	Tcl_SetHashValue(hPtr, typePtr);
     }
     Tcl_MutexUnlock(&tableMutex);
 }
@@ -3210,20 +3181,20 @@ TclRegisterAuxDataType(typePtr)
  */
 
 AuxDataType *
-TclGetAuxDataType(typeName)
-    char *typeName;		/* Name of AuxData type to look up. */
+TclGetAuxDataType(
+    char *typeName)		/* Name of AuxData type to look up. */
 {
     register Tcl_HashEntry *hPtr;
     AuxDataType *typePtr = NULL;
 
     Tcl_MutexLock(&tableMutex);
     if (!auxDataTypeTableInitialized) {
-        TclInitAuxDataTypeTable();
+	TclInitAuxDataTypeTable();
     }
 
     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
-    if (hPtr != (Tcl_HashEntry *) NULL) {
-        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+    if (hPtr != NULL) {
+	typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
     }
     Tcl_MutexUnlock(&tableMutex);
 
@@ -3235,8 +3206,8 @@ TclGetAuxDataType(typeName)
  *
  * TclInitAuxDataTypeTable --
  *
- *	This procedure is invoked to perform once-only initialization of
- *	the AuxData type table. It also registers the AuxData types defined in 
+ *	This procedure is invoked to perform once-only initialization of the
+ *	AuxData type table. It also registers the AuxData types defined in
  *	this file.
  *
  * Results:
@@ -3250,7 +3221,7 @@ TclGetAuxDataType(typeName)
  */
 
 void
-TclInitAuxDataTypeTable()
+TclInitAuxDataTypeTable(void)
 {
     /*
      * The table mutex must already be held before this routine is invoked.
@@ -3260,10 +3231,11 @@ TclInitAuxDataTypeTable()
     Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
 
     /*
-     * There is only one AuxData type at this time, so register it here.
+     * There are only two AuxData type at this time, so register them here.
      */
 
     TclRegisterAuxDataType(&tclForeachInfoType);
+    TclRegisterAuxDataType(&tclJumptableInfoType);
 }
 
 /*
@@ -3271,10 +3243,10 @@ TclInitAuxDataTypeTable()
  *
  * TclFinalizeAuxDataTypeTable --
  *
- *	This procedure is called by Tcl_Finalize after all exit handlers
- *	have been run to free up storage associated with the table of AuxData
- *	types.  This procedure is called by TclFinalizeExecution() which
- *	is called by Tcl_Finalize().
+ *	This procedure is called by Tcl_Finalize after all exit handlers have
+ *	been run to free up storage associated with the table of AuxData
+ *	types. This procedure is called by TclFinalizeExecution() which is
+ *	called by Tcl_Finalize().
  *
  * Results:
  *	None.
@@ -3286,12 +3258,12 @@ TclInitAuxDataTypeTable()
  */
 
 void
-TclFinalizeAuxDataTypeTable()
+TclFinalizeAuxDataTypeTable(void)
 {
     Tcl_MutexLock(&tableMutex);
     if (auxDataTypeTableInitialized) {
-        Tcl_DeleteHashTable(&auxDataTypeTable);
-        auxDataTypeTableInitialized = 0;
+	Tcl_DeleteHashTable(&auxDataTypeTable);
+	auxDataTypeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
 }
@@ -3314,18 +3286,18 @@ TclFinalizeAuxDataTypeTable()
  */
 
 static int
-GetCmdLocEncodingSize(envPtr)
-     CompileEnv *envPtr;	/* Points to compilation environment
-				 * structure containing the CmdLocation
-				 * structure to encode. */
+GetCmdLocEncodingSize(
+    CompileEnv *envPtr)		/* Points to compilation environment structure
+				 * containing the CmdLocation structure to
+				 * encode. */
 {
     register CmdLocation *mapPtr = envPtr->cmdMapPtr;
     int numCmds = envPtr->numCommands;
     int codeDelta, codeLen, srcDelta, srcLen;
     int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
 				/* The offsets in their respective byte
-				 * sequences where the next encoded offset
-				 * or length should go. */
+				 * sequences where the next encoded offset or
+				 * length should go. */
     int prevCodeOffset, prevSrcOffset, i;
 
     codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
@@ -3333,7 +3305,7 @@ GetCmdLocEncodingSize(envPtr)
     for (i = 0;  i < numCmds;  i++) {
 	codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
 	if (codeDelta < 0) {
-	    panic("GetCmdLocEncodingSize: bad code offset");
+	    Tcl_Panic("GetCmdLocEncodingSize: bad code offset");
 	} else if (codeDelta <= 127) {
 	    codeDeltaNext++;
 	} else {
@@ -3343,7 +3315,7 @@ GetCmdLocEncodingSize(envPtr)
 
 	codeLen = mapPtr[i].numCodeBytes;
 	if (codeLen < 0) {
-	    panic("GetCmdLocEncodingSize: bad code length");
+	    Tcl_Panic("GetCmdLocEncodingSize: bad code length");
 	} else if (codeLen <= 127) {
 	    codeLengthNext++;
 	} else {
@@ -3360,7 +3332,7 @@ GetCmdLocEncodingSize(envPtr)
 
 	srcLen = mapPtr[i].numSrcBytes;
 	if (srcLen < 0) {
-	    panic("GetCmdLocEncodingSize: bad source length");
+	    Tcl_Panic("GetCmdLocEncodingSize: bad source length");
 	} else if (srcLen <= 127) {
 	    srcLengthNext++;
 	} else {
@@ -3376,8 +3348,8 @@ GetCmdLocEncodingSize(envPtr)
  *
  * EncodeCmdLocMap --
  *
- *	Encode the command location information for some compiled code into
- *	a ByteCode structure. The encoded command location map is stored as
+ *	Encode the command location information for some compiled code into a
+ *	ByteCode structure. The encoded command location map is stored as
  *	three adjacent byte sequences.
  *
  * Results:
@@ -3385,30 +3357,30 @@ GetCmdLocEncodingSize(envPtr)
  *	information.
  *
  * Side effects:
- *	The encoded information is stored into the block of memory headed
- *	by codePtr. Also records pointers to the start of the four byte
- *	sequences in fields in codePtr's ByteCode header structure.
+ *	The encoded information is stored into the block of memory headed by
+ *	codePtr. Also records pointers to the start of the four byte sequences
+ *	in fields in codePtr's ByteCode header structure.
  *
  *----------------------------------------------------------------------
  */
 
 static unsigned char *
-EncodeCmdLocMap(envPtr, codePtr, startPtr)
-     CompileEnv *envPtr;	/* Points to compilation environment
-				 * structure containing the CmdLocation
-				 * structure to encode. */
-     ByteCode *codePtr;		/* ByteCode in which to encode envPtr's
+EncodeCmdLocMap(
+    CompileEnv *envPtr,		/* Points to compilation environment structure
+				 * containing the CmdLocation structure to
+				 * encode. */
+    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
 				 * command location information. */
-     unsigned char *startPtr;	/* Points to the first byte in codePtr's
-				 * memory block where the location
-				 * information is to be stored. */
+    unsigned char *startPtr)	/* Points to the first byte in codePtr's
+				 * memory block where the location information
+				 * is to be stored. */
 {
     register CmdLocation *mapPtr = envPtr->cmdMapPtr;
     int numCmds = envPtr->numCommands;
     register unsigned char *p = startPtr;
     int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
     register int i;
-    
+
     /*
      * Encode the code offset for each command as a sequence of deltas.
      */
@@ -3418,7 +3390,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
     for (i = 0;  i < numCmds;  i++) {
 	codeDelta = (mapPtr[i].codeOffset - prevOffset);
 	if (codeDelta < 0) {
-	    panic("EncodeCmdLocMap: bad code offset");
+	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
 	} else if (codeDelta <= 127) {
 	    TclStoreInt1AtPtr(codeDelta, p);
 	    p++;
@@ -3439,7 +3411,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
     for (i = 0;  i < numCmds;  i++) {
 	codeLen = mapPtr[i].numCodeBytes;
 	if (codeLen < 0) {
-	    panic("EncodeCmdLocMap: bad code length");
+	    Tcl_Panic("EncodeCmdLocMap: bad code length");
 	} else if (codeLen <= 127) {
 	    TclStoreInt1AtPtr(codeLen, p);
 	    p++;
@@ -3479,7 +3451,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
     for (i = 0;  i < numCmds;  i++) {
 	srcLen = mapPtr[i].numSrcBytes;
 	if (srcLen < 0) {
-	    panic("EncodeCmdLocMap: bad source length");
+	    Tcl_Panic("EncodeCmdLocMap: bad source length");
 	} else if (srcLen <= 127) {
 	    TclStoreInt1AtPtr(srcLen, p);
 	    p++;
@@ -3490,7 +3462,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
 	    p += 4;
 	}
     }
-    
+
     return p;
 }
 
@@ -3500,8 +3472,8 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
  *
  * TclPrintByteCodeObj --
  *
- *	This procedure prints ("disassembles") the instructions of a
- *	bytecode object to stdout.
+ *	This procedure prints ("disassembles") the instructions of a bytecode
+ *	object to stdout.
  *
  * Results:
  *	None.
@@ -3513,19 +3485,140 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
  */
 
 void
-TclPrintByteCodeObj(interp, objPtr)
-    Tcl_Interp *interp;		/* Used only for Tcl_GetStringFromObj. */
-    Tcl_Obj *objPtr;		/* The bytecode object to disassemble. */
+TclPrintByteCodeObj(
+    Tcl_Interp *interp,		/* Used only for Tcl_GetStringFromObj. */
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
 {
-    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+    Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
+
+    fprintf(stdout, "\n%s", TclGetString(bufPtr));
+    Tcl_DecrRefCount(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ *	This procedure prints ("disassembles") one instruction from a bytecode
+ *	object to stdout.
+ *
+ * Results:
+ *	Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(
+    ByteCode *codePtr,		/* Bytecode containing the instruction. */
+    unsigned char *pc)		/* Points to first byte of instruction. */
+{
+    Tcl_Obj *bufferObj;
+    int numBytes;
+
+    TclNewObj(bufferObj);
+    numBytes = FormatInstruction(codePtr, pc, bufferObj);
+    fprintf(stdout, "%s", TclGetString(bufferObj));
+    Tcl_DecrRefCount(bufferObj);
+    return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintObject --
+ *
+ *	This procedure prints up to a specified number of characters from the
+ *	argument Tcl object's string representation to a specified file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintObject(
+    FILE *outFile,		/* The file to print the source to. */
+    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
+				 * representation should be printed. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    char *bytes;
+    int length;
+
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ *	This procedure prints up to a specified number of characters from the
+ *	argument string to a specified file. It tries to produce legible
+ *	output by adding backslashes as necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(
+    FILE *outFile,		/* The file to print the source to. */
+    const char *stringPtr,	/* The string to print. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    Tcl_Obj *bufferObj;
+
+    TclNewObj(bufferObj);
+    PrintSourceToObj(bufferObj, stringPtr, maxChars);
+    fprintf(outFile, "%s", TclGetString(bufferObj));
+    Tcl_DecrRefCount(bufferObj);
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDisassembleByteCodeObj --
+ *
+ *	Given an object which is of bytecode type, return a disassembled
+ *	version of the bytecode (in a new refcount 0 object). No guarantees
+ *	are made about the details of the contents of the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDisassembleByteCodeObj(
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
+{
+    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
     unsigned char *codeStart, *codeLimit, *pc;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
     int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
+    Tcl_Obj *bufferObj;
+    char ptrBuf1[20], ptrBuf2[20];
 
+    TclNewObj(bufferObj);
     if (codePtr->refCount <= 0) {
-	return;			/* already freed */
+	return bufferObj;	/* Already freed. */
     }
 
     codeStart = codePtr->codeStart;
@@ -3536,62 +3629,70 @@ TclPrintByteCodeObj(interp, objPtr)
      * Print header lines describing the ByteCode.
      */
 
-    fprintf(stdout, "\nByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
-	    (unsigned int) codePtr, codePtr->refCount,
-	    codePtr->compileEpoch, (unsigned int) iPtr,
+    sprintf(ptrBuf1, "%p", codePtr);
+    sprintf(ptrBuf2, "%p", iPtr);
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+	    ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
 	    iPtr->compileEpoch);
-    fprintf(stdout, "  Source ");
-    TclPrintSource(stdout, codePtr->source,
+    Tcl_AppendToObj(bufferObj, "  Source ", -1);
+    PrintSourceToObj(bufferObj, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
-    fprintf(stdout, "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
 	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
 	    codePtr->numLitObjects, codePtr->numAuxDataItems,
 	    codePtr->maxStackDepth,
 #ifdef TCL_COMPILE_STATS
-	    (codePtr->numSrcBytes?
-	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
-#else
-	    0.0);
+	    codePtr->numSrcBytes?
+		    codePtr->structureSize/(float)codePtr->numSrcBytes :
 #endif
+	    0.0);
+
 #ifdef TCL_COMPILE_STATS
-    fprintf(stdout,
-	    "  Code %u = header %u+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
-	    (unsigned int)codePtr->structureSize,
-	    (unsigned int)(sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+	    (unsigned long) codePtr->structureSize,
+	    (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
 	    codePtr->numCodeBytes,
-	    (unsigned long)(codePtr->numLitObjects * sizeof(Tcl_Obj *)),
-	    (unsigned long)(codePtr->numExceptRanges * sizeof(ExceptionRange)),
-	    (unsigned long)(codePtr->numAuxDataItems * sizeof(AuxData)),
+	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
 	    codePtr->numCmdLocBytes);
 #endif /* TCL_COMPILE_STATS */
-    
+
     /*
      * If the ByteCode is the compiled body of a Tcl procedure, print
      * information about that procedure. Note that we don't know the
      * procedure's name since ByteCode's can be shared among procedures.
      */
-    
+
     if (codePtr->procPtr != NULL) {
 	Proc *procPtr = codePtr->procPtr;
 	int numCompiledLocals = procPtr->numCompiledLocals;
-	fprintf(stdout,
-	        "  Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
-		(unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
+
+	sprintf(ptrBuf1, "%p", procPtr);
+	Tcl_AppendPrintfToObj(bufferObj,
+		"  Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
+		ptrBuf1, procPtr->refCount, procPtr->numArgs,
 		numCompiledLocals);
 	if (numCompiledLocals > 0) {
 	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
+
 	    for (i = 0;  i < numCompiledLocals;  i++) {
-		fprintf(stdout, "      slot %d%s%s%s%s%s%s", i, 
-			((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
-			((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
-			((localPtr->flags & VAR_LINK)?  ", link"  : ""),
-			((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
-			((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
-			((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+		Tcl_AppendPrintfToObj(bufferObj,
+			"      slot %d%s%s%s%s%s%s", i,
+			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
+			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
+			(localPtr->flags & VAR_LINK) ? ", link" : "",
+			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
+			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
+			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
 		if (TclIsVarTemporary(localPtr)) {
-		    fprintf(stdout,	"\n");
+		    Tcl_AppendToObj(bufferObj, "\n", -1);
 		} else {
-		    fprintf(stdout,	", \"%s\"\n", localPtr->name);
+		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+			    localPtr->name);
 		}
 		localPtr = localPtr->nextPtr;
 	    }
@@ -3603,58 +3704,60 @@ TclPrintByteCodeObj(interp, objPtr)
      */
 
     if (codePtr->numExceptRanges > 0) {
-	fprintf(stdout, "  Exception ranges %d, depth %d:\n",
-	        codePtr->numExceptRanges, codePtr->maxExceptDepth);
+	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
+		codePtr->numExceptRanges, codePtr->maxExceptDepth);
 	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
 	    ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
-	    fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
+
+	    Tcl_AppendPrintfToObj(bufferObj,
+		    "      %d: level %d, %s, pc %d-%d, ",
 		    i, rangePtr->nestingLevel,
-		    ((rangePtr->type == LOOP_EXCEPTION_RANGE)
-			    ? "loop" : "catch"),
+		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
 		    rangePtr->codeOffset,
 		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
 	    switch (rangePtr->type) {
 	    case LOOP_EXCEPTION_RANGE:
-		fprintf(stdout,	"continue %d, break %d\n",
-		        rangePtr->continueOffset, rangePtr->breakOffset);
+		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
+			rangePtr->continueOffset, rangePtr->breakOffset);
 		break;
 	    case CATCH_EXCEPTION_RANGE:
-		fprintf(stdout,	"catch %d\n", rangePtr->catchOffset);
+		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+			rangePtr->catchOffset);
 		break;
 	    default:
-		panic("TclPrintByteCodeObj: bad ExceptionRange type %d\n",
-		        rangePtr->type);
+		Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
+			rangePtr->type);
 	    }
 	}
     }
-    
+
     /*
-     * If there were no commands (e.g., an expression or an empty string
-     * was compiled), just print all instructions and return.
+     * If there were no commands (e.g., an expression or an empty string was
+     * compiled), just print all instructions and return.
      */
 
     if (numCmds == 0) {
 	pc = codeStart;
 	while (pc < codeLimit) {
-	    fprintf(stdout, "    ");
-	    pc += TclPrintInstruction(codePtr, pc);
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
 	}
-	return;
+	return bufferObj;
     }
-    
+
     /*
-     * Print table showing the code offset, source offset, and source
-     * length for each command. These are encoded as a sequence of bytes.
+     * Print table showing the code offset, source offset, and source length
+     * for each command. These are encoded as a sequence of bytes.
      */
 
-    fprintf(stdout, "  Commands %d:", numCmds);
+    Tcl_AppendPrintfToObj(bufferObj, "  Commands %d:", numCmds);
     codeDeltaNext = codePtr->codeDeltaStart;
     codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
     srcLengthNext = codePtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -3664,7 +3767,7 @@ TclPrintByteCodeObj(interp, objPtr)
 	}
 	codeOffset += delta;
 
-	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
 	    codeLengthNext++;
 	    codeLen = TclGetInt4AtPtr(codeLengthNext);
 	    codeLengthNext += 4;
@@ -3672,8 +3775,8 @@ TclPrintByteCodeObj(interp, objPtr)
 	    codeLen = TclGetInt1AtPtr(codeLengthNext);
 	    codeLengthNext++;
 	}
-	
-	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -3683,7 +3786,7 @@ TclPrintByteCodeObj(interp, objPtr)
 	}
 	srcOffset += delta;
 
-	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -3691,29 +3794,29 @@ TclPrintByteCodeObj(interp, objPtr)
 	    srcLen = TclGetInt1AtPtr(srcLengthNext);
 	    srcLengthNext++;
 	}
-	
-	fprintf(stdout,	"%s%4d: pc %d-%d, src %d-%d",
+
+	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
 		((i % 2)? "   	" : "\n   "),
 		(i+1), codeOffset, (codeOffset + codeLen - 1),
 		srcOffset, (srcOffset + srcLen - 1));
     }
     if (numCmds > 0) {
-	fprintf(stdout,	"\n");
+	Tcl_AppendToObj(bufferObj, "\n", -1);
     }
-    
+
     /*
-     * Print each instruction. If the instruction corresponds to the start
-     * of a command, print the command's source. Note that we don't need
-     * the code length here.
+     * Print each instruction. If the instruction corresponds to the start of
+     * a command, print the command's source. Note that we don't need the code
+     * length here.
      */
 
     codeDeltaNext = codePtr->codeDeltaStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
     srcLengthNext = codePtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     pc = codeStart;
     for (i = 0;  i < numCmds;  i++) {
-	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -3723,7 +3826,7 @@ TclPrintByteCodeObj(interp, objPtr)
 	}
 	codeOffset += delta;
 
-	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -3733,7 +3836,7 @@ TclPrintByteCodeObj(interp, objPtr)
 	}
 	srcOffset += delta;
 
-	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -3745,16 +3848,16 @@ TclPrintByteCodeObj(interp, objPtr)
 	/*
 	 * Print instructions before command i.
 	 */
-	
+
 	while ((pc-codeStart) < codeOffset) {
-	    fprintf(stdout, "    ");
-	    pc += TclPrintInstruction(codePtr, pc);
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
 	}
 
-	fprintf(stdout, "  Command %d: ", (i+1));
-	TclPrintSource(stdout, (codePtr->source + srcOffset),
-	        TclMin(srcLen, 55));
-	fprintf(stdout, "\n");
+	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
+	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
+		TclMin(srcLen, 55));
+	Tcl_AppendToObj(bufferObj, "\n", -1);
     }
     if (pc < codeLimit) {
 	/*
@@ -3762,225 +3865,201 @@ TclPrintByteCodeObj(interp, objPtr)
 	 */
 
 	while (pc < codeLimit) {
-	    fprintf(stdout, "    ");
-	    pc += TclPrintInstruction(codePtr, pc);
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
 	}
     }
+    return bufferObj;
 }
-#endif /* TCL_COMPILE_DEBUG */
 
 /*
  *----------------------------------------------------------------------
  *
- * TclPrintInstruction --
- *
- *	This procedure prints ("disassembles") one instruction from a
- *	bytecode object to stdout.
- *
- * Results:
- *	Returns the length in bytes of the current instruiction.
+ * FormatInstruction --
  *
- * Side effects:
- *	None.
+ *	Appends a representation of a bytecode instruction to a Tcl_Obj.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclPrintInstruction(codePtr, pc)
-    ByteCode* codePtr;		/* Bytecode containing the instruction. */
-    unsigned char *pc;		/* Points to first byte of instruction. */
+static int
+FormatInstruction(
+    ByteCode *codePtr,		/* Bytecode containing the instruction. */
+    unsigned char *pc,		/* Points to first byte of instruction. */
+    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
 {
     Proc *procPtr = codePtr->procPtr;
     unsigned char opCode = *pc;
     register InstructionDesc *instDesc = &tclInstructionTable[opCode];
     unsigned char *codeStart = codePtr->codeStart;
-    unsigned int pcOffset = (pc - codeStart);
-    int opnd, i, j;
-    
-    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
+    unsigned pcOffset = pc - codeStart;
+    int opnd = 0, i, j, numBytes = 1;
+    int localCt = procPtr ? procPtr->numCompiledLocals : 0;
+    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
+    char suffixBuffer[128];	/* Additional info to print after main opcode
+				 * and immediates. */
+    char *suffixSrc = NULL;
+    Tcl_Obj *suffixObj = NULL;
+    AuxData *auxPtr = NULL;
+
+    suffixBuffer[0] = '\0';
+    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
     for (i = 0;  i < instDesc->numOperands;  i++) {
 	switch (instDesc->opTypes[i]) {
 	case OPERAND_INT1:
-	    opnd = TclGetInt1AtPtr(pc+1+i);
-	    if ((i == 0) && ((opCode == INST_JUMP1)
-			     || (opCode == INST_JUMP_TRUE1)
-		             || (opCode == INST_JUMP_FALSE1))) {
-		fprintf(stdout, "%d  	# pc %u", opnd, (pcOffset + opnd));
-	    } else {
-		fprintf(stdout, "%d", opnd);
+	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+	    if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
+		    || opCode == INST_JUMP_FALSE1) {
+		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
 	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
 	    break;
 	case OPERAND_INT4:
-	    opnd = TclGetInt4AtPtr(pc+1+i);
-	    if ((i == 0) && ((opCode == INST_JUMP4)
-			     || (opCode == INST_JUMP_TRUE4)
-		             || (opCode == INST_JUMP_FALSE4))) {
-		fprintf(stdout, "%d  	# pc %u", opnd, (pcOffset + opnd));
-	    } else {
-		fprintf(stdout, "%d", opnd);
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
+		    || opCode == INST_JUMP_FALSE4) {
+		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    } else if (opCode == INST_START_CMD) {
+		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
 	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
 	    break;
 	case OPERAND_UINT1:
-	    opnd = TclGetUInt1AtPtr(pc+1+i);
-	    if ((i == 0) && (opCode == INST_PUSH1)) {
-		fprintf(stdout, "%u  	# ", (unsigned int) opnd);
-		TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
-	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
-				    || (opCode == INST_LOAD_ARRAY1)
-				    || (opCode == INST_STORE_SCALAR1)
-				    || (opCode == INST_STORE_ARRAY1))) {
-		int localCt = procPtr->numCompiledLocals;
-		CompiledLocal *localPtr = procPtr->firstLocalPtr;
-		if (opnd >= localCt) {
-		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
-			     (unsigned int) opnd, localCt);
-		    return instDesc->numBytes;
-		}
-		for (j = 0;  j < opnd;  j++) {
-		    localPtr = localPtr->nextPtr;
-		}
-		if (TclIsVarTemporary(localPtr)) {
-		    fprintf(stdout, "%u	# temp var %u",
-			    (unsigned int) opnd, (unsigned int) opnd);
-		} else {
-		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
-		    TclPrintSource(stdout, localPtr->name, 40);
-		}
-	    } else {
-		fprintf(stdout, "%u ", (unsigned int) opnd);
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    if (opCode == INST_PUSH1) {
+		suffixObj = codePtr->objArrayPtr[opnd];
 	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
 	    break;
+	case OPERAND_AUX4:
 	case OPERAND_UINT4:
-	    opnd = TclGetUInt4AtPtr(pc+1+i);
+	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
 	    if (opCode == INST_PUSH4) {
-		fprintf(stdout, "%u  	# ", opnd);
-		TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
-	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
-				    || (opCode == INST_LOAD_ARRAY4)
-				    || (opCode == INST_STORE_SCALAR4)
-				    || (opCode == INST_STORE_ARRAY4))) {
-		int localCt = procPtr->numCompiledLocals;
-		CompiledLocal *localPtr = procPtr->firstLocalPtr;
+		suffixObj = codePtr->objArrayPtr[opnd];
+	    } else if (opCode == INST_START_CMD && opnd != 1) {
+		sprintf(suffixBuffer+strlen(suffixBuffer),
+			", %u cmds start here", opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    if (instDesc->opTypes[i] == OPERAND_AUX4) {
+		auxPtr = &codePtr->auxDataArrayPtr[opnd];
+	    }
+	    break;
+	case OPERAND_IDX4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opnd >= -1) {
+		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
+	    } else if (opnd == -2) {
+		Tcl_AppendPrintfToObj(bufferObj, "end ");
+	    } else {
+		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
+	    }
+	    break;
+	case OPERAND_LVT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes);
+	    numBytes++;
+	    goto printLVTindex;
+	case OPERAND_LVT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes);
+	    numBytes += 4;
+	printLVTindex:
+	    if (localPtr != NULL) {
 		if (opnd >= localCt) {
-		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
-			     (unsigned int) opnd, localCt);
-		    return instDesc->numBytes;
+		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+			    (unsigned) opnd, localCt);
 		}
 		for (j = 0;  j < opnd;  j++) {
 		    localPtr = localPtr->nextPtr;
 		}
 		if (TclIsVarTemporary(localPtr)) {
-		    fprintf(stdout, "%u	# temp var %u",
-			    (unsigned int) opnd, (unsigned int) opnd);
+		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
 		} else {
-		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
-		    TclPrintSource(stdout, localPtr->name, 40);
+		    sprintf(suffixBuffer, "var ");
+		    suffixSrc = localPtr->name;
 		}
-	    } else {
-		fprintf(stdout, "%u ", (unsigned int) opnd);
 	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
 	    break;
 	case OPERAND_NONE:
 	default:
 	    break;
 	}
     }
-    fprintf(stdout, "\n");
-    return instDesc->numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintObject --
- *
- *	This procedure prints up to a specified number of characters from
- *	the argument Tcl object's string representation to a specified file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintObject(outFile, objPtr, maxChars)
-    FILE *outFile;		/* The file to print the source to. */
-    Tcl_Obj *objPtr;		/* Points to the Tcl object whose string
-				 * representation should be printed. */
-    int maxChars;		/* Maximum number of chars to print. */
-{
-    char *bytes;
-    int length;
-    
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
-    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+    if (suffixObj) {
+	char *bytes;
+	int length;
+
+	Tcl_AppendToObj(bufferObj, "\t# ", -1);
+	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
+    } else if (suffixBuffer[0]) {
+	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
+	if (suffixSrc) {
+	    PrintSourceToObj(bufferObj, suffixSrc, 40);
+	}
+    }
+    Tcl_AppendToObj(bufferObj, "\n", -1);
+    if (auxPtr && auxPtr->type->printProc) {
+	Tcl_AppendToObj(bufferObj, "\t\t[", -1);
+	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
+		pcOffset);
+	Tcl_AppendToObj(bufferObj, "]\n", -1);
+    }
+    return numBytes;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclPrintSource --
+ * PrintSourceToObj --
  *
- *	This procedure prints up to a specified number of characters from
- *	the argument string to a specified file. It tries to produce legible
- *	output by adding backslashes as necessary.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Outputs characters to the specified file.
+ *	Appends a quoted representation of a string to a Tcl_Obj.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclPrintSource(outFile, string, maxChars)
-    FILE *outFile;		/* The file to print the source to. */
-    CONST char *string;		/* The string to print. */
-    int maxChars;		/* Maximum number of chars to print. */
+static void
+PrintSourceToObj(
+    Tcl_Obj *appendObj,		/* The object to print the source to. */
+    const char *stringPtr,	/* The string to print. */
+    int maxChars)		/* Maximum number of chars to print. */
 {
-    register CONST char *p;
+    register const char *p;
     register int i = 0;
 
-    if (string == NULL) {
-	fprintf(outFile, "\"\"");
+    if (stringPtr == NULL) {
+	Tcl_AppendToObj(appendObj, "\"\"", -1);
 	return;
     }
 
-    fprintf(outFile, "\"");
-    p = string;
+    Tcl_AppendToObj(appendObj, "\"", -1);
+    p = stringPtr;
     for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
 	switch (*p) {
-	    case '"':
-		fprintf(outFile, "\\\"");
-		continue;
-	    case '\f':
-		fprintf(outFile, "\\f");
-		continue;
-	    case '\n':
-		fprintf(outFile, "\\n");
-		continue;
-            case '\r':
-		fprintf(outFile, "\\r");
-		continue;
-	    case '\t':
-		fprintf(outFile, "\\t");
-		continue;
-            case '\v':
-		fprintf(outFile, "\\v");
-		continue;
-	    default:
-		fprintf(outFile, "%c", *p);
-		continue;
+	case '"':
+	    Tcl_AppendToObj(appendObj, "\\\"", -1);
+	    continue;
+	case '\f':
+	    Tcl_AppendToObj(appendObj, "\\f", -1);
+	    continue;
+	case '\n':
+	    Tcl_AppendToObj(appendObj, "\\n", -1);
+	    continue;
+	case '\r':
+	    Tcl_AppendToObj(appendObj, "\\r", -1);
+	    continue;
+	case '\t':
+	    Tcl_AppendToObj(appendObj, "\\t", -1);
+	    continue;
+	case '\v':
+	    Tcl_AppendToObj(appendObj, "\\v", -1);
+	    continue;
+	default:
+	    Tcl_AppendPrintfToObj(appendObj, "%c", *p);
+	    continue;
 	}
     }
-    fprintf(outFile, "\"");
+    Tcl_AppendToObj(appendObj, "\"", -1);
 }
 
 #ifdef TCL_COMPILE_STATS
@@ -3998,41 +4077,42 @@ TclPrintSource(outFile, string, maxChars)
  *
  * Side effects:
  *	Accumulates aggregate code-related statistics in the interpreter's
- *	ByteCodeStats structure. Records statistics specific to a ByteCode
- *	in its ByteCode structure.
+ *	ByteCodeStats structure. Records statistics specific to a ByteCode in
+ *	its ByteCode structure.
  *
  *----------------------------------------------------------------------
  */
 
 void
-RecordByteCodeStats(codePtr)
-    ByteCode *codePtr;		/* Points to ByteCode structure with info
+RecordByteCodeStats(
+    ByteCode *codePtr)		/* Points to ByteCode structure with info
 				 * to add to accumulated statistics. */
 {
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
-    register ByteCodeStats *statsPtr = &(iPtr->stats);
+    register ByteCodeStats *statsPtr;
 
     if (iPtr == NULL) {
 	/* Avoid segfaulting in case we're called in a deleted interp */
 	return;
     }
+    statsPtr = &(iPtr->stats);
 
     statsPtr->numCompilations++;
-    statsPtr->totalSrcBytes        += (double) codePtr->numSrcBytes;
-    statsPtr->totalByteCodeBytes   += (double) codePtr->structureSize;
-    statsPtr->currentSrcBytes      += (double) codePtr->numSrcBytes;
+    statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
+    statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
+    statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
     statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
-    
+
     statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
     statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
 
-    statsPtr->currentInstBytes   += (double) codePtr->numCodeBytes;
-    statsPtr->currentLitBytes    +=
-	    (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *)); 
-    statsPtr->currentExceptBytes +=
-	    (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
-    statsPtr->currentAuxBytes    +=
-            (double) (codePtr->numAuxDataItems * sizeof(AuxData));
+    statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
+    statsPtr->currentLitBytes += (double)
+	    codePtr->numLitObjects * sizeof(Tcl_Obj *);
+    statsPtr->currentExceptBytes += (double)
+	    codePtr->numExceptRanges * sizeof(ExceptionRange);
+    statsPtr->currentAuxBytes += (double)
+	    codePtr->numAuxDataItems * sizeof(AuxData);
     statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
 }
 #endif /* TCL_COMPILE_STATS */
@@ -4044,4 +4124,3 @@ RecordByteCodeStats(codePtr)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 31c1b94..c035a03 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -3,24 +3,19 @@
  *
  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #ifndef _TCLCOMPILATION
 #define _TCLCOMPILATION 1
 
-#ifndef _TCLINT
 #include "tclInt.h"
-#endif /* _TCLINT */
 
-#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
+struct ByteCode;		/* Forward declaration. */
 
 /*
  *------------------------------------------------------------------------
@@ -39,10 +34,8 @@
  * This variable is linked to the Tcl variable "tcl_traceCompile".
  */
 
-extern int 		tclTraceCompile;
-#endif
+MODULE_SCOPE int 	tclTraceCompile;
 
-#ifdef TCL_COMPILE_DEBUG
 /*
  * Variable that controls whether execution tracing is enabled and, if so,
  * what level of tracing is desired:
@@ -53,9 +46,9 @@ extern int 		tclTraceCompile;
  * This variable is linked to the Tcl variable "tcl_traceExec".
  */
 
-extern int 		tclTraceExec;
+MODULE_SCOPE int 	tclTraceExec;
 #endif
-
+
 /*
  *------------------------------------------------------------------------
  * Data structures related to compilation.
@@ -63,54 +56,55 @@ extern int 		tclTraceExec;
  */
 
 /*
- * The structure used to implement Tcl "exceptions" (exceptional returns):
- * for example, those generated in loops by the break and continue commands,
- * and those generated by scripts and caught by the catch command. This
- * ExceptionRange structure describes a range of code (e.g., a loop body),
- * the kind of exceptions (e.g., a break or continue) that might occur, and
- * the PC offsets to jump to if a matching exception does occur. Exception
- * ranges can nest so this structure includes a nesting level that is used
- * at runtime to find the closest exception range surrounding a PC. For
- * example, when a break command is executed, the ExceptionRange structure
- * for the most deeply nested loop, if any, is found and used. These
- * structures are also generated for the "next" subcommands of for loops
- * since a break there terminates the for command. This means a for command
- * actually generates two LoopInfo structures.
+ * The structure used to implement Tcl "exceptions" (exceptional returns): for
+ * example, those generated in loops by the break and continue commands, and
+ * those generated by scripts and caught by the catch command. This
+ * ExceptionRange structure describes a range of code (e.g., a loop body), the
+ * kind of exceptions (e.g., a break or continue) that might occur, and the PC
+ * offsets to jump to if a matching exception does occur. Exception ranges can
+ * nest so this structure includes a nesting level that is used at runtime to
+ * find the closest exception range surrounding a PC. For example, when a
+ * break command is executed, the ExceptionRange structure for the most deeply
+ * nested loop, if any, is found and used. These structures are also generated
+ * for the "next" subcommands of for loops since a break there terminates the
+ * for command. This means a for command actually generates two LoopInfo
+ * structures.
  */
 
 typedef enum {
-    LOOP_EXCEPTION_RANGE,	/* Exception's range is part of a loop.
-				 * Break and continue "exceptions" cause
-				 * jumps to appropriate PC offsets. */
-    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a
-				 * catch command. Errors in the range cause
-				 * a jump to a catch PC offset. */
+    LOOP_EXCEPTION_RANGE,	/* Exception's range is part of a loop. Break
+				 * and continue "exceptions" cause jumps to
+				 * appropriate PC offsets. */
+    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a catch
+				 * command. Errors in the range cause a jump
+				 * to a catch PC offset. */
 } ExceptionRangeType;
 
 typedef struct ExceptionRange {
     ExceptionRangeType type;	/* The kind of ExceptionRange. */
-    int nestingLevel;		/* Static depth of the exception range.
-				 * Used to find the most deeply-nested
-				 * range surrounding a PC at runtime. */
-    int codeOffset;		/* Offset of the first instruction byte of
-				 * the code range. */
+    int nestingLevel;		/* Static depth of the exception range. Used
+				 * to find the most deeply-nested range
+				 * surrounding a PC at runtime. */
+    int codeOffset;		/* Offset of the first instruction byte of the
+				 * code range. */
     int numCodeBytes;		/* Number of bytes in the code range. */
     int breakOffset;		/* If LOOP_EXCEPTION_RANGE, the target PC
 				 * offset for a break command in the range. */
     int continueOffset;		/* If LOOP_EXCEPTION_RANGE and not -1, the
 				 * target PC offset for a continue command in
-				 * the code range. Otherwise, ignore this range
-				 * when processing a continue command. */
+				 * the code range. Otherwise, ignore this
+				 * range when processing a continue
+				 * command. */
     int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
 				 * offset for any "exception" in range. */
 } ExceptionRange;
 
 /*
  * Structure used to map between instruction pc and source locations. It
- * defines for each compiled Tcl command its code's starting offset and 
- * its source's starting offset and length. Note that the code offset
- * increases monotonically: that is, the table is sorted in code offset
- * order. The source offset is not monotonic.
+ * defines for each compiled Tcl command its code's starting offset and its
+ * source's starting offset and length. Note that the code offset increases
+ * monotonically: that is, the table is sorted in code offset order. The
+ * source offset is not monotonic.
  */
 
 typedef struct CmdLocation {
@@ -120,80 +114,90 @@ typedef struct CmdLocation {
     int numSrcBytes;		/* Number of command source chars. */
 } CmdLocation;
 
-#ifdef TCL_TIP280
 /*
  * TIP #280
- * Structure to record additional location information for byte code.
- * This information is internal and not saved. I.e. tbcload'ed code
- * will not have this information. It records the lines for all words
- * of all commands found in the byte code. The association with a
- * ByteCode structure BC is done through the 'lineBCPtr' HashTable in
- * Interp, keyed by the address of BC. Also recorded is information
- * coming from the context, i.e. type of the frame and associated
- * information, like the path of a sourced file.
+ * Structure to record additional location information for byte code. This
+ * information is internal and not saved. i.e. tbcload'ed code will not have
+ * this information. It records the lines for all words of all commands found
+ * in the byte code. The association with a ByteCode structure BC is done
+ * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
+ * Also recorded is information coming from the context, i.e. type of the
+ * frame and associated information, like the path of a sourced file.
  */
 
 typedef struct ECL {
-  int  srcOffset; /* cmd location to find the entry */
-  int  nline;     /* Number of words in the command */
-  int* line;      /* line information for all words in the command */
-  int** next;     /* Transient information during compile, ICL tracking */
+    int srcOffset;		/* Command location to find the entry. */
+    int nline;                  /* Number of words in the command */
+    int *line;			/* Line information for all words in the
+				 * command. */
+    int** next;                 /* Transient information used by the compiler
+				 * for tracking of hidden continuation
+				 * lines. */
 } ECL;
 
 typedef struct ExtCmdLoc {
-  int      type;  /* Context type */
-  Tcl_Obj* path;  /* Path of the sourced file the command is in */
-  ECL*     loc;   /* Command word locations (lines) */
-  int      nloc;  /* Number of allocated entries in 'loc' */
-  int      nuloc; /* Number of used entries in 'loc' */
-  Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the
-			  * information accessible per command and
-			  * argument, not per whole bytecode. Value is
-			  * index of command in 'loc', giving us the
-			  * literals to associate with line
-			  * information as command argument, see
-			  * TclArgumentBCEnter() */
+    int type;			/* Context type. */
+    int start;                  /* Starting line for compiled script. Needed
+				 * for the extended recompile check in
+				 * TclCompEvalObj. */
+
+    Tcl_Obj *path;		/* Path of the sourced file the command is
+				 * in. */
+    ECL *loc;			/* Command word locations (lines). */
+    int nloc;			/* Number of allocated entries in 'loc'. */
+    int nuloc;			/* Number of used entries in 'loc'. */
+    Tcl_HashTable litInfo;      /* Indexed by bytecode 'PC', to have the
+				 * information accessible per command and
+				 * argument, not per whole bytecode. Value is
+				 * index of command in 'loc', giving us the
+				 * literals to associate with line information
+				 * as command argument, see
+				 * TclArgumentBCEnter() */
 } ExtCmdLoc;
-#endif
 
 /*
- * CompileProcs need the ability to record information during compilation
- * that can be used by bytecode instructions during execution. The AuxData
- * structure provides this "auxiliary data" mechanism. An arbitrary number
- * of these structures can be stored in the ByteCode record (during
- * compilation they are stored in a CompileEnv structure). Each AuxData
- * record holds one word of client-specified data (often a pointer) and is
- * given an index that instructions can later use to look up the structure
- * and its data.
+ * CompileProcs need the ability to record information during compilation that
+ * can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number of
+ * these structures can be stored in the ByteCode record (during compilation
+ * they are stored in a CompileEnv structure). Each AuxData record holds one
+ * word of client-specified data (often a pointer) and is given an index that
+ * instructions can later use to look up the structure and its data.
  *
  * The following definitions declare the types of procedures that are called
  * to duplicate or free this auxiliary data when the containing ByteCode
- * objects are duplicated and freed. Pointers to these procedures are kept
- * in the AuxData structure.
+ * objects are duplicated and freed. Pointers to these procedures are kept in
+ * the AuxData structure.
  */
 
-typedef ClientData (AuxDataDupProc)  _ANSI_ARGS_((ClientData clientData));
-typedef void       (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef ClientData (AuxDataDupProc)  (ClientData clientData);
+typedef void       (AuxDataFreeProc) (ClientData clientData);
+typedef void	   (AuxDataPrintProc)(ClientData clientData,
+			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
+			    unsigned int pcOffset);
 
 /*
  * We define a separate AuxDataType struct to hold type-related information
  * for the AuxData structure. This separation makes it possible for clients
- * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
- * for example, it makes it possible to pickle and unpickle AuxData structs.
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
+ * example, it makes it possible to pickle and unpickle AuxData structs.
  */
 
 typedef struct AuxDataType {
-    char *name;					/* the name of the type. Types can be
-                                 * registered and found by name */
-    AuxDataDupProc *dupProc;	/* Callback procedure to invoke when the
-                                 * aux data is duplicated (e.g., when the
-                                 * ByteCode structure containing the aux
-                                 * data is duplicated). NULL means just
-                                 * copy the source clientData bits; no
-                                 * proc need be called. */
-    AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the
-                                 * aux data is freed. NULL means no
-                                 * proc need be called. */
+    char *name;			/* The name of the type. Types can be
+				 * registered and found by name */
+    AuxDataDupProc *dupProc;	/* Callback procedure to invoke when the aux
+				 * data is duplicated (e.g., when the ByteCode
+				 * structure containing the aux data is
+				 * duplicated). NULL means just copy the
+				 * source clientData bits; no proc need be
+				 * called. */
+    AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the aux
+				 * data is freed. NULL means no proc need be
+				 * called. */
+    AuxDataPrintProc *printProc;/* Callback function to invoke when printing
+				 * the aux data as part of debugging. NULL
+				 * means that the data can't be printed. */
 } AuxDataType;
 
 /*
@@ -203,8 +207,8 @@ typedef struct AuxDataType {
  */
 
 typedef struct AuxData {
-    AuxDataType *type;		/* pointer to the AuxData type associated with
-                             * this ClientData. */
+    AuxDataType *type;		/* Pointer to the AuxData type associated with
+				 * this ClientData. */
     ClientData clientData;	/* The compilation data itself. */
 } AuxData;
 
@@ -222,90 +226,91 @@ typedef struct AuxData {
 
 typedef struct CompileEnv {
     Interp *iPtr;		/* Interpreter containing the code being
-				 * compiled. Commands and their compile
-				 * procs are specific to an interpreter so
-				 * the code emitted will depend on the
-				 * interpreter. */
-    char *source;		/* The source string being compiled by
+				 * compiled. Commands and their compile procs
+				 * are specific to an interpreter so the code
+				 * emitted will depend on the interpreter. */
+    const char *source;		/* The source string being compiled by
 				 * SetByteCodeFromAny. This pointer is not
 				 * owned by the CompileEnv and must not be
 				 * freed or changed by it. */
     int numSrcBytes;		/* Number of bytes in source. */
-    Proc *procPtr;		/* If a procedure is being compiled, a
-				 * pointer to its Proc structure; otherwise
-				 * NULL. Used to compile local variables.
-				 * Set from information provided by
-				 * ObjInterpProc in tclProc.c. */
+    Proc *procPtr;		/* If a procedure is being compiled, a pointer
+				 * to its Proc structure; otherwise NULL. Used
+				 * to compile local variables. Set from
+				 * information provided by ObjInterpProc in
+				 * tclProc.c. */
     int numCommands;		/* Number of commands compiled. */
-    int exceptDepth;		/* Current exception range nesting level;
-				 * -1 if not in any range currently. */
-    int maxExceptDepth;		/* Max nesting level of exception ranges;
-				 * -1 if no ranges have been compiled. */
-    int maxStackDepth;		/* Maximum number of stack elements needed
-				 * to execute the code. Set by compilation
+    int exceptDepth;		/* Current exception range nesting level; -1
+				 * if not in any range currently. */
+    int maxExceptDepth;		/* Max nesting level of exception ranges; -1
+				 * if no ranges have been compiled. */
+    int maxStackDepth;		/* Maximum number of stack elements needed to
+				 * execute the code. Set by compilation
 				 * procedures before returning. */
-    int currStackDepth;         /* Current stack depth. */
-    LiteralTable localLitTable;	/* Contains LiteralEntry's describing
-				 * all Tcl objects referenced by this
-				 * compiled code. Indexed by the string
-				 * representations of the literals. Used to
-				 * avoid creating duplicate objects. */
+    int currStackDepth;		/* Current stack depth. */
+    LiteralTable localLitTable;	/* Contains LiteralEntry's describing all Tcl
+				 * objects referenced by this compiled code.
+				 * Indexed by the string representations of
+				 * the literals. Used to avoid creating
+				 * duplicate objects. */
     unsigned char *codeStart;	/* Points to the first byte of the code. */
     unsigned char *codeNext;	/* Points to next code array byte to use. */
-    unsigned char *codeEnd;	/* Points just after the last allocated
-				 * code array byte. */
-    int mallocedCodeArray;      /* Set 1 if code array was expanded 
-				 * and codeStart points into the heap.*/
+    unsigned char *codeEnd;	/* Points just after the last allocated code
+				 * array byte. */
+    int mallocedCodeArray;	/* Set 1 if code array was expanded and
+				 * codeStart points into the heap.*/
     LiteralEntry *literalArrayPtr;
     				/* Points to start of LiteralEntry array. */
     int literalArrayNext;	/* Index of next free object array entry. */
     int literalArrayEnd;	/* Index just after last obj array entry. */
-    int mallocedLiteralArray;   /* 1 if object array was expanded and
-                                 * objArray points into the heap, else 0. */
+    int mallocedLiteralArray;	/* 1 if object array was expanded and objArray
+				 * points into the heap, else 0. */
     ExceptionRange *exceptArrayPtr;
     				/* Points to start of the ExceptionRange
 				 * array. */
     int exceptArrayNext;	/* Next free ExceptionRange array index.
-				 * exceptArrayNext is the number of ranges
-				 * and (exceptArrayNext-1) is the index of
-				 * the current range's array entry. */
-    int exceptArrayEnd;		/* Index after the last ExceptionRange
-				 * array entry. */
-    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded
-				 * and exceptArrayPtr points in heap,
-				 * else 0. */
+				 * exceptArrayNext is the number of ranges and
+				 * (exceptArrayNext-1) is the index of the
+				 * current range's array entry. */
+    int exceptArrayEnd;		/* Index after the last ExceptionRange array
+				 * entry. */
+    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
+				 * exceptArrayPtr points in heap, else 0. */
     CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
-				 * numCommands is the index of the next
-				 * entry to use; (numCommands-1) is the
-				 * entry index for the last command. */
+				 * numCommands is the index of the next entry
+				 * to use; (numCommands-1) is the entry index
+				 * for the last command. */
     int cmdMapEnd;		/* Index after last CmdLocation entry. */
     int mallocedCmdMap;		/* 1 if command map array was expanded and
 				 * cmdMapPtr points in the heap, else 0. */
-    AuxData *auxDataArrayPtr;   /* Points to auxiliary data array start. */
+    AuxData *auxDataArrayPtr;	/* Points to auxiliary data array start. */
     int auxDataArrayNext;	/* Next free compile aux data array index.
-				 * auxDataArrayNext is the number of aux
-				 * data items and (auxDataArrayNext-1) is
-				 * index of current aux data array entry. */
+				 * auxDataArrayNext is the number of aux data
+				 * items and (auxDataArrayNext-1) is index of
+				 * current aux data array entry. */
     int auxDataArrayEnd;	/* Index after last aux data array entry. */
     int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
 				 * auxDataArrayPtr points in heap else 0. */
     unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
-                                /* Initial storage for code. */
+				/* Initial storage for code. */
     LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
-                                /* Initial storage of LiteralEntry array. */
+				/* Initial storage of LiteralEntry array. */
     ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
-                                /* Initial ExceptionRange array storage. */
+				/* Initial ExceptionRange array storage. */
     CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
-                                /* Initial storage for cmd location map. */
+				/* Initial storage for cmd location map. */
     AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
-                                /* Initial storage for aux data array. */
-#ifdef TCL_TIP280
+				/* Initial storage for aux data array. */
     /* TIP #280 */
-    ExtCmdLoc* extCmdMapPtr;    /* Extended command location information
-				 * for 'info frame'. */
-    int        line;            /* First line of the script, based on the
+    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
+				 * 'info frame'. */
+    int line;			/* First line of the script, based on the
 				 * invoking context, then the line of the
 				 * command currently compiled. */
+    int atCmdStart;		/* Flag to say whether an INST_START_CMD
+				 * should be issued; they should never be
+				 * issued repeatedly, as that is significantly
+				 * inefficient. */
     ContLineLoc* clLoc;  /* If not NULL, the table holding the
 			  * locations of the invisible continuation
 			  * lines in the input script, to adjust the
@@ -313,26 +318,33 @@ typedef struct CompileEnv {
     int*         clNext; /* If not NULL, it refers to the next slot in
 			  * clLoc to check for an invisible
 			  * continuation line. */
-#endif
 } CompileEnv;
 
 /*
- * The structure defining the bytecode instructions resulting from compiling
- * a Tcl script. Note that this structure is variable length: a single heap
- * object is allocated to hold the ByteCode structure immediately followed
- * by the code bytes, the literal object array, the ExceptionRange array,
- * the CmdLocation map, and the compilation AuxData array.
+ * The structure defining the bytecode instructions resulting from compiling a
+ * Tcl script. Note that this structure is variable length: a single heap
+ * object is allocated to hold the ByteCode structure immediately followed by
+ * the code bytes, the literal object array, the ExceptionRange array, the
+ * CmdLocation map, and the compilation AuxData array.
  */
 
 /*
  * A PRECOMPILED bytecode struct is one that was generated from a compiled
  * image rather than implicitly compiled from source
  */
+
 #define TCL_BYTECODE_PRECOMPILED		0x0001
 
+/*
+ * When a bytecode is compiled, interp or namespace resolvers have not been
+ * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
+ */
+
+#define TCL_BYTECODE_RESOLVE_VARS		0x0002
+
 typedef struct ByteCode {
     TclHandle interpHandle;	/* Handle for interpreter containing the
-				 * compiled code.  Commands and their compile
+				 * compiled code. Commands and their compile
 				 * procs are specific to an interpreter so the
 				 * code emitted will depend on the
 				 * interpreter. */
@@ -340,25 +352,25 @@ typedef struct ByteCode {
 				 * ByteCode was compiled. Used to invalidate
 				 * code when, e.g., commands with compile
 				 * procs are redefined. */
-    Namespace *nsPtr;		/* Namespace context in which this code
-				 * was compiled. If the code is executed
-				 * if a different namespace, it must be
+    Namespace *nsPtr;		/* Namespace context in which this code was
+				 * compiled. If the code is executed if a
+				 * different namespace, it must be
 				 * recompiled. */
     int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
 				 * ByteCode was compiled. Used to invalidate
 				 * code when new namespace resolution rules
 				 * are put into effect. */
-    int refCount;		/* Reference count: set 1 when created
-				 * plus 1 for each execution of the code
-				 * currently active. This structure can be
-				 * freed when refCount becomes zero. */
+    int refCount;		/* Reference count: set 1 when created plus 1
+				 * for each execution of the code currently
+				 * active. This structure can be freed when
+				 * refCount becomes zero. */
     unsigned int flags;		/* flags describing state for the codebyte.
-                                 * this variable holds ORed values from the
-                                 * TCL_BYTECODE_ masks defined above */
-    char *source;		/* The source string from which this
-				 * ByteCode was compiled. Note that this
-				 * pointer is not owned by the ByteCode and
-				 * must not be freed or modified by it. */
+				 * this variable holds ORed values from the
+				 * TCL_BYTECODE_ masks defined above */
+    const char *source;		/* The source string from which this ByteCode
+				 * was compiled. Note that this pointer is not
+				 * owned by the ByteCode and must not be freed
+				 * or modified by it. */
     Proc *procPtr;		/* If the ByteCode was compiled from a
 				 * procedure body, this is a pointer to its
 				 * Proc structure; otherwise NULL. This
@@ -374,71 +386,72 @@ typedef struct ByteCode {
     int numLitObjects;		/* Number of objects in literal array. */
     int numExceptRanges;	/* Number of ExceptionRange array elems. */
     int numAuxDataItems;	/* Number of AuxData items. */
-    int numCmdLocBytes;		/* Number of bytes needed for encoded
-				 * command location information. */
+    int numCmdLocBytes;		/* Number of bytes needed for encoded command
+				 * location information. */
     int maxExceptDepth;		/* Maximum nesting level of ExceptionRanges;
 				 * -1 if no ranges were compiled. */
-    int maxStackDepth;		/* Maximum number of stack elements needed
-				 * to execute the code. */
-    unsigned char *codeStart;	/* Points to the first byte of the code.
-				 * This is just after the final ByteCode
-				 * member cmdMapPtr. */
-    Tcl_Obj **objArrayPtr;	/* Points to the start of the literal
-				 * object array. This is just after the
-				 * last code byte. */
+    int maxStackDepth;		/* Maximum number of stack elements needed to
+				 * execute the code. */
+    unsigned char *codeStart;	/* Points to the first byte of the code. This
+				 * is just after the final ByteCode member
+				 * cmdMapPtr. */
+    Tcl_Obj **objArrayPtr;	/* Points to the start of the literal object
+				 * array. This is just after the last code
+				 * byte. */
     ExceptionRange *exceptArrayPtr;
     				/* Points to the start of the ExceptionRange
-				 * array. This is just after the last
-				 * object in the object array. */
-    AuxData *auxDataArrayPtr;   /* Points to the start of the auxiliary data
-				 * array. This is just after the last entry
-				 * in the ExceptionRange array. */
+				 * array. This is just after the last object
+				 * in the object array. */
+    AuxData *auxDataArrayPtr;	/* Points to the start of the auxiliary data
+				 * array. This is just after the last entry in
+				 * the ExceptionRange array. */
     unsigned char *codeDeltaStart;
-				/* Points to the first of a sequence of
-				 * bytes that encode the change in the
-				 * starting offset of each command's code.
-				 * If -127<=delta<=127, it is encoded as 1
-				 * byte, otherwise 0xFF (128) appears and
-				 * the delta is encoded by the next 4 bytes.
-				 * Code deltas are always positive. This
-				 * sequence is just after the last entry in
-				 * the AuxData array. */
+				/* Points to the first of a sequence of bytes
+				 * that encode the change in the starting
+				 * offset of each command's code. If -127 <=
+				 * delta <= 127, it is encoded as 1 byte,
+				 * otherwise 0xFF (128) appears and the delta
+				 * is encoded by the next 4 bytes. Code deltas
+				 * are always positive. This sequence is just
+				 * after the last entry in the AuxData
+				 * array. */
     unsigned char *codeLengthStart;
-				/* Points to the first of a sequence of
-				 * bytes that encode the length of each
-				 * command's code. The encoding is the same
-				 * as for code deltas. Code lengths are
-				 * always positive. This sequence is just
-				 * after the last entry in the code delta
-				 * sequence. */
+				/* Points to the first of a sequence of bytes
+				 * that encode the length of each command's
+				 * code. The encoding is the same as for code
+				 * deltas. Code lengths are always positive.
+				 * This sequence is just after the last entry
+				 * in the code delta sequence. */
     unsigned char *srcDeltaStart;
-				/* Points to the first of a sequence of
-				 * bytes that encode the change in the
-				 * starting offset of each command's source.
-				 * The encoding is the same as for code
-				 * deltas. Source deltas can be negative.
-				 * This sequence is just after the last byte
-				 * in the code length sequence. */
+				/* Points to the first of a sequence of bytes
+				 * that encode the change in the starting
+				 * offset of each command's source. The
+				 * encoding is the same as for code deltas.
+				 * Source deltas can be negative. This
+				 * sequence is just after the last byte in the
+				 * code length sequence. */
     unsigned char *srcLengthStart;
-				/* Points to the first of a sequence of
-				 * bytes that encode the length of each
-				 * command's source. The encoding is the
-				 * same as for code deltas. Source lengths
-				 * are always positive. This sequence is
-				 * just after the last byte in the source
-				 * delta sequence. */
+				/* Points to the first of a sequence of bytes
+				 * that encode the length of each command's
+				 * source. The encoding is the same as for
+				 * code deltas. Source lengths are always
+				 * positive. This sequence is just after the
+				 * last byte in the source delta sequence. */
+    LocalCache *localCachePtr;  /* Pointer to the start of the cached variable
+				 * names and initialisation data for local
+				 * variables. */
 #ifdef TCL_COMPILE_STATS
     Tcl_Time createTime;	/* Absolute time when the ByteCode was
 				 * created. */
 #endif /* TCL_COMPILE_STATS */
 } ByteCode;
-
+
 /*
- * Opcodes for the Tcl bytecode instructions. These must correspond to
- * the entries in the table of instruction descriptions,
- * tclInstructionTable, in tclCompile.c. Also, the order and number of
- * the expression opcodes (e.g., INST_LOR) must match the entries in
- * the array operatorStrings in tclExecute.c.
+ * Opcodes for the Tcl bytecode instructions. These must correspond to the
+ * entries in the table of instruction descriptions, tclInstructionTable, in
+ * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
+ * INST_LOR) must match the entries in the array operatorStrings in
+ * tclExecute.c.
  */
 
 /* Opcodes 0 to 9 */
@@ -487,7 +500,7 @@ typedef struct ByteCode {
 #define INST_JUMP_TRUE1			36
 #define INST_JUMP_TRUE4			37
 #define INST_JUMP_FALSE1		38
-#define INST_JUMP_FALSE4	        39
+#define INST_JUMP_FALSE4		39
 
 /* Opcodes 40 to 64 */
 #define INST_LOR			40
@@ -564,24 +577,104 @@ typedef struct ByteCode {
 #define INST_LIST_INDEX_MULTI		94
 
 /*
- * TIP #33 - 'lset' command.  Code gen also required a Forth-like
- *           OVER operation.
+ * TIP #33 - 'lset' command. Code gen also required a Forth-like
+ *	     OVER operation.
  */
 
-#define INST_OVER                       95
+#define INST_OVER			95
 #define INST_LSET_LIST			96
-#define INST_LSET_FLAT                  97
+#define INST_LSET_FLAT			97
 
-/* The last opcode */
-#define LAST_INST_OPCODE        	97
+/* TIP#90 - 'return' command. */
+
+#define INST_RETURN_IMM			98
+
+/* TIP#123 - exponentiation operator. */
+
+#define INST_EXPON			99
+
+/* TIP #157 - {*}... (word expansion) language syntax support. */
+
+#define INST_EXPAND_START		100
+#define INST_EXPAND_STKTOP		101
+#define INST_INVOKE_EXPANDED		102
+
+/*
+ * TIP #57 - 'lassign' command. Code generation requires immediate
+ *	     LINDEX and LRANGE operators.
+ */
+
+#define INST_LIST_INDEX_IMM		103
+#define INST_LIST_RANGE_IMM		104
+
+#define INST_START_CMD			105
+
+#define INST_LIST_IN			106
+#define INST_LIST_NOT_IN		107
+
+#define INST_PUSH_RETURN_OPTIONS	108
+#define INST_RETURN_STK			109
+
+/*
+ * Dictionary (TIP#111) related commands.
+ */
+
+#define INST_DICT_GET			110
+#define INST_DICT_SET			111
+#define INST_DICT_UNSET			112
+#define INST_DICT_INCR_IMM		113
+#define INST_DICT_APPEND		114
+#define INST_DICT_LAPPEND		115
+#define INST_DICT_FIRST			116
+#define INST_DICT_NEXT			117
+#define INST_DICT_DONE			118
+#define INST_DICT_UPDATE_START		119
+#define INST_DICT_UPDATE_END		120
 
 /*
- * Table describing the Tcl bytecode instructions: their name (for
- * displaying code), total number of code bytes required (including
- * operand bytes), and a description of the type of each operand.
- * These operand types include signed and unsigned integers of length
- * one and four bytes. The unsigned integers are used for indexes or
- * for, e.g., the count of objects to push in a "push" instruction.
+ * Instruction to support jumps defined by tables (instead of the classic
+ * [switch] technique of chained comparisons).
+ */
+
+#define INST_JUMP_TABLE			121
+
+/*
+ * Instructions to support compilation of global, variable, upvar and
+ * [namespace upvar].
+ */
+
+#define INST_UPVAR			122
+#define INST_NSUPVAR			123
+#define INST_VARIABLE			124
+
+/* Instruction to support compiling syntax error to bytecode */
+
+#define INST_SYNTAX			125
+
+/* Instruction to reverse N items on top of stack */
+
+#define INST_REVERSE			126
+
+/* regexp instruction */
+
+#define INST_REGEXP			127
+
+/* For [info exists] compilation */
+#define INST_EXIST_SCALAR		128
+#define INST_EXIST_ARRAY		129
+#define INST_EXIST_ARRAY_STK		130
+#define INST_EXIST_STK			131
+
+/* The last opcode */
+#define LAST_INST_OPCODE		131
+
+/*
+ * Table describing the Tcl bytecode instructions: their name (for displaying
+ * code), total number of code bytes required (including operand bytes), and a
+ * description of the type of each operand. These operand types include signed
+ * and unsigned integers of length one and four bytes. The unsigned integers
+ * are used for indexes or for, e.g., the count of objects to push in a "push"
+ * instruction.
  */
 
 #define MAX_INSTRUCTION_OPERANDS 2
@@ -591,94 +684,43 @@ typedef enum InstOperandType {
     OPERAND_INT1,		/* One byte signed integer. */
     OPERAND_INT4,		/* Four byte signed integer. */
     OPERAND_UINT1,		/* One byte unsigned integer. */
-    OPERAND_UINT4		/* Four byte unsigned integer. */
+    OPERAND_UINT4,		/* Four byte unsigned integer. */
+    OPERAND_IDX4,		/* Four byte signed index (actually an
+				 * integer, but displayed differently.) */
+    OPERAND_LVT1,		/* One byte unsigned index into the local
+				 * variable table. */
+    OPERAND_LVT4,		/* Four byte unsigned index into the local
+				 * variable table. */
+    OPERAND_AUX4		/* Four byte unsigned index into the aux data
+				 * table. */
 } InstOperandType;
 
 typedef struct InstructionDesc {
     char *name;			/* Name of instruction. */
     int numBytes;		/* Total number of bytes for instruction. */
-    int stackEffect;            /* The worst-case balance stack effect of the 
-				 * instruction, used for stack requirements 
+    int stackEffect;		/* The worst-case balance stack effect of the
+				 * instruction, used for stack requirements
 				 * computations. The value INT_MIN signals
-				 * that the instruction's worst case effect
-				 * is (1-opnd1).
-				 */
+				 * that the instruction's worst case effect is
+				 * (1-opnd1). */
     int numOperands;		/* Number of operands. */
     InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
 				/* The type of each operand. */
 } InstructionDesc;
 
-extern InstructionDesc tclInstructionTable[];
-
-/*
- * Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's
- * operand byte. Each value denotes a builtin Tcl math function. These
- * values must correspond to the entries in the tclBuiltinFuncTable array
- * below and to the values stored in the tclInt.h MathFunc structure's
- * builtinFuncIndex field.
- */
-
-#define BUILTIN_FUNC_ACOS		0
-#define BUILTIN_FUNC_ASIN		1
-#define BUILTIN_FUNC_ATAN		2
-#define BUILTIN_FUNC_ATAN2		3
-#define BUILTIN_FUNC_CEIL		4
-#define BUILTIN_FUNC_COS		5
-#define BUILTIN_FUNC_COSH		6
-#define BUILTIN_FUNC_EXP		7
-#define BUILTIN_FUNC_FLOOR		8
-#define BUILTIN_FUNC_FMOD		9
-#define BUILTIN_FUNC_HYPOT		10
-#define BUILTIN_FUNC_LOG		11
-#define BUILTIN_FUNC_LOG10		12
-#define BUILTIN_FUNC_POW		13
-#define BUILTIN_FUNC_SIN		14
-#define BUILTIN_FUNC_SINH		15
-#define BUILTIN_FUNC_SQRT		16
-#define BUILTIN_FUNC_TAN		17
-#define BUILTIN_FUNC_TANH		18
-#define BUILTIN_FUNC_ABS		19
-#define BUILTIN_FUNC_DOUBLE		20
-#define BUILTIN_FUNC_INT		21
-#define BUILTIN_FUNC_RAND		22
-#define BUILTIN_FUNC_ROUND		23
-#define BUILTIN_FUNC_SRAND		24
-#define BUILTIN_FUNC_WIDE		25
-
-#define LAST_BUILTIN_FUNC        	25
-
-/*
- * Table describing the built-in math functions. Entries in this table are
- * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
- * operand byte.
- */
-
-typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp,
-        ExecEnv *eePtr, ClientData clientData));
-
-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. */
-    CallBuiltinFuncProc *proc;	/* Procedure implementing this function. */
-    ClientData clientData;	/* Additional argument to pass to the
-				 * function when invoking it. */
-} BuiltinFunc;
-
-extern BuiltinFunc tclBuiltinFuncTable[];
+MODULE_SCOPE InstructionDesc tclInstructionTable[];
 
 /*
  * Compilation of some Tcl constructs such as if commands and the logical or
- * (||) and logical and (&&) operators in expressions requires the
- * generation of forward jumps. Since the PC target of these jumps isn't
- * known when the jumps are emitted, we record the offset of each jump in an
- * array of JumpFixup structures. There is one array for each sequence of
- * jumps to one target PC. When we learn the target PC, we update the jumps
- * with the correct distance. Also, if the distance is too great (> 127
- * bytes), we replace the single-byte jump with a four byte jump
- * instruction, move the instructions after the jump down, and update the
- * code offsets for any commands between the jump and the target.
+ * (||) and logical and (&&) operators in expressions requires the generation
+ * of forward jumps. Since the PC target of these jumps isn't known when the
+ * jumps are emitted, we record the offset of each jump in an array of
+ * JumpFixup structures. There is one array for each sequence of jumps to one
+ * target PC. When we learn the target PC, we update the jumps with the
+ * correct distance. Also, if the distance is too great (> 127 bytes), we
+ * replace the single-byte jump with a four byte jump instruction, move the
+ * instructions after the jump down, and update the code offsets for any
+ * commands between the jump and the target.
  */
 
 typedef enum {
@@ -697,14 +739,14 @@ typedef struct JumpFixup {
 				 * commands if the two-byte jump at jumpPc
 				 * must be replaced with a five-byte one. */
     int exceptIndex;		/* Index of the first range entry in the
-				 * ExceptionRange array after the current
-				 * one. This field is used to adjust the
-				 * code offsets in subsequent ExceptionRange
+				 * ExceptionRange array after the current one.
+				 * This field is used to adjust the code
+				 * offsets in subsequent ExceptionRange
 				 * records when a jump is grown from 2 bytes
 				 * to 5 bytes. */
 } JumpFixup;
 
-#define JUMPFIXUP_INIT_ENTRIES    10
+#define JUMPFIXUP_INIT_ENTRIES	10
 
 typedef struct JumpFixupArray {
     JumpFixup *fixup;		/* Points to start of jump fixup array. */
@@ -717,21 +759,21 @@ typedef struct JumpFixupArray {
 } JumpFixupArray;
 
 /*
- * The structure describing one variable list of a foreach command. Note
- * that only foreach commands inside procedure bodies are compiled inline so
- * a ForeachVarList structure always describes local variables. Furthermore,
+ * The structure describing one variable list of a foreach command. Note that
+ * only foreach commands inside procedure bodies are compiled inline so a
+ * ForeachVarList structure always describes local variables. Furthermore,
  * only scalar variables are supported for inline-compiled foreach loops.
  */
 
 typedef struct ForeachVarList {
     int numVars;		/* The number of variables in the list. */
     int varIndexes[1];		/* An array of the indexes ("slot numbers")
-				 * for each variable in the procedure's
-				 * array of local variables. Only scalar
-				 * variables are supported. The actual
-				 * size of this field will be large enough
-				 * to numVars indexes. THIS MUST BE THE
-				 * LAST FIELD IN THE STRUCTURE! */
+				 * for each variable in the procedure's array
+				 * of local variables. Only scalar variables
+				 * are supported. The actual size of this
+				 * field will be large enough to numVars
+				 * indexes. THIS MUST BE THE LAST FIELD IN THE
+				 * STRUCTURE! */
 } ForeachVarList;
 
 /*
@@ -743,281 +785,360 @@ typedef struct ForeachVarList {
 typedef struct ForeachInfo {
     int numLists;		/* The number of both the variable and value
 				 * lists of the foreach command. */
-    int firstValueTemp;		/* Index of the first temp var in a proc
-				 * frame used to point to a value list. */
-    int loopCtTemp;		/* Index of temp var in a proc frame
-				 * holding the loop's iteration count. Used
-				 * to determine next value list element to
-				 * assign each loop var. */
+    int firstValueTemp;		/* Index of the first temp var in a proc frame
+				 * used to point to a value list. */
+    int loopCtTemp;		/* Index of temp var in a proc frame holding
+				 * the loop's iteration count. Used to
+				 * determine next value list element to assign
+				 * each loop var. */
     ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
 				 * structures describing each var list. The
 				 * actual size of this field will be large
-				 * enough to numVars indexes. THIS MUST BE
-				 * THE LAST FIELD IN THE STRUCTURE! */
+				 * enough to numVars indexes. THIS MUST BE THE
+				 * LAST FIELD IN THE STRUCTURE! */
 } ForeachInfo;
 
-extern AuxDataType		tclForeachInfoType;
+MODULE_SCOPE AuxDataType	tclForeachInfoType;
+
+/*
+ * Structure used to hold information about a switch command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct JumptableInfo {
+    Tcl_HashTable hashTable;	/* Hash that maps strings to signed ints (PC
+				 * offsets). */
+} JumptableInfo;
+
+MODULE_SCOPE AuxDataType	tclJumptableInfoType;
+
+/*
+ * Structure used to hold information about a [dict update] command that is
+ * needed during program execution. These structures are stored in CompileEnv
+ * and ByteCode structures as auxiliary data.
+ */
+
+typedef struct {
+    int length;			/* Size of array */
+    int varIndices[1];		/* Array of variable indices to manage when
+				 * processing the start and end of a [dict
+				 * update]. There is really more than one
+				 * entry, and the structure is allocated to
+				 * take account of this. MUST BE LAST FIELD IN
+				 * STRUCTURE. */
+} DictUpdateInfo;
+
+MODULE_SCOPE AuxDataType	tclDictUpdateInfoType;
 
+/*
+ * ClientData type used by the math operator commands.
+ */
 
+typedef struct {
+    const char *op;   /* Do not call it 'operator': C++ reserved */
+    const char *expected;
+    union {
+	int numArgs;
+	int identity;
+    } i;
+} TclOpCmdClientData;
+
 /*
  *----------------------------------------------------------------
  * Procedures exported by tclBasic.c to be used within the engine.
  *----------------------------------------------------------------
  */
 
-EXTERN int		TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[], CONST char *command, int length,
-			    int flags));
-EXTERN int              TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
-
-
+MODULE_SCOPE int	TclEvalObjvInternal(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[],
+			    CONST char *command, int length, int flags);
 /*
  *----------------------------------------------------------------
  * Procedures exported by the engine to be used by tclBasic.c
  *----------------------------------------------------------------
  */
 
-#ifndef TCL_TIP280
-EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-#else
-EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, CONST CmdFrame* invoker,
-			    int word));
-#endif
+MODULE_SCOPE int	TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    const CmdFrame *invoker, int word);
 
 /*
  *----------------------------------------------------------------
- * Procedures shared among Tcl bytecode compilation and execution
- * modules but not used outside:
+ * Procedures shared among Tcl bytecode compilation and execution modules but
+ * not used outside:
  *----------------------------------------------------------------
  */
 
-EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
-EXTERN int		TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
+MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
+MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
-			    CompileEnv *envPtr));
-EXTERN int		TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *script, int numBytes,
-			    CompileEnv *envPtr));
-EXTERN int		TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, CONST char *script,
+	                    int numBytes, CompileEnv *envPtr, int optimize);
+MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int numWords,
-			    CompileEnv *envPtr));
-EXTERN int		TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *script, int numBytes, int nested,
-			    CompileEnv *envPtr));
-EXTERN int		TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
+			    CONST char *script, int numBytes,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
-			    CompileEnv *envPtr));
-EXTERN int		TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
-			    AuxDataType *typePtr, CompileEnv *envPtr));
-EXTERN int		TclCreateExceptRange _ANSI_ARGS_((
-			    ExceptionRangeType type, CompileEnv *envPtr));
-EXTERN ExecEnv *	TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void		TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
-EXTERN void		TclDeleteLiteralTable _ANSI_ARGS_((
-			    Tcl_Interp *interp, LiteralTable *tablePtr));
-EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
-			    TclJumpType jumpType, JumpFixup *jumpFixupPtr));
-EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
-			    unsigned char *pc, int catchOnly,
-			    ByteCode* codePtr));
-EXTERN void		TclExpandJumpFixupArray _ANSI_ARGS_((
-                            JumpFixupArray *fixupArrayPtr));
-EXTERN void		TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
-EXTERN int		TclFindCompiledLocal _ANSI_ARGS_((CONST char *name, 
-        		    int nameChars, int create, int flags,
-			    Proc *procPtr));
-EXTERN LiteralEntry *	TclLookupLiteralEntry _ANSI_ARGS_((
-			    Tcl_Interp *interp, Tcl_Obj *objPtr));
-EXTERN int		TclFixupForwardJump _ANSI_ARGS_((
-			    CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
-			    int jumpDist, int distThreshold));
-EXTERN void		TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr));
-EXTERN void		TclFreeJumpFixupArray _ANSI_ARGS_((
-  			    JumpFixupArray *fixupArrayPtr));
-EXTERN void		TclInitAuxDataTypeTable _ANSI_ARGS_((void));
-EXTERN void		TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-			    CompileEnv *envPtr));
-EXTERN void		TclInitCompilation _ANSI_ARGS_((void));
-#ifndef TCL_TIP280
-EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
-			    CompileEnv *envPtr, char *string,
-			    int numBytes));
-#else
-EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
-			    CompileEnv *envPtr, char *string,
-			    int numBytes, CONST CmdFrame* invoker, int word));
-#endif
-EXTERN void		TclInitJumpFixupArray _ANSI_ARGS_((
-			    JumpFixupArray *fixupArrayPtr));
-EXTERN void		TclInitLiteralTable _ANSI_ARGS_((
-			    LiteralTable *tablePtr));
+			    CompileEnv *envPtr);
+MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
+			    AuxDataType *typePtr, CompileEnv *envPtr);
+MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
+			    CompileEnv *envPtr);
+MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_Obj *  TclCreateLiteral(Interp *iPtr, char *bytes,
+	                    int length, unsigned int hash, int *newPtr,
+	                    Namespace *nsPtr, int flags,
+	                    LiteralEntry **globalPtrPtr);
+MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
+MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
+			    LiteralTable *tablePtr);
+MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
+			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
+MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
+			    int catchOnly, ByteCode* codePtr);
+MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
+			    ByteCode *codePtr);
+MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
+MODULE_SCOPE int	TclFindCompiledLocal(CONST char *name, int nameChars,
+			    int create, Proc *procPtr);
+MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
+			    JumpFixup *jumpFixupPtr, int jumpDist,
+			    int distThreshold);
+MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
+MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
+MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclInitCompilation(void);
+MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
+			    CompileEnv *envPtr, const char *string,
+			    int numBytes, CONST CmdFrame* invoker, int word);
+MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
 #ifdef TCL_COMPILE_STATS
-EXTERN char *		TclLiteralStats _ANSI_ARGS_((
-			    LiteralTable *tablePtr));
-EXTERN int		TclLog2 _ANSI_ARGS_((int value));
+MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
+MODULE_SCOPE int	TclLog2(int value);
 #endif
 #ifdef TCL_COMPILE_DEBUG
-EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
-		            Tcl_Obj *objPtr));
+MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
 #endif
-EXTERN int		TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
-			    unsigned char *pc));
-EXTERN void		TclPrintObject _ANSI_ARGS_((FILE *outFile,
-			    Tcl_Obj *objPtr, int maxChars));
-EXTERN void		TclPrintSource _ANSI_ARGS_((FILE *outFile,
-			    CONST char *string, int maxChars));
-EXTERN void		TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
-EXTERN int		TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
-			    char *bytes, int length, int onHeap));
-EXTERN void		TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-EXTERN void		TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, Command *cmdPtr));
+MODULE_SCOPE int	TclPrintInstruction(ByteCode* codePtr,
+			    unsigned char *pc);
+MODULE_SCOPE void	TclPrintObject(FILE *outFile,
+			    Tcl_Obj *objPtr, int maxChars);
+MODULE_SCOPE void	TclPrintSource(FILE *outFile,
+			    CONST char *string, int maxChars);
+MODULE_SCOPE void	TclRegisterAuxDataType(AuxDataType *typePtr);
+MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
+			    char *bytes, int length, int flags);
+MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclVariadicOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
 #ifdef TCL_COMPILE_DEBUG
-EXTERN void		TclVerifyGlobalLiteralTable _ANSI_ARGS_((
-			    Interp *iPtr));
-EXTERN void		TclVerifyLocalLiteralTable _ANSI_ARGS_((
-			    CompileEnv *envPtr));
+MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
+MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
 #endif
-EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
-			    Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));
-
+MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
+			    Tcl_Obj *valuePtr);
+
 /*
  *----------------------------------------------------------------
- * Macros used by Tcl bytecode compilation and execution modules
- * inside the Tcl core but not used outside.
+ * Macros and flag values used by Tcl bytecode compilation and execution
+ * modules inside the Tcl core but not used outside.
  *----------------------------------------------------------------
  */
 
+#define LITERAL_ON_HEAP    0x01
+#define LITERAL_NS_SCOPE   0x02
+
 /*
- * Form of TclRegisterLiteral with onHeap == 0.
- * In that case, it is safe to cast away CONSTness, and it
- * is cleanest to do that here, all in one place.
+ * Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
+ * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ *
+ * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
+ *			     int length);
  */
 
 #define TclRegisterNewLiteral(envPtr, bytes, length) \
-	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
+	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
 
 /*
- * Macro used to update the stack requirements.
- * It is called by the macros TclEmitOpCode, TclEmitInst1 and
- * TclEmitInst4.
- * Remark that the very last instruction of a bytecode always
- * reduces the stack level: INST_DONE or INST_POP, so that the 
- * maxStackdepth is always updated.
+ * Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
+ * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ *
+ * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
+ *			       int length);
+ */
+
+#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
+	TclRegisterLiteral(envPtr, (char *)(bytes), length, \
+		/*flags*/ LITERAL_NS_SCOPE)
+
+/*
+ * Macro used to manually adjust the stack requirements; used in cases where
+ * the stack effect cannot be computed from the opcode and its operands, but
+ * is still known at compile time.
+ *
+ * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
+ */
+
+#define TclAdjustStackDepth(delta, envPtr) \
+    if ((delta) < 0) {\
+	if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
+	    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
+	}\
+    }\
+    (envPtr)->currStackDepth += (delta)
+
+/*
+ * Macro used to update the stack requirements. It is called by the macros
+ * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
+ * Remark that the very last instruction of a bytecode always reduces the
+ * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
+ * updated.
+ *
+ * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
  */
 
 #define TclUpdateStackReqs(op, i, envPtr) \
     {\
 	int delta = tclInstructionTable[(op)].stackEffect;\
 	if (delta) {\
-	    if (delta < 0) {\
-		if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
-		    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
-		}\
-		if (delta == INT_MIN) {\
-		    delta = 1 - (i);\
-		}\
+	    if (delta == INT_MIN) {\
+		delta = 1 - (i);\
 	    }\
-	    (envPtr)->currStackDepth += delta;\
+	    TclAdjustStackDepth(delta, envPtr);\
 	}\
     }
 
 /*
- * Macro to emit an opcode byte into a CompileEnv's code array.
- * The ANSI C "prototype" for this macro is:
+ * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
+ * "prototype" for this macro is:
  *
- * EXTERN void	TclEmitOpcode _ANSI_ARGS_((unsigned char op,
- *		    CompileEnv *envPtr));
+ * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
  */
 
 #define TclEmitOpcode(op, envPtr) \
-    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
-        TclExpandCodeArray(envPtr); \
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+	TclExpandCodeArray(envPtr); \
+    } \
     *(envPtr)->codeNext++ = (unsigned char) (op);\
+    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
     TclUpdateStackReqs(op, 0, envPtr)
 
 /*
- * Macro to emit an integer operand.
- * The ANSI C "prototype" for this macro is:
+ * Macros to emit an integer operand. The ANSI C "prototype" for these macros
+ * are:
  *
- * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ * void TclEmitInt1(int i, CompileEnv *envPtr);
+ * void TclEmitInt4(int i, CompileEnv *envPtr);
  */
 
 #define TclEmitInt1(i, envPtr) \
-    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
-        TclExpandCodeArray(envPtr); \
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+	TclExpandCodeArray(envPtr); \
+    } \
     *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
 
+#define TclEmitInt4(i, envPtr) \
+    if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
+	TclExpandCodeArray(envPtr); \
+    } \
+    *(envPtr)->codeNext++ = \
+	(unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+	(unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+	(unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+	(unsigned char) ((unsigned int) (i)      )
+
 /*
  * Macros to emit an instruction with signed or unsigned integer operands.
  * Four byte integers are stored in "big-endian" order with the high order
- * byte stored at the lowest address.
- * The ANSI C "prototypes" for these macros are:
+ * byte stored at the lowest address. The ANSI C "prototypes" for these macros
+ * are:
  *
- * EXTERN void	TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 
- *		    CompileEnv *envPtr));
- * EXTERN void	TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 
- *		    CompileEnv *envPtr));
+ * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
+ * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
  */
 
-
 #define TclEmitInstInt1(op, i, envPtr) \
     if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
-        TclExpandCodeArray(envPtr); \
+	TclExpandCodeArray(envPtr); \
     } \
     *(envPtr)->codeNext++ = (unsigned char) (op); \
     *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
+    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
     TclUpdateStackReqs(op, i, envPtr)
 
 #define TclEmitInstInt4(op, i, envPtr) \
     if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
-        TclExpandCodeArray(envPtr); \
+	TclExpandCodeArray(envPtr); \
     } \
     *(envPtr)->codeNext++ = (unsigned char) (op); \
     *(envPtr)->codeNext++ = \
-        (unsigned char) ((unsigned int) (i) >> 24); \
+	(unsigned char) ((unsigned int) (i) >> 24); \
     *(envPtr)->codeNext++ = \
-        (unsigned char) ((unsigned int) (i) >> 16); \
+	(unsigned char) ((unsigned int) (i) >> 16); \
     *(envPtr)->codeNext++ = \
-        (unsigned char) ((unsigned int) (i) >>  8); \
+	(unsigned char) ((unsigned int) (i) >>  8); \
     *(envPtr)->codeNext++ = \
-        (unsigned char) ((unsigned int) (i)      );\
+	(unsigned char) ((unsigned int) (i)      );\
+    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
     TclUpdateStackReqs(op, i, envPtr)
-    
+
 /*
  * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
- * object's one or four byte array index into the CompileEnv's code
- * array. These support, respectively, a maximum of 256 (2**8) and 2**32
- * objects in a CompileEnv. The ANSI C "prototype" for this macro is:
+ * object's one or four byte array index into the CompileEnv's code array.
+ * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
+ * CompileEnv. The ANSI C "prototype" for this macro is:
  *
- * EXTERN void	TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
+ * void	TclEmitPush(int objIndex, CompileEnv *envPtr);
  */
 
 #define TclEmitPush(objIndex, envPtr) \
     {\
-        register int objIndexCopy = (objIndex);\
-        if (objIndexCopy <= 255) { \
+	register int objIndexCopy = (objIndex);\
+	if (objIndexCopy <= 255) { \
 	    TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
-        } else { \
+	} else { \
 	    TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
 	}\
     }
 
 /*
- * Macros to update a (signed or unsigned) integer starting at a pointer.
- * The two variants depend on the number of bytes. The ANSI C "prototypes"
- * for these macros are:
+ * Macros to update a (signed or unsigned) integer starting at a pointer. The
+ * two variants depend on the number of bytes. The ANSI C "prototypes" for
+ * these macros are:
  *
- * EXTERN void	TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
- * EXTERN void	TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ * void TclStoreInt1AtPtr(int i, unsigned char *p);
+ * void TclStoreInt4AtPtr(int i, unsigned char *p);
  */
-    
+
 #define TclStoreInt1AtPtr(i, p) \
     *(p)   = (unsigned char) ((unsigned int) (i))
-    
+
 #define TclStoreInt4AtPtr(i, p) \
     *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
     *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
@@ -1025,14 +1146,12 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
     *(p+3) = (unsigned char) ((unsigned int) (i)      )
 
 /*
- * Macros to update instructions at a particular pc with a new op code
- * and a (signed or unsigned) int operand. The ANSI C "prototypes" for
- * these macros are:
+ * Macros to update instructions at a particular pc with a new op code and a
+ * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
+ * are:
  *
- * EXTERN void	TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i,
- *		    unsigned char *pc));
- * EXTERN void	TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i,
- *		    unsigned char *pc));
+ * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
+ * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
  */
 
 #define TclUpdateInstInt1AtPc(op, i, pc) \
@@ -1042,26 +1161,39 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 #define TclUpdateInstInt4AtPc(op, i, pc) \
     *(pc) = (unsigned char) (op); \
     TclStoreInt4AtPtr((i), ((pc)+1))
-    
+
+/*
+ * Macro to fix up a forward jump to point to the current code-generation
+ * position in the bytecode being created (the most common case). The ANSI C
+ * "prototypes" for this macro is:
+ *
+ * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
+ *				 int threshold);
+ */
+
+#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
+    TclFixupForwardJump((envPtr), (fixupPtr), \
+	    (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
+	    (threshold))
+
 /*
  * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
- * (GET_UINT{1,2}) from a pointer. There are two variants for each
- * return type that depend on the number of bytes fetched.
- * The ANSI C "prototypes" for these macros are:
+ * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
+ * that depend on the number of bytes fetched. The ANSI C "prototypes" for
+ * these macros are:
  *
- * EXTERN int	        TclGetInt1AtPtr  _ANSI_ARGS_((unsigned char *p));
- * EXTERN int	        TclGetInt4AtPtr  _ANSI_ARGS_((unsigned char *p));
- * EXTERN unsigned int	TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p));
- * EXTERN unsigned int	TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p));
+ * int TclGetInt1AtPtr(unsigned char *p);
+ * int TclGetInt4AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt1AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt4AtPtr(unsigned char *p);
  */
 
 /*
- * The TclGetInt1AtPtr macro is tricky because we want to do sign
- * extension on the 1-byte value. Unfortunately the "char" type isn't
- * signed on all platforms so sign-extension doesn't always happen
- * automatically. Sometimes we can explicitly declare the pointer to be
- * signed, but other times we have to explicitly sign-extend the value
- * in software.
+ * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
+ * the 1-byte value. Unfortunately the "char" type isn't signed on all
+ * platforms so sign-extension doesn't always happen automatically. Sometimes
+ * we can explicitly declare the pointer to be signed, but other times we have
+ * to explicitly sign-extend the value in software.
  */
 
 #ifndef __CHAR_UNSIGNED__
@@ -1069,29 +1201,29 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 #else
 #   ifdef HAVE_SIGNED_CHAR
 #	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
-#    else
+#   else
 #	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
 		| ((*(p) & 0200) ? (-256) : 0))
-#    endif
+#   endif
 #endif
 
 #define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
-		                  	    (*((p)+1) << 16) | \
+					    (*((p)+1) << 16) | \
 				  	    (*((p)+2) <<  8) | \
 				  	    (*((p)+3)))
 
 #define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
 #define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
-		                            (*((p)+1) << 16) | \
-				            (*((p)+2) <<  8) | \
-				            (*((p)+3)))
+					    (*((p)+1) << 16) | \
+					    (*((p)+2) <<  8) | \
+					    (*((p)+3)))
 
 /*
- * Macros used to compute the minimum and maximum of two integers.
- * The ANSI C "prototypes" for these macros are:
+ * Macros used to compute the minimum and maximum of two integers. The ANSI C
+ * "prototypes" for these macros are:
  *
- * EXTERN int  TclMin _ANSI_ARGS_((int i, int j));
- * EXTERN int  TclMax _ANSI_ARGS_((int i, int j));
+ * int TclMin(int i, int j);
+ * int TclMax(int i, int j);
  */
 
 #define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
@@ -1137,21 +1269,27 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 #define TCL_DTRACE_PROC_RETURN_ENABLED()    unlikely(TCL_PROC_RETURN_ENABLED())
 #define TCL_DTRACE_PROC_RESULT_ENABLED()    unlikely(TCL_PROC_RESULT_ENABLED())
 #define TCL_DTRACE_PROC_ARGS_ENABLED()	    unlikely(TCL_PROC_ARGS_ENABLED())
+#define TCL_DTRACE_PROC_INFO_ENABLED()	    unlikely(TCL_PROC_INFO_ENABLED())
 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   TCL_PROC_ENTRY(a0, a1, a2)
 #define TCL_DTRACE_PROC_RETURN(a0, a1)	    TCL_PROC_RETURN(a0, a1)
 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
+	TCL_PROC_INFO(a0, a1, a2, a3, a4, a5)
 
 #define TCL_DTRACE_CMD_ENTRY_ENABLED()	    unlikely(TCL_CMD_ENTRY_ENABLED())
 #define TCL_DTRACE_CMD_RETURN_ENABLED()	    unlikely(TCL_CMD_RETURN_ENABLED())
 #define TCL_DTRACE_CMD_RESULT_ENABLED()	    unlikely(TCL_CMD_RESULT_ENABLED())
 #define TCL_DTRACE_CMD_ARGS_ENABLED()	    unlikely(TCL_CMD_ARGS_ENABLED())
+#define TCL_DTRACE_CMD_INFO_ENABLED()	    unlikely(TCL_CMD_INFO_ENABLED())
 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    TCL_CMD_ENTRY(a0, a1, a2)
 #define TCL_DTRACE_CMD_RETURN(a0, a1)	    TCL_CMD_RETURN(a0, a1)
 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
+	TCL_CMD_INFO(a0, a1, a2, a3, a4, a5)
 
 #define TCL_DTRACE_INST_START_ENABLED()	    unlikely(TCL_INST_START_ENABLED())
 #define TCL_DTRACE_INST_DONE_ENABLED()	    unlikely(TCL_INST_DONE_ENABLED())
@@ -1164,25 +1302,31 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 
 #define TCL_DTRACE_DEBUG_LOG()
 
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
+
 #else /* USE_DTRACE */
 
 #define TCL_DTRACE_PROC_ENTRY_ENABLED()	    0
 #define TCL_DTRACE_PROC_RETURN_ENABLED()    0
 #define TCL_DTRACE_PROC_RESULT_ENABLED()    0
 #define TCL_DTRACE_PROC_ARGS_ENABLED()	    0
+#define TCL_DTRACE_PROC_INFO_ENABLED()	    0
 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   {}
 #define TCL_DTRACE_PROC_RETURN(a0, a1)	    {}
 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {}
 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) {}
 
 #define TCL_DTRACE_CMD_ENTRY_ENABLED()	    0
 #define TCL_DTRACE_CMD_RETURN_ENABLED()	    0
 #define TCL_DTRACE_CMD_RESULT_ENABLED()	    0
 #define TCL_DTRACE_CMD_ARGS_ENABLED()	    0
+#define TCL_DTRACE_CMD_INFO_ENABLED()	    0
 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    {}
 #define TCL_DTRACE_CMD_RETURN(a0, a1)	    {}
 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {}
 
 #define TCL_DTRACE_INST_START_ENABLED()	    0
 #define TCL_DTRACE_INST_DONE_ENABLED()	    0
@@ -1192,6 +1336,8 @@ EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 #define TCL_DTRACE_TCL_PROBE_ENABLED()	    0
 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
 
+#define TclDTraceInfo(info, args, argsi)    {*args = ""; *argsi = 0;}
+
 #endif /* USE_DTRACE */
 
 #else /* TCL_DTRACE_DEBUG */
@@ -1237,6 +1383,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_PROC_RETURN_ENABLED()    1
 #define TCL_DTRACE_PROC_RESULT_ENABLED()    1
 #define TCL_DTRACE_PROC_ARGS_ENABLED()	    1
+#define TCL_DTRACE_PROC_INFO_ENABLED()	    1
 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
 	tclDTraceDebugIndent++; \
 	TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
@@ -1248,11 +1395,15 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
 		a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
+	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d", a0, a1, \
+		a2, a3, a4, a5)
 
 #define TCL_DTRACE_CMD_ENTRY_ENABLED()	    1
 #define TCL_DTRACE_CMD_RETURN_ENABLED()	    1
 #define TCL_DTRACE_CMD_RESULT_ENABLED()	    1
 #define TCL_DTRACE_CMD_ARGS_ENABLED()	    1
+#define TCL_DTRACE_CMD_INFO_ENABLED()	    1
 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
 	tclDTraceDebugIndent++; \
 	TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
@@ -1264,6 +1415,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
 		a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
+	TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d", a0, a1, \
+		a2, a3, a4, a5)
 
 #define TCL_DTRACE_INST_START_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
 #define TCL_DTRACE_INST_DONE_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
@@ -1280,7 +1434,12 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 
 #endif /* TCL_DTRACE_DEBUG */
 
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-
 #endif /* _TCLCOMPILATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
new file mode 100644
index 0000000..28549ed
--- /dev/null
+++ b/generic/tclConfig.c
@@ -0,0 +1,392 @@
+/*
+ * tclConfig.c --
+ *
+ *	This file provides the facilities which allow Tcl and other packages
+ *	to embed configuration information into their binary libraries.
+ *
+ * Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ * Internal structure to hold embedded configuration information.
+ *
+ * Our structure is a two-level dictionary associated with the 'interp'. The
+ * first level is keyed with the package name and maps to the dictionary for
+ * that package. The package dictionary is keyed with metadata keys and maps
+ * to the metadata value for that key. This is package specific. The metadata
+ * values are in UTF-8, converted from the external representation given to us
+ * by the caller.
+ */
+
+#define ASSOC_KEY	"tclPackageAboutDict"
+
+/*
+ * A ClientData struct for the QueryConfig command.  Store the two bits
+ * of data we need; the package name for which we store a config dict,
+ * and the (Tcl_Interp *) in which it is stored.
+ */
+
+typedef struct QCCD {
+    Tcl_Obj *pkg;
+    Tcl_Interp *interp;
+} QCCD;
+
+/*
+ * Static functions in this file:
+ */
+
+static int		QueryConfigObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    struct Tcl_Obj *CONST *objv);
+static void		QueryConfigDelete(ClientData clientData);
+static Tcl_Obj *	GetConfigDict(Tcl_Interp *interp);
+static void		ConfigDictDeleteProc(ClientData clientData,
+			    Tcl_Interp *interp);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegisterConfig --
+ *
+ *	See TIP#59 for details on what this function does.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates namespace and cfg query command in it as per TIP #59.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RegisterConfig(
+    Tcl_Interp *interp,		/* Interpreter the configuration command is
+				 * registered in. */
+    CONST char *pkgName,	/* Name of the package registering the
+				 * embedded configuration. ASCII, thus in
+				 * UTF-8 too. */
+    Tcl_Config *configuration,	/* Embedded configuration. */
+    CONST char *valEncoding)	/* Name of the encoding used to store the
+				 * configuration values, ASCII, thus UTF-8. */
+{
+    Tcl_Obj *pDB, *pkgDict;
+    Tcl_DString cmdName;
+    Tcl_Config *cfg;
+    Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
+    QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));
+
+    cdPtr->interp = interp;
+    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
+
+    /*
+     * Phase I: Adding the provided information to the internal database of
+     * package meta data. Only if we have an ok encoding.
+     *
+     * Phase II: Create a command for querying this database, specific to the
+     * package registerting its configuration. This is the approved interface
+     * in TIP 59. In the future a more general interface should be done, as
+     * followup to TIP 59. Simply because our database is now general across
+     * packages, and not a structure tied to one package.
+     *
+     * Note, the created command will have a reference through its clientdata.
+     */
+
+    Tcl_IncrRefCount(cdPtr->pkg);
+
+    /*
+     * For venc == NULL aka bogus encoding we skip the step setting up the
+     * dictionaries visible at Tcl level. I.e. they are not filled
+     */
+
+    if (venc != NULL) {
+	/*
+	 * Retrieve package specific configuration...
+	 */
+
+	pDB = GetConfigDict(interp);
+
+	if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
+	    || (pkgDict == NULL)) {
+	    pkgDict = Tcl_NewDictObj();
+	} else if (Tcl_IsShared(pkgDict)) {
+	    pkgDict = Tcl_DuplicateObj(pkgDict);
+	}
+
+	/*
+	 * Extend the package configuration...
+	 */
+
+	for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
+	    Tcl_DString conv;
+	    CONST char *convValue =
+		Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
+
+	    /*
+	     * We know that the keys are in ASCII/UTF-8, so for them is no
+	     * conversion required.
+	     */
+
+	    Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
+			   Tcl_NewStringObj(convValue, -1));
+	    Tcl_DStringFree(&conv);
+	}
+
+	/*
+	 * We're now done with the encoding, so drop it.
+	 */
+
+	Tcl_FreeEncoding(venc);
+
+	/*
+	 * Write the changes back into the overall database.
+	 */
+
+	Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict);
+    }
+
+    /*
+     * Now create the interface command for retrieval of the package
+     * information.
+     */
+
+    Tcl_DStringInit(&cmdName);
+    Tcl_DStringAppend(&cmdName, "::", -1);
+    Tcl_DStringAppend(&cmdName, pkgName, -1);
+
+    /*
+     * The incomplete command name is the name of the namespace to place it
+     * in.
+     */
+
+    if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL,
+	    TCL_GLOBAL_ONLY) == NULL) {
+	if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName),
+		NULL, NULL) == NULL) {
+	    Tcl_Panic("%s.\n%s: %s",
+		    Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
+		    "Unable to create namespace for package configuration.");
+	}
+    }
+
+    Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+
+    if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
+	    QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) {
+        Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
+		"Unable to create query command for package configuration");
+    }
+
+    Tcl_DStringFree(&cmdName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueryConfigObjCmd --
+ *
+ *	Implementation of "::<package>::pkgconfig", the command to query
+ *	configuration information embedded into a binary library.
+ *
+ * Results:
+ *	A standard tcl result.
+ *
+ * Side effects:
+ *	See the manual for what this command does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+QueryConfigObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    struct Tcl_Obj *CONST *objv)
+{
+    QCCD *cdPtr = (QCCD *) clientData;
+    Tcl_Obj *pkgName = cdPtr->pkg;
+    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
+    int n, index;
+    static const char *subcmdStrings[] = {
+	"get", "list", NULL
+    };
+    enum subcmds {
+	CFG_GET, CFG_LIST
+    };
+
+    if ((objc < 2) || (objc > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    pDB = GetConfigDict(interp);
+    if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
+	    || pkgDict == NULL) {
+        /*
+	 * Maybe a Tcl_Panic is better, because the package data has to be
+	 * present.
+	 */
+
+        Tcl_SetResult(interp, "package not known", TCL_STATIC);
+	return TCL_ERROR;
+    }
+
+    switch ((enum subcmds) index) {
+    case CFG_GET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "key");
+	    return TCL_ERROR;
+	}
+
+	if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK
+		|| val == NULL) {
+	    Tcl_SetResult(interp, "key not known", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+
+	Tcl_SetObjResult(interp, val);
+	return TCL_OK;
+
+    case CFG_LIST:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+
+	Tcl_DictObjSize(interp, pkgDict, &n);
+	listPtr = Tcl_NewListObj(n, NULL);
+
+	if (!listPtr) {
+	    Tcl_SetResult(interp, "insufficient memory to create list",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+	}
+
+	if (n) {
+	    Tcl_DictSearch s;
+	    Tcl_Obj *key;
+	    int done;
+
+	    for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
+		    !done; Tcl_DictObjNext(&s, &key, NULL, &done)) {
+		Tcl_ListObjAppendElement(NULL, listPtr, key);
+	    }
+	}
+
+	Tcl_SetObjResult(interp, listPtr);
+	return TCL_OK;
+
+    default:
+	Tcl_Panic("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This can't happen");
+	break;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * QueryConfigDelete --
+ *
+ *	Command delete function. Cleans up after the configuration query
+ *	command when it is deleted by the user or during finalization.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates all non-transient memory allocated by Tcl_RegisterConfig.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+QueryConfigDelete(
+    ClientData clientData)
+{
+    QCCD *cdPtr = (QCCD *) clientData;
+    Tcl_Obj *pkgName = cdPtr->pkg;
+    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
+    Tcl_DictObjRemove(NULL, pDB, pkgName);
+    Tcl_DecrRefCount(pkgName);
+    ckfree((char *)cdPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * GetConfigDict --
+ *
+ *	Retrieve the package metadata database from the interpreter.
+ *	Initializes it, if not present yet.
+ *
+ * Results:
+ *	A Tcl_Obj reference
+ *
+ * Side effects:
+ *	May allocate a Tcl_Obj.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetConfigDict(
+    Tcl_Interp *interp)
+{
+    Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
+
+    if (pDB == NULL) {
+	pDB = Tcl_NewDictObj();
+	Tcl_IncrRefCount(pDB);
+	Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
+    }
+
+    return pDB;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigDictDeleteProc --
+ *
+ *	This function is associated with the "Package About dict" assoc data
+ *	for an interpreter; it is invoked when the interpreter is deleted in
+ *	order to free the information assoicated with any pending error
+ *	reports.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The package metadata database is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConfigDictDeleteProc(
+    ClientData clientData,	/* Pointer to Tcl_Obj. */
+    Tcl_Interp *interp)		/* Interpreter being deleted. */
+{
+    Tcl_Obj *pDB = (Tcl_Obj *) clientData;
+
+    Tcl_DecrRefCount(pDB);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
index 1713de5..4e4d3a4 100644
--- a/generic/tclDTrace.d
+++ b/generic/tclDTrace.d
@@ -51,6 +51,19 @@ provider tcl {
     probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
 	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
 	    char* arg9);
+    /*
+     *	tcl*:::proc-info probe
+     *	    triggered before proc-entry probe, gives access to TIP 280
+     *	    information for the proc invocation (i.e. [info frame 0])
+     *		arg0: TIP 280 cmd			(string)
+     *		arg1: TIP 280 type			(string)
+     *		arg2: TIP 280 proc			(string)
+     *		arg3: TIP 280 file			(string)
+     *		arg4: TIP 280 line			(int)
+     *		arg5: TIP 280 level			(int)
+     */
+    probe proc__info(char* cmd, char* type, char* proc, char* file, int line,
+	    int level);
 
     /***************************** cmd probes ******************************/
     /*
@@ -87,6 +100,19 @@ provider tcl {
     probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
 	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
 	    char* arg9);
+    /*
+     *	tcl*:::cmd-info probe
+     *	    triggered before cmd-entry probe, gives access to TIP 280
+     *	    information for the command invocation (i.e. [info frame 0])
+     *		arg0: TIP 280 cmd			(string)
+     *		arg1: TIP 280 type			(string)
+     *		arg2: TIP 280 proc			(string)
+     *		arg3: TIP 280 file			(string)
+     *		arg4: TIP 280 line			(int)
+     *		arg5: TIP 280 level			(int)
+     */
+    probe cmd__info(char* cmd, char* type, char* proc, char* file, int line,
+	    int level);
 
     /***************************** inst probes *****************************/
     /*
@@ -157,6 +183,10 @@ struct Tcl_Obj {
 	    void *ptr1;
 	    void *ptr2;
 	} twoPtrValue;
+	struct {
+	    void *ptr;
+	    unsigned long value;
+	} ptrAndLongRep;
     } internalRep;
 };
 
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 0475e58..59da2ea 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,657 +1,2567 @@
-/* 
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 1
+
+/* Using locations.  */
+#define YYLSP_NEEDED 1
+
+/* Substitute the variable and function names.  */
+#define yyparse TclDateparse
+#define yylex   TclDatelex
+#define yyerror TclDateerror
+#define yylval  TclDatelval
+#define yychar  TclDatechar
+#define yydebug TclDatedebug
+#define yynerrs TclDatenerrs
+#define yylloc TclDatelloc
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     tAGO = 258,
+     tDAY = 259,
+     tDAYZONE = 260,
+     tID = 261,
+     tMERIDIAN = 262,
+     tMONTH = 263,
+     tMONTH_UNIT = 264,
+     tSTARDATE = 265,
+     tSEC_UNIT = 266,
+     tSNUMBER = 267,
+     tUNUMBER = 268,
+     tZONE = 269,
+     tEPOCH = 270,
+     tDST = 271,
+     tISOBASE = 272,
+     tDAY_UNIT = 273,
+     tNEXT = 274
+   };
+#endif
+/* Tokens.  */
+#define tAGO 258
+#define tDAY 259
+#define tDAYZONE 260
+#define tID 261
+#define tMERIDIAN 262
+#define tMONTH 263
+#define tMONTH_UNIT 264
+#define tSTARDATE 265
+#define tSEC_UNIT 266
+#define tSNUMBER 267
+#define tUNUMBER 268
+#define tZONE 269
+#define tEPOCH 270
+#define tDST 271
+#define tISOBASE 272
+#define tDAY_UNIT 273
+#define tNEXT 274
+
+
+
+
+/* Copy the first part of user declarations.  */
+
+
+/*
  * tclDate.c --
  *
- *	This file is generated from a yacc grammar defined in
- *	the file tclGetDate.y.  It should not be edited directly.
+ *	This file is generated from a yacc grammar defined in the file
+ *	tclGetDate.y. It should not be edited directly.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
-
 #include "tclInt.h"
-#include "tclPort.h"
 
-#define EPOCH           1970
-#define START_OF_TIME   1902
-#define END_OF_TIME     2037
+/*
+ * Bison generates several labels that happen to be unused. MS Visual C++
+ * doesn't like that, and complains. Tell it to shut up.
+ */
+
+#ifdef _MSC_VER
+#pragma warning( disable : 4102 )
+#endif /* _MSC_VER */
+
+/*
+ * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
+ * parsed fields will be returned.
+ */
+
+typedef struct DateInfo {
+
+    Tcl_Obj* messages;		/* Error messages */
+    const char* separatrix;	/* String separating messages */
+
+    time_t dateYear;
+    time_t dateMonth;
+    time_t dateDay;
+    int dateHaveDate;
+
+    time_t dateHour;
+    time_t dateMinutes;
+    time_t dateSeconds;
+    int dateMeridian;
+    int dateHaveTime;
+
+    time_t dateTimezone;
+    int dateDSTmode;
+    int dateHaveZone;
+
+    time_t dateRelMonth;
+    time_t dateRelDay;
+    time_t dateRelSeconds;
+    int dateHaveRel;
+
+    time_t dateMonthOrdinal;
+    int dateHaveOrdinalMonth;
+
+    time_t dateDayOrdinal;
+    time_t dateDayNumber;
+    int dateHaveDay;
+
+    const char *dateStart;
+    const char *dateInput;
+    time_t *dateRelPointer;
+
+    int dateDigitCount;
+} DateInfo;
+
+#define YYMALLOC	ckalloc
+#define YYFREE(x)	(ckfree((void*) (x)))
+
+#define yyDSTmode	(info->dateDSTmode)
+#define yyDayOrdinal	(info->dateDayOrdinal)
+#define yyDayNumber	(info->dateDayNumber)
+#define yyMonthOrdinal	(info->dateMonthOrdinal)
+#define yyHaveDate	(info->dateHaveDate)
+#define yyHaveDay	(info->dateHaveDay)
+#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
+#define yyHaveRel	(info->dateHaveRel)
+#define yyHaveTime	(info->dateHaveTime)
+#define yyHaveZone	(info->dateHaveZone)
+#define yyTimezone	(info->dateTimezone)
+#define yyDay		(info->dateDay)
+#define yyMonth		(info->dateMonth)
+#define yyYear		(info->dateYear)
+#define yyHour		(info->dateHour)
+#define yyMinutes	(info->dateMinutes)
+#define yySeconds	(info->dateSeconds)
+#define yyMeridian	(info->dateMeridian)
+#define yyRelMonth	(info->dateRelMonth)
+#define yyRelDay	(info->dateRelDay)
+#define yyRelSeconds	(info->dateRelSeconds)
+#define yyRelPointer	(info->dateRelPointer)
+#define yyInput		(info->dateInput)
+#define yyDigitCount	(info->dateDigitCount)
+
+#define EPOCH		1970
+#define START_OF_TIME	1902
+#define END_OF_TIME	2037
 
 /*
  * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
- * I don't know how universal this is; K&R II, the NetBSD manpages, and
- * ../compat/strftime.c all agree that tm_year is the year-1900.  However,
- * some systems may have a different value.  This #define should be the
- * same as in ../compat/strftime.c.
+ * Posix requires 1900.
  */
-#define TM_YEAR_BASE 1900
 
-#define HOUR(x)         ((int) (60 * x))
-#define SECSPERDAY      (24L * 60L * 60L)
-#define IsLeapYear(x)   ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
+#define TM_YEAR_BASE	1900
+
+#define HOUR(x)		((int) (60 * x))
+#define SECSPERDAY	(24L * 60L * 60L)
+#define IsLeapYear(x)	((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
 
 /*
- *  An entry in the lexical lookup table.
+ * An entry in the lexical lookup table.
  */
+
 typedef struct _TABLE {
-    char        *name;
-    int         type;
-    time_t      value;
+    const char *name;
+    int type;
+    time_t value;
 } TABLE;
 
-
 /*
- *  Daylight-savings mode:  on, off, or not yet known.
+ * Daylight-savings mode: on, off, or not yet known.
  */
+
 typedef enum _DSTMODE {
     DSTon, DSToff, DSTmaybe
 } DSTMODE;
 
 /*
- *  Meridian:  am, pm, or 24-hour style.
+ * Meridian: am, pm, or 24-hour style.
  */
+
 typedef enum _MERIDIAN {
     MERam, MERpm, MER24
 } MERIDIAN;
 
 
-/*
- *  Global variables.  We could get rid of most of these by using a good
- *  union as the yacc stack.  (This routine was originally written before
- *  yacc had the %union construct.)  Maybe someday; right now we only use
- *  the %union very rarely.
- */
-static char     *TclDateInput;
-static DSTMODE  TclDateDSTmode;
-static time_t   TclDateDayOrdinal;
-static time_t   TclDateDayNumber;
-static time_t   TclDateMonthOrdinal;
-static int      TclDateHaveDate;
-static int      TclDateHaveDay;
-static int      TclDateHaveOrdinalMonth;
-static int      TclDateHaveRel;
-static int      TclDateHaveTime;
-static int      TclDateHaveZone;
-static time_t   TclDateTimezone;
-static time_t   TclDateDay;
-static time_t   TclDateHour;
-static time_t   TclDateMinutes;
-static time_t   TclDateMonth;
-static time_t   TclDateSeconds;
-static time_t   TclDateYear;
-static MERIDIAN TclDateMeridian;
-static time_t   TclDateRelMonth;
-static time_t   TclDateRelDay;
-static time_t   TclDateRelSeconds;
-static time_t  *TclDateRelPointer;
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+
+{
+    time_t Number;
+    enum _MERIDIAN Meridian;
+}
+/* Line 187 of yacc.c.  */
+
+	YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
+typedef struct YYLTYPE
+{
+  int first_line;
+  int first_column;
+  int last_line;
+  int last_column;
+} YYLTYPE;
+# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
+# define YYLTYPE_IS_DECLARED 1
+# define YYLTYPE_IS_TRIVIAL 1
+#endif
+
+
+/* Copy the second part of user declarations.  */
+
+
 
 /*
  * Prototypes of internal functions.
  */
-static void	TclDateerror _ANSI_ARGS_((char *s));
-static time_t	ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
-		    time_t Seconds, MERIDIAN Meridian));
-static int	Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
-		    time_t Hours, time_t Minutes, time_t Seconds,
-		    MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
-static time_t	DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
-static time_t	NamedDay _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
-		    time_t DayNumber));
-static time_t   NamedMonth _ANSI_ARGS_((time_t Start, time_t MonthOrdinal,
-                    time_t MonthNumber));
-static int	RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
-		    time_t *TimePtr));
-static int	RelativeDay _ANSI_ARGS_((time_t Start, time_t RelDay,
-		    time_t *TimePtr));
-static int	LookupWord _ANSI_ARGS_((char *buff));
-static int	TclDatelex _ANSI_ARGS_((void));
 
-int
-TclDateparse _ANSI_ARGS_((void));
-typedef union
-#ifdef __cplusplus
-	YYSTYPE
+static int		LookupWord(YYSTYPE* yylvalPtr, char *buff);
+ static void		TclDateerror(YYLTYPE* location,
+				     DateInfo* info, const char *s);
+ static int		TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
+				   DateInfo* info);
+static time_t		ToSeconds(time_t Hours, time_t Minutes,
+			    time_t Seconds, MERIDIAN Meridian);
+MODULE_SCOPE int	yyparse(DateInfo*);
+
+
+
+/* Line 216 of yacc.c.  */
+
+
+#ifdef short
+# undef short
 #endif
- {
-    time_t              Number;
-    enum _MERIDIAN      Meridian;
-} YYSTYPE;
-# define tAGO 257
-# define tDAY 258
-# define tDAYZONE 259
-# define tID 260
-# define tMERIDIAN 261
-# define tMINUTE_UNIT 262
-# define tMONTH 263
-# define tMONTH_UNIT 264
-# define tSTARDATE 265
-# define tSEC_UNIT 266
-# define tSNUMBER 267
-# define tUNUMBER 268
-# define tZONE 269
-# define tEPOCH 270
-# define tDST 271
-# define tISOBASE 272
-# define tDAY_UNIT 273
-# define tNEXT 274
-
-
-
-
-#if defined(__cplusplus) || defined(__STDC__)
-
-#if defined(__cplusplus) && defined(__EXTERN_C__)
-extern "C" {
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
 #endif
-#ifndef TclDateerror
-#if defined(__cplusplus)
-	void TclDateerror(CONST char *);
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
 #endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
 #endif
-#ifndef TclDatelex
-	int TclDatelex(void);
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
 #endif
-	int TclDateparse(void);
-#if defined(__cplusplus) && defined(__EXTERN_C__)
-}
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
 #endif
 
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
 #endif
 
-#define TclDateclearin TclDatechar = -1
-#define TclDateerrok TclDateerrflag = 0
-extern int TclDatechar;
-extern int TclDateerrflag;
-YYSTYPE TclDatelval;
-YYSTYPE TclDateval;
-typedef int TclDatetabelem;
-#ifndef YYMAXDEPTH
-#define YYMAXDEPTH 150
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
 #endif
-#if YYMAXDEPTH > 0
-int TclDate_TclDates[YYMAXDEPTH], *TclDates = TclDate_TclDates;
-YYSTYPE TclDate_TclDatev[YYMAXDEPTH], *TclDatev = TclDate_TclDatev;
-#else	/* user does initial allocation */
-int *TclDates;
-YYSTYPE *TclDatev;
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
+	     && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+    YYLTYPE yyls;
+};
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
+      + 2 * YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
 #endif
-static int TclDatemaxdepth = YYMAXDEPTH;
-# define YYERRCODE 256
 
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   79
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  26
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  16
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  56
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  83
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   274
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,    25,    22,    21,    24,    23,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,    20,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
+       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
+      15,    16,    17,    18,    19
+};
 
-/*
- * Month and day table.
- */
-static CONST TABLE MonthDayTable[] = {
-    { "january",        tMONTH,  1 },
-    { "february",       tMONTH,  2 },
-    { "march",          tMONTH,  3 },
-    { "april",          tMONTH,  4 },
-    { "may",            tMONTH,  5 },
-    { "june",           tMONTH,  6 },
-    { "july",           tMONTH,  7 },
-    { "august",         tMONTH,  8 },
-    { "september",      tMONTH,  9 },
-    { "sept",           tMONTH,  9 },
-    { "october",        tMONTH, 10 },
-    { "november",       tMONTH, 11 },
-    { "december",       tMONTH, 12 },
-    { "sunday",         tDAY, 0 },
-    { "monday",         tDAY, 1 },
-    { "tuesday",        tDAY, 2 },
-    { "tues",           tDAY, 2 },
-    { "wednesday",      tDAY, 3 },
-    { "wednes",         tDAY, 3 },
-    { "thursday",       tDAY, 4 },
-    { "thur",           tDAY, 4 },
-    { "thurs",          tDAY, 4 },
-    { "friday",         tDAY, 5 },
-    { "saturday",       tDAY, 6 },
-    { NULL }
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint8 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     9,    11,    13,    15,    17,
+      19,    21,    23,    25,    28,    33,    39,    46,    54,    57,
+      59,    61,    63,    66,    69,    73,    76,    80,    86,    88,
+      94,   100,   103,   108,   111,   113,   117,   120,   124,   128,
+     136,   139,   144,   147,   149,   153,   156,   159,   163,   165,
+     167,   169,   171,   173,   175,   177,   178
 };
 
-/*
- * Time units table.
- */
-static CONST TABLE UnitsTable[] = {
-    { "year",           tMONTH_UNIT,    12 },
-    { "month",          tMONTH_UNIT,     1 },
-    { "fortnight",      tDAY_UNIT,      14 },
-    { "week",           tDAY_UNIT,       7 },
-    { "day",            tDAY_UNIT,       1 },
-    { "hour",           tSEC_UNIT, 60 * 60 },
-    { "minute",         tSEC_UNIT,      60 },
-    { "min",            tSEC_UNIT,      60 },
-    { "second",         tSEC_UNIT,       1 },
-    { "sec",            tSEC_UNIT,       1 },
-    { NULL }
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int8 yyrhs[] =
+{
+      27,     0,    -1,    -1,    27,    28,    -1,    29,    -1,    30,
+      -1,    32,    -1,    33,    -1,    31,    -1,    36,    -1,    34,
+      -1,    35,    -1,    40,    -1,    13,     7,    -1,    13,    20,
+      13,    41,    -1,    13,    20,    13,    21,    13,    -1,    13,
+      20,    13,    20,    13,    41,    -1,    13,    20,    13,    20,
+      13,    21,    13,    -1,    14,    16,    -1,    14,    -1,     5,
+      -1,     4,    -1,     4,    22,    -1,    13,     4,    -1,    38,
+      13,     4,    -1,    19,     4,    -1,    13,    23,    13,    -1,
+      13,    23,    13,    23,    13,    -1,    17,    -1,    13,    21,
+       8,    21,    13,    -1,    13,    21,    13,    21,    13,    -1,
+       8,    13,    -1,     8,    13,    22,    13,    -1,    13,     8,
+      -1,    15,    -1,    13,     8,    13,    -1,    19,     8,    -1,
+      19,    13,     8,    -1,    17,    14,    17,    -1,    17,    14,
+      13,    20,    13,    20,    13,    -1,    17,    17,    -1,    10,
+      13,    24,    13,    -1,    37,     3,    -1,    37,    -1,    38,
+      13,    39,    -1,    13,    39,    -1,    19,    39,    -1,    19,
+      13,    39,    -1,    39,    -1,    21,    -1,    25,    -1,    11,
+      -1,    18,    -1,     9,    -1,    13,    -1,    -1,     7,    -1
 };
 
-/*
- * Assorted relative-time words.
- */
-static CONST TABLE OtherTable[] = {
-    { "tomorrow",       tDAY_UNIT,      1 },
-    { "yesterday",      tDAY_UNIT,     -1 },
-    { "today",          tDAY_UNIT,      0 },
-    { "now",            tSEC_UNIT,      0 },
-    { "last",           tUNUMBER,      -1 },
-    { "this",           tSEC_UNIT,      0 },
-    { "next",           tNEXT,          1 },
-#if 0
-    { "first",          tUNUMBER,       1 },
-    { "second",         tUNUMBER,       2 },
-    { "third",          tUNUMBER,       3 },
-    { "fourth",         tUNUMBER,       4 },
-    { "fifth",          tUNUMBER,       5 },
-    { "sixth",          tUNUMBER,       6 },
-    { "seventh",        tUNUMBER,       7 },
-    { "eighth",         tUNUMBER,       8 },
-    { "ninth",          tUNUMBER,       9 },
-    { "tenth",          tUNUMBER,       10 },
-    { "eleventh",       tUNUMBER,       11 },
-    { "twelfth",        tUNUMBER,       12 },
-#endif
-    { "ago",            tAGO,   1 },
-    { "epoch",          tEPOCH,   0 },
-    { "stardate",       tSTARDATE, 0},
-    { NULL }
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   225,   225,   226,   229,   232,   235,   238,   241,   244,
+     247,   251,   256,   259,   265,   271,   279,   285,   296,   300,
+     304,   310,   314,   318,   322,   326,   332,   336,   341,   346,
+     351,   356,   360,   365,   369,   374,   381,   385,   391,   400,
+     409,   419,   433,   438,   441,   444,   447,   450,   453,   458,
+     461,   466,   470,   474,   480,   498,   501
 };
+#endif
 
-/*
- * The timezone table.  (Note: This table was modified to not use any floating
- * point constants to work around an SGI compiler bug).
- */
-static CONST TABLE TimezoneTable[] = {
-    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
-    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
-    { "utc",    tZONE,     HOUR( 0) },
-    { "uct",    tZONE,     HOUR( 0) },      /* Universal Coordinated Time */
-    { "wet",    tZONE,     HOUR( 0) },      /* Western European */
-    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
-    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
-    { "at",     tZONE,     HOUR( 2) },      /* Azores */
-#if     0
-    /* For completeness.  BST is also British Summer, and GST is
-     * also Guam Standard. */
-    { "bst",    tZONE,     HOUR( 3) },      /* Brazil Standard */
-    { "gst",    tZONE,     HOUR( 3) },      /* Greenland Standard */
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
+  "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
+  "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
+  "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
+  "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
+  "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
+  "o_merid", 0
+};
 #endif
-    { "nft",    tZONE,     HOUR( 7/2) },    /* Newfoundland */
-    { "nst",    tZONE,     HOUR( 7/2) },    /* Newfoundland Standard */
-    { "ndt",    tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
-    { "ast",    tZONE,     HOUR( 4) },      /* Atlantic Standard */
-    { "adt",    tDAYZONE,  HOUR( 4) },      /* Atlantic Daylight */
-    { "est",    tZONE,     HOUR( 5) },      /* Eastern Standard */
-    { "edt",    tDAYZONE,  HOUR( 5) },      /* Eastern Daylight */
-    { "cst",    tZONE,     HOUR( 6) },      /* Central Standard */
-    { "cdt",    tDAYZONE,  HOUR( 6) },      /* Central Daylight */
-    { "mst",    tZONE,     HOUR( 7) },      /* Mountain Standard */
-    { "mdt",    tDAYZONE,  HOUR( 7) },      /* Mountain Daylight */
-    { "pst",    tZONE,     HOUR( 8) },      /* Pacific Standard */
-    { "pdt",    tDAYZONE,  HOUR( 8) },      /* Pacific Daylight */
-    { "yst",    tZONE,     HOUR( 9) },      /* Yukon Standard */
-    { "ydt",    tDAYZONE,  HOUR( 9) },      /* Yukon Daylight */
-    { "hst",    tZONE,     HOUR(10) },      /* Hawaii Standard */
-    { "hdt",    tDAYZONE,  HOUR(10) },      /* Hawaii Daylight */
-    { "cat",    tZONE,     HOUR(10) },      /* Central Alaska */
-    { "ahst",   tZONE,     HOUR(10) },      /* Alaska-Hawaii Standard */
-    { "nt",     tZONE,     HOUR(11) },      /* Nome */
-    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
-    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
-    { "cest",   tDAYZONE, -HOUR( 1) },      /* Central European Summer */
-    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
-    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
-    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
-    { "swt",    tZONE,    -HOUR( 1) },      /* Swedish Winter */
-    { "sst",    tDAYZONE, -HOUR( 1) },      /* Swedish Summer */
-    { "fwt",    tZONE,    -HOUR( 1) },      /* French Winter */
-    { "fst",    tDAYZONE, -HOUR( 1) },      /* French Summer */
-    { "eet",    tZONE,    -HOUR( 2) },      /* Eastern Europe, USSR Zone 1 */
-    { "bt",     tZONE,    -HOUR( 3) },      /* Baghdad, USSR Zone 2 */
-    { "it",     tZONE,    -HOUR( 7/2) },    /* Iran */
-    { "zp4",    tZONE,    -HOUR( 4) },      /* USSR Zone 3 */
-    { "zp5",    tZONE,    -HOUR( 5) },      /* USSR Zone 4 */
-    { "ist",    tZONE,    -HOUR(11/2) },    /* Indian Standard */
-    { "zp6",    tZONE,    -HOUR( 6) },      /* USSR Zone 5 */
-#if     0
-    /* For completeness.  NST is also Newfoundland Stanard, nad SST is
-     * also Swedish Summer. */
-    { "nst",    tZONE,    -HOUR(13/2) },    /* North Sumatra */
-    { "sst",    tZONE,    -HOUR( 7) },      /* South Sumatra, USSR Zone 6 */
-#endif  /* 0 */
-    { "wast",   tZONE,    -HOUR( 7) },      /* West Australian Standard */
-    { "wadt",   tDAYZONE, -HOUR( 7) },      /* West Australian Daylight */
-    { "jt",     tZONE,    -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
-    { "cct",    tZONE,    -HOUR( 8) },      /* China Coast, USSR Zone 7 */
-    { "jst",    tZONE,    -HOUR( 9) },      /* Japan Standard, USSR Zone 8 */
-    { "jdt",    tDAYZONE, -HOUR( 9) },      /* Japan Daylight */
-    { "kst",    tZONE,    -HOUR( 9) },      /* Korea Standard */
-    { "kdt",    tDAYZONE, -HOUR( 9) },      /* Korea Daylight */
-    { "cast",   tZONE,    -HOUR(19/2) },    /* Central Australian Standard */
-    { "cadt",   tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
-    { "east",   tZONE,    -HOUR(10) },      /* Eastern Australian Standard */
-    { "eadt",   tDAYZONE, -HOUR(10) },      /* Eastern Australian Daylight */
-    { "gst",    tZONE,    -HOUR(10) },      /* Guam Standard, USSR Zone 9 */
-    { "nzt",    tZONE,    -HOUR(12) },      /* New Zealand */
-    { "nzst",   tZONE,    -HOUR(12) },      /* New Zealand Standard */
-    { "nzdt",   tDAYZONE, -HOUR(12) },      /* New Zealand Daylight */
-    { "idle",   tZONE,    -HOUR(12) },      /* International Date Line East */
-    /* ADDED BY Marco Nijdam */
-    { "dst",    tDST,     HOUR( 0) },       /* DST on (hour is ignored) */
-    /* End ADDED */
-    {  NULL  }
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
+     265,   266,   267,   268,   269,   270,   271,   272,   273,   274,
+      58,    45,    44,    47,    46,    43
 };
+# endif
 
-/*
- * Military timezone table.
- */
-static CONST TABLE MilitaryTable[] = {
-    { "a",      tZONE,  HOUR(  1) },
-    { "b",      tZONE,  HOUR(  2) },
-    { "c",      tZONE,  HOUR(  3) },
-    { "d",      tZONE,  HOUR(  4) },
-    { "e",      tZONE,  HOUR(  5) },
-    { "f",      tZONE,  HOUR(  6) },
-    { "g",      tZONE,  HOUR(  7) },
-    { "h",      tZONE,  HOUR(  8) },
-    { "i",      tZONE,  HOUR(  9) },
-    { "k",      tZONE,  HOUR( 10) },
-    { "l",      tZONE,  HOUR( 11) },
-    { "m",      tZONE,  HOUR( 12) },
-    { "n",      tZONE,  HOUR(- 1) },
-    { "o",      tZONE,  HOUR(- 2) },
-    { "p",      tZONE,  HOUR(- 3) },
-    { "q",      tZONE,  HOUR(- 4) },
-    { "r",      tZONE,  HOUR(- 5) },
-    { "s",      tZONE,  HOUR(- 6) },
-    { "t",      tZONE,  HOUR(- 7) },
-    { "u",      tZONE,  HOUR(- 8) },
-    { "v",      tZONE,  HOUR(- 9) },
-    { "w",      tZONE,  HOUR(-10) },
-    { "x",      tZONE,  HOUR(-11) },
-    { "y",      tZONE,  HOUR(-12) },
-    { "z",      tZONE,  HOUR(  0) },
-    { NULL }
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint8 yyr1[] =
+{
+       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
+      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
+      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
+      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
+      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
+      38,    39,    39,    39,    40,    41,    41
 };
 
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
+       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
+       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
+       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
+       1,     1,     1,     1,     1,     0,     1
+};
 
-/*
- * Dump error messages in the bit bucket.
- */
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint8 yydefact[] =
+{
+       2,     0,     1,    21,    20,     0,    53,     0,    51,    54,
+      19,    34,    28,    52,     0,    49,    50,     3,     4,     5,
+       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
+      22,    31,     0,    23,    13,    33,     0,     0,     0,    45,
+      18,     0,    40,    25,    36,     0,    46,    42,     0,     0,
+       0,    35,    55,     0,     0,    26,     0,    38,    37,    47,
+      24,    44,    32,    41,    56,     0,     0,    14,     0,     0,
+       0,     0,    55,    15,    29,    30,    27,     0,     0,    16,
+       0,    17,    39
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int8 yydefgoto[] =
+{
+      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
+      25,    26,    27,    28,    29,    67
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -22
+static const yytype_int8 yypact[] =
+{
+     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
+      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
+     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
+     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
+     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
+      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
+     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
+      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
+      64,   -22,   -22
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int8 yypgoto[] =
+{
+     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
+     -22,   -22,   -22,    -9,   -22,     6
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -1
+static const yytype_uint8 yytable[] =
+{
+      39,    30,     2,    53,    64,    46,     3,     4,    54,    31,
+       5,     6,     7,     8,    32,     9,    10,    11,    78,    12,
+      13,    14,    41,    15,    64,    42,    33,    16,    56,    34,
+      35,     6,    57,     8,    40,    47,    59,    65,    66,    61,
+      13,    48,    36,    37,    43,    38,    49,    60,    44,     6,
+      50,     8,     6,    45,     8,    51,    58,     6,    13,     8,
+      52,    13,    55,    62,    63,    68,    13,    69,    70,    72,
+      73,    74,    71,    75,    76,    77,    81,    82,    79,    80
+};
+
+static const yytype_uint8 yycheck[] =
+{
+       9,    22,     0,     8,     7,    14,     4,     5,    13,    13,
+       8,     9,    10,    11,    13,    13,    14,    15,    21,    17,
+      18,    19,    14,    21,     7,    17,     4,    25,    13,     7,
+       8,     9,    17,    11,    16,     3,    45,    20,    21,    48,
+      18,    13,    20,    21,     4,    23,    22,     4,     8,     9,
+      24,    11,     9,    13,    11,    13,     8,     9,    18,    11,
+      13,    18,    13,    13,    13,    21,    18,    21,    23,    13,
+      13,    13,    20,    13,    13,    13,    13,    13,    72,    20
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint8 yystos[] =
+{
+       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
+      14,    15,    17,    18,    19,    21,    25,    28,    29,    30,
+      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
+      22,    13,    13,     4,     7,     8,    20,    21,    23,    39,
+      16,    14,    17,     4,     8,    13,    39,     3,    13,    22,
+      24,    13,    13,     8,    13,    13,    13,    17,     8,    39,
+       4,    39,    13,    13,     7,    20,    21,    41,    21,    21,
+      23,    20,    13,    13,    13,    13,    13,    13,    21,    41,
+      20,    13,    13
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
+#else
+# define YYLEX yylex (&yylval, &yylloc, info)
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value, Location, info); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
+#else
 static void
-TclDateerror(s)
-    char  *s;
+yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+    YYLTYPE const * const yylocationp;
+    DateInfo* info;
+#endif
 {
+  if (!yyvaluep)
+    return;
+  YYUSE (yylocationp);
+  YYUSE (info);
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
 }
 
 
-static time_t
-ToSeconds(Hours, Minutes, Seconds, Meridian)
-    time_t      Hours;
-    time_t      Minutes;
-    time_t      Seconds;
-    MERIDIAN    Meridian;
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+    YYLTYPE const * const yylocationp;
+    DateInfo* info;
+#endif
 {
-    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
-        return -1;
-    switch (Meridian) {
-    case MER24:
-        if (Hours < 0 || Hours > 23)
-            return -1;
-        return (Hours * 60L + Minutes) * 60L + Seconds;
-    case MERam:
-        if (Hours < 1 || Hours > 12)
-            return -1;
-        return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
-    case MERpm:
-        if (Hours < 1 || Hours > 12)
-            return -1;
-        return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
-    }
-    return -1;  /* Should never be reached */
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  YY_LOCATION_PRINT (yyoutput, *yylocationp);
+  YYFPRINTF (yyoutput, ": ");
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
+  YYFPRINTF (yyoutput, ")");
 }
 
-/*
- *-----------------------------------------------------------------------------
- *
- * Convert --
- *
- *      Convert a {month, day, year, hours, minutes, seconds, meridian, dst}
- *      tuple into a clock seconds value.
- *
- * Results:
- *      0 or -1 indicating success or failure.
- *
- * Side effects:
- *      Fills TimePtr with the computed value.
- *
- *-----------------------------------------------------------------------------
- */
-static int
-Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
-    time_t      Month;
-    time_t      Day;
-    time_t      Year;
-    time_t      Hours;
-    time_t      Minutes;
-    time_t      Seconds;
-    MERIDIAN    Meridian;
-    DSTMODE     DSTmode;
-    time_t     *TimePtr;
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
 {
-    static int  DaysInMonth[12] = {
-        31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
-    };
-    time_t tod;
-    time_t Julian;
-    int i;
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
 
-    /* Figure out how many days are in February for the given year.
-     * Every year divisible by 4 is a leap year.
-     * But, every year divisible by 100 is not a leap year.
-     * But, every year divisible by 400 is a leap year after all.
-     */
-    DaysInMonth[1] = IsLeapYear(Year) ? 29 : 28;
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
 
-    /* Check the inputs for validity */
-    if (Month < 1 || Month > 12
-	    || Year < START_OF_TIME || Year > END_OF_TIME
-	    || Day < 1 || Day > DaysInMonth[(int)--Month])
-        return -1;
 
-    /* Start computing the value.  First determine the number of days
-     * represented by the date, then multiply by the number of seconds/day.
-     */
-    for (Julian = Day - 1, i = 0; i < Month; i++)
-        Julian += DaysInMonth[i];
-    if (Year >= EPOCH) {
-        for (i = EPOCH; i < Year; i++)
-            Julian += 365 + IsLeapYear(i);
-    } else {
-        for (i = (int)Year; i < EPOCH; i++)
-            Julian -= 365 + IsLeapYear(i);
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
+#else
+static void
+yy_reduce_print (yyvsp, yylsp, yyrule, info)
+    YYSTYPE *yyvsp;
+    YYLTYPE *yylsp;
+    int yyrule;
+    DateInfo* info;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       , &(yylsp[(yyi + 1) - (yynrhs)])		       , info);
+      fprintf (stderr, "\n");
     }
-    Julian *= SECSPERDAY;
+}
 
-    /* Add the timezone offset ?? */
-    Julian += TclDateTimezone * 60L;
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, yylsp, Rule, info); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
 
-    /* Add the number of seconds represented by the time component */
-    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
-        return -1;
-    Julian += tod;
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
 
-    /* Perform a preliminary DST compensation ?? */
-    if (DSTmode == DSTon
-     || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
-        Julian -= 60 * 60;
-    *TimePtr = Julian;
-    return 0;
-}
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
 
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
 
-static time_t
-DSTcorrect(Start, Future)
-    time_t      Start;
-    time_t      Future;
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
 {
-    time_t      StartDay;
-    time_t      FutureDay;
-    StartDay = (TclpGetDate((TclpTime_t)&Start, 0)->tm_hour + 1) % 24;
-    FutureDay = (TclpGetDate((TclpTime_t)&Future, 0)->tm_hour + 1) % 24;
-    return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
 }
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
 
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
 
-static time_t
-NamedDay(Start, DayOrdinal, DayNumber)
-    time_t      Start;
-    time_t      DayOrdinal;
-    time_t      DayNumber;
-{
-    struct tm   *tm;
-    time_t      now;
-
-    now = Start;
-    tm = TclpGetDate((TclpTime_t)&now, 0);
-    now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
-    now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
-    return DSTcorrect(Start, now);
+  return yyd - 1;
 }
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
 
-static time_t
-NamedMonth(Start, MonthOrdinal, MonthNumber)
-    time_t Start;
-    time_t MonthOrdinal;
-    time_t MonthNumber;
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
 {
-    struct tm *tm;
-    time_t now;
-    int result;
-    
-    now = Start;
-    tm = TclpGetDate((TclpTime_t)&now, 0);
-    /* To compute the next n'th month, we use this alg:
-     * add n to year value
-     * if currentMonth < requestedMonth decrement year value by 1 (so that
-     *  doing next february from january gives us february of the current year)
-     * set day to 1, time to 0
-     */
-    tm->tm_year += (int)MonthOrdinal;
-    if (tm->tm_mon < MonthNumber - 1) {
-	tm->tm_year--;
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
     }
-    result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE,
-	    (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now);
-    if (result < 0) {
-	return 0;
+}
+#endif /* YYERROR_VERBOSE */
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+    YYLTYPE *yylocationp;
+    DateInfo* info;
+#endif
+{
+  YYUSE (yyvaluep);
+  YYUSE (yylocationp);
+  YYUSE (info);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
     }
-    return DSTcorrect(Start, now);
 }
+
 
-static int
-RelativeMonth(Start, RelMonth, TimePtr)
-    time_t Start;
-    time_t RelMonth;
-    time_t *TimePtr;
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (DateInfo* info);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (DateInfo* info)
+#else
+int
+yyparse (info)
+    DateInfo* info;
+#endif
+#endif
 {
-    struct tm *tm;
-    time_t Month;
-    time_t Year;
-    time_t Julian;
-    int result;
-
-    if (RelMonth == 0) {
-        *TimePtr = 0;
-        return 0;
+  /* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+/* Location data for the look-ahead symbol.  */
+YYLTYPE yylloc;
+
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+  /* The location stack.  */
+  YYLTYPE yylsa[YYINITDEPTH];
+  YYLTYPE *yyls = yylsa;
+  YYLTYPE *yylsp;
+  /* The locations where the error started and ended.  */
+  YYLTYPE yyerror_range[2];
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+  YYLTYPE yyloc;
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+  yylsp = yyls;
+#if YYLTYPE_IS_TRIVIAL
+  /* Initialize the default location before parsing starts.  */
+  yylloc.first_line   = yylloc.last_line   = 1;
+  yylloc.first_column = yylloc.last_column = 0;
+#endif
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+	YYLTYPE *yyls1 = yyls;
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+		    &yyls1, yysize * sizeof (*yylsp),
+		    &yystacksize);
+	yyls = yyls1;
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+	YYSTACK_RELOCATE (yyls);
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+      yylsp = yyls + yysize - 1;
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
     }
-    tm = TclpGetDate((TclpTime_t)&Start, 0);
-    Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
-    Year = Month / 12;
-    Month = Month % 12 + 1;
-    result = Convert(Month, (time_t) tm->tm_mday, Year,
-	    (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
-	    MER24, DSTmaybe, &Julian);
 
-    /*
-     * The Julian time returned above is behind by one day, if "month" 
-     * or "year" is used to specify relative time and the GMT flag is true.
-     * This problem occurs only when the current time is closer to
-     * midnight, the difference being not more than its time difference
-     * with GMT. For example, in US/Pacific time zone, the problem occurs
-     * whenever the current time is between midnight to 8:00am or 7:00amDST.
-     * See Bug# 413397 for more details and sample script.
-     * To resolve this bug, we simply add the number of seconds corresponding
-     * to timezone difference with GMT to Julian time, if GMT flag is true.
-     */
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
 
-    if (TclDateTimezone == 0) {
-        Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
     }
 
-    /*
-     * The following iteration takes into account the case were we jump
-     * into a "short month".  Far example, "one month from Jan 31" will
-     * fail because there is no Feb 31.  The code below will reduce the
-     * day and try converting the date until we succed or the date equals
-     * 28 (which always works unless the date is bad in another way).
-     */
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
 
-    while ((result != 0) && (tm->tm_mday > 28)) {
-	tm->tm_mday--;
-	result = Convert(Month, (time_t) tm->tm_mday, Year,
-		(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
-		MER24, DSTmaybe, &Julian);
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
     }
-    if (result != 0) {
-	return -1;
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+  *++yylsp = yylloc;
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+  /* Default location.  */
+  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 4:
+
+    {
+	    yyHaveTime++;
+	;}
+    break;
+
+  case 5:
+
+    {
+	    yyHaveZone++;
+	;}
+    break;
+
+  case 6:
+
+    {
+	    yyHaveDate++;
+	;}
+    break;
+
+  case 7:
+
+    {
+	    yyHaveOrdinalMonth++;
+	;}
+    break;
+
+  case 8:
+
+    {
+	    yyHaveDay++;
+	;}
+    break;
+
+  case 9:
+
+    {
+	    yyHaveRel++;
+	;}
+    break;
+
+  case 10:
+
+    {
+	    yyHaveTime++;
+	    yyHaveDate++;
+	;}
+    break;
+
+  case 11:
+
+    {
+	    yyHaveTime++;
+	    yyHaveDate++;
+	    yyHaveRel++;
+	;}
+    break;
+
+  case 13:
+
+    {
+	    yyHour = (yyvsp[(1) - (2)].Number);
+	    yyMinutes = 0;
+	    yySeconds = 0;
+	    yyMeridian = (yyvsp[(2) - (2)].Meridian);
+	;}
+    break;
+
+  case 14:
+
+    {
+	    yyHour = (yyvsp[(1) - (4)].Number);
+	    yyMinutes = (yyvsp[(3) - (4)].Number);
+	    yySeconds = 0;
+	    yyMeridian = (yyvsp[(4) - (4)].Meridian);
+	;}
+    break;
+
+  case 15:
+
+    {
+	    yyHour = (yyvsp[(1) - (5)].Number);
+	    yyMinutes = (yyvsp[(3) - (5)].Number);
+	    yyMeridian = MER24;
+	    yyDSTmode = DSToff;
+	    yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
+	    ++yyHaveZone;
+	;}
+    break;
+
+  case 16:
+
+    {
+	    yyHour = (yyvsp[(1) - (6)].Number);
+	    yyMinutes = (yyvsp[(3) - (6)].Number);
+	    yySeconds = (yyvsp[(5) - (6)].Number);
+	    yyMeridian = (yyvsp[(6) - (6)].Meridian);
+	;}
+    break;
+
+  case 17:
+
+    {
+	    yyHour = (yyvsp[(1) - (7)].Number);
+	    yyMinutes = (yyvsp[(3) - (7)].Number);
+	    yySeconds = (yyvsp[(5) - (7)].Number);
+	    yyMeridian = MER24;
+	    yyDSTmode = DSToff;
+	    yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
+	    ++yyHaveZone;
+	;}
+    break;
+
+  case 18:
+
+    {
+	    yyTimezone = (yyvsp[(1) - (2)].Number);
+	    yyDSTmode = DSTon;
+	;}
+    break;
+
+  case 19:
+
+    {
+	    yyTimezone = (yyvsp[(1) - (1)].Number);
+	    yyDSTmode = DSToff;
+	;}
+    break;
+
+  case 20:
+
+    {
+	    yyTimezone = (yyvsp[(1) - (1)].Number);
+	    yyDSTmode = DSTon;
+	;}
+    break;
+
+  case 21:
+
+    {
+	    yyDayOrdinal = 1;
+	    yyDayNumber = (yyvsp[(1) - (1)].Number);
+	;}
+    break;
+
+  case 22:
+
+    {
+	    yyDayOrdinal = 1;
+	    yyDayNumber = (yyvsp[(1) - (2)].Number);
+	;}
+    break;
+
+  case 23:
+
+    {
+	    yyDayOrdinal = (yyvsp[(1) - (2)].Number);
+	    yyDayNumber = (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 24:
+
+    {
+	    yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
+	    yyDayNumber = (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 25:
+
+    {
+	    yyDayOrdinal = 2;
+	    yyDayNumber = (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 26:
+
+    {
+	    yyMonth = (yyvsp[(1) - (3)].Number);
+	    yyDay = (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 27:
+
+    {
+	    yyMonth = (yyvsp[(1) - (5)].Number);
+	    yyDay = (yyvsp[(3) - (5)].Number);
+	    yyYear = (yyvsp[(5) - (5)].Number);
+	;}
+    break;
+
+  case 28:
+
+    {
+	    yyYear = (yyvsp[(1) - (1)].Number) / 10000;
+	    yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
+	    yyDay = (yyvsp[(1) - (1)].Number) % 100;
+	;}
+    break;
+
+  case 29:
+
+    {
+	    yyDay = (yyvsp[(1) - (5)].Number);
+	    yyMonth = (yyvsp[(3) - (5)].Number);
+	    yyYear = (yyvsp[(5) - (5)].Number);
+	;}
+    break;
+
+  case 30:
+
+    {
+	    yyMonth = (yyvsp[(3) - (5)].Number);
+	    yyDay = (yyvsp[(5) - (5)].Number);
+	    yyYear = (yyvsp[(1) - (5)].Number);
+	;}
+    break;
+
+  case 31:
+
+    {
+	    yyMonth = (yyvsp[(1) - (2)].Number);
+	    yyDay = (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 32:
+
+    {
+	    yyMonth = (yyvsp[(1) - (4)].Number);
+	    yyDay = (yyvsp[(2) - (4)].Number);
+	    yyYear = (yyvsp[(4) - (4)].Number);
+	;}
+    break;
+
+  case 33:
+
+    {
+	    yyMonth = (yyvsp[(2) - (2)].Number);
+	    yyDay = (yyvsp[(1) - (2)].Number);
+	;}
+    break;
+
+  case 34:
+
+    {
+	    yyMonth = 1;
+	    yyDay = 1;
+	    yyYear = EPOCH;
+	;}
+    break;
+
+  case 35:
+
+    {
+	    yyMonth = (yyvsp[(2) - (3)].Number);
+	    yyDay = (yyvsp[(1) - (3)].Number);
+	    yyYear = (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 36:
+
+    {
+	    yyMonthOrdinal = 1;
+	    yyMonth = (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 37:
+
+    {
+	    yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
+	    yyMonth = (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 38:
+
+    {
+	    if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
+	    yyYear = (yyvsp[(1) - (3)].Number) / 10000;
+	    yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
+	    yyDay = (yyvsp[(1) - (3)].Number) % 100;
+	    yyHour = (yyvsp[(3) - (3)].Number) / 10000;
+	    yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
+	    yySeconds = (yyvsp[(3) - (3)].Number) % 100;
+	;}
+    break;
+
+  case 39:
+
+    {
+	    if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
+	    yyYear = (yyvsp[(1) - (7)].Number) / 10000;
+	    yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
+	    yyDay = (yyvsp[(1) - (7)].Number) % 100;
+	    yyHour = (yyvsp[(3) - (7)].Number);
+	    yyMinutes = (yyvsp[(5) - (7)].Number);
+	    yySeconds = (yyvsp[(7) - (7)].Number);
+	;}
+    break;
+
+  case 40:
+
+    {
+	    yyYear = (yyvsp[(1) - (2)].Number) / 10000;
+	    yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
+	    yyDay = (yyvsp[(1) - (2)].Number) % 100;
+	    yyHour = (yyvsp[(2) - (2)].Number) / 10000;
+	    yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
+	    yySeconds = (yyvsp[(2) - (2)].Number) % 100;
+	;}
+    break;
+
+  case 41:
+
+    {
+	    /*
+	     * Offset computed year by -377 so that the returned years will be
+	     * in a range accessible with a 32 bit clock seconds value.
+	     */
+
+	    yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
+	    yyDay  = 1;
+	    yyMonth = 1;
+	    yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
+	    yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
+	;}
+    break;
+
+  case 42:
+
+    {
+	    yyRelSeconds *= -1;
+	    yyRelMonth *= -1;
+	    yyRelDay *= -1;
+	;}
+    break;
+
+  case 44:
+
+    {
+	    *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 45:
+
+    {
+	    *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 46:
+
+    {
+	    *yyRelPointer += (yyvsp[(2) - (2)].Number);
+	;}
+    break;
+
+  case 47:
+
+    {
+	    *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
+	;}
+    break;
+
+  case 48:
+
+    {
+	    *yyRelPointer += (yyvsp[(1) - (1)].Number);
+	;}
+    break;
+
+  case 49:
+
+    {
+	    (yyval.Number) = -1;
+	;}
+    break;
+
+  case 50:
+
+    {
+	    (yyval.Number) =  1;
+	;}
+    break;
+
+  case 51:
+
+    {
+	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
+	    yyRelPointer = &yyRelSeconds;
+	;}
+    break;
+
+  case 52:
+
+    {
+	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
+	    yyRelPointer = &yyRelDay;
+	;}
+    break;
+
+  case 53:
+
+    {
+	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
+	    yyRelPointer = &yyRelMonth;
+	;}
+    break;
+
+  case 54:
+
+    {
+	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
+		yyYear = (yyvsp[(1) - (1)].Number);
+	    } else {
+		yyHaveTime++;
+		if (yyDigitCount <= 2) {
+		    yyHour = (yyvsp[(1) - (1)].Number);
+		    yyMinutes = 0;
+		} else {
+		    yyHour = (yyvsp[(1) - (1)].Number) / 100;
+		    yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
+		}
+		yySeconds = 0;
+		yyMeridian = MER24;
+	    }
+	;}
+    break;
+
+  case 55:
+
+    {
+	    (yyval.Meridian) = MER24;
+	;}
+    break;
+
+  case 56:
+
+    {
+	    (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
+	;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+
+      default: break;
     }
-    *TimePtr = DSTcorrect(Start, Julian);
-    return 0;
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+  *++yylsp = yyloc;
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (&yylloc, info, YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (&yylloc, info, yymsg);
+	  }
+	else
+	  {
+	    yyerror (&yylloc, info, YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+  yyerror_range[0] = yylloc;
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval, &yylloc, info);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  yyerror_range[0] = yylsp[1-yylen];
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+      yyerror_range[0] = *yylsp;
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp, yylsp, info);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+  yyerror_range[1] = yylloc;
+  /* Using YYLLOC is tempting, but would change the location of
+     the look-ahead.  YYLOC is available though.  */
+  YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
+  *++yylsp = yyloc;
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (&yylloc, info, YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval, &yylloc, info);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp, yylsp, info);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
 }
 
 
+
+
+MODULE_SCOPE int yychar;
+MODULE_SCOPE YYSTYPE yylval;
+MODULE_SCOPE int yynerrs;
+
 /*
- *-----------------------------------------------------------------------------
- *
- * RelativeDay --
- *
- *      Given a starting time and a number of days before or after, compute the
- *      DST corrected difference between those dates.
- *
- * Results:
- *     1 or -1 indicating success or failure.
- *
- * Side effects:
- *      Fills TimePtr with the computed value.
- *
- *-----------------------------------------------------------------------------
+ * Month and day table.
  */
 
-static int
-RelativeDay(Start, RelDay, TimePtr)
-    time_t Start;
-    time_t RelDay;
-    time_t *TimePtr;
+static const TABLE MonthDayTable[] = {
+    { "january",	tMONTH,	 1 },
+    { "february",	tMONTH,	 2 },
+    { "march",		tMONTH,	 3 },
+    { "april",		tMONTH,	 4 },
+    { "may",		tMONTH,	 5 },
+    { "june",		tMONTH,	 6 },
+    { "july",		tMONTH,	 7 },
+    { "august",		tMONTH,	 8 },
+    { "september",	tMONTH,	 9 },
+    { "sept",		tMONTH,	 9 },
+    { "october",	tMONTH, 10 },
+    { "november",	tMONTH, 11 },
+    { "december",	tMONTH, 12 },
+    { "sunday",		tDAY, 0 },
+    { "monday",		tDAY, 1 },
+    { "tuesday",	tDAY, 2 },
+    { "tues",		tDAY, 2 },
+    { "wednesday",	tDAY, 3 },
+    { "wednes",		tDAY, 3 },
+    { "thursday",	tDAY, 4 },
+    { "thur",		tDAY, 4 },
+    { "thurs",		tDAY, 4 },
+    { "friday",		tDAY, 5 },
+    { "saturday",	tDAY, 6 },
+    { NULL }
+};
+
+/*
+ * Time units table.
+ */
+
+static const TABLE UnitsTable[] = {
+    { "year",		tMONTH_UNIT,	12 },
+    { "month",		tMONTH_UNIT,	 1 },
+    { "fortnight",	tDAY_UNIT,	14 },
+    { "week",		tDAY_UNIT,	 7 },
+    { "day",		tDAY_UNIT,	 1 },
+    { "hour",		tSEC_UNIT, 60 * 60 },
+    { "minute",		tSEC_UNIT,	60 },
+    { "min",		tSEC_UNIT,	60 },
+    { "second",		tSEC_UNIT,	 1 },
+    { "sec",		tSEC_UNIT,	 1 },
+    { NULL }
+};
+
+/*
+ * Assorted relative-time words.
+ */
+
+static const TABLE OtherTable[] = {
+    { "tomorrow",	tDAY_UNIT,	1 },
+    { "yesterday",	tDAY_UNIT,	-1 },
+    { "today",		tDAY_UNIT,	0 },
+    { "now",		tSEC_UNIT,	0 },
+    { "last",		tUNUMBER,	-1 },
+    { "this",		tSEC_UNIT,	0 },
+    { "next",		tNEXT,		1 },
+#if 0
+    { "first",		tUNUMBER,	1 },
+    { "second",		tUNUMBER,	2 },
+    { "third",		tUNUMBER,	3 },
+    { "fourth",		tUNUMBER,	4 },
+    { "fifth",		tUNUMBER,	5 },
+    { "sixth",		tUNUMBER,	6 },
+    { "seventh",	tUNUMBER,	7 },
+    { "eighth",		tUNUMBER,	8 },
+    { "ninth",		tUNUMBER,	9 },
+    { "tenth",		tUNUMBER,	10 },
+    { "eleventh",	tUNUMBER,	11 },
+    { "twelfth",	tUNUMBER,	12 },
+#endif
+    { "ago",		tAGO,		1 },
+    { "epoch",		tEPOCH,		0 },
+    { "stardate",	tSTARDATE,	0 },
+    { NULL }
+};
+
+/*
+ * The timezone table. (Note: This table was modified to not use any floating
+ * point constants to work around an SGI compiler bug).
+ */
+
+static const TABLE TimezoneTable[] = {
+    { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
+    { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
+    { "utc",	tZONE,	   HOUR( 0) },
+    { "uct",	tZONE,	   HOUR( 0) },	    /* Universal Coordinated Time */
+    { "wet",	tZONE,	   HOUR( 0) },	    /* Western European */
+    { "bst",	tDAYZONE,  HOUR( 0) },	    /* British Summer */
+    { "wat",	tZONE,	   HOUR( 1) },	    /* West Africa */
+    { "at",	tZONE,	   HOUR( 2) },	    /* Azores */
+#if	0
+    /* For completeness.  BST is also British Summer, and GST is
+     * also Guam Standard. */
+    { "bst",	tZONE,	   HOUR( 3) },	    /* Brazil Standard */
+    { "gst",	tZONE,	   HOUR( 3) },	    /* Greenland Standard */
+#endif
+    { "nft",	tZONE,	   HOUR( 7/2) },    /* Newfoundland */
+    { "nst",	tZONE,	   HOUR( 7/2) },    /* Newfoundland Standard */
+    { "ndt",	tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
+    { "ast",	tZONE,	   HOUR( 4) },	    /* Atlantic Standard */
+    { "adt",	tDAYZONE,  HOUR( 4) },	    /* Atlantic Daylight */
+    { "est",	tZONE,	   HOUR( 5) },	    /* Eastern Standard */
+    { "edt",	tDAYZONE,  HOUR( 5) },	    /* Eastern Daylight */
+    { "cst",	tZONE,	   HOUR( 6) },	    /* Central Standard */
+    { "cdt",	tDAYZONE,  HOUR( 6) },	    /* Central Daylight */
+    { "mst",	tZONE,	   HOUR( 7) },	    /* Mountain Standard */
+    { "mdt",	tDAYZONE,  HOUR( 7) },	    /* Mountain Daylight */
+    { "pst",	tZONE,	   HOUR( 8) },	    /* Pacific Standard */
+    { "pdt",	tDAYZONE,  HOUR( 8) },	    /* Pacific Daylight */
+    { "yst",	tZONE,	   HOUR( 9) },	    /* Yukon Standard */
+    { "ydt",	tDAYZONE,  HOUR( 9) },	    /* Yukon Daylight */
+    { "hst",	tZONE,	   HOUR(10) },	    /* Hawaii Standard */
+    { "hdt",	tDAYZONE,  HOUR(10) },	    /* Hawaii Daylight */
+    { "cat",	tZONE,	   HOUR(10) },	    /* Central Alaska */
+    { "ahst",	tZONE,	   HOUR(10) },	    /* Alaska-Hawaii Standard */
+    { "nt",	tZONE,	   HOUR(11) },	    /* Nome */
+    { "idlw",	tZONE,	   HOUR(12) },	    /* International Date Line West */
+    { "cet",	tZONE,	  -HOUR( 1) },	    /* Central European */
+    { "cest",	tDAYZONE, -HOUR( 1) },	    /* Central European Summer */
+    { "met",	tZONE,	  -HOUR( 1) },	    /* Middle European */
+    { "mewt",	tZONE,	  -HOUR( 1) },	    /* Middle European Winter */
+    { "mest",	tDAYZONE, -HOUR( 1) },	    /* Middle European Summer */
+    { "swt",	tZONE,	  -HOUR( 1) },	    /* Swedish Winter */
+    { "sst",	tDAYZONE, -HOUR( 1) },	    /* Swedish Summer */
+    { "fwt",	tZONE,	  -HOUR( 1) },	    /* French Winter */
+    { "fst",	tDAYZONE, -HOUR( 1) },	    /* French Summer */
+    { "eet",	tZONE,	  -HOUR( 2) },	    /* Eastern Europe, USSR Zone 1 */
+    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
+    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
+    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
+    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
+    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
+    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
+#if	0
+    /* For completeness.  NST is also Newfoundland Stanard, nad SST is
+     * also Swedish Summer. */
+    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
+    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
+#endif	/* 0 */
+    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
+    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
+    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
+    { "cct",	tZONE,	  -HOUR( 8) },	    /* China Coast, USSR Zone 7 */
+    { "jst",	tZONE,	  -HOUR( 9) },	    /* Japan Standard, USSR Zone 8 */
+    { "jdt",	tDAYZONE, -HOUR( 9) },	    /* Japan Daylight */
+    { "kst",	tZONE,	  -HOUR( 9) },	    /* Korea Standard */
+    { "kdt",	tDAYZONE, -HOUR( 9) },	    /* Korea Daylight */
+    { "cast",	tZONE,	  -HOUR(19/2) },    /* Central Australian Standard */
+    { "cadt",	tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
+    { "east",	tZONE,	  -HOUR(10) },	    /* Eastern Australian Standard */
+    { "eadt",	tDAYZONE, -HOUR(10) },	    /* Eastern Australian Daylight */
+    { "gst",	tZONE,	  -HOUR(10) },	    /* Guam Standard, USSR Zone 9 */
+    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
+    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
+    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
+    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
+    /* ADDED BY Marco Nijdam */
+    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
+    /* End ADDED */
+    {  NULL  }
+};
+
+/*
+ * Military timezone table.
+ */
+
+static const TABLE MilitaryTable[] = {
+    { "a",	tZONE,	-HOUR( 1) },
+    { "b",	tZONE,	-HOUR( 2) },
+    { "c",	tZONE,	-HOUR( 3) },
+    { "d",	tZONE,	-HOUR( 4) },
+    { "e",	tZONE,	-HOUR( 5) },
+    { "f",	tZONE,	-HOUR( 6) },
+    { "g",	tZONE,	-HOUR( 7) },
+    { "h",	tZONE,	-HOUR( 8) },
+    { "i",	tZONE,	-HOUR( 9) },
+    { "k",	tZONE,	-HOUR(10) },
+    { "l",	tZONE,	-HOUR(11) },
+    { "m",	tZONE,	-HOUR(12) },
+    { "n",	tZONE,	HOUR(  1) },
+    { "o",	tZONE,	HOUR(  2) },
+    { "p",	tZONE,	HOUR(  3) },
+    { "q",	tZONE,	HOUR(  4) },
+    { "r",	tZONE,	HOUR(  5) },
+    { "s",	tZONE,	HOUR(  6) },
+    { "t",	tZONE,	HOUR(  7) },
+    { "u",	tZONE,	HOUR(  8) },
+    { "v",	tZONE,	HOUR(  9) },
+    { "w",	tZONE,	HOUR( 10) },
+    { "x",	tZONE,	HOUR( 11) },
+    { "y",	tZONE,	HOUR( 12) },
+    { "z",	tZONE,	HOUR( 0) },
+    { NULL }
+};
+
+/*
+ * Dump error messages in the bit bucket.
+ */
+
+static void
+TclDateerror(
+    YYLTYPE* location,
+    DateInfo* infoPtr,
+    const char *s)
 {
-    time_t new;
+    Tcl_Obj* t;
+    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
+    Tcl_AppendToObj(infoPtr->messages, s, -1);
+    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
+    t = Tcl_NewIntObj(location->first_column);
+    Tcl_IncrRefCount(t);
+    Tcl_AppendObjToObj(infoPtr->messages, t);
+    Tcl_DecrRefCount(t);
+    Tcl_AppendToObj(infoPtr->messages, "-", -1);
+    t = Tcl_NewIntObj(location->last_column);
+    Tcl_IncrRefCount(t);
+    Tcl_AppendObjToObj(infoPtr->messages, t);
+    Tcl_DecrRefCount(t);
+    Tcl_AppendToObj(infoPtr->messages, ")", -1);
+    infoPtr->separatrix = "\n";
+}
 
-    new = Start + (RelDay * 60 * 60 * 24);
-    *TimePtr = DSTcorrect(Start, new);
-    return 1;
+static time_t
+ToSeconds(
+    time_t Hours,
+    time_t Minutes,
+    time_t Seconds,
+    MERIDIAN Meridian)
+{
+    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
+	return -1;
+    }
+    switch (Meridian) {
+    case MER24:
+	if (Hours < 0 || Hours > 23) {
+	    return -1;
+	}
+	return (Hours * 60L + Minutes) * 60L + Seconds;
+    case MERam:
+	if (Hours < 1 || Hours > 12) {
+	    return -1;
+	}
+	return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+    case MERpm:
+	if (Hours < 1 || Hours > 12) {
+	    return -1;
+	}
+	return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
+    }
+    return -1;			/* Should never be reached */
 }
 
 static int
-LookupWord(buff)
-    char                *buff;
+LookupWord(
+    YYSTYPE* yylvalPtr,
+    char *buff)
 {
     register char *p;
     register char *q;
-    register CONST TABLE *tp;
-    int i;
-    int abbrev;
+    register const TABLE *tp;
+    int i, abbrev;
 
     /*
      * Make it lowercase.
@@ -660,1208 +2570,347 @@ LookupWord(buff)
     Tcl_UtfToLower(buff);
 
     if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
-        TclDatelval.Meridian = MERam;
-        return tMERIDIAN;
+	yylvalPtr->Meridian = MERam;
+	return tMERIDIAN;
     }
     if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
-        TclDatelval.Meridian = MERpm;
-        return tMERIDIAN;
+	yylvalPtr->Meridian = MERpm;
+	return tMERIDIAN;
     }
 
     /*
      * See if we have an abbreviation for a month.
      */
+
     if (strlen(buff) == 3) {
-        abbrev = 1;
+	abbrev = 1;
     } else if (strlen(buff) == 4 && buff[3] == '.') {
-        abbrev = 1;
-        buff[3] = '\0';
+	abbrev = 1;
+	buff[3] = '\0';
     } else {
-        abbrev = 0;
+	abbrev = 0;
     }
 
     for (tp = MonthDayTable; tp->name; tp++) {
-        if (abbrev) {
-            if (strncmp(buff, tp->name, 3) == 0) {
-                TclDatelval.Number = tp->value;
-                return tp->type;
-            }
-        } else if (strcmp(buff, tp->name) == 0) {
-            TclDatelval.Number = tp->value;
-            return tp->type;
-        }
+	if (abbrev) {
+	    if (strncmp(buff, tp->name, 3) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
+	} else if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     for (tp = TimezoneTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            TclDatelval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     for (tp = UnitsTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            TclDatelval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     /*
      * Strip off any plural and try the units table again.
      */
+
     i = strlen(buff) - 1;
-    if (buff[i] == 's') {
-        buff[i] = '\0';
-        for (tp = UnitsTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                TclDatelval.Number = tp->value;
-                return tp->type;
-            }
+    if (i > 0 && buff[i] == 's') {
+	buff[i] = '\0';
+	for (tp = UnitsTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
 
     for (tp = OtherTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            TclDatelval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     /*
      * Military timezones.
      */
+
     if (buff[1] == '\0' && !(*buff & 0x80)
-	    && isalpha(UCHAR(*buff))) {	/* INTL: ISO only */
-        for (tp = MilitaryTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                TclDatelval.Number = tp->value;
-                return tp->type;
-            }
+	    && isalpha(UCHAR(*buff))) {			/* INTL: ISO only */
+	for (tp = MilitaryTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
 
     /*
      * Drop out any periods and try the timezone table again.
      */
-    for (i = 0, p = q = buff; *q; q++)
-        if (*q != '.') {
-            *p++ = *q;
-        } else {
-            i++;
+
+    for (i = 0, p = q = buff; *q; q++) {
+	if (*q != '.') {
+	    *p++ = *q;
+	} else {
+	    i++;
 	}
+    }
     *p = '\0';
     if (i) {
-        for (tp = TimezoneTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                TclDatelval.Number = tp->value;
-                return tp->type;
-            }
+	for (tp = TimezoneTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
-    
+
     return tID;
 }
 
-
 static int
-TclDatelex()
+TclDatelex(
+    YYSTYPE* yylvalPtr,
+    YYLTYPE* location,
+    DateInfo *info)
 {
-    register char       c;
-    register char       *p;
-    char                buff[20];
-    int                 Count;
+    register char c;
+    register char *p;
+    char buff[20];
+    int Count;
 
+    location->first_column = yyInput - info->dateStart;
     for ( ; ; ) {
-        while (isspace(UCHAR(*TclDateInput))) {
-            TclDateInput++;
+	while (isspace(UCHAR(*yyInput))) {
+	    yyInput++;
 	}
 
-        if (isdigit(UCHAR(c = *TclDateInput))) { /* INTL: digit */
-	    /* convert the string into a number; count the number of digits */
+	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+	    /*
+	     * Convert the string into a number; count the number of digits.
+	     */
+
 	    Count = 0;
-            for (TclDatelval.Number = 0;
-		    isdigit(UCHAR(c = *TclDateInput++)); ) { /* INTL: digit */
-                TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
+	    for (yylvalPtr->Number = 0;
+		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
+		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
 		Count++;
 	    }
-            TclDateInput--;
-	    /* A number with 6 or more digits is considered an ISO 8601 base */
+	    yyInput--;
+	    yyDigitCount = Count;
+
+	    /*
+	     * A number with 6 or more digits is considered an ISO 8601 base.
+	     */
+
 	    if (Count >= 6) {
+		location->last_column = yyInput - info->dateStart - 1;
 		return tISOBASE;
 	    } else {
+		location->last_column = yyInput - info->dateStart - 1;
 		return tUNUMBER;
 	    }
-        }
-        if (!(c & 0x80) && isalpha(UCHAR(c))) {	/* INTL: ISO only. */
-            for (p = buff; isalpha(UCHAR(c = *TclDateInput++)) /* INTL: ISO only. */
+	}
+	if (!(c & 0x80) && isalpha(UCHAR(c))) {		  /* INTL: ISO only. */
+	    for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
 		     || c == '.'; ) {
-                if (p < &buff[sizeof buff - 1]) {
-                    *p++ = c;
+		if (p < &buff[sizeof buff - 1]) {
+		    *p++ = c;
 		}
 	    }
-            *p = '\0';
-            TclDateInput--;
-            return LookupWord(buff);
-        }
-        if (c != '(') {
-            return *TclDateInput++;
+	    *p = '\0';
+	    yyInput--;
+	    location->last_column = yyInput - info->dateStart - 1;
+	    return LookupWord(yylvalPtr, buff);
+	}
+	if (c != '(') {
+	    location->last_column = yyInput - info->dateStart;
+	    return *yyInput++;
 	}
-        Count = 0;
-        do {
-            c = *TclDateInput++;
-            if (c == '\0') {
-                return c;
+	Count = 0;
+	do {
+	    c = *yyInput++;
+	    if (c == '\0') {
+		location->last_column = yyInput - info->dateStart - 1;
+		return c;
 	    } else if (c == '(') {
-                Count++;
+		Count++;
 	    } else if (c == ')') {
-                Count--;
+		Count--;
 	    }
-        } while (Count > 0);
+	} while (Count > 0);
     }
 }
 
-/*
- * Specify zone is of -50000 to force GMT.  (This allows BST to work).
- */
-
 int
-TclGetDate(p, now, zone, timePtr)
-    char *p;
-    Tcl_WideInt now;
-    long zone;
-    Tcl_WideInt *timePtr;
+TclClockOldscanObjCmd(
+    ClientData clientData,	/* Unused */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Count of paraneters */
+    Tcl_Obj *CONST *objv)	/* Parameters */
 {
-    struct tm *tm;
-    time_t Start;
-    time_t Time;
-    time_t tod;
-    int thisyear;
-
-    TclDateInput = p;
-    /* now has to be cast to a time_t for 64bit compliance */
-    Start = (time_t) now;
-    tm = TclpGetDate((TclpTime_t) &Start, (zone == -50000));
-    thisyear = tm->tm_year + TM_YEAR_BASE;
-    TclDateYear = thisyear;
-    TclDateMonth = tm->tm_mon + 1;
-    TclDateDay = tm->tm_mday;
-    TclDateTimezone = zone;
-    if (zone == -50000) {
-        TclDateDSTmode = DSToff;  /* assume GMT */
-        TclDateTimezone = 0;
-    } else {
-        TclDateDSTmode = DSTmaybe;
+    Tcl_Obj *result, *resultElement;
+    int yr, mo, da;
+    DateInfo dateInfo;
+    DateInfo* info = &dateInfo;
+    int status;
+
+    if (objc != 5) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"stringToParse baseYear baseMonth baseDay" );
+	return TCL_ERROR;
     }
-    TclDateHour = 0;
-    TclDateMinutes = 0;
-    TclDateSeconds = 0;
-    TclDateMeridian = MER24;
-    TclDateRelSeconds = 0;
-    TclDateRelMonth = 0;
-    TclDateRelDay = 0;
-    TclDateRelPointer = NULL;
-
-    TclDateHaveDate = 0;
-    TclDateHaveDay = 0;
-    TclDateHaveOrdinalMonth = 0;
-    TclDateHaveRel = 0;
-    TclDateHaveTime = 0;
-    TclDateHaveZone = 0;
-
-    if (TclDateparse() || TclDateHaveTime > 1 || TclDateHaveZone > 1 || TclDateHaveDate > 1 ||
-	    TclDateHaveDay > 1 || TclDateHaveOrdinalMonth > 1) {
-        return -1;
+
+    yyInput = Tcl_GetString( objv[1] );
+    dateInfo.dateStart = yyInput;
+
+    yyHaveDate = 0;
+    if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
+	return TCL_ERROR;
     }
-    
-    if (TclDateHaveDate || TclDateHaveTime || TclDateHaveDay) {
-	if (TclDateYear < 0) {
-	    TclDateYear = -TclDateYear;
-	}
-	/*
-	 * The following line handles years that are specified using
-	 * only two digits.  The line of code below implements a policy
-	 * defined by the X/Open workgroup on the millinium rollover.
-	 * Note: some of those dates may not actually be valid on some
-	 * platforms.  The POSIX standard startes that the dates 70-99
-	 * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
-	 * This later definition should work on all platforms.
-	 */
-
-	if (TclDateYear < 100) {
-	    if (TclDateYear >= 69) {
-		TclDateYear += 1900;
-	    } else {
-		TclDateYear += 2000;
-	    }
-	}
-	if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds,
-		TclDateMeridian, TclDateDSTmode, &Start) < 0) {
-            return -1;
-	}
-    } else {
-        Start = (time_t) now;
-        if (!TclDateHaveRel) {
-            Start -= ((tm->tm_hour * 60L * 60L) +
-		    tm->tm_min * 60L) +	tm->tm_sec;
-	}
+    yyYear = yr; yyMonth = mo; yyDay = da;
+
+    yyHaveTime = 0;
+    yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
+
+    yyHaveZone = 0;
+    yyTimezone = 0; yyDSTmode = DSTmaybe;
+
+    yyHaveOrdinalMonth = 0;
+    yyMonthOrdinal = 0;
+
+    yyHaveDay = 0;
+    yyDayOrdinal = 0; yyDayNumber = 0;
+
+    yyHaveRel = 0;
+    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+
+    dateInfo.messages = Tcl_NewObj();
+    dateInfo.separatrix = "";
+    Tcl_IncrRefCount(dateInfo.messages);
+
+    status = yyparse(&dateInfo);
+    if (status == 1) {
+	Tcl_SetObjResult(interp, dateInfo.messages);
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
+    } else if (status == 2) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
+    } else if (status != 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
+						  "from date parser. Please "
+						  "report this error as a "
+						  "bug in Tcl.", -1));
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
     }
+    Tcl_DecrRefCount(dateInfo.messages);
 
-    Start += TclDateRelSeconds;
-    if (RelativeMonth(Start, TclDateRelMonth, &Time) < 0) {
-        return -1;
+    if (yyHaveDate > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one date in string", -1));
+	return TCL_ERROR;
     }
-    Start += Time;
-
-    if (RelativeDay(Start, TclDateRelDay, &Time) < 0) {
-	return -1;
+    if (yyHaveTime > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one time of day in string", -1));
+	return TCL_ERROR;
     }
-    Start += Time;
-    
-    if (TclDateHaveDay && !TclDateHaveDate) {
-        tod = NamedDay(Start, TclDateDayOrdinal, TclDateDayNumber);
-        Start += tod;
+    if (yyHaveZone > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one time zone in string", -1));
+	return TCL_ERROR;
     }
-
-    if (TclDateHaveOrdinalMonth) {
-	tod = NamedMonth(Start, TclDateMonthOrdinal, TclDateMonth);
-	Start += tod;
+    if (yyHaveDay > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one weekday in string", -1));
+	return TCL_ERROR;
+    }
+    if (yyHaveOrdinalMonth > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one ordinal month in string", -1));
+	return TCL_ERROR;
     }
-    
-    *timePtr = Start;
-    return 0;
-}
-static CONST TclDatetabelem TclDateexca[] ={
--1, 1,
-	0, -1,
-	-2, 0,
-	};
-# define YYNPROD 56
-# define YYLAST 261
-static CONST TclDatetabelem TclDateact[]={
-
-    24,    40,    23,    36,    54,    81,    41,    28,    53,    26,
-    37,    42,    58,    38,    56,    28,    27,    26,    28,    33,
-    26,    32,    61,    50,    27,    80,    76,    27,    51,    75,
-    74,    73,    30,    72,    71,    70,    69,    52,    49,    48,
-    47,    45,    39,    62,    78,    46,    79,    68,    25,    65,
-    60,    67,    66,    55,    44,    21,    63,    11,    10,     9,
-     8,    35,     7,     6,     5,     4,     3,    43,     2,     1,
-    20,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,    57,     0,     0,    59,    77,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-     0,     0,     0,     0,     0,    19,    14,     0,     0,     0,
-    16,    28,    22,    26,     0,    12,    13,    17,     0,    15,
-    27,    18,    31,     0,     0,    29,     0,    34,    28,     0,
-    26,     0,     0,     0,     0,     0,     0,    27,     0,     0,
-     0,     0,     0,     0,     0,     0,     0,     0,     0,    64,
-    64 };
-static CONST TclDatetabelem TclDatepact[]={
-
--10000000,   -43,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
--10000000,-10000000,   -26,  -268,-10000000,  -259,  -226,-10000000,  -257,    10,
-  -227,  -212,  -228,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
-  -229,-10000000,  -230,  -240,  -231,-10000000,-10000000,  -264,-10000000,     9,
--10000000,-10000000,  -249,-10000000,-10000000,  -246,-10000000,     4,    -2,     2,
-     7,     6,-10000000,-10000000,   -11,  -232,-10000000,-10000000,-10000000,-10000000,
-  -233,-10000000,  -234,  -235,-10000000,  -237,  -238,  -239,  -242,-10000000,
--10000000,-10000000,    -1,-10000000,-10000000,-10000000,   -12,-10000000,  -243,  -263,
--10000000,-10000000 };
-static CONST TclDatetabelem TclDatepgo[]={
-
-     0,    48,    70,    22,    69,    68,    66,    65,    64,    63,
-    62,    60,    59,    58,    57,    55 };
-static CONST TclDatetabelem TclDater1[]={
-
-     0,     4,     4,     5,     5,     5,     5,     5,     5,     5,
-     5,     5,     6,     6,     6,     6,     6,     7,     7,     7,
-    10,    10,    10,    10,    10,     8,     8,     8,     8,     8,
-     8,     8,     8,     8,     8,     9,     9,    12,    12,    12,
-    13,    11,    11,    15,    15,    15,    15,    15,     2,     2,
-     1,     1,     1,    14,     3,     3 };
-static CONST TclDatetabelem TclDater2[]={
-
-     0,     0,     4,     3,     3,     3,     3,     3,     3,     3,
-     3,     2,     5,     9,    11,    13,    15,     5,     3,     3,
-     3,     5,     5,     7,     5,     7,    11,     3,    11,    11,
-     5,     9,     5,     3,     7,     5,     7,     7,    15,     5,
-     9,     5,     2,     7,     5,     5,     7,     3,     3,     3,
-     3,     3,     3,     3,     1,     3 };
-static CONST TclDatetabelem TclDatechk[]={
-
--10000000,    -4,    -5,    -6,    -7,    -8,    -9,   -10,   -11,   -12,
-   -13,   -14,   268,   269,   259,   272,   263,   270,   274,   258,
-    -2,   -15,   265,    45,    43,    -1,   266,   273,   264,   261,
-    58,   258,    47,    45,   263,    -1,   271,   269,   272,   268,
-   258,   263,   268,    -1,    44,   268,   257,   268,   268,   268,
-   263,   268,   268,   272,   268,    44,   263,    -1,   258,    -1,
-    46,    -3,    45,    58,   261,    47,    45,    45,    58,   268,
-   268,   268,   268,   268,   268,   268,   268,    -3,    45,    58,
-   268,   268 };
-static CONST TclDatetabelem TclDatedef[]={
-
-     1,    -2,     2,     3,     4,     5,     6,     7,     8,     9,
-    10,    11,    53,    18,    19,    27,     0,    33,     0,    20,
-     0,    42,     0,    48,    49,    47,    50,    51,    52,    12,
-     0,    22,     0,     0,    32,    44,    17,     0,    39,    30,
-    24,    35,     0,    45,    21,     0,    41,     0,    54,    25,
-     0,     0,    34,    37,     0,     0,    36,    46,    23,    43,
-     0,    13,     0,     0,    55,     0,     0,     0,     0,    31,
-    40,    14,    54,    26,    28,    29,     0,    15,     0,     0,
-    16,    38 };
-typedef struct
-#ifdef __cplusplus
-	TclDatetoktype
-#endif
-{ char *t_name; int t_val; } TclDatetoktype;
-#ifndef YYDEBUG
-#	define YYDEBUG	0	/* don't allow debugging */
-#endif
-
-#if YYDEBUG
-
-TclDatetoktype TclDatetoks[] =
-{
-	"tAGO",	257,
-	"tDAY",	258,
-	"tDAYZONE",	259,
-	"tID",	260,
-	"tMERIDIAN",	261,
-	"tMINUTE_UNIT",	262,
-	"tMONTH",	263,
-	"tMONTH_UNIT",	264,
-	"tSTARDATE",	265,
-	"tSEC_UNIT",	266,
-	"tSNUMBER",	267,
-	"tUNUMBER",	268,
-	"tZONE",	269,
-	"tEPOCH",	270,
-	"tDST",	271,
-	"tISOBASE",	272,
-	"tDAY_UNIT",	273,
-	"tNEXT",	274,
-	"-unknown-",	-1	/* ends search */
-};
-
-char * TclDatereds[] =
-{
-	"-no such reduction-",
-	"spec : /* empty */",
-	"spec : spec item",
-	"item : time",
-	"item : zone",
-	"item : date",
-	"item : ordMonth",
-	"item : day",
-	"item : relspec",
-	"item : iso",
-	"item : trek",
-	"item : number",
-	"time : tUNUMBER tMERIDIAN",
-	"time : tUNUMBER ':' tUNUMBER o_merid",
-	"time : tUNUMBER ':' tUNUMBER '-' tUNUMBER",
-	"time : tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid",
-	"time : tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER",
-	"zone : tZONE tDST",
-	"zone : tZONE",
-	"zone : tDAYZONE",
-	"day : tDAY",
-	"day : tDAY ','",
-	"day : tUNUMBER tDAY",
-	"day : sign tUNUMBER tDAY",
-	"day : tNEXT tDAY",
-	"date : tUNUMBER '/' tUNUMBER",
-	"date : tUNUMBER '/' tUNUMBER '/' tUNUMBER",
-	"date : tISOBASE",
-	"date : tUNUMBER '-' tMONTH '-' tUNUMBER",
-	"date : tUNUMBER '-' tUNUMBER '-' tUNUMBER",
-	"date : tMONTH tUNUMBER",
-	"date : tMONTH tUNUMBER ',' tUNUMBER",
-	"date : tUNUMBER tMONTH",
-	"date : tEPOCH",
-	"date : tUNUMBER tMONTH tUNUMBER",
-	"ordMonth : tNEXT tMONTH",
-	"ordMonth : tNEXT tUNUMBER tMONTH",
-	"iso : tISOBASE tZONE tISOBASE",
-	"iso : tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER",
-	"iso : tISOBASE tISOBASE",
-	"trek : tSTARDATE tUNUMBER '.' tUNUMBER",
-	"relspec : relunits tAGO",
-	"relspec : relunits",
-	"relunits : sign tUNUMBER unit",
-	"relunits : tUNUMBER unit",
-	"relunits : tNEXT unit",
-	"relunits : tNEXT tUNUMBER unit",
-	"relunits : unit",
-	"sign : '-'",
-	"sign : '+'",
-	"unit : tSEC_UNIT",
-	"unit : tDAY_UNIT",
-	"unit : tMONTH_UNIT",
-	"number : tUNUMBER",
-	"o_merid : /* empty */",
-	"o_merid : tMERIDIAN",
-};
-#endif /* YYDEBUG */
-/*
- * Copyright (c) 1993 by Sun Microsystems, Inc.
- */
-
-
-/*
-** Skeleton parser driver for yacc output
-*/
-
-/*
-** yacc user known macros and defines
-*/
-#define YYERROR		goto TclDateerrlab
-#define YYACCEPT	return(0)
-#define YYABORT		return(1)
-#define YYBACKUP( newtoken, newvalue )\
-{\
-	if ( TclDatechar >= 0 || ( TclDater2[ TclDatetmp ] >> 1 ) != 1 )\
-	{\
-		TclDateerror( "syntax error - cannot backup" );\
-		goto TclDateerrlab;\
-	}\
-	TclDatechar = newtoken;\
-	TclDatestate = *TclDateps;\
-	TclDatelval = newvalue;\
-	goto TclDatenewstate;\
-}
-#define YYRECOVERING()	(!!TclDateerrflag)
-#define YYNEW(type)	malloc(sizeof(type) * TclDatenewmax)
-#define YYCOPY(to, from, type) \
-	(type *) memcpy(to, (char *) from, TclDatemaxdepth * sizeof (type))
-#define YYENLARGE( from, type) \
-	(type *) realloc((char *) from, TclDatenewmax * sizeof(type))
-#ifndef YYDEBUG
-#	define YYDEBUG	1	/* make debugging available */
-#endif
-
-/*
-** user known globals
-*/
-int TclDatedebug;			/* set to 1 to get debugging */
-
-/*
-** driver internal defines
-*/
-#define YYFLAG		(-10000000)
-
-/*
-** global variables used by the parser
-*/
-YYSTYPE *TclDatepv;			/* top of value stack */
-int *TclDateps;			/* top of state stack */
-
-int TclDatestate;			/* current state */
-int TclDatetmp;			/* extra var (lasts between blocks) */
 
-int TclDatenerrs;			/* number of errors */
-int TclDateerrflag;			/* error recovery flag */
-int TclDatechar;			/* current input token number */
+    result = Tcl_NewObj();
+    resultElement = Tcl_NewObj();
+    if (yyHaveDate) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyYear));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonth));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDay));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
 
+    if (yyHaveTime) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
+		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
+    } else {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
+    }
 
+    resultElement = Tcl_NewObj();
+    if (yyHaveZone) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) -yyTimezone));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj(1 - yyDSTmode));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    resultElement = Tcl_NewObj();
+    if (yyHaveRel) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelMonth));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelDay));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelSeconds));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    resultElement = Tcl_NewObj();
+    if (yyHaveDay && !yyHaveDate) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDayOrdinal));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDayNumber));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    resultElement = Tcl_NewObj();
+    if (yyHaveOrdinalMonth) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonthOrdinal));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonth));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
 
-#ifdef YYNMBCHARS
-#define YYLEX()		TclDatecvtok(TclDatelex())
-/*
-** TclDatecvtok - return a token if i is a wchar_t value that exceeds 255.
-**	If i<255, i itself is the token.  If i>255 but the neither 
-**	of the 30th or 31st bit is on, i is already a token.
-*/
-#if defined(__STDC__) || defined(__cplusplus)
-int TclDatecvtok(int i)
-#else
-int TclDatecvtok(i) int i;
-#endif
-{
-	int first = 0;
-	int last = YYNMBCHARS - 1;
-	int mid;
-	wchar_t j;
-
-	if(i&0x60000000){/*Must convert to a token. */
-		if( TclDatembchars[last].character < i ){
-			return i;/*Giving up*/
-		}
-		while ((last>=first)&&(first>=0)) {/*Binary search loop*/
-			mid = (first+last)/2;
-			j = TclDatembchars[mid].character;
-			if( j==i ){/*Found*/ 
-				return TclDatembchars[mid].tvalue;
-			}else if( j<i ){
-				first = mid + 1;
-			}else{
-				last = mid -1;
-			}
-		}
-		/*No entry in the table.*/
-		return i;/* Giving up.*/
-	}else{/* i is already a token. */
-		return i;
-	}
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
 }
-#else/*!YYNMBCHARS*/
-#define YYLEX()		TclDatelex()
-#endif/*!YYNMBCHARS*/
-
+
 /*
-** TclDateparse - return 0 if worked, 1 if syntax error not recovered from
-*/
-#if defined(__STDC__) || defined(__cplusplus)
-int TclDateparse(void)
-#else
-int TclDateparse()
-#endif
-{
-	register YYSTYPE *TclDatepvt = 0;	/* top of value stack for $vars */
-
-#if defined(__cplusplus) || defined(lint)
-/*
-	hacks to please C++ and lint - goto's inside
-	switch should never be executed
-*/
-	static int __yaccpar_lint_hack__ = 0;
-	switch (__yaccpar_lint_hack__)
-	{
-		case 1: goto TclDateerrlab;
-		case 2: goto TclDatenewstate;
-	}
-#endif
-
-	/*
-	** Initialize externals - TclDateparse may be called more than once
-	*/
-	TclDatepv = &TclDatev[-1];
-	TclDateps = &TclDates[-1];
-	TclDatestate = 0;
-	TclDatetmp = 0;
-	TclDatenerrs = 0;
-	TclDateerrflag = 0;
-	TclDatechar = -1;
-
-#if YYMAXDEPTH <= 0
-	if (TclDatemaxdepth <= 0)
-	{
-		if ((TclDatemaxdepth = YYEXPAND(0)) <= 0)
-		{
-			TclDateerror("yacc initialization error");
-			YYABORT;
-		}
-	}
-#endif
-
-	{
-		register YYSTYPE *TclDate_pv;	/* top of value stack */
-		register int *TclDate_ps;		/* top of state stack */
-		register int TclDate_state;		/* current state */
-		register int  TclDate_n;		/* internal state number info */
-	goto TclDatestack;	/* moved from 6 lines above to here to please C++ */
-
-		/*
-		** get globals into registers.
-		** branch to here only if YYBACKUP was called.
-		*/
-		TclDate_pv = TclDatepv;
-		TclDate_ps = TclDateps;
-		TclDate_state = TclDatestate;
-		goto TclDate_newstate;
-
-		/*
-		** get globals into registers.
-		** either we just started, or we just finished a reduction
-		*/
-	TclDatestack:
-		TclDate_pv = TclDatepv;
-		TclDate_ps = TclDateps;
-		TclDate_state = TclDatestate;
-
-		/*
-		** top of for (;;) loop while no reductions done
-		*/
-	TclDate_stack:
-		/*
-		** put a state and value onto the stacks
-		*/
-#if YYDEBUG
-		/*
-		** if debugging, look up token value in list of value vs.
-		** name pairs.  0 and negative (-1) are special values.
-		** Note: linear search is used since time is not a real
-		** consideration while debugging.
-		*/
-		if ( TclDatedebug )
-		{
-			register int TclDate_i;
-
-			printf( "State %d, token ", TclDate_state );
-			if ( TclDatechar == 0 )
-				printf( "end-of-file\n" );
-			else if ( TclDatechar < 0 )
-				printf( "-none-\n" );
-			else
-			{
-				for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
-					TclDate_i++ )
-				{
-					if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
-						break;
-				}
-				printf( "%s\n", TclDatetoks[TclDate_i].t_name );
-			}
-		}
-#endif /* YYDEBUG */
-		if ( ++TclDate_ps >= &TclDates[ TclDatemaxdepth ] )	/* room on stack? */
-		{
-			/*
-			** reallocate and recover.  Note that pointers
-			** have to be reset, or bad things will happen
-			*/
-			long TclDateps_index = (TclDate_ps - TclDates);
-			long TclDatepv_index = (TclDate_pv - TclDatev);
-			long TclDatepvt_index = (TclDatepvt - TclDatev);
-			int TclDatenewmax;
-#ifdef YYEXPAND
-			TclDatenewmax = YYEXPAND(TclDatemaxdepth);
-#else
-			TclDatenewmax = 2 * TclDatemaxdepth;	/* double table size */
-			if (TclDatemaxdepth == YYMAXDEPTH)	/* first time growth */
-			{
-				char *newTclDates = (char *)YYNEW(int);
-				char *newTclDatev = (char *)YYNEW(YYSTYPE);
-				if (newTclDates != 0 && newTclDatev != 0)
-				{
-					TclDates = YYCOPY(newTclDates, TclDates, int);
-					TclDatev = YYCOPY(newTclDatev, TclDatev, YYSTYPE);
-				}
-				else
-					TclDatenewmax = 0;	/* failed */
-			}
-			else				/* not first time */
-			{
-				TclDates = YYENLARGE(TclDates, int);
-				TclDatev = YYENLARGE(TclDatev, YYSTYPE);
-				if (TclDates == 0 || TclDatev == 0)
-					TclDatenewmax = 0;	/* failed */
-			}
-#endif
-			if (TclDatenewmax <= TclDatemaxdepth)	/* tables not expanded */
-			{
-				TclDateerror( "yacc stack overflow" );
-				YYABORT;
-			}
-			TclDatemaxdepth = TclDatenewmax;
-
-			TclDate_ps = TclDates + TclDateps_index;
-			TclDate_pv = TclDatev + TclDatepv_index;
-			TclDatepvt = TclDatev + TclDatepvt_index;
-		}
-		*TclDate_ps = TclDate_state;
-		*++TclDate_pv = TclDateval;
-
-		/*
-		** we have a new state - find out what to do
-		*/
-	TclDate_newstate:
-		if ( ( TclDate_n = TclDatepact[ TclDate_state ] ) <= YYFLAG )
-			goto TclDatedefault;		/* simple state */
-#if YYDEBUG
-		/*
-		** if debugging, need to mark whether new token grabbed
-		*/
-		TclDatetmp = TclDatechar < 0;
-#endif
-		if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
-			TclDatechar = 0;		/* reached EOF */
-#if YYDEBUG
-		if ( TclDatedebug && TclDatetmp )
-		{
-			register int TclDate_i;
-
-			printf( "Received token " );
-			if ( TclDatechar == 0 )
-				printf( "end-of-file\n" );
-			else if ( TclDatechar < 0 )
-				printf( "-none-\n" );
-			else
-			{
-				for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
-					TclDate_i++ )
-				{
-					if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
-						break;
-				}
-				printf( "%s\n", TclDatetoks[TclDate_i].t_name );
-			}
-		}
-#endif /* YYDEBUG */
-		if ( ( ( TclDate_n += TclDatechar ) < 0 ) || ( TclDate_n >= YYLAST ) )
-			goto TclDatedefault;
-		if ( TclDatechk[ TclDate_n = TclDateact[ TclDate_n ] ] == TclDatechar )	/*valid shift*/
-		{
-			TclDatechar = -1;
-			TclDateval = TclDatelval;
-			TclDate_state = TclDate_n;
-			if ( TclDateerrflag > 0 )
-				TclDateerrflag--;
-			goto TclDate_stack;
-		}
-
-	TclDatedefault:
-		if ( ( TclDate_n = TclDatedef[ TclDate_state ] ) == -2 )
-		{
-#if YYDEBUG
-			TclDatetmp = TclDatechar < 0;
-#endif
-			if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
-				TclDatechar = 0;		/* reached EOF */
-#if YYDEBUG
-			if ( TclDatedebug && TclDatetmp )
-			{
-				register int TclDate_i;
-
-				printf( "Received token " );
-				if ( TclDatechar == 0 )
-					printf( "end-of-file\n" );
-				else if ( TclDatechar < 0 )
-					printf( "-none-\n" );
-				else
-				{
-					for ( TclDate_i = 0;
-						TclDatetoks[TclDate_i].t_val >= 0;
-						TclDate_i++ )
-					{
-						if ( TclDatetoks[TclDate_i].t_val
-							== TclDatechar )
-						{
-							break;
-						}
-					}
-					printf( "%s\n", TclDatetoks[TclDate_i].t_name );
-				}
-			}
-#endif /* YYDEBUG */
-			/*
-			** look through exception table
-			*/
-			{
-				register CONST int *TclDatexi = TclDateexca;
-
-				while ( ( *TclDatexi != -1 ) ||
-					( TclDatexi[1] != TclDate_state ) )
-				{
-					TclDatexi += 2;
-				}
-				while ( ( *(TclDatexi += 2) >= 0 ) &&
-					( *TclDatexi != TclDatechar ) )
-					;
-				if ( ( TclDate_n = TclDatexi[1] ) < 0 )
-					YYACCEPT;
-			}
-		}
-
-		/*
-		** check for syntax error
-		*/
-		if ( TclDate_n == 0 )	/* have an error */
-		{
-			/* no worry about speed here! */
-			switch ( TclDateerrflag )
-			{
-			case 0:		/* new error */
-				TclDateerror( "syntax error" );
-				goto skip_init;
-				/*
-				** get globals into registers.
-				** we have a user generated syntax type error
-				*/
-				TclDate_pv = TclDatepv;
-				TclDate_ps = TclDateps;
-				TclDate_state = TclDatestate;
-			skip_init:
-				TclDatenerrs++;
-				/* FALLTHRU */
-			case 1:
-			case 2:		/* incompletely recovered error */
-					/* try again... */
-				TclDateerrflag = 3;
-				/*
-				** find state where "error" is a legal
-				** shift action
-				*/
-				while ( TclDate_ps >= TclDates )
-				{
-					TclDate_n = TclDatepact[ *TclDate_ps ] + YYERRCODE;
-					if ( TclDate_n >= 0 && TclDate_n < YYLAST &&
-						TclDatechk[TclDateact[TclDate_n]] == YYERRCODE)					{
-						/*
-						** simulate shift of "error"
-						*/
-						TclDate_state = TclDateact[ TclDate_n ];
-						goto TclDate_stack;
-					}
-					/*
-					** current state has no shift on
-					** "error", pop stack
-					*/
-#if YYDEBUG
-#	define _POP_ "Error recovery pops state %d, uncovers state %d\n"
-					if ( TclDatedebug )
-						printf( _POP_, *TclDate_ps,
-							TclDate_ps[-1] );
-#	undef _POP_
-#endif
-					TclDate_ps--;
-					TclDate_pv--;
-				}
-				/*
-				** there is no state on stack with "error" as
-				** a valid shift.  give up.
-				*/
-				YYABORT;
-			case 3:		/* no shift yet; eat a token */
-#if YYDEBUG
-				/*
-				** if debugging, look up token in list of
-				** pairs.  0 and negative shouldn't occur,
-				** but since timing doesn't matter when
-				** debugging, it doesn't hurt to leave the
-				** tests here.
-				*/
-				if ( TclDatedebug )
-				{
-					register int TclDate_i;
-
-					printf( "Error recovery discards " );
-					if ( TclDatechar == 0 )
-						printf( "token end-of-file\n" );
-					else if ( TclDatechar < 0 )
-						printf( "token -none-\n" );
-					else
-					{
-						for ( TclDate_i = 0;
-							TclDatetoks[TclDate_i].t_val >= 0;
-							TclDate_i++ )
-						{
-							if ( TclDatetoks[TclDate_i].t_val
-								== TclDatechar )
-							{
-								break;
-							}
-						}
-						printf( "token %s\n",
-							TclDatetoks[TclDate_i].t_name );
-					}
-				}
-#endif /* YYDEBUG */
-				if ( TclDatechar == 0 )	/* reached EOF. quit */
-					YYABORT;
-				TclDatechar = -1;
-				goto TclDate_newstate;
-			}
-		}/* end if ( TclDate_n == 0 ) */
-		/*
-		** reduction by production TclDate_n
-		** put stack tops, etc. so things right after switch
-		*/
-#if YYDEBUG
-		/*
-		** if debugging, print the string that is the user's
-		** specification of the reduction which is just about
-		** to be done.
-		*/
-		if ( TclDatedebug )
-			printf( "Reduce by (%d) \"%s\"\n",
-				TclDate_n, TclDatereds[ TclDate_n ] );
-#endif
-		TclDatetmp = TclDate_n;			/* value to switch over */
-		TclDatepvt = TclDate_pv;			/* $vars top of value stack */
-		/*
-		** Look in goto table for next state
-		** Sorry about using TclDate_state here as temporary
-		** register variable, but why not, if it works...
-		** If TclDater2[ TclDate_n ] doesn't have the low order bit
-		** set, then there is no action to be done for
-		** this reduction.  So, no saving & unsaving of
-		** registers done.  The only difference between the
-		** code just after the if and the body of the if is
-		** the goto TclDate_stack in the body.  This way the test
-		** can be made before the choice of what to do is needed.
-		*/
-		{
-			/* length of production doubled with extra bit */
-			register int TclDate_len = TclDater2[ TclDate_n ];
-
-			if ( !( TclDate_len & 01 ) )
-			{
-				TclDate_len >>= 1;
-				TclDateval = ( TclDate_pv -= TclDate_len )[1];	/* $$ = $1 */
-				TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
-					*( TclDate_ps -= TclDate_len ) + 1;
-				if ( TclDate_state >= YYLAST ||
-					TclDatechk[ TclDate_state =
-					TclDateact[ TclDate_state ] ] != -TclDate_n )
-				{
-					TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
-				}
-				goto TclDate_stack;
-			}
-			TclDate_len >>= 1;
-			TclDateval = ( TclDate_pv -= TclDate_len )[1];	/* $$ = $1 */
-			TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
-				*( TclDate_ps -= TclDate_len ) + 1;
-			if ( TclDate_state >= YYLAST ||
-				TclDatechk[ TclDate_state = TclDateact[ TclDate_state ] ] != -TclDate_n )
-			{
-				TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
-			}
-		}
-					/* save until reenter driver code */
-		TclDatestate = TclDate_state;
-		TclDateps = TclDate_ps;
-		TclDatepv = TclDate_pv;
-	}
-	/*
-	** code supplied by user is placed in this switch
-	*/
-	switch( TclDatetmp )
-	{
-		
-case 3:{
-            TclDateHaveTime++;
-        } break;
-case 4:{
-            TclDateHaveZone++;
-        } break;
-case 5:{
-            TclDateHaveDate++;
-        } break;
-case 6:{
-            TclDateHaveOrdinalMonth++;
-        } break;
-case 7:{
-            TclDateHaveDay++;
-        } break;
-case 8:{
-            TclDateHaveRel++;
-        } break;
-case 9:{
-	    TclDateHaveTime++;
-	    TclDateHaveDate++;
-	} break;
-case 10:{
-	    TclDateHaveTime++;
-	    TclDateHaveDate++;
-	    TclDateHaveRel++;
-        } break;
-case 12:{
-            TclDateHour = TclDatepvt[-1].Number;
-            TclDateMinutes = 0;
-            TclDateSeconds = 0;
-            TclDateMeridian = TclDatepvt[-0].Meridian;
-        } break;
-case 13:{
-            TclDateHour = TclDatepvt[-3].Number;
-            TclDateMinutes = TclDatepvt[-1].Number;
-            TclDateSeconds = 0;
-            TclDateMeridian = TclDatepvt[-0].Meridian;
-        } break;
-case 14:{
-            TclDateHour = TclDatepvt[-4].Number;
-            TclDateMinutes = TclDatepvt[-2].Number;
-            TclDateMeridian = MER24;
-            TclDateDSTmode = DSToff;
-            TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
-        } break;
-case 15:{
-            TclDateHour = TclDatepvt[-5].Number;
-            TclDateMinutes = TclDatepvt[-3].Number;
-            TclDateSeconds = TclDatepvt[-1].Number;
-            TclDateMeridian = TclDatepvt[-0].Meridian;
-        } break;
-case 16:{
-            TclDateHour = TclDatepvt[-6].Number;
-            TclDateMinutes = TclDatepvt[-4].Number;
-            TclDateSeconds = TclDatepvt[-2].Number;
-            TclDateMeridian = MER24;
-            TclDateDSTmode = DSToff;
-            TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
-        } break;
-case 17:{
-            TclDateTimezone = TclDatepvt[-1].Number;
-            TclDateDSTmode = DSTon;
-        } break;
-case 18:{
-            TclDateTimezone = TclDatepvt[-0].Number;
-            TclDateDSTmode = DSToff;
-        } break;
-case 19:{
-            TclDateTimezone = TclDatepvt[-0].Number;
-            TclDateDSTmode = DSTon;
-        } break;
-case 20:{
-            TclDateDayOrdinal = 1;
-            TclDateDayNumber = TclDatepvt[-0].Number;
-        } break;
-case 21:{
-            TclDateDayOrdinal = 1;
-            TclDateDayNumber = TclDatepvt[-1].Number;
-        } break;
-case 22:{
-            TclDateDayOrdinal = TclDatepvt[-1].Number;
-            TclDateDayNumber = TclDatepvt[-0].Number;
-        } break;
-case 23:{
-            TclDateDayOrdinal = TclDatepvt[-2].Number * TclDatepvt[-1].Number;
-            TclDateDayNumber = TclDatepvt[-0].Number;
-        } break;
-case 24:{
-            TclDateDayOrdinal = 2;
-            TclDateDayNumber = TclDatepvt[-0].Number;
-        } break;
-case 25:{
-            TclDateMonth = TclDatepvt[-2].Number;
-            TclDateDay = TclDatepvt[-0].Number;
-        } break;
-case 26:{
-            TclDateMonth = TclDatepvt[-4].Number;
-            TclDateDay = TclDatepvt[-2].Number;
-            TclDateYear = TclDatepvt[-0].Number;
-        } break;
-case 27:{
-	    TclDateYear = TclDatepvt[-0].Number / 10000;
-	    TclDateMonth = (TclDatepvt[-0].Number % 10000)/100;
-	    TclDateDay = TclDatepvt[-0].Number % 100;
-	} break;
-case 28:{
-	    TclDateDay = TclDatepvt[-4].Number;
-	    TclDateMonth = TclDatepvt[-2].Number;
-	    TclDateYear = TclDatepvt[-0].Number;
-	} break;
-case 29:{
-            TclDateMonth = TclDatepvt[-2].Number;
-            TclDateDay = TclDatepvt[-0].Number;
-            TclDateYear = TclDatepvt[-4].Number;
-        } break;
-case 30:{
-            TclDateMonth = TclDatepvt[-1].Number;
-            TclDateDay = TclDatepvt[-0].Number;
-        } break;
-case 31:{
-            TclDateMonth = TclDatepvt[-3].Number;
-            TclDateDay = TclDatepvt[-2].Number;
-            TclDateYear = TclDatepvt[-0].Number;
-        } break;
-case 32:{
-            TclDateMonth = TclDatepvt[-0].Number;
-            TclDateDay = TclDatepvt[-1].Number;
-        } break;
-case 33:{
-	    TclDateMonth = 1;
-	    TclDateDay = 1;
-	    TclDateYear = EPOCH;
-	} break;
-case 34:{
-            TclDateMonth = TclDatepvt[-1].Number;
-            TclDateDay = TclDatepvt[-2].Number;
-            TclDateYear = TclDatepvt[-0].Number;
-        } break;
-case 35:{
-	    TclDateMonthOrdinal = 1;
-	    TclDateMonth = TclDatepvt[-0].Number;
-	} break;
-case 36:{
-	    TclDateMonthOrdinal = TclDatepvt[-1].Number;
-	    TclDateMonth = TclDatepvt[-0].Number;
-	} break;
-case 37:{
-            if (TclDatepvt[-1].Number != HOUR(- 7)) YYABORT;
-	    TclDateYear = TclDatepvt[-2].Number / 10000;
-	    TclDateMonth = (TclDatepvt[-2].Number % 10000)/100;
-	    TclDateDay = TclDatepvt[-2].Number % 100;
-	    TclDateHour = TclDatepvt[-0].Number / 10000;
-	    TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
-	    TclDateSeconds = TclDatepvt[-0].Number % 100;
-        } break;
-case 38:{
-            if (TclDatepvt[-5].Number != HOUR(- 7)) YYABORT;
-	    TclDateYear = TclDatepvt[-6].Number / 10000;
-	    TclDateMonth = (TclDatepvt[-6].Number % 10000)/100;
-	    TclDateDay = TclDatepvt[-6].Number % 100;
-	    TclDateHour = TclDatepvt[-4].Number;
-	    TclDateMinutes = TclDatepvt[-2].Number;
-	    TclDateSeconds = TclDatepvt[-0].Number;
-        } break;
-case 39:{
-	    TclDateYear = TclDatepvt[-1].Number / 10000;
-	    TclDateMonth = (TclDatepvt[-1].Number % 10000)/100;
-	    TclDateDay = TclDatepvt[-1].Number % 100;
-	    TclDateHour = TclDatepvt[-0].Number / 10000;
-	    TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
-	    TclDateSeconds = TclDatepvt[-0].Number % 100;
-        } break;
-case 40:{
-            /*
-	     * Offset computed year by -377 so that the returned years will
-	     * be in a range accessible with a 32 bit clock seconds value
-	     */
-            TclDateYear = TclDatepvt[-2].Number/1000 + 2323 - 377;
-            TclDateDay  = 1;
-	    TclDateMonth = 1;
-	    TclDateRelDay += ((TclDatepvt[-2].Number%1000)*(365 + IsLeapYear(TclDateYear)))/1000;
-	    TclDateRelSeconds += TclDatepvt[-0].Number * 144 * 60;
-        } break;
-case 41:{
-	    TclDateRelSeconds *= -1;
-	    TclDateRelMonth *= -1;
-	    TclDateRelDay *= -1;
-	} break;
-case 43:{ *TclDateRelPointer += TclDatepvt[-2].Number * TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
-case 44:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
-case 45:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
-case 46:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
-case 47:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
-case 48:{ TclDateval.Number = -1; } break;
-case 49:{ TclDateval.Number =  1; } break;
-case 50:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelSeconds; } break;
-case 51:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelDay; } break;
-case 52:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelMonth; } break;
-case 53:{
-	if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel) {
-	    TclDateYear = TclDatepvt[-0].Number;
-	} else {
-	    TclDateHaveTime++;
-	    if (TclDatepvt[-0].Number < 100) {
-		TclDateHour = TclDatepvt[-0].Number;
-		TclDateMinutes = 0;
-	    } else {
-		TclDateHour = TclDatepvt[-0].Number / 100;
-		TclDateMinutes = TclDatepvt[-0].Number % 100;
-	    }
-	    TclDateSeconds = 0;
-	    TclDateMeridian = MER24;
-	}
-    } break;
-case 54:{
-            TclDateval.Meridian = MER24;
-        } break;
-case 55:{
-            TclDateval.Meridian = TclDatepvt[-0].Meridian;
-        } break;
-	}
-	goto TclDatestack;		/* reset registers in driver code */
-}
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8d9f635..20ec35d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -12,6 +12,17 @@
 #ifndef _TCLDECLS
 #define _TCLDECLS
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -24,1617 +35,3379 @@
  * Exported function declarations:
  */
 
+#ifndef Tcl_PkgProvideEx_TCL_DECLARED
+#define Tcl_PkgProvideEx_TCL_DECLARED
 /* 0 */
-EXTERN int		Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
 				CONST char *name, CONST char *version,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_PkgRequireEx_TCL_DECLARED
+#define Tcl_PkgRequireEx_TCL_DECLARED
 /* 1 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name,
-				CONST char *version, int exact,
-				ClientData *clientDataPtr));
+EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
+				CONST char *name, CONST char *version,
+				int exact, ClientData *clientDataPtr);
+#endif
+#ifndef Tcl_Panic_TCL_DECLARED
+#define Tcl_Panic_TCL_DECLARED
 /* 2 */
-EXTERN void		Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
+EXTERN void		Tcl_Panic(CONST char *format, ...);
+#endif
+#ifndef Tcl_Alloc_TCL_DECLARED
+#define Tcl_Alloc_TCL_DECLARED
 /* 3 */
-EXTERN char *		Tcl_Alloc _ANSI_ARGS_((unsigned int size));
+EXTERN char *		Tcl_Alloc(unsigned int size);
+#endif
+#ifndef Tcl_Free_TCL_DECLARED
+#define Tcl_Free_TCL_DECLARED
 /* 4 */
-EXTERN void		Tcl_Free _ANSI_ARGS_((char *ptr));
+EXTERN void		Tcl_Free(char *ptr);
+#endif
+#ifndef Tcl_Realloc_TCL_DECLARED
+#define Tcl_Realloc_TCL_DECLARED
 /* 5 */
-EXTERN char *		Tcl_Realloc _ANSI_ARGS_((char *ptr,
-				unsigned int size));
+EXTERN char *		Tcl_Realloc(char *ptr, unsigned int size);
+#endif
+#ifndef Tcl_DbCkalloc_TCL_DECLARED
+#define Tcl_DbCkalloc_TCL_DECLARED
 /* 6 */
-EXTERN char *		Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
-				CONST char *file, int line));
+EXTERN char *		Tcl_DbCkalloc(unsigned int size, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbCkfree_TCL_DECLARED
+#define Tcl_DbCkfree_TCL_DECLARED
 /* 7 */
-EXTERN void		Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
-				CONST char *file, int line));
+EXTERN void		Tcl_DbCkfree(char *ptr, CONST char *file, int line);
+#endif
+#ifndef Tcl_DbCkrealloc_TCL_DECLARED
+#define Tcl_DbCkrealloc_TCL_DECLARED
 /* 8 */
-EXTERN char *		Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
-				unsigned int size, CONST char *file,
-				int line));
+EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
+				CONST char *file, int line);
+#endif
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#ifndef Tcl_CreateFileHandler_TCL_DECLARED
+#define Tcl_CreateFileHandler_TCL_DECLARED
 /* 9 */
-EXTERN void		Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
-				Tcl_FileProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
+				Tcl_FileProc *proc, ClientData clientData);
+#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
+#ifndef Tcl_CreateFileHandler_TCL_DECLARED
+#define Tcl_CreateFileHandler_TCL_DECLARED
 /* 9 */
-EXTERN void		Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
-				Tcl_FileProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
+				Tcl_FileProc *proc, ClientData clientData);
+#endif
 #endif /* MACOSX */
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
+#define Tcl_DeleteFileHandler_TCL_DECLARED
 /* 10 */
-EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
+EXTERN void		Tcl_DeleteFileHandler(int fd);
+#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
+#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
+#define Tcl_DeleteFileHandler_TCL_DECLARED
 /* 10 */
-EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
+EXTERN void		Tcl_DeleteFileHandler(int fd);
+#endif
 #endif /* MACOSX */
+#ifndef Tcl_SetTimer_TCL_DECLARED
+#define Tcl_SetTimer_TCL_DECLARED
 /* 11 */
-EXTERN void		Tcl_SetTimer _ANSI_ARGS_((Tcl_Time *timePtr));
+EXTERN void		Tcl_SetTimer(Tcl_Time *timePtr);
+#endif
+#ifndef Tcl_Sleep_TCL_DECLARED
+#define Tcl_Sleep_TCL_DECLARED
 /* 12 */
-EXTERN void		Tcl_Sleep _ANSI_ARGS_((int ms));
+EXTERN void		Tcl_Sleep(int ms);
+#endif
+#ifndef Tcl_WaitForEvent_TCL_DECLARED
+#define Tcl_WaitForEvent_TCL_DECLARED
 /* 13 */
-EXTERN int		Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time *timePtr));
+EXTERN int		Tcl_WaitForEvent(Tcl_Time *timePtr);
+#endif
+#ifndef Tcl_AppendAllObjTypes_TCL_DECLARED
+#define Tcl_AppendAllObjTypes_TCL_DECLARED
 /* 14 */
-EXTERN int		Tcl_AppendAllObjTypes _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr));
+EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_AppendStringsToObj_TCL_DECLARED
+#define Tcl_AppendStringsToObj_TCL_DECLARED
 /* 15 */
-EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr));
+EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
+#endif
+#ifndef Tcl_AppendToObj_TCL_DECLARED
+#define Tcl_AppendToObj_TCL_DECLARED
 /* 16 */
-EXTERN void		Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST char *bytes, int length));
+EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, CONST char *bytes,
+				int length);
+#endif
+#ifndef Tcl_ConcatObj_TCL_DECLARED
+#define Tcl_ConcatObj_TCL_DECLARED
 /* 17 */
-EXTERN Tcl_Obj *	Tcl_ConcatObj _ANSI_ARGS_((int objc,
-				Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_ConvertToType_TCL_DECLARED
+#define Tcl_ConvertToType_TCL_DECLARED
 /* 18 */
-EXTERN int		Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_ObjType *typePtr));
+EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_ObjType *typePtr);
+#endif
+#ifndef Tcl_DbDecrRefCount_TCL_DECLARED
+#define Tcl_DbDecrRefCount_TCL_DECLARED
 /* 19 */
-EXTERN void		Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST char *file, int line));
+EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbIncrRefCount_TCL_DECLARED
+#define Tcl_DbIncrRefCount_TCL_DECLARED
 /* 20 */
-EXTERN void		Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST char *file, int line));
+EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbIsShared_TCL_DECLARED
+#define Tcl_DbIsShared_TCL_DECLARED
 /* 21 */
-EXTERN int		Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST char *file, int line));
+EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbNewBooleanObj_TCL_DECLARED
+#define Tcl_DbNewBooleanObj_TCL_DECLARED
 /* 22 */
-EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
-				CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbNewByteArrayObj_TCL_DECLARED
+#define Tcl_DbNewByteArrayObj_TCL_DECLARED
 /* 23 */
-EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj _ANSI_ARGS_((
-				CONST unsigned char *bytes, int length,
-				CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(CONST unsigned char *bytes,
+				int length, CONST char *file, int line);
+#endif
+#ifndef Tcl_DbNewDoubleObj_TCL_DECLARED
+#define Tcl_DbNewDoubleObj_TCL_DECLARED
 /* 24 */
-EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
-				CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_DbNewListObj_TCL_DECLARED
+#define Tcl_DbNewListObj_TCL_DECLARED
 /* 25 */
-EXTERN Tcl_Obj *	Tcl_DbNewListObj _ANSI_ARGS_((int objc,
-				Tcl_Obj *CONST *objv, CONST char *file,
-				int line));
+EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_DbNewLongObj_TCL_DECLARED
+#define Tcl_DbNewLongObj_TCL_DECLARED
 /* 26 */
-EXTERN Tcl_Obj *	Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
-				CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_DbNewObj_TCL_DECLARED
+#define Tcl_DbNewObj_TCL_DECLARED
 /* 27 */
-EXTERN Tcl_Obj *	Tcl_DbNewObj _ANSI_ARGS_((CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewObj(CONST char *file, int line);
+#endif
+#ifndef Tcl_DbNewStringObj_TCL_DECLARED
+#define Tcl_DbNewStringObj_TCL_DECLARED
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_DbNewStringObj _ANSI_ARGS_((CONST char *bytes,
-				int length, CONST char *file, int line));
+EXTERN Tcl_Obj *	Tcl_DbNewStringObj(CONST char *bytes, int length,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_DuplicateObj_TCL_DECLARED
+#define Tcl_DuplicateObj_TCL_DECLARED
 /* 29 */
-EXTERN Tcl_Obj *	Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
+#endif
+#ifndef TclFreeObj_TCL_DECLARED
+#define TclFreeObj_TCL_DECLARED
 /* 30 */
-EXTERN void		TclFreeObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetBoolean_TCL_DECLARED
+#define Tcl_GetBoolean_TCL_DECLARED
 /* 31 */
-EXTERN int		Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *src, int *boolPtr));
+EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src,
+				int *boolPtr);
+#endif
+#ifndef Tcl_GetBooleanFromObj_TCL_DECLARED
+#define Tcl_GetBooleanFromObj_TCL_DECLARED
 /* 32 */
-EXTERN int		Tcl_GetBooleanFromObj _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int *boolPtr));
+EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *boolPtr);
+#endif
+#ifndef Tcl_GetByteArrayFromObj_TCL_DECLARED
+#define Tcl_GetByteArrayFromObj_TCL_DECLARED
 /* 33 */
-EXTERN unsigned char *	Tcl_GetByteArrayFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int *lengthPtr));
+EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
+				int *lengthPtr);
+#endif
+#ifndef Tcl_GetDouble_TCL_DECLARED
+#define Tcl_GetDouble_TCL_DECLARED
 /* 34 */
-EXTERN int		Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *src, double *doublePtr));
+EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, CONST char *src,
+				double *doublePtr);
+#endif
+#ifndef Tcl_GetDoubleFromObj_TCL_DECLARED
+#define Tcl_GetDoubleFromObj_TCL_DECLARED
 /* 35 */
-EXTERN int		Tcl_GetDoubleFromObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, double *doublePtr));
+EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, double *doublePtr);
+#endif
+#ifndef Tcl_GetIndexFromObj_TCL_DECLARED
+#define Tcl_GetIndexFromObj_TCL_DECLARED
 /* 36 */
-EXTERN int		Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, CONST84 char **tablePtr,
-				CONST char *msg, int flags, int *indexPtr));
+				CONST char *msg, int flags, int *indexPtr);
+#endif
+#ifndef Tcl_GetInt_TCL_DECLARED
+#define Tcl_GetInt_TCL_DECLARED
 /* 37 */
-EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *src, int *intPtr));
+EXTERN int		Tcl_GetInt(Tcl_Interp *interp, CONST char *src,
+				int *intPtr);
+#endif
+#ifndef Tcl_GetIntFromObj_TCL_DECLARED
+#define Tcl_GetIntFromObj_TCL_DECLARED
 /* 38 */
-EXTERN int		Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *intPtr));
+EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *intPtr);
+#endif
+#ifndef Tcl_GetLongFromObj_TCL_DECLARED
+#define Tcl_GetLongFromObj_TCL_DECLARED
 /* 39 */
-EXTERN int		Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, long *longPtr));
+EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, long *longPtr);
+#endif
+#ifndef Tcl_GetObjType_TCL_DECLARED
+#define Tcl_GetObjType_TCL_DECLARED
 /* 40 */
-EXTERN Tcl_ObjType *	Tcl_GetObjType _ANSI_ARGS_((CONST char *typeName));
+EXTERN Tcl_ObjType *	Tcl_GetObjType(CONST char *typeName);
+#endif
+#ifndef Tcl_GetStringFromObj_TCL_DECLARED
+#define Tcl_GetStringFromObj_TCL_DECLARED
 /* 41 */
-EXTERN char *		Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int *lengthPtr));
+EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
+#endif
+#ifndef Tcl_InvalidateStringRep_TCL_DECLARED
+#define Tcl_InvalidateStringRep_TCL_DECLARED
 /* 42 */
-EXTERN void		Tcl_InvalidateStringRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_ListObjAppendList_TCL_DECLARED
+#define Tcl_ListObjAppendList_TCL_DECLARED
 /* 43 */
-EXTERN int		Tcl_ListObjAppendList _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *listPtr,
-				Tcl_Obj *elemListPtr));
+EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
+				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
+#endif
+#ifndef Tcl_ListObjAppendElement_TCL_DECLARED
+#define Tcl_ListObjAppendElement_TCL_DECLARED
 /* 44 */
-EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *listPtr,
-				Tcl_Obj *objPtr));
+EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
+				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_ListObjGetElements_TCL_DECLARED
+#define Tcl_ListObjGetElements_TCL_DECLARED
 /* 45 */
-EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *listPtr,
-				int *objcPtr, Tcl_Obj ***objvPtr));
+EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
+				Tcl_Obj *listPtr, int *objcPtr,
+				Tcl_Obj ***objvPtr);
+#endif
+#ifndef Tcl_ListObjIndex_TCL_DECLARED
+#define Tcl_ListObjIndex_TCL_DECLARED
 /* 46 */
-EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
-				Tcl_Obj **objPtrPtr));
+				Tcl_Obj **objPtrPtr);
+#endif
+#ifndef Tcl_ListObjLength_TCL_DECLARED
+#define Tcl_ListObjLength_TCL_DECLARED
 /* 47 */
-EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *listPtr, int *lengthPtr));
+EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
+				Tcl_Obj *listPtr, int *lengthPtr);
+#endif
+#ifndef Tcl_ListObjReplace_TCL_DECLARED
+#define Tcl_ListObjReplace_TCL_DECLARED
 /* 48 */
-EXTERN int		Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int first, int count,
-				int objc, Tcl_Obj *CONST objv[]));
+				int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_NewBooleanObj_TCL_DECLARED
+#define Tcl_NewBooleanObj_TCL_DECLARED
 /* 49 */
-EXTERN Tcl_Obj *	Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
+EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int boolValue);
+#endif
+#ifndef Tcl_NewByteArrayObj_TCL_DECLARED
+#define Tcl_NewByteArrayObj_TCL_DECLARED
 /* 50 */
-EXTERN Tcl_Obj *	Tcl_NewByteArrayObj _ANSI_ARGS_((
-				CONST unsigned char *bytes, int length));
+EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(CONST unsigned char *bytes,
+				int length);
+#endif
+#ifndef Tcl_NewDoubleObj_TCL_DECLARED
+#define Tcl_NewDoubleObj_TCL_DECLARED
 /* 51 */
-EXTERN Tcl_Obj *	Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
+EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
+#endif
+#ifndef Tcl_NewIntObj_TCL_DECLARED
+#define Tcl_NewIntObj_TCL_DECLARED
 /* 52 */
-EXTERN Tcl_Obj *	Tcl_NewIntObj _ANSI_ARGS_((int intValue));
+EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
+#endif
+#ifndef Tcl_NewListObj_TCL_DECLARED
+#define Tcl_NewListObj_TCL_DECLARED
 /* 53 */
-EXTERN Tcl_Obj *	Tcl_NewListObj _ANSI_ARGS_((int objc,
-				Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_NewLongObj_TCL_DECLARED
+#define Tcl_NewLongObj_TCL_DECLARED
 /* 54 */
-EXTERN Tcl_Obj *	Tcl_NewLongObj _ANSI_ARGS_((long longValue));
+EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
+#endif
+#ifndef Tcl_NewObj_TCL_DECLARED
+#define Tcl_NewObj_TCL_DECLARED
 /* 55 */
-EXTERN Tcl_Obj *	Tcl_NewObj _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	Tcl_NewObj(void);
+#endif
+#ifndef Tcl_NewStringObj_TCL_DECLARED
+#define Tcl_NewStringObj_TCL_DECLARED
 /* 56 */
-EXTERN Tcl_Obj *	Tcl_NewStringObj _ANSI_ARGS_((CONST char *bytes,
-				int length));
+EXTERN Tcl_Obj *	Tcl_NewStringObj(CONST char *bytes, int length);
+#endif
+#ifndef Tcl_SetBooleanObj_TCL_DECLARED
+#define Tcl_SetBooleanObj_TCL_DECLARED
 /* 57 */
-EXTERN void		Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int boolValue));
+EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+#endif
+#ifndef Tcl_SetByteArrayLength_TCL_DECLARED
+#define Tcl_SetByteArrayLength_TCL_DECLARED
 /* 58 */
-EXTERN unsigned char *	Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int length));
+EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
+#endif
+#ifndef Tcl_SetByteArrayObj_TCL_DECLARED
+#define Tcl_SetByteArrayObj_TCL_DECLARED
 /* 59 */
-EXTERN void		Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST unsigned char *bytes, int length));
+EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
+				CONST unsigned char *bytes, int length);
+#endif
+#ifndef Tcl_SetDoubleObj_TCL_DECLARED
+#define Tcl_SetDoubleObj_TCL_DECLARED
 /* 60 */
-EXTERN void		Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				double doubleValue));
+EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
+#endif
+#ifndef Tcl_SetIntObj_TCL_DECLARED
+#define Tcl_SetIntObj_TCL_DECLARED
 /* 61 */
-EXTERN void		Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int intValue));
+EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+#endif
+#ifndef Tcl_SetListObj_TCL_DECLARED
+#define Tcl_SetListObj_TCL_DECLARED
 /* 62 */
-EXTERN void		Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int objc, Tcl_Obj *CONST objv[]));
+EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_SetLongObj_TCL_DECLARED
+#define Tcl_SetLongObj_TCL_DECLARED
 /* 63 */
-EXTERN void		Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				long longValue));
+EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
+#endif
+#ifndef Tcl_SetObjLength_TCL_DECLARED
+#define Tcl_SetObjLength_TCL_DECLARED
 /* 64 */
-EXTERN void		Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int length));
+EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
+#endif
+#ifndef Tcl_SetStringObj_TCL_DECLARED
+#define Tcl_SetStringObj_TCL_DECLARED
 /* 65 */
-EXTERN void		Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST char *bytes, int length));
+EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, CONST char *bytes,
+				int length);
+#endif
+#ifndef Tcl_AddErrorInfo_TCL_DECLARED
+#define Tcl_AddErrorInfo_TCL_DECLARED
 /* 66 */
-EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *message));
+EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
+				CONST char *message);
+#endif
+#ifndef Tcl_AddObjErrorInfo_TCL_DECLARED
+#define Tcl_AddObjErrorInfo_TCL_DECLARED
 /* 67 */
-EXTERN void		Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *message, int length));
+EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
+				CONST char *message, int length);
+#endif
+#ifndef Tcl_AllowExceptions_TCL_DECLARED
+#define Tcl_AllowExceptions_TCL_DECLARED
 /* 68 */
-EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_AppendElement_TCL_DECLARED
+#define Tcl_AppendElement_TCL_DECLARED
 /* 69 */
-EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *element));
+EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
+				CONST char *element);
+#endif
+#ifndef Tcl_AppendResult_TCL_DECLARED
+#define Tcl_AppendResult_TCL_DECLARED
 /* 70 */
-EXTERN void		Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
+#endif
+#ifndef Tcl_AsyncCreate_TCL_DECLARED
+#define Tcl_AsyncCreate_TCL_DECLARED
 /* 71 */
-EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
-				ClientData clientData));
+EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_AsyncDelete_TCL_DECLARED
+#define Tcl_AsyncDelete_TCL_DECLARED
 /* 72 */
-EXTERN void		Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
+#endif
+#ifndef Tcl_AsyncInvoke_TCL_DECLARED
+#define Tcl_AsyncInvoke_TCL_DECLARED
 /* 73 */
-EXTERN int		Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
-				int code));
+EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
+#endif
+#ifndef Tcl_AsyncMark_TCL_DECLARED
+#define Tcl_AsyncMark_TCL_DECLARED
 /* 74 */
-EXTERN void		Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
+#endif
+#ifndef Tcl_AsyncReady_TCL_DECLARED
+#define Tcl_AsyncReady_TCL_DECLARED
 /* 75 */
-EXTERN int		Tcl_AsyncReady _ANSI_ARGS_((void));
+EXTERN int		Tcl_AsyncReady(void);
+#endif
+#ifndef Tcl_BackgroundError_TCL_DECLARED
+#define Tcl_BackgroundError_TCL_DECLARED
 /* 76 */
-EXTERN void		Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_Backslash_TCL_DECLARED
+#define Tcl_Backslash_TCL_DECLARED
 /* 77 */
-EXTERN char		Tcl_Backslash _ANSI_ARGS_((CONST char *src,
-				int *readPtr));
+EXTERN char		Tcl_Backslash(CONST char *src, int *readPtr);
+#endif
+#ifndef Tcl_BadChannelOption_TCL_DECLARED
+#define Tcl_BadChannelOption_TCL_DECLARED
 /* 78 */
-EXTERN int		Tcl_BadChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
 				CONST char *optionName,
-				CONST char *optionList));
+				CONST char *optionList);
+#endif
+#ifndef Tcl_CallWhenDeleted_TCL_DECLARED
+#define Tcl_CallWhenDeleted_TCL_DECLARED
 /* 79 */
-EXTERN void		Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_CancelIdleCall_TCL_DECLARED
+#define Tcl_CancelIdleCall_TCL_DECLARED
 /* 80 */
-EXTERN void		Tcl_CancelIdleCall _ANSI_ARGS_((
-				Tcl_IdleProc *idleProc,
-				ClientData clientData));
+EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_Close_TCL_DECLARED
+#define Tcl_Close_TCL_DECLARED
 /* 81 */
-EXTERN int		Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
+#endif
+#ifndef Tcl_CommandComplete_TCL_DECLARED
+#define Tcl_CommandComplete_TCL_DECLARED
 /* 82 */
-EXTERN int		Tcl_CommandComplete _ANSI_ARGS_((CONST char *cmd));
+EXTERN int		Tcl_CommandComplete(CONST char *cmd);
+#endif
+#ifndef Tcl_Concat_TCL_DECLARED
+#define Tcl_Concat_TCL_DECLARED
 /* 83 */
-EXTERN char *		Tcl_Concat _ANSI_ARGS_((int argc,
-				CONST84 char *CONST *argv));
+EXTERN char *		Tcl_Concat(int argc, CONST84 char *CONST *argv);
+#endif
+#ifndef Tcl_ConvertElement_TCL_DECLARED
+#define Tcl_ConvertElement_TCL_DECLARED
 /* 84 */
-EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((CONST char *src,
-				char *dst, int flags));
+EXTERN int		Tcl_ConvertElement(CONST char *src, char *dst,
+				int flags);
+#endif
+#ifndef Tcl_ConvertCountedElement_TCL_DECLARED
+#define Tcl_ConvertCountedElement_TCL_DECLARED
 /* 85 */
-EXTERN int		Tcl_ConvertCountedElement _ANSI_ARGS_((
-				CONST char *src, int length, char *dst,
-				int flags));
+EXTERN int		Tcl_ConvertCountedElement(CONST char *src,
+				int length, char *dst, int flags);
+#endif
+#ifndef Tcl_CreateAlias_TCL_DECLARED
+#define Tcl_CreateAlias_TCL_DECLARED
 /* 86 */
-EXTERN int		Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp *slave,
+EXTERN int		Tcl_CreateAlias(Tcl_Interp *slave,
 				CONST char *slaveCmd, Tcl_Interp *target,
 				CONST char *targetCmd, int argc,
-				CONST84 char *CONST *argv));
+				CONST84 char *CONST *argv);
+#endif
+#ifndef Tcl_CreateAliasObj_TCL_DECLARED
+#define Tcl_CreateAliasObj_TCL_DECLARED
 /* 87 */
-EXTERN int		Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp *slave,
+EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *slave,
 				CONST char *slaveCmd, Tcl_Interp *target,
 				CONST char *targetCmd, int objc,
-				Tcl_Obj *CONST objv[]));
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_CreateChannel_TCL_DECLARED
+#define Tcl_CreateChannel_TCL_DECLARED
 /* 88 */
-EXTERN Tcl_Channel	Tcl_CreateChannel _ANSI_ARGS_((
-				Tcl_ChannelType *typePtr,
+EXTERN Tcl_Channel	Tcl_CreateChannel(Tcl_ChannelType *typePtr,
 				CONST char *chanName,
-				ClientData instanceData, int mask));
+				ClientData instanceData, int mask);
+#endif
+#ifndef Tcl_CreateChannelHandler_TCL_DECLARED
+#define Tcl_CreateChannelHandler_TCL_DECLARED
 /* 89 */
-EXTERN void		Tcl_CreateChannelHandler _ANSI_ARGS_((
-				Tcl_Channel chan, int mask,
-				Tcl_ChannelProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
+				Tcl_ChannelProc *proc, ClientData clientData);
+#endif
+#ifndef Tcl_CreateCloseHandler_TCL_DECLARED
+#define Tcl_CreateCloseHandler_TCL_DECLARED
 /* 90 */
-EXTERN void		Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_CloseProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
+				Tcl_CloseProc *proc, ClientData clientData);
+#endif
+#ifndef Tcl_CreateCommand_TCL_DECLARED
+#define Tcl_CreateCommand_TCL_DECLARED
 /* 91 */
-EXTERN Tcl_Command	Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
 				CONST char *cmdName, Tcl_CmdProc *proc,
 				ClientData clientData,
-				Tcl_CmdDeleteProc *deleteProc));
+				Tcl_CmdDeleteProc *deleteProc);
+#endif
+#ifndef Tcl_CreateEventSource_TCL_DECLARED
+#define Tcl_CreateEventSource_TCL_DECLARED
 /* 92 */
-EXTERN void		Tcl_CreateEventSource _ANSI_ARGS_((
-				Tcl_EventSetupProc *setupProc,
+EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_CreateExitHandler_TCL_DECLARED
+#define Tcl_CreateExitHandler_TCL_DECLARED
 /* 93 */
-EXTERN void		Tcl_CreateExitHandler _ANSI_ARGS_((
-				Tcl_ExitProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_CreateInterp_TCL_DECLARED
+#define Tcl_CreateInterp_TCL_DECLARED
 /* 94 */
-EXTERN Tcl_Interp *	Tcl_CreateInterp _ANSI_ARGS_((void));
+EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
+#endif
+#ifndef Tcl_CreateMathFunc_TCL_DECLARED
+#define Tcl_CreateMathFunc_TCL_DECLARED
 /* 95 */
-EXTERN void		Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
 				CONST char *name, int numArgs,
 				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_CreateObjCommand_TCL_DECLARED
+#define Tcl_CreateObjCommand_TCL_DECLARED
 /* 96 */
-EXTERN Tcl_Command	Tcl_CreateObjCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
 				CONST char *cmdName, Tcl_ObjCmdProc *proc,
 				ClientData clientData,
-				Tcl_CmdDeleteProc *deleteProc));
+				Tcl_CmdDeleteProc *deleteProc);
+#endif
+#ifndef Tcl_CreateSlave_TCL_DECLARED
+#define Tcl_CreateSlave_TCL_DECLARED
 /* 97 */
-EXTERN Tcl_Interp *	Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *slaveName, int isSafe));
+EXTERN Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp,
+				CONST char *slaveName, int isSafe);
+#endif
+#ifndef Tcl_CreateTimerHandler_TCL_DECLARED
+#define Tcl_CreateTimerHandler_TCL_DECLARED
 /* 98 */
-EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
-				Tcl_TimerProc *proc, ClientData clientData));
+EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
+				Tcl_TimerProc *proc, ClientData clientData);
+#endif
+#ifndef Tcl_CreateTrace_TCL_DECLARED
+#define Tcl_CreateTrace_TCL_DECLARED
 /* 99 */
-EXTERN Tcl_Trace	Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
-				int level, Tcl_CmdTraceProc *proc,
-				ClientData clientData));
+EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
+				Tcl_CmdTraceProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DeleteAssocData_TCL_DECLARED
+#define Tcl_DeleteAssocData_TCL_DECLARED
 /* 100 */
-EXTERN void		Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *name));
+EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
+				CONST char *name);
+#endif
+#ifndef Tcl_DeleteChannelHandler_TCL_DECLARED
+#define Tcl_DeleteChannelHandler_TCL_DECLARED
 /* 101 */
-EXTERN void		Tcl_DeleteChannelHandler _ANSI_ARGS_((
-				Tcl_Channel chan, Tcl_ChannelProc *proc,
-				ClientData clientData));
+EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
+				Tcl_ChannelProc *proc, ClientData clientData);
+#endif
+#ifndef Tcl_DeleteCloseHandler_TCL_DECLARED
+#define Tcl_DeleteCloseHandler_TCL_DECLARED
 /* 102 */
-EXTERN void		Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_CloseProc *proc, ClientData clientData));
+EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
+				Tcl_CloseProc *proc, ClientData clientData);
+#endif
+#ifndef Tcl_DeleteCommand_TCL_DECLARED
+#define Tcl_DeleteCommand_TCL_DECLARED
 /* 103 */
-EXTERN int		Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *cmdName));
+EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
+				CONST char *cmdName);
+#endif
+#ifndef Tcl_DeleteCommandFromToken_TCL_DECLARED
+#define Tcl_DeleteCommandFromToken_TCL_DECLARED
 /* 104 */
-EXTERN int		Tcl_DeleteCommandFromToken _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Command command));
+EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
+				Tcl_Command command);
+#endif
+#ifndef Tcl_DeleteEvents_TCL_DECLARED
+#define Tcl_DeleteEvents_TCL_DECLARED
 /* 105 */
-EXTERN void		Tcl_DeleteEvents _ANSI_ARGS_((
-				Tcl_EventDeleteProc *proc,
-				ClientData clientData));
+EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DeleteEventSource_TCL_DECLARED
+#define Tcl_DeleteEventSource_TCL_DECLARED
 /* 106 */
-EXTERN void		Tcl_DeleteEventSource _ANSI_ARGS_((
-				Tcl_EventSetupProc *setupProc,
+EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_DeleteExitHandler_TCL_DECLARED
+#define Tcl_DeleteExitHandler_TCL_DECLARED
 /* 107 */
-EXTERN void		Tcl_DeleteExitHandler _ANSI_ARGS_((
-				Tcl_ExitProc *proc, ClientData clientData));
+EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DeleteHashEntry_TCL_DECLARED
+#define Tcl_DeleteHashEntry_TCL_DECLARED
 /* 108 */
-EXTERN void		Tcl_DeleteHashEntry _ANSI_ARGS_((
-				Tcl_HashEntry *entryPtr));
+EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
+#endif
+#ifndef Tcl_DeleteHashTable_TCL_DECLARED
+#define Tcl_DeleteHashTable_TCL_DECLARED
 /* 109 */
-EXTERN void		Tcl_DeleteHashTable _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr));
+EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
+#endif
+#ifndef Tcl_DeleteInterp_TCL_DECLARED
+#define Tcl_DeleteInterp_TCL_DECLARED
 /* 110 */
-EXTERN void		Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_DetachPids_TCL_DECLARED
+#define Tcl_DetachPids_TCL_DECLARED
 /* 111 */
-EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids,
-				Tcl_Pid *pidPtr));
+EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
+#endif
+#ifndef Tcl_DeleteTimerHandler_TCL_DECLARED
+#define Tcl_DeleteTimerHandler_TCL_DECLARED
 /* 112 */
-EXTERN void		Tcl_DeleteTimerHandler _ANSI_ARGS_((
-				Tcl_TimerToken token));
+EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
+#endif
+#ifndef Tcl_DeleteTrace_TCL_DECLARED
+#define Tcl_DeleteTrace_TCL_DECLARED
 /* 113 */
-EXTERN void		Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Trace trace));
+EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
+#endif
+#ifndef Tcl_DontCallWhenDeleted_TCL_DECLARED
+#define Tcl_DontCallWhenDeleted_TCL_DECLARED
 /* 114 */
-EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
-				Tcl_Interp *interp,
+EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_DoOneEvent_TCL_DECLARED
+#define Tcl_DoOneEvent_TCL_DECLARED
 /* 115 */
-EXTERN int		Tcl_DoOneEvent _ANSI_ARGS_((int flags));
+EXTERN int		Tcl_DoOneEvent(int flags);
+#endif
+#ifndef Tcl_DoWhenIdle_TCL_DECLARED
+#define Tcl_DoWhenIdle_TCL_DECLARED
 /* 116 */
-EXTERN void		Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc *proc,
-				ClientData clientData));
+EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DStringAppend_TCL_DECLARED
+#define Tcl_DStringAppend_TCL_DECLARED
 /* 117 */
-EXTERN char *		Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
-				CONST char *bytes, int length));
+EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
+				CONST char *bytes, int length);
+#endif
+#ifndef Tcl_DStringAppendElement_TCL_DECLARED
+#define Tcl_DStringAppendElement_TCL_DECLARED
 /* 118 */
-EXTERN char *		Tcl_DStringAppendElement _ANSI_ARGS_((
-				Tcl_DString *dsPtr, CONST char *element));
+EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
+				CONST char *element);
+#endif
+#ifndef Tcl_DStringEndSublist_TCL_DECLARED
+#define Tcl_DStringEndSublist_TCL_DECLARED
 /* 119 */
-EXTERN void		Tcl_DStringEndSublist _ANSI_ARGS_((
-				Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_DStringFree_TCL_DECLARED
+#define Tcl_DStringFree_TCL_DECLARED
 /* 120 */
-EXTERN void		Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_DStringGetResult_TCL_DECLARED
+#define Tcl_DStringGetResult_TCL_DECLARED
 /* 121 */
-EXTERN void		Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_DStringInit_TCL_DECLARED
+#define Tcl_DStringInit_TCL_DECLARED
 /* 122 */
-EXTERN void		Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_DStringResult_TCL_DECLARED
+#define Tcl_DStringResult_TCL_DECLARED
 /* 123 */
-EXTERN void		Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_DStringSetLength_TCL_DECLARED
+#define Tcl_DStringSetLength_TCL_DECLARED
 /* 124 */
-EXTERN void		Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
-				int length));
+EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
+#endif
+#ifndef Tcl_DStringStartSublist_TCL_DECLARED
+#define Tcl_DStringStartSublist_TCL_DECLARED
 /* 125 */
-EXTERN void		Tcl_DStringStartSublist _ANSI_ARGS_((
-				Tcl_DString *dsPtr));
+EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_Eof_TCL_DECLARED
+#define Tcl_Eof_TCL_DECLARED
 /* 126 */
-EXTERN int		Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_Eof(Tcl_Channel chan);
+#endif
+#ifndef Tcl_ErrnoId_TCL_DECLARED
+#define Tcl_ErrnoId_TCL_DECLARED
 /* 127 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
+#endif
+#ifndef Tcl_ErrnoMsg_TCL_DECLARED
+#define Tcl_ErrnoMsg_TCL_DECLARED
 /* 128 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
+EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
+#endif
+#ifndef Tcl_Eval_TCL_DECLARED
+#define Tcl_Eval_TCL_DECLARED
 /* 129 */
-EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *script));
+EXTERN int		Tcl_Eval(Tcl_Interp *interp, CONST char *script);
+#endif
+#ifndef Tcl_EvalFile_TCL_DECLARED
+#define Tcl_EvalFile_TCL_DECLARED
 /* 130 */
-EXTERN int		Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *fileName));
+EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
+				CONST char *fileName);
+#endif
+#ifndef Tcl_EvalObj_TCL_DECLARED
+#define Tcl_EvalObj_TCL_DECLARED
 /* 131 */
-EXTERN int		Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr));
+EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_EventuallyFree_TCL_DECLARED
+#define Tcl_EventuallyFree_TCL_DECLARED
 /* 132 */
-EXTERN void		Tcl_EventuallyFree _ANSI_ARGS_((
-				ClientData clientData,
-				Tcl_FreeProc *freeProc));
+EXTERN void		Tcl_EventuallyFree(ClientData clientData,
+				Tcl_FreeProc *freeProc);
+#endif
+#ifndef Tcl_Exit_TCL_DECLARED
+#define Tcl_Exit_TCL_DECLARED
 /* 133 */
-EXTERN void		Tcl_Exit _ANSI_ARGS_((int status));
+EXTERN void		Tcl_Exit(int status);
+#endif
+#ifndef Tcl_ExposeCommand_TCL_DECLARED
+#define Tcl_ExposeCommand_TCL_DECLARED
 /* 134 */
-EXTERN int		Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
 				CONST char *hiddenCmdToken,
-				CONST char *cmdName));
+				CONST char *cmdName);
+#endif
+#ifndef Tcl_ExprBoolean_TCL_DECLARED
+#define Tcl_ExprBoolean_TCL_DECLARED
 /* 135 */
-EXTERN int		Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *expr, int *ptr));
+EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr,
+				int *ptr);
+#endif
+#ifndef Tcl_ExprBooleanObj_TCL_DECLARED
+#define Tcl_ExprBooleanObj_TCL_DECLARED
 /* 136 */
-EXTERN int		Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *ptr));
+EXTERN int		Tcl_ExprBooleanObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *ptr);
+#endif
+#ifndef Tcl_ExprDouble_TCL_DECLARED
+#define Tcl_ExprDouble_TCL_DECLARED
 /* 137 */
-EXTERN int		Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *expr, double *ptr));
+EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr,
+				double *ptr);
+#endif
+#ifndef Tcl_ExprDoubleObj_TCL_DECLARED
+#define Tcl_ExprDoubleObj_TCL_DECLARED
 /* 138 */
-EXTERN int		Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, double *ptr));
+EXTERN int		Tcl_ExprDoubleObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, double *ptr);
+#endif
+#ifndef Tcl_ExprLong_TCL_DECLARED
+#define Tcl_ExprLong_TCL_DECLARED
 /* 139 */
-EXTERN int		Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *expr, long *ptr));
+EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr,
+				long *ptr);
+#endif
+#ifndef Tcl_ExprLongObj_TCL_DECLARED
+#define Tcl_ExprLongObj_TCL_DECLARED
 /* 140 */
-EXTERN int		Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, long *ptr));
+EXTERN int		Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				long *ptr);
+#endif
+#ifndef Tcl_ExprObj_TCL_DECLARED
+#define Tcl_ExprObj_TCL_DECLARED
 /* 141 */
-EXTERN int		Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr));
+EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				Tcl_Obj **resultPtrPtr);
+#endif
+#ifndef Tcl_ExprString_TCL_DECLARED
+#define Tcl_ExprString_TCL_DECLARED
 /* 142 */
-EXTERN int		Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *expr));
+EXTERN int		Tcl_ExprString(Tcl_Interp *interp, CONST char *expr);
+#endif
+#ifndef Tcl_Finalize_TCL_DECLARED
+#define Tcl_Finalize_TCL_DECLARED
 /* 143 */
-EXTERN void		Tcl_Finalize _ANSI_ARGS_((void));
+EXTERN void		Tcl_Finalize(void);
+#endif
+#ifndef Tcl_FindExecutable_TCL_DECLARED
+#define Tcl_FindExecutable_TCL_DECLARED
 /* 144 */
-EXTERN void		Tcl_FindExecutable _ANSI_ARGS_((CONST char *argv0));
+EXTERN void		Tcl_FindExecutable(CONST char *argv0);
+#endif
+#ifndef Tcl_FirstHashEntry_TCL_DECLARED
+#define Tcl_FirstHashEntry_TCL_DECLARED
 /* 145 */
-EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr,
-				Tcl_HashSearch *searchPtr));
+EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
+				Tcl_HashSearch *searchPtr);
+#endif
+#ifndef Tcl_Flush_TCL_DECLARED
+#define Tcl_Flush_TCL_DECLARED
 /* 146 */
-EXTERN int		Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_Flush(Tcl_Channel chan);
+#endif
+#ifndef Tcl_FreeResult_TCL_DECLARED
+#define Tcl_FreeResult_TCL_DECLARED
 /* 147 */
-EXTERN void		Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetAlias_TCL_DECLARED
+#define Tcl_GetAlias_TCL_DECLARED
 /* 148 */
-EXTERN int		Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
 				CONST char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *argcPtr,
-				CONST84 char ***argvPtr));
+				CONST84 char ***argvPtr);
+#endif
+#ifndef Tcl_GetAliasObj_TCL_DECLARED
+#define Tcl_GetAliasObj_TCL_DECLARED
 /* 149 */
-EXTERN int		Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
 				CONST char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *objcPtr,
-				Tcl_Obj ***objv));
+				Tcl_Obj ***objv);
+#endif
+#ifndef Tcl_GetAssocData_TCL_DECLARED
+#define Tcl_GetAssocData_TCL_DECLARED
 /* 150 */
-EXTERN ClientData	Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
 				CONST char *name,
-				Tcl_InterpDeleteProc **procPtr));
+				Tcl_InterpDeleteProc **procPtr);
+#endif
+#ifndef Tcl_GetChannel_TCL_DECLARED
+#define Tcl_GetChannel_TCL_DECLARED
 /* 151 */
-EXTERN Tcl_Channel	Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *chanName, int *modePtr));
+EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
+				CONST char *chanName, int *modePtr);
+#endif
+#ifndef Tcl_GetChannelBufferSize_TCL_DECLARED
+#define Tcl_GetChannelBufferSize_TCL_DECLARED
 /* 152 */
-EXTERN int		Tcl_GetChannelBufferSize _ANSI_ARGS_((
-				Tcl_Channel chan));
+EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetChannelHandle_TCL_DECLARED
+#define Tcl_GetChannelHandle_TCL_DECLARED
 /* 153 */
-EXTERN int		Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
-				int direction, ClientData *handlePtr));
+EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
+				ClientData *handlePtr);
+#endif
+#ifndef Tcl_GetChannelInstanceData_TCL_DECLARED
+#define Tcl_GetChannelInstanceData_TCL_DECLARED
 /* 154 */
-EXTERN ClientData	Tcl_GetChannelInstanceData _ANSI_ARGS_((
-				Tcl_Channel chan));
+EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetChannelMode_TCL_DECLARED
+#define Tcl_GetChannelMode_TCL_DECLARED
 /* 155 */
-EXTERN int		Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetChannelName_TCL_DECLARED
+#define Tcl_GetChannelName_TCL_DECLARED
 /* 156 */
-EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_((
-				Tcl_Channel chan));
+EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetChannelOption_TCL_DECLARED
+#define Tcl_GetChannelOption_TCL_DECLARED
 /* 157 */
-EXTERN int		Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
 				Tcl_Channel chan, CONST char *optionName,
-				Tcl_DString *dsPtr));
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_GetChannelType_TCL_DECLARED
+#define Tcl_GetChannelType_TCL_DECLARED
 /* 158 */
-EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetCommandInfo_TCL_DECLARED
+#define Tcl_GetCommandInfo_TCL_DECLARED
 /* 159 */
-EXTERN int		Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *cmdName, Tcl_CmdInfo *infoPtr));
+EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
+				CONST char *cmdName, Tcl_CmdInfo *infoPtr);
+#endif
+#ifndef Tcl_GetCommandName_TCL_DECLARED
+#define Tcl_GetCommandName_TCL_DECLARED
 /* 160 */
-EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Command command));
+EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+				Tcl_Command command);
+#endif
+#ifndef Tcl_GetErrno_TCL_DECLARED
+#define Tcl_GetErrno_TCL_DECLARED
 /* 161 */
-EXTERN int		Tcl_GetErrno _ANSI_ARGS_((void));
+EXTERN int		Tcl_GetErrno(void);
+#endif
+#ifndef Tcl_GetHostName_TCL_DECLARED
+#define Tcl_GetHostName_TCL_DECLARED
 /* 162 */
-EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
+#endif
+#ifndef Tcl_GetInterpPath_TCL_DECLARED
+#define Tcl_GetInterpPath_TCL_DECLARED
 /* 163 */
-EXTERN int		Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
-				Tcl_Interp *slaveInterp));
+EXTERN int		Tcl_GetInterpPath(Tcl_Interp *askInterp,
+				Tcl_Interp *slaveInterp);
+#endif
+#ifndef Tcl_GetMaster_TCL_DECLARED
+#define Tcl_GetMaster_TCL_DECLARED
 /* 164 */
-EXTERN Tcl_Interp *	Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetNameOfExecutable_TCL_DECLARED
+#define Tcl_GetNameOfExecutable_TCL_DECLARED
 /* 165 */
-EXTERN CONST char *	Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
+EXTERN CONST char *	Tcl_GetNameOfExecutable(void);
+#endif
+#ifndef Tcl_GetObjResult_TCL_DECLARED
+#define Tcl_GetObjResult_TCL_DECLARED
 /* 166 */
-EXTERN Tcl_Obj *	Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
+#endif
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#ifndef Tcl_GetOpenFile_TCL_DECLARED
+#define Tcl_GetOpenFile_TCL_DECLARED
 /* 167 */
-EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
 				CONST char *chanID, int forWriting,
-				int checkUsage, ClientData *filePtr));
+				int checkUsage, ClientData *filePtr);
+#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
+#ifndef Tcl_GetOpenFile_TCL_DECLARED
+#define Tcl_GetOpenFile_TCL_DECLARED
 /* 167 */
-EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
 				CONST char *chanID, int forWriting,
-				int checkUsage, ClientData *filePtr));
+				int checkUsage, ClientData *filePtr);
+#endif
 #endif /* MACOSX */
+#ifndef Tcl_GetPathType_TCL_DECLARED
+#define Tcl_GetPathType_TCL_DECLARED
 /* 168 */
-EXTERN Tcl_PathType	Tcl_GetPathType _ANSI_ARGS_((CONST char *path));
+EXTERN Tcl_PathType	Tcl_GetPathType(CONST char *path);
+#endif
+#ifndef Tcl_Gets_TCL_DECLARED
+#define Tcl_Gets_TCL_DECLARED
 /* 169 */
-EXTERN int		Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_DString *dsPtr));
+EXTERN int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_GetsObj_TCL_DECLARED
+#define Tcl_GetsObj_TCL_DECLARED
 /* 170 */
-EXTERN int		Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_Obj *objPtr));
+EXTERN int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetServiceMode_TCL_DECLARED
+#define Tcl_GetServiceMode_TCL_DECLARED
 /* 171 */
-EXTERN int		Tcl_GetServiceMode _ANSI_ARGS_((void));
+EXTERN int		Tcl_GetServiceMode(void);
+#endif
+#ifndef Tcl_GetSlave_TCL_DECLARED
+#define Tcl_GetSlave_TCL_DECLARED
 /* 172 */
-EXTERN Tcl_Interp *	Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *slaveName));
+EXTERN Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
+				CONST char *slaveName);
+#endif
+#ifndef Tcl_GetStdChannel_TCL_DECLARED
+#define Tcl_GetStdChannel_TCL_DECLARED
 /* 173 */
-EXTERN Tcl_Channel	Tcl_GetStdChannel _ANSI_ARGS_((int type));
+EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
+#endif
+#ifndef Tcl_GetStringResult_TCL_DECLARED
+#define Tcl_GetStringResult_TCL_DECLARED
 /* 174 */
-EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_((
-				Tcl_Interp *interp));
+EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetVar_TCL_DECLARED
+#define Tcl_GetVar_TCL_DECLARED
 /* 175 */
-EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName, int flags));
+EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
+				CONST char *varName, int flags);
+#endif
+#ifndef Tcl_GetVar2_TCL_DECLARED
+#define Tcl_GetVar2_TCL_DECLARED
 /* 176 */
-EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
 				CONST char *part1, CONST char *part2,
-				int flags));
+				int flags);
+#endif
+#ifndef Tcl_GlobalEval_TCL_DECLARED
+#define Tcl_GlobalEval_TCL_DECLARED
 /* 177 */
-EXTERN int		Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *command));
+EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
+				CONST char *command);
+#endif
+#ifndef Tcl_GlobalEvalObj_TCL_DECLARED
+#define Tcl_GlobalEvalObj_TCL_DECLARED
 /* 178 */
-EXTERN int		Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr));
+EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_HideCommand_TCL_DECLARED
+#define Tcl_HideCommand_TCL_DECLARED
 /* 179 */
-EXTERN int		Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
 				CONST char *cmdName,
-				CONST char *hiddenCmdToken));
+				CONST char *hiddenCmdToken);
+#endif
+#ifndef Tcl_Init_TCL_DECLARED
+#define Tcl_Init_TCL_DECLARED
 /* 180 */
-EXTERN int		Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_Init(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_InitHashTable_TCL_DECLARED
+#define Tcl_InitHashTable_TCL_DECLARED
 /* 181 */
-EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr, int keyType));
+EXTERN void		Tcl_InitHashTable(Tcl_HashTable *tablePtr,
+				int keyType);
+#endif
+#ifndef Tcl_InputBlocked_TCL_DECLARED
+#define Tcl_InputBlocked_TCL_DECLARED
 /* 182 */
-EXTERN int		Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_InputBlocked(Tcl_Channel chan);
+#endif
+#ifndef Tcl_InputBuffered_TCL_DECLARED
+#define Tcl_InputBuffered_TCL_DECLARED
 /* 183 */
-EXTERN int		Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_InputBuffered(Tcl_Channel chan);
+#endif
+#ifndef Tcl_InterpDeleted_TCL_DECLARED
+#define Tcl_InterpDeleted_TCL_DECLARED
 /* 184 */
-EXTERN int		Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_InterpDeleted(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_IsSafe_TCL_DECLARED
+#define Tcl_IsSafe_TCL_DECLARED
 /* 185 */
-EXTERN int		Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_JoinPath_TCL_DECLARED
+#define Tcl_JoinPath_TCL_DECLARED
 /* 186 */
-EXTERN char *		Tcl_JoinPath _ANSI_ARGS_((int argc,
-				CONST84 char *CONST *argv,
-				Tcl_DString *resultPtr));
+EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *CONST *argv,
+				Tcl_DString *resultPtr);
+#endif
+#ifndef Tcl_LinkVar_TCL_DECLARED
+#define Tcl_LinkVar_TCL_DECLARED
 /* 187 */
-EXTERN int		Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName, char *addr, int type));
+EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName,
+				char *addr, int type);
+#endif
 /* Slot 188 is reserved */
+#ifndef Tcl_MakeFileChannel_TCL_DECLARED
+#define Tcl_MakeFileChannel_TCL_DECLARED
 /* 189 */
-EXTERN Tcl_Channel	Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
-				int mode));
+EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
+#endif
+#ifndef Tcl_MakeSafe_TCL_DECLARED
+#define Tcl_MakeSafe_TCL_DECLARED
 /* 190 */
-EXTERN int		Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_MakeTcpClientChannel_TCL_DECLARED
+#define Tcl_MakeTcpClientChannel_TCL_DECLARED
 /* 191 */
-EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel _ANSI_ARGS_((
-				ClientData tcpSocket));
+EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
+#endif
+#ifndef Tcl_Merge_TCL_DECLARED
+#define Tcl_Merge_TCL_DECLARED
 /* 192 */
-EXTERN char *		Tcl_Merge _ANSI_ARGS_((int argc,
-				CONST84 char *CONST *argv));
+EXTERN char *		Tcl_Merge(int argc, CONST84 char *CONST *argv);
+#endif
+#ifndef Tcl_NextHashEntry_TCL_DECLARED
+#define Tcl_NextHashEntry_TCL_DECLARED
 /* 193 */
-EXTERN Tcl_HashEntry *	Tcl_NextHashEntry _ANSI_ARGS_((
-				Tcl_HashSearch *searchPtr));
+EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
+#endif
+#ifndef Tcl_NotifyChannel_TCL_DECLARED
+#define Tcl_NotifyChannel_TCL_DECLARED
 /* 194 */
-EXTERN void		Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
-				int mask));
+EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
+#endif
+#ifndef Tcl_ObjGetVar2_TCL_DECLARED
+#define Tcl_ObjGetVar2_TCL_DECLARED
 /* 195 */
-EXTERN Tcl_Obj *	Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
-				int flags));
+EXTERN Tcl_Obj *	Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, int flags);
+#endif
+#ifndef Tcl_ObjSetVar2_TCL_DECLARED
+#define Tcl_ObjSetVar2_TCL_DECLARED
 /* 196 */
-EXTERN Tcl_Obj *	Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
-				Tcl_Obj *newValuePtr, int flags));
+EXTERN Tcl_Obj *	Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
+				int flags);
+#endif
+#ifndef Tcl_OpenCommandChannel_TCL_DECLARED
+#define Tcl_OpenCommandChannel_TCL_DECLARED
 /* 197 */
-EXTERN Tcl_Channel	Tcl_OpenCommandChannel _ANSI_ARGS_((
-				Tcl_Interp *interp, int argc,
-				CONST84 char **argv, int flags));
+EXTERN Tcl_Channel	Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
+				CONST84 char **argv, int flags);
+#endif
+#ifndef Tcl_OpenFileChannel_TCL_DECLARED
+#define Tcl_OpenFileChannel_TCL_DECLARED
 /* 198 */
-EXTERN Tcl_Channel	Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
 				CONST char *fileName, CONST char *modeString,
-				int permissions));
+				int permissions);
+#endif
+#ifndef Tcl_OpenTcpClient_TCL_DECLARED
+#define Tcl_OpenTcpClient_TCL_DECLARED
 /* 199 */
-EXTERN Tcl_Channel	Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp *interp,
-				int port, CONST char *address,
-				CONST char *myaddr, int myport, int async));
+EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
+				CONST char *address, CONST char *myaddr,
+				int myport, int async);
+#endif
+#ifndef Tcl_OpenTcpServer_TCL_DECLARED
+#define Tcl_OpenTcpServer_TCL_DECLARED
 /* 200 */
-EXTERN Tcl_Channel	Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp *interp,
-				int port, CONST char *host,
+EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
+				CONST char *host,
 				Tcl_TcpAcceptProc *acceptProc,
-				ClientData callbackData));
+				ClientData callbackData);
+#endif
+#ifndef Tcl_Preserve_TCL_DECLARED
+#define Tcl_Preserve_TCL_DECLARED
 /* 201 */
-EXTERN void		Tcl_Preserve _ANSI_ARGS_((ClientData data));
+EXTERN void		Tcl_Preserve(ClientData data);
+#endif
+#ifndef Tcl_PrintDouble_TCL_DECLARED
+#define Tcl_PrintDouble_TCL_DECLARED
 /* 202 */
-EXTERN void		Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
-				double value, char *dst));
+EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
+				char *dst);
+#endif
+#ifndef Tcl_PutEnv_TCL_DECLARED
+#define Tcl_PutEnv_TCL_DECLARED
 /* 203 */
-EXTERN int		Tcl_PutEnv _ANSI_ARGS_((CONST char *assignment));
+EXTERN int		Tcl_PutEnv(CONST char *assignment);
+#endif
+#ifndef Tcl_PosixError_TCL_DECLARED
+#define Tcl_PosixError_TCL_DECLARED
 /* 204 */
-EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_QueueEvent_TCL_DECLARED
+#define Tcl_QueueEvent_TCL_DECLARED
 /* 205 */
-EXTERN void		Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event *evPtr,
-				Tcl_QueuePosition position));
+EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
+				Tcl_QueuePosition position);
+#endif
+#ifndef Tcl_Read_TCL_DECLARED
+#define Tcl_Read_TCL_DECLARED
 /* 206 */
-EXTERN int		Tcl_Read _ANSI_ARGS_((Tcl_Channel chan, char *bufPtr,
-				int toRead));
+EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
+#endif
+#ifndef Tcl_ReapDetachedProcs_TCL_DECLARED
+#define Tcl_ReapDetachedProcs_TCL_DECLARED
 /* 207 */
-EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+EXTERN void		Tcl_ReapDetachedProcs(void);
+#endif
+#ifndef Tcl_RecordAndEval_TCL_DECLARED
+#define Tcl_RecordAndEval_TCL_DECLARED
 /* 208 */
-EXTERN int		Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *cmd, int flags));
+EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
+				CONST char *cmd, int flags);
+#endif
+#ifndef Tcl_RecordAndEvalObj_TCL_DECLARED
+#define Tcl_RecordAndEvalObj_TCL_DECLARED
 /* 209 */
-EXTERN int		Tcl_RecordAndEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *cmdPtr, int flags));
+EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
+				Tcl_Obj *cmdPtr, int flags);
+#endif
+#ifndef Tcl_RegisterChannel_TCL_DECLARED
+#define Tcl_RegisterChannel_TCL_DECLARED
 /* 210 */
-EXTERN void		Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN void		Tcl_RegisterChannel(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef Tcl_RegisterObjType_TCL_DECLARED
+#define Tcl_RegisterObjType_TCL_DECLARED
 /* 211 */
-EXTERN void		Tcl_RegisterObjType _ANSI_ARGS_((
-				Tcl_ObjType *typePtr));
+EXTERN void		Tcl_RegisterObjType(Tcl_ObjType *typePtr);
+#endif
+#ifndef Tcl_RegExpCompile_TCL_DECLARED
+#define Tcl_RegExpCompile_TCL_DECLARED
 /* 212 */
-EXTERN Tcl_RegExp	Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *pattern));
+EXTERN Tcl_RegExp	Tcl_RegExpCompile(Tcl_Interp *interp,
+				CONST char *pattern);
+#endif
+#ifndef Tcl_RegExpExec_TCL_DECLARED
+#define Tcl_RegExpExec_TCL_DECLARED
 /* 213 */
-EXTERN int		Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_RegExp regexp, CONST char *text,
-				CONST char *start));
+EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
+				CONST char *text, CONST char *start);
+#endif
+#ifndef Tcl_RegExpMatch_TCL_DECLARED
+#define Tcl_RegExpMatch_TCL_DECLARED
 /* 214 */
-EXTERN int		Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *text, CONST char *pattern));
+EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text,
+				CONST char *pattern);
+#endif
+#ifndef Tcl_RegExpRange_TCL_DECLARED
+#define Tcl_RegExpRange_TCL_DECLARED
 /* 215 */
-EXTERN void		Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
-				int index, CONST84 char **startPtr,
-				CONST84 char **endPtr));
+EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
+				CONST84 char **startPtr,
+				CONST84 char **endPtr);
+#endif
+#ifndef Tcl_Release_TCL_DECLARED
+#define Tcl_Release_TCL_DECLARED
 /* 216 */
-EXTERN void		Tcl_Release _ANSI_ARGS_((ClientData clientData));
+EXTERN void		Tcl_Release(ClientData clientData);
+#endif
+#ifndef Tcl_ResetResult_TCL_DECLARED
+#define Tcl_ResetResult_TCL_DECLARED
 /* 217 */
-EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_ScanElement_TCL_DECLARED
+#define Tcl_ScanElement_TCL_DECLARED
 /* 218 */
-EXTERN int		Tcl_ScanElement _ANSI_ARGS_((CONST char *src,
-				int *flagPtr));
+EXTERN int		Tcl_ScanElement(CONST char *src, int *flagPtr);
+#endif
+#ifndef Tcl_ScanCountedElement_TCL_DECLARED
+#define Tcl_ScanCountedElement_TCL_DECLARED
 /* 219 */
-EXTERN int		Tcl_ScanCountedElement _ANSI_ARGS_((CONST char *src,
-				int length, int *flagPtr));
+EXTERN int		Tcl_ScanCountedElement(CONST char *src, int length,
+				int *flagPtr);
+#endif
+#ifndef Tcl_SeekOld_TCL_DECLARED
+#define Tcl_SeekOld_TCL_DECLARED
 /* 220 */
-EXTERN int		Tcl_SeekOld _ANSI_ARGS_((Tcl_Channel chan,
-				int offset, int mode));
+EXTERN int		Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
+#endif
+#ifndef Tcl_ServiceAll_TCL_DECLARED
+#define Tcl_ServiceAll_TCL_DECLARED
 /* 221 */
-EXTERN int		Tcl_ServiceAll _ANSI_ARGS_((void));
+EXTERN int		Tcl_ServiceAll(void);
+#endif
+#ifndef Tcl_ServiceEvent_TCL_DECLARED
+#define Tcl_ServiceEvent_TCL_DECLARED
 /* 222 */
-EXTERN int		Tcl_ServiceEvent _ANSI_ARGS_((int flags));
+EXTERN int		Tcl_ServiceEvent(int flags);
+#endif
+#ifndef Tcl_SetAssocData_TCL_DECLARED
+#define Tcl_SetAssocData_TCL_DECLARED
 /* 223 */
-EXTERN void		Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
 				CONST char *name, Tcl_InterpDeleteProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_SetChannelBufferSize_TCL_DECLARED
+#define Tcl_SetChannelBufferSize_TCL_DECLARED
 /* 224 */
-EXTERN void		Tcl_SetChannelBufferSize _ANSI_ARGS_((
-				Tcl_Channel chan, int sz));
+EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
+#endif
+#ifndef Tcl_SetChannelOption_TCL_DECLARED
+#define Tcl_SetChannelOption_TCL_DECLARED
 /* 225 */
-EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
 				Tcl_Channel chan, CONST char *optionName,
-				CONST char *newValue));
+				CONST char *newValue);
+#endif
+#ifndef Tcl_SetCommandInfo_TCL_DECLARED
+#define Tcl_SetCommandInfo_TCL_DECLARED
 /* 226 */
-EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
 				CONST char *cmdName,
-				CONST Tcl_CmdInfo *infoPtr));
+				CONST Tcl_CmdInfo *infoPtr);
+#endif
+#ifndef Tcl_SetErrno_TCL_DECLARED
+#define Tcl_SetErrno_TCL_DECLARED
 /* 227 */
-EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
+EXTERN void		Tcl_SetErrno(int err);
+#endif
+#ifndef Tcl_SetErrorCode_TCL_DECLARED
+#define Tcl_SetErrorCode_TCL_DECLARED
 /* 228 */
-EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
+#endif
+#ifndef Tcl_SetMaxBlockTime_TCL_DECLARED
+#define Tcl_SetMaxBlockTime_TCL_DECLARED
 /* 229 */
-EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
+EXTERN void		Tcl_SetMaxBlockTime(Tcl_Time *timePtr);
+#endif
+#ifndef Tcl_SetPanicProc_TCL_DECLARED
+#define Tcl_SetPanicProc_TCL_DECLARED
 /* 230 */
-EXTERN void		Tcl_SetPanicProc _ANSI_ARGS_((
-				Tcl_PanicProc *panicProc));
+EXTERN void		Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
+#endif
+#ifndef Tcl_SetRecursionLimit_TCL_DECLARED
+#define Tcl_SetRecursionLimit_TCL_DECLARED
 /* 231 */
-EXTERN int		Tcl_SetRecursionLimit _ANSI_ARGS_((
-				Tcl_Interp *interp, int depth));
+EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
+#endif
+#ifndef Tcl_SetResult_TCL_DECLARED
+#define Tcl_SetResult_TCL_DECLARED
 /* 232 */
-EXTERN void		Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
-				char *result, Tcl_FreeProc *freeProc));
+EXTERN void		Tcl_SetResult(Tcl_Interp *interp, char *result,
+				Tcl_FreeProc *freeProc);
+#endif
+#ifndef Tcl_SetServiceMode_TCL_DECLARED
+#define Tcl_SetServiceMode_TCL_DECLARED
 /* 233 */
-EXTERN int		Tcl_SetServiceMode _ANSI_ARGS_((int mode));
+EXTERN int		Tcl_SetServiceMode(int mode);
+#endif
+#ifndef Tcl_SetObjErrorCode_TCL_DECLARED
+#define Tcl_SetObjErrorCode_TCL_DECLARED
 /* 234 */
-EXTERN void		Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *errorObjPtr));
+EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
+				Tcl_Obj *errorObjPtr);
+#endif
+#ifndef Tcl_SetObjResult_TCL_DECLARED
+#define Tcl_SetObjResult_TCL_DECLARED
 /* 235 */
-EXTERN void		Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *resultObjPtr));
+EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
+				Tcl_Obj *resultObjPtr);
+#endif
+#ifndef Tcl_SetStdChannel_TCL_DECLARED
+#define Tcl_SetStdChannel_TCL_DECLARED
 /* 236 */
-EXTERN void		Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
-				int type));
+EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
+#endif
+#ifndef Tcl_SetVar_TCL_DECLARED
+#define Tcl_SetVar_TCL_DECLARED
 /* 237 */
-EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
 				CONST char *varName, CONST char *newValue,
-				int flags));
+				int flags);
+#endif
+#ifndef Tcl_SetVar2_TCL_DECLARED
+#define Tcl_SetVar2_TCL_DECLARED
 /* 238 */
-EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
 				CONST char *part1, CONST char *part2,
-				CONST char *newValue, int flags));
+				CONST char *newValue, int flags);
+#endif
+#ifndef Tcl_SignalId_TCL_DECLARED
+#define Tcl_SignalId_TCL_DECLARED
 /* 239 */
-EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
+#endif
+#ifndef Tcl_SignalMsg_TCL_DECLARED
+#define Tcl_SignalMsg_TCL_DECLARED
 /* 240 */
-EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
+#endif
+#ifndef Tcl_SourceRCFile_TCL_DECLARED
+#define Tcl_SourceRCFile_TCL_DECLARED
 /* 241 */
-EXTERN void		Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_SplitList_TCL_DECLARED
+#define Tcl_SplitList_TCL_DECLARED
 /* 242 */
-EXTERN int		Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
 				CONST char *listStr, int *argcPtr,
-				CONST84 char ***argvPtr));
+				CONST84 char ***argvPtr);
+#endif
+#ifndef Tcl_SplitPath_TCL_DECLARED
+#define Tcl_SplitPath_TCL_DECLARED
 /* 243 */
-EXTERN void		Tcl_SplitPath _ANSI_ARGS_((CONST char *path,
-				int *argcPtr, CONST84 char ***argvPtr));
+EXTERN void		Tcl_SplitPath(CONST char *path, int *argcPtr,
+				CONST84 char ***argvPtr);
+#endif
+#ifndef Tcl_StaticPackage_TCL_DECLARED
+#define Tcl_StaticPackage_TCL_DECLARED
 /* 244 */
-EXTERN void		Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
 				CONST char *pkgName,
 				Tcl_PackageInitProc *initProc,
-				Tcl_PackageInitProc *safeInitProc));
+				Tcl_PackageInitProc *safeInitProc);
+#endif
+#ifndef Tcl_StringMatch_TCL_DECLARED
+#define Tcl_StringMatch_TCL_DECLARED
 /* 245 */
-EXTERN int		Tcl_StringMatch _ANSI_ARGS_((CONST char *str,
-				CONST char *pattern));
+EXTERN int		Tcl_StringMatch(CONST char *str, CONST char *pattern);
+#endif
+#ifndef Tcl_TellOld_TCL_DECLARED
+#define Tcl_TellOld_TCL_DECLARED
 /* 246 */
-EXTERN int		Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_TellOld(Tcl_Channel chan);
+#endif
+#ifndef Tcl_TraceVar_TCL_DECLARED
+#define Tcl_TraceVar_TCL_DECLARED
 /* 247 */
-EXTERN int		Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName, int flags,
-				Tcl_VarTraceProc *proc,
-				ClientData clientData));
-/* 248 */
-EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
+EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName,
 				int flags, Tcl_VarTraceProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_TraceVar2_TCL_DECLARED
+#define Tcl_TraceVar2_TCL_DECLARED
+/* 248 */
+EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, int flags,
+				Tcl_VarTraceProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_TranslateFileName_TCL_DECLARED
+#define Tcl_TranslateFileName_TCL_DECLARED
 /* 249 */
-EXTERN char *		Tcl_TranslateFileName _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name,
-				Tcl_DString *bufferPtr));
+EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
+				CONST char *name, Tcl_DString *bufferPtr);
+#endif
+#ifndef Tcl_Ungets_TCL_DECLARED
+#define Tcl_Ungets_TCL_DECLARED
 /* 250 */
-EXTERN int		Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan,
-				CONST char *str, int len, int atHead));
+EXTERN int		Tcl_Ungets(Tcl_Channel chan, CONST char *str,
+				int len, int atHead);
+#endif
+#ifndef Tcl_UnlinkVar_TCL_DECLARED
+#define Tcl_UnlinkVar_TCL_DECLARED
 /* 251 */
-EXTERN void		Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName));
+EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
+				CONST char *varName);
+#endif
+#ifndef Tcl_UnregisterChannel_TCL_DECLARED
+#define Tcl_UnregisterChannel_TCL_DECLARED
 /* 252 */
-EXTERN int		Tcl_UnregisterChannel _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Channel chan));
+EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef Tcl_UnsetVar_TCL_DECLARED
+#define Tcl_UnsetVar_TCL_DECLARED
 /* 253 */
-EXTERN int		Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName, int flags));
+EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName,
+				int flags);
+#endif
+#ifndef Tcl_UnsetVar2_TCL_DECLARED
+#define Tcl_UnsetVar2_TCL_DECLARED
 /* 254 */
-EXTERN int		Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
-				int flags));
+EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, int flags);
+#endif
+#ifndef Tcl_UntraceVar_TCL_DECLARED
+#define Tcl_UntraceVar_TCL_DECLARED
 /* 255 */
-EXTERN void		Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
 				CONST char *varName, int flags,
 				Tcl_VarTraceProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_UntraceVar2_TCL_DECLARED
+#define Tcl_UntraceVar2_TCL_DECLARED
 /* 256 */
-EXTERN void		Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
 				CONST char *part1, CONST char *part2,
 				int flags, Tcl_VarTraceProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_UpdateLinkedVar_TCL_DECLARED
+#define Tcl_UpdateLinkedVar_TCL_DECLARED
 /* 257 */
-EXTERN void		Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName));
+EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
+				CONST char *varName);
+#endif
+#ifndef Tcl_UpVar_TCL_DECLARED
+#define Tcl_UpVar_TCL_DECLARED
 /* 258 */
-EXTERN int		Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *frameName, CONST char *varName,
-				CONST char *localName, int flags));
+EXTERN int		Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName,
+				CONST char *varName, CONST char *localName,
+				int flags);
+#endif
+#ifndef Tcl_UpVar2_TCL_DECLARED
+#define Tcl_UpVar2_TCL_DECLARED
 /* 259 */
-EXTERN int		Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *frameName, CONST char *part1,
-				CONST char *part2, CONST char *localName,
-				int flags));
+EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName,
+				CONST char *part1, CONST char *part2,
+				CONST char *localName, int flags);
+#endif
+#ifndef Tcl_VarEval_TCL_DECLARED
+#define Tcl_VarEval_TCL_DECLARED
 /* 260 */
-EXTERN int		Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
+#endif
+#ifndef Tcl_VarTraceInfo_TCL_DECLARED
+#define Tcl_VarTraceInfo_TCL_DECLARED
 /* 261 */
-EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
 				CONST char *varName, int flags,
 				Tcl_VarTraceProc *procPtr,
-				ClientData prevClientData));
+				ClientData prevClientData);
+#endif
+#ifndef Tcl_VarTraceInfo2_TCL_DECLARED
+#define Tcl_VarTraceInfo2_TCL_DECLARED
 /* 262 */
-EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
 				CONST char *part1, CONST char *part2,
 				int flags, Tcl_VarTraceProc *procPtr,
-				ClientData prevClientData));
+				ClientData prevClientData);
+#endif
+#ifndef Tcl_Write_TCL_DECLARED
+#define Tcl_Write_TCL_DECLARED
 /* 263 */
-EXTERN int		Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
-				CONST char *s, int slen));
+EXTERN int		Tcl_Write(Tcl_Channel chan, CONST char *s, int slen);
+#endif
+#ifndef Tcl_WrongNumArgs_TCL_DECLARED
+#define Tcl_WrongNumArgs_TCL_DECLARED
 /* 264 */
-EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
-				int objc, Tcl_Obj *CONST objv[],
-				CONST char *message));
+EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
+				Tcl_Obj *CONST objv[], CONST char *message);
+#endif
+#ifndef Tcl_DumpActiveMemory_TCL_DECLARED
+#define Tcl_DumpActiveMemory_TCL_DECLARED
 /* 265 */
-EXTERN int		Tcl_DumpActiveMemory _ANSI_ARGS_((
-				CONST char *fileName));
+EXTERN int		Tcl_DumpActiveMemory(CONST char *fileName);
+#endif
+#ifndef Tcl_ValidateAllMemory_TCL_DECLARED
+#define Tcl_ValidateAllMemory_TCL_DECLARED
 /* 266 */
-EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((CONST char *file,
-				int line));
+EXTERN void		Tcl_ValidateAllMemory(CONST char *file, int line);
+#endif
+#ifndef Tcl_AppendResultVA_TCL_DECLARED
+#define Tcl_AppendResultVA_TCL_DECLARED
 /* 267 */
-EXTERN void		Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp *interp,
-				va_list argList));
+EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
+				va_list argList);
+#endif
+#ifndef Tcl_AppendStringsToObjVA_TCL_DECLARED
+#define Tcl_AppendStringsToObjVA_TCL_DECLARED
 /* 268 */
-EXTERN void		Tcl_AppendStringsToObjVA _ANSI_ARGS_((
-				Tcl_Obj *objPtr, va_list argList));
+EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
+				va_list argList);
+#endif
+#ifndef Tcl_HashStats_TCL_DECLARED
+#define Tcl_HashStats_TCL_DECLARED
 /* 269 */
-EXTERN char *		Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
+#endif
+#ifndef Tcl_ParseVar_TCL_DECLARED
+#define Tcl_ParseVar_TCL_DECLARED
 /* 270 */
-EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *start, CONST84 char **termPtr));
+EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
+				CONST char *start, CONST84 char **termPtr);
+#endif
+#ifndef Tcl_PkgPresent_TCL_DECLARED
+#define Tcl_PkgPresent_TCL_DECLARED
 /* 271 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
 				CONST char *name, CONST char *version,
-				int exact));
+				int exact);
+#endif
+#ifndef Tcl_PkgPresentEx_TCL_DECLARED
+#define Tcl_PkgPresentEx_TCL_DECLARED
 /* 272 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name,
-				CONST char *version, int exact,
-				ClientData *clientDataPtr));
+EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
+				CONST char *name, CONST char *version,
+				int exact, ClientData *clientDataPtr);
+#endif
+#ifndef Tcl_PkgProvide_TCL_DECLARED
+#define Tcl_PkgProvide_TCL_DECLARED
 /* 273 */
-EXTERN int		Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *name, CONST char *version));
+EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name,
+				CONST char *version);
+#endif
+#ifndef Tcl_PkgRequire_TCL_DECLARED
+#define Tcl_PkgRequire_TCL_DECLARED
 /* 274 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
 				CONST char *name, CONST char *version,
-				int exact));
+				int exact);
+#endif
+#ifndef Tcl_SetErrorCodeVA_TCL_DECLARED
+#define Tcl_SetErrorCodeVA_TCL_DECLARED
 /* 275 */
-EXTERN void		Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp *interp,
-				va_list argList));
+EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
+				va_list argList);
+#endif
+#ifndef Tcl_VarEvalVA_TCL_DECLARED
+#define Tcl_VarEvalVA_TCL_DECLARED
 /* 276 */
-EXTERN int		Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp *interp,
-				va_list argList));
+EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
+#endif
+#ifndef Tcl_WaitPid_TCL_DECLARED
+#define Tcl_WaitPid_TCL_DECLARED
 /* 277 */
-EXTERN Tcl_Pid		Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int *statPtr,
-				int options));
+EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
+#endif
+#ifndef Tcl_PanicVA_TCL_DECLARED
+#define Tcl_PanicVA_TCL_DECLARED
 /* 278 */
-EXTERN void		Tcl_PanicVA _ANSI_ARGS_((CONST char *format,
-				va_list argList));
+EXTERN void		Tcl_PanicVA(CONST char *format, va_list argList);
+#endif
+#ifndef Tcl_GetVersion_TCL_DECLARED
+#define Tcl_GetVersion_TCL_DECLARED
 /* 279 */
-EXTERN void		Tcl_GetVersion _ANSI_ARGS_((int *major, int *minor,
-				int *patchLevel, int *type));
+EXTERN void		Tcl_GetVersion(int *major, int *minor,
+				int *patchLevel, int *type);
+#endif
+#ifndef Tcl_InitMemory_TCL_DECLARED
+#define Tcl_InitMemory_TCL_DECLARED
 /* 280 */
-EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_StackChannel_TCL_DECLARED
+#define Tcl_StackChannel_TCL_DECLARED
 /* 281 */
-EXTERN Tcl_Channel	Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
 				Tcl_ChannelType *typePtr,
 				ClientData instanceData, int mask,
-				Tcl_Channel prevChan));
+				Tcl_Channel prevChan);
+#endif
+#ifndef Tcl_UnstackChannel_TCL_DECLARED
+#define Tcl_UnstackChannel_TCL_DECLARED
 /* 282 */
-EXTERN int		Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef Tcl_GetStackedChannel_TCL_DECLARED
+#define Tcl_GetStackedChannel_TCL_DECLARED
 /* 283 */
-EXTERN Tcl_Channel	Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
+#endif
+#ifndef Tcl_SetMainLoop_TCL_DECLARED
+#define Tcl_SetMainLoop_TCL_DECLARED
 /* 284 */
-EXTERN void		Tcl_SetMainLoop _ANSI_ARGS_((Tcl_MainLoopProc *proc));
+EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
+#endif
 /* Slot 285 is reserved */
+#ifndef Tcl_AppendObjToObj_TCL_DECLARED
+#define Tcl_AppendObjToObj_TCL_DECLARED
 /* 286 */
-EXTERN void		Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				Tcl_Obj *appendObjPtr));
+EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
+				Tcl_Obj *appendObjPtr);
+#endif
+#ifndef Tcl_CreateEncoding_TCL_DECLARED
+#define Tcl_CreateEncoding_TCL_DECLARED
 /* 287 */
-EXTERN Tcl_Encoding	Tcl_CreateEncoding _ANSI_ARGS_((
-				Tcl_EncodingType *typePtr));
+EXTERN Tcl_Encoding	Tcl_CreateEncoding(CONST Tcl_EncodingType *typePtr);
+#endif
+#ifndef Tcl_CreateThreadExitHandler_TCL_DECLARED
+#define Tcl_CreateThreadExitHandler_TCL_DECLARED
 /* 288 */
-EXTERN void		Tcl_CreateThreadExitHandler _ANSI_ARGS_((
-				Tcl_ExitProc *proc, ClientData clientData));
+EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DeleteThreadExitHandler_TCL_DECLARED
+#define Tcl_DeleteThreadExitHandler_TCL_DECLARED
 /* 289 */
-EXTERN void		Tcl_DeleteThreadExitHandler _ANSI_ARGS_((
-				Tcl_ExitProc *proc, ClientData clientData));
+EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_DiscardResult_TCL_DECLARED
+#define Tcl_DiscardResult_TCL_DECLARED
 /* 290 */
-EXTERN void		Tcl_DiscardResult _ANSI_ARGS_((
-				Tcl_SavedResult *statePtr));
+EXTERN void		Tcl_DiscardResult(Tcl_SavedResult *statePtr);
+#endif
+#ifndef Tcl_EvalEx_TCL_DECLARED
+#define Tcl_EvalEx_TCL_DECLARED
 /* 291 */
-EXTERN int		Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *script, int numBytes, int flags));
+EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, CONST char *script,
+				int numBytes, int flags);
+#endif
+#ifndef Tcl_EvalObjv_TCL_DECLARED
+#define Tcl_EvalObjv_TCL_DECLARED
 /* 292 */
-EXTERN int		Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp *interp,
-				int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
+				Tcl_Obj *CONST objv[], int flags);
+#endif
+#ifndef Tcl_EvalObjEx_TCL_DECLARED
+#define Tcl_EvalObjEx_TCL_DECLARED
 /* 293 */
-EXTERN int		Tcl_EvalObjEx _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int flags));
+EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				int flags);
+#endif
+#ifndef Tcl_ExitThread_TCL_DECLARED
+#define Tcl_ExitThread_TCL_DECLARED
 /* 294 */
-EXTERN void		Tcl_ExitThread _ANSI_ARGS_((int status));
+EXTERN void		Tcl_ExitThread(int status);
+#endif
+#ifndef Tcl_ExternalToUtf_TCL_DECLARED
+#define Tcl_ExternalToUtf_TCL_DECLARED
 /* 295 */
-EXTERN int		Tcl_ExternalToUtf _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ExternalToUtf(Tcl_Interp *interp,
 				Tcl_Encoding encoding, CONST char *src,
 				int srcLen, int flags,
 				Tcl_EncodingState *statePtr, char *dst,
 				int dstLen, int *srcReadPtr,
-				int *dstWrotePtr, int *dstCharsPtr));
+				int *dstWrotePtr, int *dstCharsPtr);
+#endif
+#ifndef Tcl_ExternalToUtfDString_TCL_DECLARED
+#define Tcl_ExternalToUtfDString_TCL_DECLARED
 /* 296 */
-EXTERN char *		Tcl_ExternalToUtfDString _ANSI_ARGS_((
-				Tcl_Encoding encoding, CONST char *src,
-				int srcLen, Tcl_DString *dsPtr));
+EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
+				CONST char *src, int srcLen,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_FinalizeThread_TCL_DECLARED
+#define Tcl_FinalizeThread_TCL_DECLARED
 /* 297 */
-EXTERN void		Tcl_FinalizeThread _ANSI_ARGS_((void));
+EXTERN void		Tcl_FinalizeThread(void);
+#endif
+#ifndef Tcl_FinalizeNotifier_TCL_DECLARED
+#define Tcl_FinalizeNotifier_TCL_DECLARED
 /* 298 */
-EXTERN void		Tcl_FinalizeNotifier _ANSI_ARGS_((
-				ClientData clientData));
+EXTERN void		Tcl_FinalizeNotifier(ClientData clientData);
+#endif
+#ifndef Tcl_FreeEncoding_TCL_DECLARED
+#define Tcl_FreeEncoding_TCL_DECLARED
 /* 299 */
-EXTERN void		Tcl_FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
+EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
+#endif
+#ifndef Tcl_GetCurrentThread_TCL_DECLARED
+#define Tcl_GetCurrentThread_TCL_DECLARED
 /* 300 */
-EXTERN Tcl_ThreadId	Tcl_GetCurrentThread _ANSI_ARGS_((void));
+EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
+#endif
+#ifndef Tcl_GetEncoding_TCL_DECLARED
+#define Tcl_GetEncoding_TCL_DECLARED
 /* 301 */
-EXTERN Tcl_Encoding	Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *name));
+EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name);
+#endif
+#ifndef Tcl_GetEncodingName_TCL_DECLARED
+#define Tcl_GetEncodingName_TCL_DECLARED
 /* 302 */
-EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_((
-				Tcl_Encoding encoding));
+EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
+#endif
+#ifndef Tcl_GetEncodingNames_TCL_DECLARED
+#define Tcl_GetEncodingNames_TCL_DECLARED
 /* 303 */
-EXTERN void		Tcl_GetEncodingNames _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetIndexFromObjStruct_TCL_DECLARED
+#define Tcl_GetIndexFromObjStruct_TCL_DECLARED
 /* 304 */
-EXTERN int		Tcl_GetIndexFromObjStruct _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr,
-				CONST VOID *tablePtr, int offset,
-				CONST char *msg, int flags, int *indexPtr));
+EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, CONST VOID *tablePtr,
+				int offset, CONST char *msg, int flags,
+				int *indexPtr);
+#endif
+#ifndef Tcl_GetThreadData_TCL_DECLARED
+#define Tcl_GetThreadData_TCL_DECLARED
 /* 305 */
-EXTERN VOID *		Tcl_GetThreadData _ANSI_ARGS_((
-				Tcl_ThreadDataKey *keyPtr, int size));
+EXTERN VOID *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
+				int size);
+#endif
+#ifndef Tcl_GetVar2Ex_TCL_DECLARED
+#define Tcl_GetVar2Ex_TCL_DECLARED
 /* 306 */
-EXTERN Tcl_Obj *	Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
-				int flags));
+EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, int flags);
+#endif
+#ifndef Tcl_InitNotifier_TCL_DECLARED
+#define Tcl_InitNotifier_TCL_DECLARED
 /* 307 */
-EXTERN ClientData	Tcl_InitNotifier _ANSI_ARGS_((void));
+EXTERN ClientData	Tcl_InitNotifier(void);
+#endif
+#ifndef Tcl_MutexLock_TCL_DECLARED
+#define Tcl_MutexLock_TCL_DECLARED
 /* 308 */
-EXTERN void		Tcl_MutexLock _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
+EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
+#endif
+#ifndef Tcl_MutexUnlock_TCL_DECLARED
+#define Tcl_MutexUnlock_TCL_DECLARED
 /* 309 */
-EXTERN void		Tcl_MutexUnlock _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
+EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
+#endif
+#ifndef Tcl_ConditionNotify_TCL_DECLARED
+#define Tcl_ConditionNotify_TCL_DECLARED
 /* 310 */
-EXTERN void		Tcl_ConditionNotify _ANSI_ARGS_((
-				Tcl_Condition *condPtr));
+EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
+#endif
+#ifndef Tcl_ConditionWait_TCL_DECLARED
+#define Tcl_ConditionWait_TCL_DECLARED
 /* 311 */
-EXTERN void		Tcl_ConditionWait _ANSI_ARGS_((
-				Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
-				Tcl_Time *timePtr));
+EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
+				Tcl_Mutex *mutexPtr, Tcl_Time *timePtr);
+#endif
+#ifndef Tcl_NumUtfChars_TCL_DECLARED
+#define Tcl_NumUtfChars_TCL_DECLARED
 /* 312 */
-EXTERN int		Tcl_NumUtfChars _ANSI_ARGS_((CONST char *src,
-				int length));
+EXTERN int		Tcl_NumUtfChars(CONST char *src, int length);
+#endif
+#ifndef Tcl_ReadChars_TCL_DECLARED
+#define Tcl_ReadChars_TCL_DECLARED
 /* 313 */
-EXTERN int		Tcl_ReadChars _ANSI_ARGS_((Tcl_Channel channel,
-				Tcl_Obj *objPtr, int charsToRead,
-				int appendFlag));
+EXTERN int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
+				int charsToRead, int appendFlag);
+#endif
+#ifndef Tcl_RestoreResult_TCL_DECLARED
+#define Tcl_RestoreResult_TCL_DECLARED
 /* 314 */
-EXTERN void		Tcl_RestoreResult _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_SavedResult *statePtr));
+EXTERN void		Tcl_RestoreResult(Tcl_Interp *interp,
+				Tcl_SavedResult *statePtr);
+#endif
+#ifndef Tcl_SaveResult_TCL_DECLARED
+#define Tcl_SaveResult_TCL_DECLARED
 /* 315 */
-EXTERN void		Tcl_SaveResult _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_SavedResult *statePtr));
+EXTERN void		Tcl_SaveResult(Tcl_Interp *interp,
+				Tcl_SavedResult *statePtr);
+#endif
+#ifndef Tcl_SetSystemEncoding_TCL_DECLARED
+#define Tcl_SetSystemEncoding_TCL_DECLARED
 /* 316 */
-EXTERN int		Tcl_SetSystemEncoding _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name));
+EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
+				CONST char *name);
+#endif
+#ifndef Tcl_SetVar2Ex_TCL_DECLARED
+#define Tcl_SetVar2Ex_TCL_DECLARED
 /* 317 */
-EXTERN Tcl_Obj *	Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
-				Tcl_Obj *newValuePtr, int flags));
+EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, Tcl_Obj *newValuePtr,
+				int flags);
+#endif
+#ifndef Tcl_ThreadAlert_TCL_DECLARED
+#define Tcl_ThreadAlert_TCL_DECLARED
 /* 318 */
-EXTERN void		Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
+EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
+#endif
+#ifndef Tcl_ThreadQueueEvent_TCL_DECLARED
+#define Tcl_ThreadQueueEvent_TCL_DECLARED
 /* 319 */
-EXTERN void		Tcl_ThreadQueueEvent _ANSI_ARGS_((
-				Tcl_ThreadId threadId, Tcl_Event *evPtr,
-				Tcl_QueuePosition position));
+EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
+				Tcl_Event *evPtr, Tcl_QueuePosition position);
+#endif
+#ifndef Tcl_UniCharAtIndex_TCL_DECLARED
+#define Tcl_UniCharAtIndex_TCL_DECLARED
 /* 320 */
-EXTERN Tcl_UniChar	Tcl_UniCharAtIndex _ANSI_ARGS_((CONST char *src,
-				int index));
+EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(CONST char *src, int index);
+#endif
+#ifndef Tcl_UniCharToLower_TCL_DECLARED
+#define Tcl_UniCharToLower_TCL_DECLARED
 /* 321 */
-EXTERN Tcl_UniChar	Tcl_UniCharToLower _ANSI_ARGS_((int ch));
+EXTERN Tcl_UniChar	Tcl_UniCharToLower(int ch);
+#endif
+#ifndef Tcl_UniCharToTitle_TCL_DECLARED
+#define Tcl_UniCharToTitle_TCL_DECLARED
 /* 322 */
-EXTERN Tcl_UniChar	Tcl_UniCharToTitle _ANSI_ARGS_((int ch));
+EXTERN Tcl_UniChar	Tcl_UniCharToTitle(int ch);
+#endif
+#ifndef Tcl_UniCharToUpper_TCL_DECLARED
+#define Tcl_UniCharToUpper_TCL_DECLARED
 /* 323 */
-EXTERN Tcl_UniChar	Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
+EXTERN Tcl_UniChar	Tcl_UniCharToUpper(int ch);
+#endif
+#ifndef Tcl_UniCharToUtf_TCL_DECLARED
+#define Tcl_UniCharToUtf_TCL_DECLARED
 /* 324 */
-EXTERN int		Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char *buf));
+EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
+#endif
+#ifndef Tcl_UtfAtIndex_TCL_DECLARED
+#define Tcl_UtfAtIndex_TCL_DECLARED
 /* 325 */
-EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char *src,
-				int index));
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index);
+#endif
+#ifndef Tcl_UtfCharComplete_TCL_DECLARED
+#define Tcl_UtfCharComplete_TCL_DECLARED
 /* 326 */
-EXTERN int		Tcl_UtfCharComplete _ANSI_ARGS_((CONST char *src,
-				int length));
+EXTERN int		Tcl_UtfCharComplete(CONST char *src, int length);
+#endif
+#ifndef Tcl_UtfBackslash_TCL_DECLARED
+#define Tcl_UtfBackslash_TCL_DECLARED
 /* 327 */
-EXTERN int		Tcl_UtfBackslash _ANSI_ARGS_((CONST char *src,
-				int *readPtr, char *dst));
+EXTERN int		Tcl_UtfBackslash(CONST char *src, int *readPtr,
+				char *dst);
+#endif
+#ifndef Tcl_UtfFindFirst_TCL_DECLARED
+#define Tcl_UtfFindFirst_TCL_DECLARED
 /* 328 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char *src,
-				int ch));
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch);
+#endif
+#ifndef Tcl_UtfFindLast_TCL_DECLARED
+#define Tcl_UtfFindLast_TCL_DECLARED
 /* 329 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char *src,
-				int ch));
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch);
+#endif
+#ifndef Tcl_UtfNext_TCL_DECLARED
+#define Tcl_UtfNext_TCL_DECLARED
 /* 330 */
-EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char *src));
+EXTERN CONST84_RETURN char * Tcl_UtfNext(CONST char *src);
+#endif
+#ifndef Tcl_UtfPrev_TCL_DECLARED
+#define Tcl_UtfPrev_TCL_DECLARED
 /* 331 */
-EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char *src,
-				CONST char *start));
+EXTERN CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start);
+#endif
+#ifndef Tcl_UtfToExternal_TCL_DECLARED
+#define Tcl_UtfToExternal_TCL_DECLARED
 /* 332 */
-EXTERN int		Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
 				Tcl_Encoding encoding, CONST char *src,
 				int srcLen, int flags,
 				Tcl_EncodingState *statePtr, char *dst,
 				int dstLen, int *srcReadPtr,
-				int *dstWrotePtr, int *dstCharsPtr));
+				int *dstWrotePtr, int *dstCharsPtr);
+#endif
+#ifndef Tcl_UtfToExternalDString_TCL_DECLARED
+#define Tcl_UtfToExternalDString_TCL_DECLARED
 /* 333 */
-EXTERN char *		Tcl_UtfToExternalDString _ANSI_ARGS_((
-				Tcl_Encoding encoding, CONST char *src,
-				int srcLen, Tcl_DString *dsPtr));
+EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
+				CONST char *src, int srcLen,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_UtfToLower_TCL_DECLARED
+#define Tcl_UtfToLower_TCL_DECLARED
 /* 334 */
-EXTERN int		Tcl_UtfToLower _ANSI_ARGS_((char *src));
+EXTERN int		Tcl_UtfToLower(char *src);
+#endif
+#ifndef Tcl_UtfToTitle_TCL_DECLARED
+#define Tcl_UtfToTitle_TCL_DECLARED
 /* 335 */
-EXTERN int		Tcl_UtfToTitle _ANSI_ARGS_((char *src));
+EXTERN int		Tcl_UtfToTitle(char *src);
+#endif
+#ifndef Tcl_UtfToUniChar_TCL_DECLARED
+#define Tcl_UtfToUniChar_TCL_DECLARED
 /* 336 */
-EXTERN int		Tcl_UtfToUniChar _ANSI_ARGS_((CONST char *src,
-				Tcl_UniChar *chPtr));
+EXTERN int		Tcl_UtfToUniChar(CONST char *src, Tcl_UniChar *chPtr);
+#endif
+#ifndef Tcl_UtfToUpper_TCL_DECLARED
+#define Tcl_UtfToUpper_TCL_DECLARED
 /* 337 */
-EXTERN int		Tcl_UtfToUpper _ANSI_ARGS_((char *src));
+EXTERN int		Tcl_UtfToUpper(char *src);
+#endif
+#ifndef Tcl_WriteChars_TCL_DECLARED
+#define Tcl_WriteChars_TCL_DECLARED
 /* 338 */
-EXTERN int		Tcl_WriteChars _ANSI_ARGS_((Tcl_Channel chan,
-				CONST char *src, int srcLen));
+EXTERN int		Tcl_WriteChars(Tcl_Channel chan, CONST char *src,
+				int srcLen);
+#endif
+#ifndef Tcl_WriteObj_TCL_DECLARED
+#define Tcl_WriteObj_TCL_DECLARED
 /* 339 */
-EXTERN int		Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_Obj *objPtr));
+EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetString_TCL_DECLARED
+#define Tcl_GetString_TCL_DECLARED
 /* 340 */
-EXTERN char *		Tcl_GetString _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetDefaultEncodingDir_TCL_DECLARED
+#define Tcl_GetDefaultEncodingDir_TCL_DECLARED
 /* 341 */
-EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
+#endif
+#ifndef Tcl_SetDefaultEncodingDir_TCL_DECLARED
+#define Tcl_SetDefaultEncodingDir_TCL_DECLARED
 /* 342 */
-EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((
-				CONST char *path));
+EXTERN void		Tcl_SetDefaultEncodingDir(CONST char *path);
+#endif
+#ifndef Tcl_AlertNotifier_TCL_DECLARED
+#define Tcl_AlertNotifier_TCL_DECLARED
 /* 343 */
-EXTERN void		Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
+EXTERN void		Tcl_AlertNotifier(ClientData clientData);
+#endif
+#ifndef Tcl_ServiceModeHook_TCL_DECLARED
+#define Tcl_ServiceModeHook_TCL_DECLARED
 /* 344 */
-EXTERN void		Tcl_ServiceModeHook _ANSI_ARGS_((int mode));
+EXTERN void		Tcl_ServiceModeHook(int mode);
+#endif
+#ifndef Tcl_UniCharIsAlnum_TCL_DECLARED
+#define Tcl_UniCharIsAlnum_TCL_DECLARED
 /* 345 */
-EXTERN int		Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsAlnum(int ch);
+#endif
+#ifndef Tcl_UniCharIsAlpha_TCL_DECLARED
+#define Tcl_UniCharIsAlpha_TCL_DECLARED
 /* 346 */
-EXTERN int		Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsAlpha(int ch);
+#endif
+#ifndef Tcl_UniCharIsDigit_TCL_DECLARED
+#define Tcl_UniCharIsDigit_TCL_DECLARED
 /* 347 */
-EXTERN int		Tcl_UniCharIsDigit _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsDigit(int ch);
+#endif
+#ifndef Tcl_UniCharIsLower_TCL_DECLARED
+#define Tcl_UniCharIsLower_TCL_DECLARED
 /* 348 */
-EXTERN int		Tcl_UniCharIsLower _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsLower(int ch);
+#endif
+#ifndef Tcl_UniCharIsSpace_TCL_DECLARED
+#define Tcl_UniCharIsSpace_TCL_DECLARED
 /* 349 */
-EXTERN int		Tcl_UniCharIsSpace _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsSpace(int ch);
+#endif
+#ifndef Tcl_UniCharIsUpper_TCL_DECLARED
+#define Tcl_UniCharIsUpper_TCL_DECLARED
 /* 350 */
-EXTERN int		Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsUpper(int ch);
+#endif
+#ifndef Tcl_UniCharIsWordChar_TCL_DECLARED
+#define Tcl_UniCharIsWordChar_TCL_DECLARED
 /* 351 */
-EXTERN int		Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsWordChar(int ch);
+#endif
+#ifndef Tcl_UniCharLen_TCL_DECLARED
+#define Tcl_UniCharLen_TCL_DECLARED
 /* 352 */
-EXTERN int		Tcl_UniCharLen _ANSI_ARGS_((
-				CONST Tcl_UniChar *uniStr));
+EXTERN int		Tcl_UniCharLen(CONST Tcl_UniChar *uniStr);
+#endif
+#ifndef Tcl_UniCharNcmp_TCL_DECLARED
+#define Tcl_UniCharNcmp_TCL_DECLARED
 /* 353 */
-EXTERN int		Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *ucs,
+EXTERN int		Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs,
 				CONST Tcl_UniChar *uct,
-				unsigned long numChars));
+				unsigned long numChars);
+#endif
+#ifndef Tcl_UniCharToUtfDString_TCL_DECLARED
+#define Tcl_UniCharToUtfDString_TCL_DECLARED
 /* 354 */
-EXTERN char *		Tcl_UniCharToUtfDString _ANSI_ARGS_((
-				CONST Tcl_UniChar *uniStr, int uniLength,
-				Tcl_DString *dsPtr));
+EXTERN char *		Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr,
+				int uniLength, Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_UtfToUniCharDString_TCL_DECLARED
+#define Tcl_UtfToUniCharDString_TCL_DECLARED
 /* 355 */
-EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString _ANSI_ARGS_((CONST char *src,
-				int length, Tcl_DString *dsPtr));
+EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(CONST char *src, int length,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_GetRegExpFromObj_TCL_DECLARED
+#define Tcl_GetRegExpFromObj_TCL_DECLARED
 /* 356 */
-EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *patObj, int flags));
+EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
+				Tcl_Obj *patObj, int flags);
+#endif
+#ifndef Tcl_EvalTokens_TCL_DECLARED
+#define Tcl_EvalTokens_TCL_DECLARED
 /* 357 */
-EXTERN Tcl_Obj *	Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Token *tokenPtr, int count));
+EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
+				Tcl_Token *tokenPtr, int count);
+#endif
+#ifndef Tcl_FreeParse_TCL_DECLARED
+#define Tcl_FreeParse_TCL_DECLARED
 /* 358 */
-EXTERN void		Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse *parsePtr));
+EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
+#endif
+#ifndef Tcl_LogCommandInfo_TCL_DECLARED
+#define Tcl_LogCommandInfo_TCL_DECLARED
 /* 359 */
-EXTERN void		Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
 				CONST char *script, CONST char *command,
-				int length));
+				int length);
+#endif
+#ifndef Tcl_ParseBraces_TCL_DECLARED
+#define Tcl_ParseBraces_TCL_DECLARED
 /* 360 */
-EXTERN int		Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
 				CONST char *start, int numBytes,
 				Tcl_Parse *parsePtr, int append,
-				CONST84 char **termPtr));
+				CONST84 char **termPtr);
+#endif
+#ifndef Tcl_ParseCommand_TCL_DECLARED
+#define Tcl_ParseCommand_TCL_DECLARED
 /* 361 */
-EXTERN int		Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
 				CONST char *start, int numBytes, int nested,
-				Tcl_Parse *parsePtr));
+				Tcl_Parse *parsePtr);
+#endif
+#ifndef Tcl_ParseExpr_TCL_DECLARED
+#define Tcl_ParseExpr_TCL_DECLARED
 /* 362 */
-EXTERN int		Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *start, int numBytes,
-				Tcl_Parse *parsePtr));
+EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start,
+				int numBytes, Tcl_Parse *parsePtr);
+#endif
+#ifndef Tcl_ParseQuotedString_TCL_DECLARED
+#define Tcl_ParseQuotedString_TCL_DECLARED
 /* 363 */
-EXTERN int		Tcl_ParseQuotedString _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *start,
-				int numBytes, Tcl_Parse *parsePtr,
-				int append, CONST84 char **termPtr));
+EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
+				CONST char *start, int numBytes,
+				Tcl_Parse *parsePtr, int append,
+				CONST84 char **termPtr);
+#endif
+#ifndef Tcl_ParseVarName_TCL_DECLARED
+#define Tcl_ParseVarName_TCL_DECLARED
 /* 364 */
-EXTERN int		Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
 				CONST char *start, int numBytes,
-				Tcl_Parse *parsePtr, int append));
+				Tcl_Parse *parsePtr, int append);
+#endif
+#ifndef Tcl_GetCwd_TCL_DECLARED
+#define Tcl_GetCwd_TCL_DECLARED
 /* 365 */
-EXTERN char *		Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_DString *cwdPtr));
+EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
+#endif
+#ifndef Tcl_Chdir_TCL_DECLARED
+#define Tcl_Chdir_TCL_DECLARED
 /* 366 */
-EXTERN int		Tcl_Chdir _ANSI_ARGS_((CONST char *dirName));
+EXTERN int		Tcl_Chdir(CONST char *dirName);
+#endif
+#ifndef Tcl_Access_TCL_DECLARED
+#define Tcl_Access_TCL_DECLARED
 /* 367 */
-EXTERN int		Tcl_Access _ANSI_ARGS_((CONST char *path, int mode));
+EXTERN int		Tcl_Access(CONST char *path, int mode);
+#endif
+#ifndef Tcl_Stat_TCL_DECLARED
+#define Tcl_Stat_TCL_DECLARED
 /* 368 */
-EXTERN int		Tcl_Stat _ANSI_ARGS_((CONST char *path,
-				struct stat *bufPtr));
+EXTERN int		Tcl_Stat(CONST char *path, struct stat *bufPtr);
+#endif
+#ifndef Tcl_UtfNcmp_TCL_DECLARED
+#define Tcl_UtfNcmp_TCL_DECLARED
 /* 369 */
-EXTERN int		Tcl_UtfNcmp _ANSI_ARGS_((CONST char *s1,
-				CONST char *s2, unsigned long n));
+EXTERN int		Tcl_UtfNcmp(CONST char *s1, CONST char *s2,
+				unsigned long n);
+#endif
+#ifndef Tcl_UtfNcasecmp_TCL_DECLARED
+#define Tcl_UtfNcasecmp_TCL_DECLARED
 /* 370 */
-EXTERN int		Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char *s1,
-				CONST char *s2, unsigned long n));
+EXTERN int		Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2,
+				unsigned long n);
+#endif
+#ifndef Tcl_StringCaseMatch_TCL_DECLARED
+#define Tcl_StringCaseMatch_TCL_DECLARED
 /* 371 */
-EXTERN int		Tcl_StringCaseMatch _ANSI_ARGS_((CONST char *str,
-				CONST char *pattern, int nocase));
+EXTERN int		Tcl_StringCaseMatch(CONST char *str,
+				CONST char *pattern, int nocase);
+#endif
+#ifndef Tcl_UniCharIsControl_TCL_DECLARED
+#define Tcl_UniCharIsControl_TCL_DECLARED
 /* 372 */
-EXTERN int		Tcl_UniCharIsControl _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsControl(int ch);
+#endif
+#ifndef Tcl_UniCharIsGraph_TCL_DECLARED
+#define Tcl_UniCharIsGraph_TCL_DECLARED
 /* 373 */
-EXTERN int		Tcl_UniCharIsGraph _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsGraph(int ch);
+#endif
+#ifndef Tcl_UniCharIsPrint_TCL_DECLARED
+#define Tcl_UniCharIsPrint_TCL_DECLARED
 /* 374 */
-EXTERN int		Tcl_UniCharIsPrint _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsPrint(int ch);
+#endif
+#ifndef Tcl_UniCharIsPunct_TCL_DECLARED
+#define Tcl_UniCharIsPunct_TCL_DECLARED
 /* 375 */
-EXTERN int		Tcl_UniCharIsPunct _ANSI_ARGS_((int ch));
+EXTERN int		Tcl_UniCharIsPunct(int ch);
+#endif
+#ifndef Tcl_RegExpExecObj_TCL_DECLARED
+#define Tcl_RegExpExecObj_TCL_DECLARED
 /* 376 */
-EXTERN int		Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
 				Tcl_RegExp regexp, Tcl_Obj *textObj,
-				int offset, int nmatches, int flags));
+				int offset, int nmatches, int flags);
+#endif
+#ifndef Tcl_RegExpGetInfo_TCL_DECLARED
+#define Tcl_RegExpGetInfo_TCL_DECLARED
 /* 377 */
-EXTERN void		Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp,
-				Tcl_RegExpInfo *infoPtr));
+EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
+				Tcl_RegExpInfo *infoPtr);
+#endif
+#ifndef Tcl_NewUnicodeObj_TCL_DECLARED
+#define Tcl_NewUnicodeObj_TCL_DECLARED
 /* 378 */
-EXTERN Tcl_Obj *	Tcl_NewUnicodeObj _ANSI_ARGS_((
-				CONST Tcl_UniChar *unicode, int numChars));
+EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(CONST Tcl_UniChar *unicode,
+				int numChars);
+#endif
+#ifndef Tcl_SetUnicodeObj_TCL_DECLARED
+#define Tcl_SetUnicodeObj_TCL_DECLARED
 /* 379 */
-EXTERN void		Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST Tcl_UniChar *unicode, int numChars));
+EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
+				CONST Tcl_UniChar *unicode, int numChars);
+#endif
+#ifndef Tcl_GetCharLength_TCL_DECLARED
+#define Tcl_GetCharLength_TCL_DECLARED
 /* 380 */
-EXTERN int		Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetUniChar_TCL_DECLARED
+#define Tcl_GetUniChar_TCL_DECLARED
 /* 381 */
-EXTERN Tcl_UniChar	Tcl_GetUniChar _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int index));
+EXTERN Tcl_UniChar	Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
+#endif
+#ifndef Tcl_GetUnicode_TCL_DECLARED
+#define Tcl_GetUnicode_TCL_DECLARED
 /* 382 */
-EXTERN Tcl_UniChar *	Tcl_GetUnicode _ANSI_ARGS_((Tcl_Obj *objPtr));
+EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetRange_TCL_DECLARED
+#define Tcl_GetRange_TCL_DECLARED
 /* 383 */
-EXTERN Tcl_Obj *	Tcl_GetRange _ANSI_ARGS_((Tcl_Obj *objPtr, int first,
-				int last));
+EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
+#endif
+#ifndef Tcl_AppendUnicodeToObj_TCL_DECLARED
+#define Tcl_AppendUnicodeToObj_TCL_DECLARED
 /* 384 */
-EXTERN void		Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				CONST Tcl_UniChar *unicode, int length));
+EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
+				CONST Tcl_UniChar *unicode, int length);
+#endif
+#ifndef Tcl_RegExpMatchObj_TCL_DECLARED
+#define Tcl_RegExpMatchObj_TCL_DECLARED
 /* 385 */
-EXTERN int		Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *textObj, Tcl_Obj *patternObj));
+EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
+				Tcl_Obj *textObj, Tcl_Obj *patternObj);
+#endif
+#ifndef Tcl_SetNotifier_TCL_DECLARED
+#define Tcl_SetNotifier_TCL_DECLARED
 /* 386 */
-EXTERN void		Tcl_SetNotifier _ANSI_ARGS_((
-				Tcl_NotifierProcs *notifierProcPtr));
+EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
+#endif
+#ifndef Tcl_GetAllocMutex_TCL_DECLARED
+#define Tcl_GetAllocMutex_TCL_DECLARED
 /* 387 */
-EXTERN Tcl_Mutex *	Tcl_GetAllocMutex _ANSI_ARGS_((void));
+EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
+#endif
+#ifndef Tcl_GetChannelNames_TCL_DECLARED
+#define Tcl_GetChannelNames_TCL_DECLARED
 /* 388 */
-EXTERN int		Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetChannelNamesEx_TCL_DECLARED
+#define Tcl_GetChannelNamesEx_TCL_DECLARED
 /* 389 */
-EXTERN int		Tcl_GetChannelNamesEx _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *pattern));
+EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
+				CONST char *pattern);
+#endif
+#ifndef Tcl_ProcObjCmd_TCL_DECLARED
+#define Tcl_ProcObjCmd_TCL_DECLARED
 /* 390 */
-EXTERN int		Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int		Tcl_ProcObjCmd(ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[]));
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_ConditionFinalize_TCL_DECLARED
+#define Tcl_ConditionFinalize_TCL_DECLARED
 /* 391 */
-EXTERN void		Tcl_ConditionFinalize _ANSI_ARGS_((
-				Tcl_Condition *condPtr));
+EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
+#endif
+#ifndef Tcl_MutexFinalize_TCL_DECLARED
+#define Tcl_MutexFinalize_TCL_DECLARED
 /* 392 */
-EXTERN void		Tcl_MutexFinalize _ANSI_ARGS_((Tcl_Mutex *mutex));
+EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
+#endif
+#ifndef Tcl_CreateThread_TCL_DECLARED
+#define Tcl_CreateThread_TCL_DECLARED
 /* 393 */
-EXTERN int		Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId *idPtr,
+EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
 				Tcl_ThreadCreateProc proc,
 				ClientData clientData, int stackSize,
-				int flags));
+				int flags);
+#endif
+#ifndef Tcl_ReadRaw_TCL_DECLARED
+#define Tcl_ReadRaw_TCL_DECLARED
 /* 394 */
-EXTERN int		Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan, char *dst,
-				int bytesToRead));
+EXTERN int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
+				int bytesToRead);
+#endif
+#ifndef Tcl_WriteRaw_TCL_DECLARED
+#define Tcl_WriteRaw_TCL_DECLARED
 /* 395 */
-EXTERN int		Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
-				CONST char *src, int srcLen));
+EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, CONST char *src,
+				int srcLen);
+#endif
+#ifndef Tcl_GetTopChannel_TCL_DECLARED
+#define Tcl_GetTopChannel_TCL_DECLARED
 /* 396 */
-EXTERN Tcl_Channel	Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
+#endif
+#ifndef Tcl_ChannelBuffered_TCL_DECLARED
+#define Tcl_ChannelBuffered_TCL_DECLARED
 /* 397 */
-EXTERN int		Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
+#endif
+#ifndef Tcl_ChannelName_TCL_DECLARED
+#define Tcl_ChannelName_TCL_DECLARED
 /* 398 */
-EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN CONST84_RETURN char * Tcl_ChannelName(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelVersion_TCL_DECLARED
+#define Tcl_ChannelVersion_TCL_DECLARED
 /* 399 */
-EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelBlockModeProc_TCL_DECLARED
+#define Tcl_ChannelBlockModeProc_TCL_DECLARED
 /* 400 */
-EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelCloseProc_TCL_DECLARED
+#define Tcl_ChannelCloseProc_TCL_DECLARED
 /* 401 */
-EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelClose2Proc_TCL_DECLARED
+#define Tcl_ChannelClose2Proc_TCL_DECLARED
 /* 402 */
-EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelInputProc_TCL_DECLARED
+#define Tcl_ChannelInputProc_TCL_DECLARED
 /* 403 */
-EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelOutputProc_TCL_DECLARED
+#define Tcl_ChannelOutputProc_TCL_DECLARED
 /* 404 */
-EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelSeekProc_TCL_DECLARED
+#define Tcl_ChannelSeekProc_TCL_DECLARED
 /* 405 */
-EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelSetOptionProc_TCL_DECLARED
+#define Tcl_ChannelSetOptionProc_TCL_DECLARED
 /* 406 */
-EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelGetOptionProc_TCL_DECLARED
+#define Tcl_ChannelGetOptionProc_TCL_DECLARED
 /* 407 */
-EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelWatchProc_TCL_DECLARED
+#define Tcl_ChannelWatchProc_TCL_DECLARED
 /* 408 */
-EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelGetHandleProc_TCL_DECLARED
+#define Tcl_ChannelGetHandleProc_TCL_DECLARED
 /* 409 */
-EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelFlushProc_TCL_DECLARED
+#define Tcl_ChannelFlushProc_TCL_DECLARED
 /* 410 */
-EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_ChannelHandlerProc_TCL_DECLARED
+#define Tcl_ChannelHandlerProc_TCL_DECLARED
 /* 411 */
-EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
+EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_JoinThread_TCL_DECLARED
+#define Tcl_JoinThread_TCL_DECLARED
 /* 412 */
-EXTERN int		Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId threadId,
-				int *result));
+EXTERN int		Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
+#endif
+#ifndef Tcl_IsChannelShared_TCL_DECLARED
+#define Tcl_IsChannelShared_TCL_DECLARED
 /* 413 */
-EXTERN int		Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel));
+EXTERN int		Tcl_IsChannelShared(Tcl_Channel channel);
+#endif
+#ifndef Tcl_IsChannelRegistered_TCL_DECLARED
+#define Tcl_IsChannelRegistered_TCL_DECLARED
 /* 414 */
-EXTERN int		Tcl_IsChannelRegistered _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Channel channel));
+EXTERN int		Tcl_IsChannelRegistered(Tcl_Interp *interp,
+				Tcl_Channel channel);
+#endif
+#ifndef Tcl_CutChannel_TCL_DECLARED
+#define Tcl_CutChannel_TCL_DECLARED
 /* 415 */
-EXTERN void		Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel));
+EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
+#endif
+#ifndef Tcl_SpliceChannel_TCL_DECLARED
+#define Tcl_SpliceChannel_TCL_DECLARED
 /* 416 */
-EXTERN void		Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel));
+EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
+#endif
+#ifndef Tcl_ClearChannelHandlers_TCL_DECLARED
+#define Tcl_ClearChannelHandlers_TCL_DECLARED
 /* 417 */
-EXTERN void		Tcl_ClearChannelHandlers _ANSI_ARGS_((
-				Tcl_Channel channel));
+EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
+#endif
+#ifndef Tcl_IsChannelExisting_TCL_DECLARED
+#define Tcl_IsChannelExisting_TCL_DECLARED
 /* 418 */
-EXTERN int		Tcl_IsChannelExisting _ANSI_ARGS_((
-				CONST char *channelName));
+EXTERN int		Tcl_IsChannelExisting(CONST char *channelName);
+#endif
+#ifndef Tcl_UniCharNcasecmp_TCL_DECLARED
+#define Tcl_UniCharNcasecmp_TCL_DECLARED
 /* 419 */
-EXTERN int		Tcl_UniCharNcasecmp _ANSI_ARGS_((
-				CONST Tcl_UniChar *ucs,
+EXTERN int		Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs,
 				CONST Tcl_UniChar *uct,
-				unsigned long numChars));
+				unsigned long numChars);
+#endif
+#ifndef Tcl_UniCharCaseMatch_TCL_DECLARED
+#define Tcl_UniCharCaseMatch_TCL_DECLARED
 /* 420 */
-EXTERN int		Tcl_UniCharCaseMatch _ANSI_ARGS_((
-				CONST Tcl_UniChar *uniStr,
-				CONST Tcl_UniChar *uniPattern, int nocase));
+EXTERN int		Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr,
+				CONST Tcl_UniChar *uniPattern, int nocase);
+#endif
+#ifndef Tcl_FindHashEntry_TCL_DECLARED
+#define Tcl_FindHashEntry_TCL_DECLARED
 /* 421 */
-EXTERN Tcl_HashEntry *	Tcl_FindHashEntry _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr, CONST char *key));
+EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
+				CONST char *key);
+#endif
+#ifndef Tcl_CreateHashEntry_TCL_DECLARED
+#define Tcl_CreateHashEntry_TCL_DECLARED
 /* 422 */
-EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr, CONST char *key,
-				int *newPtr));
+EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
+				CONST char *key, int *newPtr);
+#endif
+#ifndef Tcl_InitCustomHashTable_TCL_DECLARED
+#define Tcl_InitCustomHashTable_TCL_DECLARED
 /* 423 */
-EXTERN void		Tcl_InitCustomHashTable _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr, int keyType,
-				Tcl_HashKeyType *typePtr));
+EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
+				int keyType, Tcl_HashKeyType *typePtr);
+#endif
+#ifndef Tcl_InitObjHashTable_TCL_DECLARED
+#define Tcl_InitObjHashTable_TCL_DECLARED
 /* 424 */
-EXTERN void		Tcl_InitObjHashTable _ANSI_ARGS_((
-				Tcl_HashTable *tablePtr));
+EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
+#endif
+#ifndef Tcl_CommandTraceInfo_TCL_DECLARED
+#define Tcl_CommandTraceInfo_TCL_DECLARED
 /* 425 */
-EXTERN ClientData	Tcl_CommandTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
 				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *procPtr,
-				ClientData prevClientData));
+				ClientData prevClientData);
+#endif
+#ifndef Tcl_TraceCommand_TCL_DECLARED
+#define Tcl_TraceCommand_TCL_DECLARED
 /* 426 */
-EXTERN int		Tcl_TraceCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
 				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_UntraceCommand_TCL_DECLARED
+#define Tcl_UntraceCommand_TCL_DECLARED
 /* 427 */
-EXTERN void		Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
 				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
-				ClientData clientData));
+				ClientData clientData);
+#endif
+#ifndef Tcl_AttemptAlloc_TCL_DECLARED
+#define Tcl_AttemptAlloc_TCL_DECLARED
 /* 428 */
-EXTERN char *		Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size));
+EXTERN char *		Tcl_AttemptAlloc(unsigned int size);
+#endif
+#ifndef Tcl_AttemptDbCkalloc_TCL_DECLARED
+#define Tcl_AttemptDbCkalloc_TCL_DECLARED
 /* 429 */
-EXTERN char *		Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size,
-				CONST char *file, int line));
+EXTERN char *		Tcl_AttemptDbCkalloc(unsigned int size,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_AttemptRealloc_TCL_DECLARED
+#define Tcl_AttemptRealloc_TCL_DECLARED
 /* 430 */
-EXTERN char *		Tcl_AttemptRealloc _ANSI_ARGS_((char *ptr,
-				unsigned int size));
+EXTERN char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
+#endif
+#ifndef Tcl_AttemptDbCkrealloc_TCL_DECLARED
+#define Tcl_AttemptDbCkrealloc_TCL_DECLARED
 /* 431 */
-EXTERN char *		Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char *ptr,
-				unsigned int size, CONST char *file,
-				int line));
+EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_AttemptSetObjLength_TCL_DECLARED
+#define Tcl_AttemptSetObjLength_TCL_DECLARED
 /* 432 */
-EXTERN int		Tcl_AttemptSetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int length));
+EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
+#endif
+#ifndef Tcl_GetChannelThread_TCL_DECLARED
+#define Tcl_GetChannelThread_TCL_DECLARED
 /* 433 */
-EXTERN Tcl_ThreadId	Tcl_GetChannelThread _ANSI_ARGS_((
-				Tcl_Channel channel));
+EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
+#endif
+#ifndef Tcl_GetUnicodeFromObj_TCL_DECLARED
+#define Tcl_GetUnicodeFromObj_TCL_DECLARED
 /* 434 */
-EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				int *lengthPtr));
+EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
+				int *lengthPtr);
+#endif
+#ifndef Tcl_GetMathFuncInfo_TCL_DECLARED
+#define Tcl_GetMathFuncInfo_TCL_DECLARED
 /* 435 */
-EXTERN int		Tcl_GetMathFuncInfo _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
 				CONST char *name, int *numArgsPtr,
 				Tcl_ValueType **argTypesPtr,
 				Tcl_MathProc **procPtr,
-				ClientData *clientDataPtr));
+				ClientData *clientDataPtr);
+#endif
+#ifndef Tcl_ListMathFuncs_TCL_DECLARED
+#define Tcl_ListMathFuncs_TCL_DECLARED
 /* 436 */
-EXTERN Tcl_Obj *	Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *pattern));
+EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
+				CONST char *pattern);
+#endif
+#ifndef Tcl_SubstObj_TCL_DECLARED
+#define Tcl_SubstObj_TCL_DECLARED
 /* 437 */
-EXTERN Tcl_Obj *	Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int flags));
+EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				int flags);
+#endif
+#ifndef Tcl_DetachChannel_TCL_DECLARED
+#define Tcl_DetachChannel_TCL_DECLARED
 /* 438 */
-EXTERN int		Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel channel));
+EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
+				Tcl_Channel channel);
+#endif
+#ifndef Tcl_IsStandardChannel_TCL_DECLARED
+#define Tcl_IsStandardChannel_TCL_DECLARED
 /* 439 */
-EXTERN int		Tcl_IsStandardChannel _ANSI_ARGS_((
-				Tcl_Channel channel));
+EXTERN int		Tcl_IsStandardChannel(Tcl_Channel channel);
+#endif
+#ifndef Tcl_FSCopyFile_TCL_DECLARED
+#define Tcl_FSCopyFile_TCL_DECLARED
 /* 440 */
-EXTERN int		Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr));
+EXTERN int		Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr);
+#endif
+#ifndef Tcl_FSCopyDirectory_TCL_DECLARED
+#define Tcl_FSCopyDirectory_TCL_DECLARED
 /* 441 */
-EXTERN int		Tcl_FSCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
+EXTERN int		Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
+#endif
+#ifndef Tcl_FSCreateDirectory_TCL_DECLARED
+#define Tcl_FSCreateDirectory_TCL_DECLARED
 /* 442 */
-EXTERN int		Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int		Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSDeleteFile_TCL_DECLARED
+#define Tcl_FSDeleteFile_TCL_DECLARED
 /* 443 */
-EXTERN int		Tcl_FSDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int		Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSLoadFile_TCL_DECLARED
+#define Tcl_FSLoadFile_TCL_DECLARED
 /* 444 */
-EXTERN int		Tcl_FSLoadFile _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *pathPtr, CONST char *sym1,
-				CONST char *sym2,
+EXTERN int		Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+				CONST char *sym1, CONST char *sym2,
 				Tcl_PackageInitProc **proc1Ptr,
 				Tcl_PackageInitProc **proc2Ptr,
 				Tcl_LoadHandle *handlePtr,
-				Tcl_FSUnloadFileProc **unloadProcPtr));
+				Tcl_FSUnloadFileProc **unloadProcPtr);
+#endif
+#ifndef Tcl_FSMatchInDirectory_TCL_DECLARED
+#define Tcl_FSMatchInDirectory_TCL_DECLARED
 /* 445 */
-EXTERN int		Tcl_FSMatchInDirectory _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *result,
-				Tcl_Obj *pathPtr, CONST char *pattern,
-				Tcl_GlobTypeData *types));
+EXTERN int		Tcl_FSMatchInDirectory(Tcl_Interp *interp,
+				Tcl_Obj *result, Tcl_Obj *pathPtr,
+				CONST char *pattern, Tcl_GlobTypeData *types);
+#endif
+#ifndef Tcl_FSLink_TCL_DECLARED
+#define Tcl_FSLink_TCL_DECLARED
 /* 446 */
-EXTERN Tcl_Obj *	Tcl_FSLink _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				Tcl_Obj *toPtr, int linkAction));
+EXTERN Tcl_Obj *	Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+				int linkAction);
+#endif
+#ifndef Tcl_FSRemoveDirectory_TCL_DECLARED
+#define Tcl_FSRemoveDirectory_TCL_DECLARED
 /* 447 */
-EXTERN int		Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				int recursive, Tcl_Obj **errorPtr));
+EXTERN int		Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
+				int recursive, Tcl_Obj **errorPtr);
+#endif
+#ifndef Tcl_FSRenameFile_TCL_DECLARED
+#define Tcl_FSRenameFile_TCL_DECLARED
 /* 448 */
-EXTERN int		Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr));
+EXTERN int		Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr);
+#endif
+#ifndef Tcl_FSLstat_TCL_DECLARED
+#define Tcl_FSLstat_TCL_DECLARED
 /* 449 */
-EXTERN int		Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				Tcl_StatBuf *buf));
+EXTERN int		Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+#endif
+#ifndef Tcl_FSUtime_TCL_DECLARED
+#define Tcl_FSUtime_TCL_DECLARED
 /* 450 */
-EXTERN int		Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				struct utimbuf *tval));
+EXTERN int		Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
+#endif
+#ifndef Tcl_FSFileAttrsGet_TCL_DECLARED
+#define Tcl_FSFileAttrsGet_TCL_DECLARED
 /* 451 */
-EXTERN int		Tcl_FSFileAttrsGet _ANSI_ARGS_((Tcl_Interp *interp,
-				int index, Tcl_Obj *pathPtr,
-				Tcl_Obj **objPtrRef));
+EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
+				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+#endif
+#ifndef Tcl_FSFileAttrsSet_TCL_DECLARED
+#define Tcl_FSFileAttrsSet_TCL_DECLARED
 /* 452 */
-EXTERN int		Tcl_FSFileAttrsSet _ANSI_ARGS_((Tcl_Interp *interp,
-				int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
+EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
+				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_FSFileAttrStrings_TCL_DECLARED
+#define Tcl_FSFileAttrStrings_TCL_DECLARED
 /* 453 */
-EXTERN CONST char **	Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				Tcl_Obj **objPtrRef));
+EXTERN CONST char **	Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+				Tcl_Obj **objPtrRef);
+#endif
+#ifndef Tcl_FSStat_TCL_DECLARED
+#define Tcl_FSStat_TCL_DECLARED
 /* 454 */
-EXTERN int		Tcl_FSStat _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				Tcl_StatBuf *buf));
+EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+#endif
+#ifndef Tcl_FSAccess_TCL_DECLARED
+#define Tcl_FSAccess_TCL_DECLARED
 /* 455 */
-EXTERN int		Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
+EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
+#endif
+#ifndef Tcl_FSOpenFileChannel_TCL_DECLARED
+#define Tcl_FSOpenFileChannel_TCL_DECLARED
 /* 456 */
-EXTERN Tcl_Channel	Tcl_FSOpenFileChannel _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *pathPtr,
-				CONST char *modeString, int permissions));
+EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr, CONST char *modeString,
+				int permissions);
+#endif
+#ifndef Tcl_FSGetCwd_TCL_DECLARED
+#define Tcl_FSGetCwd_TCL_DECLARED
 /* 457 */
-EXTERN Tcl_Obj *	Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Obj *	Tcl_FSGetCwd(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_FSChdir_TCL_DECLARED
+#define Tcl_FSChdir_TCL_DECLARED
 /* 458 */
-EXTERN int		Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSConvertToPathType_TCL_DECLARED
+#define Tcl_FSConvertToPathType_TCL_DECLARED
 /* 459 */
-EXTERN int		Tcl_FSConvertToPathType _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *pathPtr));
+EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSJoinPath_TCL_DECLARED
+#define Tcl_FSJoinPath_TCL_DECLARED
 /* 460 */
-EXTERN Tcl_Obj *	Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj *listObj,
-				int elements));
+EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
+#endif
+#ifndef Tcl_FSSplitPath_TCL_DECLARED
+#define Tcl_FSSplitPath_TCL_DECLARED
 /* 461 */
-EXTERN Tcl_Obj *	Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				int *lenPtr));
+EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
+#endif
+#ifndef Tcl_FSEqualPaths_TCL_DECLARED
+#define Tcl_FSEqualPaths_TCL_DECLARED
 /* 462 */
-EXTERN int		Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj *firstPtr,
-				Tcl_Obj *secondPtr));
+EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
+				Tcl_Obj *secondPtr);
+#endif
+#ifndef Tcl_FSGetNormalizedPath_TCL_DECLARED
+#define Tcl_FSGetNormalizedPath_TCL_DECLARED
 /* 463 */
-EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSJoinToPath_TCL_DECLARED
+#define Tcl_FSJoinToPath_TCL_DECLARED
 /* 464 */
-EXTERN Tcl_Obj *	Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				int objc, Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
+#define Tcl_FSGetInternalRep_TCL_DECLARED
 /* 465 */
-EXTERN ClientData	Tcl_FSGetInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr,
-				Tcl_Filesystem *fsPtr));
+EXTERN ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
+				Tcl_Filesystem *fsPtr);
+#endif
+#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
+#define Tcl_FSGetTranslatedPath_TCL_DECLARED
 /* 466 */
-EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSEvalFile_TCL_DECLARED
+#define Tcl_FSEvalFile_TCL_DECLARED
 /* 467 */
-EXTERN int		Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *fileName));
+EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
+#endif
+#ifndef Tcl_FSNewNativePath_TCL_DECLARED
+#define Tcl_FSNewNativePath_TCL_DECLARED
 /* 468 */
-EXTERN Tcl_Obj *	Tcl_FSNewNativePath _ANSI_ARGS_((
-				Tcl_Filesystem *fromFilesystem,
-				ClientData clientData));
+EXTERN Tcl_Obj *	Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
+				ClientData clientData);
+#endif
+#ifndef Tcl_FSGetNativePath_TCL_DECLARED
+#define Tcl_FSGetNativePath_TCL_DECLARED
 /* 469 */
-EXTERN CONST char *	Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN CONST char *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
+#define Tcl_FSFileSystemInfo_TCL_DECLARED
 /* 470 */
-EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSPathSeparator_TCL_DECLARED
+#define Tcl_FSPathSeparator_TCL_DECLARED
 /* 471 */
-EXTERN Tcl_Obj *	Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSListVolumes_TCL_DECLARED
+#define Tcl_FSListVolumes_TCL_DECLARED
 /* 472 */
-EXTERN Tcl_Obj *	Tcl_FSListVolumes _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
+#endif
+#ifndef Tcl_FSRegister_TCL_DECLARED
+#define Tcl_FSRegister_TCL_DECLARED
 /* 473 */
-EXTERN int		Tcl_FSRegister _ANSI_ARGS_((ClientData clientData,
-				Tcl_Filesystem *fsPtr));
+EXTERN int		Tcl_FSRegister(ClientData clientData,
+				Tcl_Filesystem *fsPtr);
+#endif
+#ifndef Tcl_FSUnregister_TCL_DECLARED
+#define Tcl_FSUnregister_TCL_DECLARED
 /* 474 */
-EXTERN int		Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem *fsPtr));
+EXTERN int		Tcl_FSUnregister(Tcl_Filesystem *fsPtr);
+#endif
+#ifndef Tcl_FSData_TCL_DECLARED
+#define Tcl_FSData_TCL_DECLARED
 /* 475 */
-EXTERN ClientData	Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem *fsPtr));
+EXTERN ClientData	Tcl_FSData(Tcl_Filesystem *fsPtr);
+#endif
+#ifndef Tcl_FSGetTranslatedStringPath_TCL_DECLARED
+#define Tcl_FSGetTranslatedStringPath_TCL_DECLARED
 /* 476 */
-EXTERN CONST char *	Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *pathPtr));
+EXTERN CONST char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
+#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
 /* 477 */
-EXTERN Tcl_Filesystem *	 Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
-				Tcl_Obj *pathPtr));
+EXTERN Tcl_Filesystem *	 Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_FSGetPathType_TCL_DECLARED
+#define Tcl_FSGetPathType_TCL_DECLARED
 /* 478 */
-EXTERN Tcl_PathType	Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
+#endif
+#ifndef Tcl_OutputBuffered_TCL_DECLARED
+#define Tcl_OutputBuffered_TCL_DECLARED
 /* 479 */
-EXTERN int		Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
+#endif
+#ifndef Tcl_FSMountsChanged_TCL_DECLARED
+#define Tcl_FSMountsChanged_TCL_DECLARED
 /* 480 */
-EXTERN void		Tcl_FSMountsChanged _ANSI_ARGS_((
-				Tcl_Filesystem *fsPtr));
+EXTERN void		Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr);
+#endif
+#ifndef Tcl_EvalTokensStandard_TCL_DECLARED
+#define Tcl_EvalTokensStandard_TCL_DECLARED
 /* 481 */
-EXTERN int		Tcl_EvalTokensStandard _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Token *tokenPtr,
-				int count));
+EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
+				Tcl_Token *tokenPtr, int count);
+#endif
+#ifndef Tcl_GetTime_TCL_DECLARED
+#define Tcl_GetTime_TCL_DECLARED
 /* 482 */
-EXTERN void		Tcl_GetTime _ANSI_ARGS_((Tcl_Time *timeBuf));
+EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
+#endif
+#ifndef Tcl_CreateObjTrace_TCL_DECLARED
+#define Tcl_CreateObjTrace_TCL_DECLARED
 /* 483 */
-EXTERN Tcl_Trace	Tcl_CreateObjTrace _ANSI_ARGS_((Tcl_Interp *interp,
-				int level, int flags,
-				Tcl_CmdObjTraceProc *objProc,
+EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
+				int flags, Tcl_CmdObjTraceProc *objProc,
 				ClientData clientData,
-				Tcl_CmdObjTraceDeleteProc *delProc));
+				Tcl_CmdObjTraceDeleteProc *delProc);
+#endif
+#ifndef Tcl_GetCommandInfoFromToken_TCL_DECLARED
+#define Tcl_GetCommandInfoFromToken_TCL_DECLARED
 /* 484 */
-EXTERN int		Tcl_GetCommandInfoFromToken _ANSI_ARGS_((
-				Tcl_Command token, Tcl_CmdInfo *infoPtr));
+EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
+				Tcl_CmdInfo *infoPtr);
+#endif
+#ifndef Tcl_SetCommandInfoFromToken_TCL_DECLARED
+#define Tcl_SetCommandInfoFromToken_TCL_DECLARED
 /* 485 */
-EXTERN int		Tcl_SetCommandInfoFromToken _ANSI_ARGS_((
-				Tcl_Command token,
-				CONST Tcl_CmdInfo *infoPtr));
+EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
+				CONST Tcl_CmdInfo *infoPtr);
+#endif
+#ifndef Tcl_DbNewWideIntObj_TCL_DECLARED
+#define Tcl_DbNewWideIntObj_TCL_DECLARED
 /* 486 */
-EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj _ANSI_ARGS_((
-				Tcl_WideInt wideValue, CONST char *file,
-				int line));
+EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
+				CONST char *file, int line);
+#endif
+#ifndef Tcl_GetWideIntFromObj_TCL_DECLARED
+#define Tcl_GetWideIntFromObj_TCL_DECLARED
 /* 487 */
-EXTERN int		Tcl_GetWideIntFromObj _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr,
-				Tcl_WideInt *widePtr));
+EXTERN int		Tcl_GetWideIntFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
+#endif
+#ifndef Tcl_NewWideIntObj_TCL_DECLARED
+#define Tcl_NewWideIntObj_TCL_DECLARED
 /* 488 */
-EXTERN Tcl_Obj *	Tcl_NewWideIntObj _ANSI_ARGS_((Tcl_WideInt wideValue));
+EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
+#endif
+#ifndef Tcl_SetWideIntObj_TCL_DECLARED
+#define Tcl_SetWideIntObj_TCL_DECLARED
 /* 489 */
-EXTERN void		Tcl_SetWideIntObj _ANSI_ARGS_((Tcl_Obj *objPtr,
-				Tcl_WideInt wideValue));
+EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
+				Tcl_WideInt wideValue);
+#endif
+#ifndef Tcl_AllocStatBuf_TCL_DECLARED
+#define Tcl_AllocStatBuf_TCL_DECLARED
 /* 490 */
-EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf _ANSI_ARGS_((void));
+EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
+#endif
+#ifndef Tcl_Seek_TCL_DECLARED
+#define Tcl_Seek_TCL_DECLARED
 /* 491 */
-EXTERN Tcl_WideInt	Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
-				Tcl_WideInt offset, int mode));
+EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
+				int mode);
+#endif
+#ifndef Tcl_Tell_TCL_DECLARED
+#define Tcl_Tell_TCL_DECLARED
 /* 492 */
-EXTERN Tcl_WideInt	Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
+#endif
+#ifndef Tcl_ChannelWideSeekProc_TCL_DECLARED
+#define Tcl_ChannelWideSeekProc_TCL_DECLARED
 /* 493 */
-EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
-/* Slot 494 is reserved */
-/* Slot 495 is reserved */
-/* Slot 496 is reserved */
-/* Slot 497 is reserved */
-/* Slot 498 is reserved */
-/* Slot 499 is reserved */
-/* Slot 500 is reserved */
-/* Slot 501 is reserved */
-/* Slot 502 is reserved */
-/* Slot 503 is reserved */
-/* Slot 504 is reserved */
-/* Slot 505 is reserved */
-/* Slot 506 is reserved */
-/* Slot 507 is reserved */
-/* Slot 508 is reserved */
-/* Slot 509 is reserved */
-/* Slot 510 is reserved */
-/* Slot 511 is reserved */
-/* Slot 512 is reserved */
-/* Slot 513 is reserved */
-/* Slot 514 is reserved */
-/* Slot 515 is reserved */
-/* Slot 516 is reserved */
-/* Slot 517 is reserved */
-/* Slot 518 is reserved */
-/* Slot 519 is reserved */
-/* Slot 520 is reserved */
-/* Slot 521 is reserved */
-/* Slot 522 is reserved */
-/* Slot 523 is reserved */
-/* Slot 524 is reserved */
-/* Slot 525 is reserved */
-/* Slot 526 is reserved */
-/* Slot 527 is reserved */
-/* Slot 528 is reserved */
-/* Slot 529 is reserved */
-/* Slot 530 is reserved */
-/* Slot 531 is reserved */
-/* Slot 532 is reserved */
-/* Slot 533 is reserved */
-/* Slot 534 is reserved */
-/* Slot 535 is reserved */
-/* Slot 536 is reserved */
-/* Slot 537 is reserved */
-/* Slot 538 is reserved */
-/* Slot 539 is reserved */
-/* Slot 540 is reserved */
-/* Slot 541 is reserved */
-/* Slot 542 is reserved */
-/* Slot 543 is reserved */
-/* Slot 544 is reserved */
-/* Slot 545 is reserved */
-/* Slot 546 is reserved */
-/* Slot 547 is reserved */
-/* Slot 548 is reserved */
-/* Slot 549 is reserved */
-/* Slot 550 is reserved */
-/* Slot 551 is reserved */
-/* Slot 552 is reserved */
-/* Slot 553 is reserved */
+EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_DictObjPut_TCL_DECLARED
+#define Tcl_DictObjPut_TCL_DECLARED
+/* 494 */
+EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
+#endif
+#ifndef Tcl_DictObjGet_TCL_DECLARED
+#define Tcl_DictObjGet_TCL_DECLARED
+/* 495 */
+EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
+#endif
+#ifndef Tcl_DictObjRemove_TCL_DECLARED
+#define Tcl_DictObjRemove_TCL_DECLARED
+/* 496 */
+EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
+				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
+#endif
+#ifndef Tcl_DictObjSize_TCL_DECLARED
+#define Tcl_DictObjSize_TCL_DECLARED
+/* 497 */
+EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+				int *sizePtr);
+#endif
+#ifndef Tcl_DictObjFirst_TCL_DECLARED
+#define Tcl_DictObjFirst_TCL_DECLARED
+/* 498 */
+EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
+				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
+				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
+				int *donePtr);
+#endif
+#ifndef Tcl_DictObjNext_TCL_DECLARED
+#define Tcl_DictObjNext_TCL_DECLARED
+/* 499 */
+EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
+				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
+				int *donePtr);
+#endif
+#ifndef Tcl_DictObjDone_TCL_DECLARED
+#define Tcl_DictObjDone_TCL_DECLARED
+/* 500 */
+EXTERN void		Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
+#endif
+#ifndef Tcl_DictObjPutKeyList_TCL_DECLARED
+#define Tcl_DictObjPutKeyList_TCL_DECLARED
+/* 501 */
+EXTERN int		Tcl_DictObjPutKeyList(Tcl_Interp *interp,
+				Tcl_Obj *dictPtr, int keyc,
+				Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr);
+#endif
+#ifndef Tcl_DictObjRemoveKeyList_TCL_DECLARED
+#define Tcl_DictObjRemoveKeyList_TCL_DECLARED
+/* 502 */
+EXTERN int		Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
+				Tcl_Obj *dictPtr, int keyc,
+				Tcl_Obj *CONST *keyv);
+#endif
+#ifndef Tcl_NewDictObj_TCL_DECLARED
+#define Tcl_NewDictObj_TCL_DECLARED
+/* 503 */
+EXTERN Tcl_Obj *	Tcl_NewDictObj(void);
+#endif
+#ifndef Tcl_DbNewDictObj_TCL_DECLARED
+#define Tcl_DbNewDictObj_TCL_DECLARED
+/* 504 */
+EXTERN Tcl_Obj *	Tcl_DbNewDictObj(CONST char *file, int line);
+#endif
+#ifndef Tcl_RegisterConfig_TCL_DECLARED
+#define Tcl_RegisterConfig_TCL_DECLARED
+/* 505 */
+EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
+				CONST char *pkgName,
+				Tcl_Config *configuration,
+				CONST char *valEncoding);
+#endif
+#ifndef Tcl_CreateNamespace_TCL_DECLARED
+#define Tcl_CreateNamespace_TCL_DECLARED
+/* 506 */
+EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
+				CONST char *name, ClientData clientData,
+				Tcl_NamespaceDeleteProc *deleteProc);
+#endif
+#ifndef Tcl_DeleteNamespace_TCL_DECLARED
+#define Tcl_DeleteNamespace_TCL_DECLARED
+/* 507 */
+EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
+#endif
+#ifndef Tcl_AppendExportList_TCL_DECLARED
+#define Tcl_AppendExportList_TCL_DECLARED
+/* 508 */
+EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_Export_TCL_DECLARED
+#define Tcl_Export_TCL_DECLARED
+/* 509 */
+EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+				CONST char *pattern, int resetListFirst);
+#endif
+#ifndef Tcl_Import_TCL_DECLARED
+#define Tcl_Import_TCL_DECLARED
+/* 510 */
+EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+				CONST char *pattern, int allowOverwrite);
+#endif
+#ifndef Tcl_ForgetImport_TCL_DECLARED
+#define Tcl_ForgetImport_TCL_DECLARED
+/* 511 */
+EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, CONST char *pattern);
+#endif
+#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
+#define Tcl_GetCurrentNamespace_TCL_DECLARED
+/* 512 */
+EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
+#define Tcl_GetGlobalNamespace_TCL_DECLARED
+/* 513 */
+EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_FindNamespace_TCL_DECLARED
+#define Tcl_FindNamespace_TCL_DECLARED
+/* 514 */
+EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags);
+#endif
+#ifndef Tcl_FindCommand_TCL_DECLARED
+#define Tcl_FindCommand_TCL_DECLARED
+/* 515 */
+EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags);
+#endif
+#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
+#define Tcl_GetCommandFromObj_TCL_DECLARED
+/* 516 */
+EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetCommandFullName_TCL_DECLARED
+#define Tcl_GetCommandFullName_TCL_DECLARED
+/* 517 */
+EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
+				Tcl_Command command, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_FSEvalFileEx_TCL_DECLARED
+#define Tcl_FSEvalFileEx_TCL_DECLARED
+/* 518 */
+EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
+				Tcl_Obj *fileName, CONST char *encodingName);
+#endif
+#ifndef Tcl_SetExitProc_TCL_DECLARED
+#define Tcl_SetExitProc_TCL_DECLARED
+/* 519 */
+EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
+#endif
+#ifndef Tcl_LimitAddHandler_TCL_DECLARED
+#define Tcl_LimitAddHandler_TCL_DECLARED
+/* 520 */
+EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
+				Tcl_LimitHandlerProc *handlerProc,
+				ClientData clientData,
+				Tcl_LimitHandlerDeleteProc *deleteProc);
+#endif
+#ifndef Tcl_LimitRemoveHandler_TCL_DECLARED
+#define Tcl_LimitRemoveHandler_TCL_DECLARED
+/* 521 */
+EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
+				Tcl_LimitHandlerProc *handlerProc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_LimitReady_TCL_DECLARED
+#define Tcl_LimitReady_TCL_DECLARED
+/* 522 */
+EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_LimitCheck_TCL_DECLARED
+#define Tcl_LimitCheck_TCL_DECLARED
+/* 523 */
+EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_LimitExceeded_TCL_DECLARED
+#define Tcl_LimitExceeded_TCL_DECLARED
+/* 524 */
+EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_LimitSetCommands_TCL_DECLARED
+#define Tcl_LimitSetCommands_TCL_DECLARED
+/* 525 */
+EXTERN void		Tcl_LimitSetCommands(Tcl_Interp *interp,
+				int commandLimit);
+#endif
+#ifndef Tcl_LimitSetTime_TCL_DECLARED
+#define Tcl_LimitSetTime_TCL_DECLARED
+/* 526 */
+EXTERN void		Tcl_LimitSetTime(Tcl_Interp *interp,
+				Tcl_Time *timeLimitPtr);
+#endif
+#ifndef Tcl_LimitSetGranularity_TCL_DECLARED
+#define Tcl_LimitSetGranularity_TCL_DECLARED
+/* 527 */
+EXTERN void		Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
+				int granularity);
+#endif
+#ifndef Tcl_LimitTypeEnabled_TCL_DECLARED
+#define Tcl_LimitTypeEnabled_TCL_DECLARED
+/* 528 */
+EXTERN int		Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
+#endif
+#ifndef Tcl_LimitTypeExceeded_TCL_DECLARED
+#define Tcl_LimitTypeExceeded_TCL_DECLARED
+/* 529 */
+EXTERN int		Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
+#endif
+#ifndef Tcl_LimitTypeSet_TCL_DECLARED
+#define Tcl_LimitTypeSet_TCL_DECLARED
+/* 530 */
+EXTERN void		Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
+#endif
+#ifndef Tcl_LimitTypeReset_TCL_DECLARED
+#define Tcl_LimitTypeReset_TCL_DECLARED
+/* 531 */
+EXTERN void		Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
+#endif
+#ifndef Tcl_LimitGetCommands_TCL_DECLARED
+#define Tcl_LimitGetCommands_TCL_DECLARED
+/* 532 */
+EXTERN int		Tcl_LimitGetCommands(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_LimitGetTime_TCL_DECLARED
+#define Tcl_LimitGetTime_TCL_DECLARED
+/* 533 */
+EXTERN void		Tcl_LimitGetTime(Tcl_Interp *interp,
+				Tcl_Time *timeLimitPtr);
+#endif
+#ifndef Tcl_LimitGetGranularity_TCL_DECLARED
+#define Tcl_LimitGetGranularity_TCL_DECLARED
+/* 534 */
+EXTERN int		Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
+#endif
+#ifndef Tcl_SaveInterpState_TCL_DECLARED
+#define Tcl_SaveInterpState_TCL_DECLARED
+/* 535 */
+EXTERN Tcl_InterpState	Tcl_SaveInterpState(Tcl_Interp *interp, int status);
+#endif
+#ifndef Tcl_RestoreInterpState_TCL_DECLARED
+#define Tcl_RestoreInterpState_TCL_DECLARED
+/* 536 */
+EXTERN int		Tcl_RestoreInterpState(Tcl_Interp *interp,
+				Tcl_InterpState state);
+#endif
+#ifndef Tcl_DiscardInterpState_TCL_DECLARED
+#define Tcl_DiscardInterpState_TCL_DECLARED
+/* 537 */
+EXTERN void		Tcl_DiscardInterpState(Tcl_InterpState state);
+#endif
+#ifndef Tcl_SetReturnOptions_TCL_DECLARED
+#define Tcl_SetReturnOptions_TCL_DECLARED
+/* 538 */
+EXTERN int		Tcl_SetReturnOptions(Tcl_Interp *interp,
+				Tcl_Obj *options);
+#endif
+#ifndef Tcl_GetReturnOptions_TCL_DECLARED
+#define Tcl_GetReturnOptions_TCL_DECLARED
+/* 539 */
+EXTERN Tcl_Obj *	Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
+#endif
+#ifndef Tcl_IsEnsemble_TCL_DECLARED
+#define Tcl_IsEnsemble_TCL_DECLARED
+/* 540 */
+EXTERN int		Tcl_IsEnsemble(Tcl_Command token);
+#endif
+#ifndef Tcl_CreateEnsemble_TCL_DECLARED
+#define Tcl_CreateEnsemble_TCL_DECLARED
+/* 541 */
+EXTERN Tcl_Command	Tcl_CreateEnsemble(Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_Namespace *namespacePtr, int flags);
+#endif
+#ifndef Tcl_FindEnsemble_TCL_DECLARED
+#define Tcl_FindEnsemble_TCL_DECLARED
+/* 542 */
+EXTERN Tcl_Command	Tcl_FindEnsemble(Tcl_Interp *interp,
+				Tcl_Obj *cmdNameObj, int flags);
+#endif
+#ifndef Tcl_SetEnsembleSubcommandList_TCL_DECLARED
+#define Tcl_SetEnsembleSubcommandList_TCL_DECLARED
+/* 543 */
+EXTERN int		Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj *subcmdList);
+#endif
+#ifndef Tcl_SetEnsembleMappingDict_TCL_DECLARED
+#define Tcl_SetEnsembleMappingDict_TCL_DECLARED
+/* 544 */
+EXTERN int		Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj *mapDict);
+#endif
+#ifndef Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
+#define Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
+/* 545 */
+EXTERN int		Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj *unknownList);
+#endif
+#ifndef Tcl_SetEnsembleFlags_TCL_DECLARED
+#define Tcl_SetEnsembleFlags_TCL_DECLARED
+/* 546 */
+EXTERN int		Tcl_SetEnsembleFlags(Tcl_Interp *interp,
+				Tcl_Command token, int flags);
+#endif
+#ifndef Tcl_GetEnsembleSubcommandList_TCL_DECLARED
+#define Tcl_GetEnsembleSubcommandList_TCL_DECLARED
+/* 547 */
+EXTERN int		Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj **subcmdListPtr);
+#endif
+#ifndef Tcl_GetEnsembleMappingDict_TCL_DECLARED
+#define Tcl_GetEnsembleMappingDict_TCL_DECLARED
+/* 548 */
+EXTERN int		Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj **mapDictPtr);
+#endif
+#ifndef Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
+#define Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
+/* 549 */
+EXTERN int		Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
+				Tcl_Command token, Tcl_Obj **unknownListPtr);
+#endif
+#ifndef Tcl_GetEnsembleFlags_TCL_DECLARED
+#define Tcl_GetEnsembleFlags_TCL_DECLARED
+/* 550 */
+EXTERN int		Tcl_GetEnsembleFlags(Tcl_Interp *interp,
+				Tcl_Command token, int *flagsPtr);
+#endif
+#ifndef Tcl_GetEnsembleNamespace_TCL_DECLARED
+#define Tcl_GetEnsembleNamespace_TCL_DECLARED
+/* 551 */
+EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
+				Tcl_Command token,
+				Tcl_Namespace **namespacePtrPtr);
+#endif
+#ifndef Tcl_SetTimeProc_TCL_DECLARED
+#define Tcl_SetTimeProc_TCL_DECLARED
+/* 552 */
+EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
+				Tcl_ScaleTimeProc *scaleProc,
+				ClientData clientData);
+#endif
+#ifndef Tcl_QueryTimeProc_TCL_DECLARED
+#define Tcl_QueryTimeProc_TCL_DECLARED
+/* 553 */
+EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
+				Tcl_ScaleTimeProc **scaleProc,
+				ClientData *clientData);
+#endif
+#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
+#define Tcl_ChannelThreadActionProc_TCL_DECLARED
 /* 554 */
-EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc _ANSI_ARGS_((
-				Tcl_ChannelType *chanTypePtr));
-/* Slot 555 is reserved */
-/* Slot 556 is reserved */
-/* Slot 557 is reserved */
-/* Slot 558 is reserved */
-/* Slot 559 is reserved */
-/* Slot 560 is reserved */
-/* Slot 561 is reserved */
-/* Slot 562 is reserved */
-/* Slot 563 is reserved */
-/* Slot 564 is reserved */
-/* Slot 565 is reserved */
-/* Slot 566 is reserved */
-/* Slot 567 is reserved */
-/* Slot 568 is reserved */
-/* Slot 569 is reserved */
-/* Slot 570 is reserved */
-/* Slot 571 is reserved */
-/* Slot 572 is reserved */
+EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_NewBignumObj_TCL_DECLARED
+#define Tcl_NewBignumObj_TCL_DECLARED
+/* 555 */
+EXTERN Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
+#endif
+#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
+#define Tcl_DbNewBignumObj_TCL_DECLARED
+/* 556 */
+EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, CONST char *file,
+				int line);
+#endif
+#ifndef Tcl_SetBignumObj_TCL_DECLARED
+#define Tcl_SetBignumObj_TCL_DECLARED
+/* 557 */
+EXTERN void		Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
+#endif
+#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
+#define Tcl_GetBignumFromObj_TCL_DECLARED
+/* 558 */
+EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
+				Tcl_Obj *obj, mp_int *value);
+#endif
+#ifndef Tcl_TakeBignumFromObj_TCL_DECLARED
+#define Tcl_TakeBignumFromObj_TCL_DECLARED
+/* 559 */
+EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
+				Tcl_Obj *obj, mp_int *value);
+#endif
+#ifndef Tcl_TruncateChannel_TCL_DECLARED
+#define Tcl_TruncateChannel_TCL_DECLARED
+/* 560 */
+EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
+				Tcl_WideInt length);
+#endif
+#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
+#define Tcl_ChannelTruncateProc_TCL_DECLARED
+/* 561 */
+EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
+				CONST Tcl_ChannelType *chanTypePtr);
+#endif
+#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
+#define Tcl_SetChannelErrorInterp_TCL_DECLARED
+/* 562 */
+EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
+				Tcl_Obj *msg);
+#endif
+#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
+#define Tcl_GetChannelErrorInterp_TCL_DECLARED
+/* 563 */
+EXTERN void		Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
+				Tcl_Obj **msg);
+#endif
+#ifndef Tcl_SetChannelError_TCL_DECLARED
+#define Tcl_SetChannelError_TCL_DECLARED
+/* 564 */
+EXTERN void		Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
+#endif
+#ifndef Tcl_GetChannelError_TCL_DECLARED
+#define Tcl_GetChannelError_TCL_DECLARED
+/* 565 */
+EXTERN void		Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
+#endif
+#ifndef Tcl_InitBignumFromDouble_TCL_DECLARED
+#define Tcl_InitBignumFromDouble_TCL_DECLARED
+/* 566 */
+EXTERN int		Tcl_InitBignumFromDouble(Tcl_Interp *interp,
+				double initval, mp_int *toInit);
+#endif
+#ifndef Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
+#define Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
+/* 567 */
+EXTERN Tcl_Obj *	Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr);
+#endif
+#ifndef Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
+#define Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
+/* 568 */
+EXTERN int		Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
+#endif
+#ifndef Tcl_GetEncodingFromObj_TCL_DECLARED
+#define Tcl_GetEncodingFromObj_TCL_DECLARED
+/* 569 */
+EXTERN int		Tcl_GetEncodingFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
+#endif
+#ifndef Tcl_GetEncodingSearchPath_TCL_DECLARED
+#define Tcl_GetEncodingSearchPath_TCL_DECLARED
+/* 570 */
+EXTERN Tcl_Obj *	Tcl_GetEncodingSearchPath(void);
+#endif
+#ifndef Tcl_SetEncodingSearchPath_TCL_DECLARED
+#define Tcl_SetEncodingSearchPath_TCL_DECLARED
+/* 571 */
+EXTERN int		Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
+#endif
+#ifndef Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
+#define Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
+/* 572 */
+EXTERN CONST char *	Tcl_GetEncodingNameFromEnvironment(
+				Tcl_DString *bufPtr);
+#endif
+#ifndef Tcl_PkgRequireProc_TCL_DECLARED
+#define Tcl_PkgRequireProc_TCL_DECLARED
 /* 573 */
-EXTERN int		Tcl_PkgRequireProc _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
 				CONST char *name, int objc,
 				Tcl_Obj *CONST objv[],
-				ClientData *clientDataPtr));
-/* Slot 574 is reserved */
-/* Slot 575 is reserved */
-/* Slot 576 is reserved */
-/* Slot 577 is reserved */
-/* Slot 578 is reserved */
-/* Slot 579 is reserved */
+				ClientData *clientDataPtr);
+#endif
+#ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED
+#define Tcl_AppendObjToErrorInfo_TCL_DECLARED
+/* 574 */
+EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_AppendLimitedToObj_TCL_DECLARED
+#define Tcl_AppendLimitedToObj_TCL_DECLARED
+/* 575 */
+EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
+				CONST char *bytes, int length, int limit,
+				CONST char *ellipsis);
+#endif
+#ifndef Tcl_Format_TCL_DECLARED
+#define Tcl_Format_TCL_DECLARED
+/* 576 */
+EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, CONST char *format,
+				int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_AppendFormatToObj_TCL_DECLARED
+#define Tcl_AppendFormatToObj_TCL_DECLARED
+/* 577 */
+EXTERN int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, CONST char *format,
+				int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef Tcl_ObjPrintf_TCL_DECLARED
+#define Tcl_ObjPrintf_TCL_DECLARED
+/* 578 */
+EXTERN Tcl_Obj *	Tcl_ObjPrintf(CONST char *format, ...);
+#endif
+#ifndef Tcl_AppendPrintfToObj_TCL_DECLARED
+#define Tcl_AppendPrintfToObj_TCL_DECLARED
+/* 579 */
+EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
+				CONST char *format, ...);
+#endif
 /* Slot 580 is reserved */
 /* Slot 581 is reserved */
 /* Slot 582 is reserved */
@@ -1685,8 +3458,11 @@ EXTERN int		Tcl_PkgRequireProc _ANSI_ARGS_((Tcl_Interp *interp,
 /* Slot 627 is reserved */
 /* Slot 628 is reserved */
 /* Slot 629 is reserved */
+#ifndef TclUnusedStubEntry_TCL_DECLARED
+#define TclUnusedStubEntry_TCL_DECLARED
 /* 630 */
-EXTERN void		TclUnusedStubEntry _ANSI_ARGS_((void));
+EXTERN void		TclUnusedStubEntry(void);
+#endif
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1698,610 +3474,610 @@ typedef struct TclStubs {
     int magic;
     struct TclStubHooks *hooks;
 
-    int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData)); /* 0 */
-    CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr)); /* 1 */
-    void (*tcl_Panic) _ANSI_ARGS_((CONST char *format, ...)); /* 2 */
-    char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
-    void (*tcl_Free) _ANSI_ARGS_((char *ptr)); /* 4 */
-    char * (*tcl_Realloc) _ANSI_ARGS_((char *ptr, unsigned int size)); /* 5 */
-    char * (*tcl_DbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char *file, int line)); /* 6 */
-    void (*tcl_DbCkfree) _ANSI_ARGS_((char *ptr, CONST char *file, int line)); /* 7 */
-    char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char *ptr, unsigned int size, CONST char *file, int line)); /* 8 */
+    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData); /* 0 */
+    CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 1 */
+    void (*tcl_Panic) (CONST char *format, ...); /* 2 */
+    char * (*tcl_Alloc) (unsigned int size); /* 3 */
+    void (*tcl_Free) (char *ptr); /* 4 */
+    char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
+    char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */
+    void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */
+    char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-    void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)); /* 9 */
+    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* UNIX */
 #if defined(__WIN32__) /* WIN */
     VOID *reserved9;
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-    void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)); /* 9 */
+    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* MACOSX */
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-    void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */
+    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* UNIX */
 #if defined(__WIN32__) /* WIN */
     VOID *reserved10;
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-    void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */
+    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* MACOSX */
-    void (*tcl_SetTimer) _ANSI_ARGS_((Tcl_Time *timePtr)); /* 11 */
-    void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */
-    int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time *timePtr)); /* 13 */
-    int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* 14 */
-    void (*tcl_AppendStringsToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, ...)); /* 15 */
-    void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *bytes, int length)); /* 16 */
-    Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */
-    int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr)); /* 18 */
-    void (*tcl_DbDecrRefCount) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *file, int line)); /* 19 */
-    void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *file, int line)); /* 20 */
-    int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *file, int line)); /* 21 */
-    Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, CONST char *file, int line)); /* 22 */
-    Tcl_Obj * (*tcl_DbNewByteArrayObj) _ANSI_ARGS_((CONST unsigned char *bytes, int length, CONST char *file, int line)); /* 23 */
-    Tcl_Obj * (*tcl_DbNewDoubleObj) _ANSI_ARGS_((double doubleValue, CONST char *file, int line)); /* 24 */
-    Tcl_Obj * (*tcl_DbNewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST *objv, CONST char *file, int line)); /* 25 */
-    Tcl_Obj * (*tcl_DbNewLongObj) _ANSI_ARGS_((long longValue, CONST char *file, int line)); /* 26 */
-    Tcl_Obj * (*tcl_DbNewObj) _ANSI_ARGS_((CONST char *file, int line)); /* 27 */
-    Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char *bytes, int length, CONST char *file, int line)); /* 28 */
-    Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 29 */
-    void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 30 */
-    int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *src, int *boolPtr)); /* 31 */
-    int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr)); /* 32 */
-    unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int *lengthPtr)); /* 33 */
-    int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *src, double *doublePtr)); /* 34 */
-    int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr)); /* 35 */
-    int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr)); /* 36 */
-    int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *src, int *intPtr)); /* 37 */
-    int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)); /* 38 */
-    int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)); /* 39 */
-    Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((CONST char *typeName)); /* 40 */
-    char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int *lengthPtr)); /* 41 */
-    void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 42 */
-    int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr)); /* 43 */
-    int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr)); /* 44 */
-    int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr)); /* 45 */
-    int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr)); /* 46 */
-    int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr)); /* 47 */
-    int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */
-    Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */
-    Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((CONST unsigned char *bytes, int length)); /* 50 */
-    Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */
-    Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */
-    Tcl_Obj * (*tcl_NewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 53 */
-    Tcl_Obj * (*tcl_NewLongObj) _ANSI_ARGS_((long longValue)); /* 54 */
-    Tcl_Obj * (*tcl_NewObj) _ANSI_ARGS_((void)); /* 55 */
-    Tcl_Obj * (*tcl_NewStringObj) _ANSI_ARGS_((CONST char *bytes, int length)); /* 56 */
-    void (*tcl_SetBooleanObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int boolValue)); /* 57 */
-    unsigned char * (*tcl_SetByteArrayLength) _ANSI_ARGS_((Tcl_Obj *objPtr, int length)); /* 58 */
-    void (*tcl_SetByteArrayObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST unsigned char *bytes, int length)); /* 59 */
-    void (*tcl_SetDoubleObj) _ANSI_ARGS_((Tcl_Obj *objPtr, double doubleValue)); /* 60 */
-    void (*tcl_SetIntObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int intValue)); /* 61 */
-    void (*tcl_SetListObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[])); /* 62 */
-    void (*tcl_SetLongObj) _ANSI_ARGS_((Tcl_Obj *objPtr, long longValue)); /* 63 */
-    void (*tcl_SetObjLength) _ANSI_ARGS_((Tcl_Obj *objPtr, int length)); /* 64 */
-    void (*tcl_SetStringObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *bytes, int length)); /* 65 */
-    void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *message)); /* 66 */
-    void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *message, int length)); /* 67 */
-    void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp *interp)); /* 68 */
-    void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *element)); /* 69 */
-    void (*tcl_AppendResult) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 70 */
-    Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc *proc, ClientData clientData)); /* 71 */
-    void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */
-    int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp *interp, int code)); /* 73 */
-    void (*tcl_AsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 74 */
-    int (*tcl_AsyncReady) _ANSI_ARGS_((void)); /* 75 */
-    void (*tcl_BackgroundError) _ANSI_ARGS_((Tcl_Interp *interp)); /* 76 */
-    char (*tcl_Backslash) _ANSI_ARGS_((CONST char *src, int *readPtr)); /* 77 */
-    int (*tcl_BadChannelOption) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *optionName, CONST char *optionList)); /* 78 */
-    void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData)); /* 79 */
-    void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc *idleProc, ClientData clientData)); /* 80 */
-    int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 81 */
-    int (*tcl_CommandComplete) _ANSI_ARGS_((CONST char *cmd)); /* 82 */
-    char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char *CONST *argv)); /* 83 */
-    int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char *src, char *dst, int flags)); /* 84 */
-    int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char *src, int length, char *dst, int flags)); /* 85 */
-    int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv)); /* 86 */
-    int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */
-    Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask)); /* 88 */
-    void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData)); /* 89 */
-    void (*tcl_CreateCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData)); /* 90 */
-    Tcl_Command (*tcl_CreateCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc)); /* 91 */
-    void (*tcl_CreateEventSource) _ANSI_ARGS_((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData)); /* 92 */
-    void (*tcl_CreateExitHandler) _ANSI_ARGS_((Tcl_ExitProc *proc, ClientData clientData)); /* 93 */
-    Tcl_Interp * (*tcl_CreateInterp) _ANSI_ARGS_((void)); /* 94 */
-    void (*tcl_CreateMathFunc) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData)); /* 95 */
-    Tcl_Command (*tcl_CreateObjCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc)); /* 96 */
-    Tcl_Interp * (*tcl_CreateSlave) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *slaveName, int isSafe)); /* 97 */
-    Tcl_TimerToken (*tcl_CreateTimerHandler) _ANSI_ARGS_((int milliseconds, Tcl_TimerProc *proc, ClientData clientData)); /* 98 */
-    Tcl_Trace (*tcl_CreateTrace) _ANSI_ARGS_((Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData)); /* 99 */
-    void (*tcl_DeleteAssocData) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); /* 100 */
-    void (*tcl_DeleteChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData)); /* 101 */
-    void (*tcl_DeleteCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData)); /* 102 */
-    int (*tcl_DeleteCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName)); /* 103 */
-    int (*tcl_DeleteCommandFromToken) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Command command)); /* 104 */
-    void (*tcl_DeleteEvents) _ANSI_ARGS_((Tcl_EventDeleteProc *proc, ClientData clientData)); /* 105 */
-    void (*tcl_DeleteEventSource) _ANSI_ARGS_((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData)); /* 106 */
-    void (*tcl_DeleteExitHandler) _ANSI_ARGS_((Tcl_ExitProc *proc, ClientData clientData)); /* 107 */
-    void (*tcl_DeleteHashEntry) _ANSI_ARGS_((Tcl_HashEntry *entryPtr)); /* 108 */
-    void (*tcl_DeleteHashTable) _ANSI_ARGS_((Tcl_HashTable *tablePtr)); /* 109 */
-    void (*tcl_DeleteInterp) _ANSI_ARGS_((Tcl_Interp *interp)); /* 110 */
-    void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr)); /* 111 */
-    void (*tcl_DeleteTimerHandler) _ANSI_ARGS_((Tcl_TimerToken token)); /* 112 */
-    void (*tcl_DeleteTrace) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Trace trace)); /* 113 */
-    void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData)); /* 114 */
-    int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */
-    void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc *proc, ClientData clientData)); /* 116 */
-    char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString *dsPtr, CONST char *bytes, int length)); /* 117 */
-    char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString *dsPtr, CONST char *element)); /* 118 */
-    void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString *dsPtr)); /* 119 */
-    void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString *dsPtr)); /* 120 */
-    void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *dsPtr)); /* 121 */
-    void (*tcl_DStringInit) _ANSI_ARGS_((Tcl_DString *dsPtr)); /* 122 */
-    void (*tcl_DStringResult) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *dsPtr)); /* 123 */
-    void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString *dsPtr, int length)); /* 124 */
-    void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString *dsPtr)); /* 125 */
-    int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */
-    CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
-    CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
-    int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script)); /* 129 */
-    int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *fileName)); /* 130 */
-    int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* 131 */
-    void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc *freeProc)); /* 132 */
-    void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */
-    int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName)); /* 134 */
-    int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *expr, int *ptr)); /* 135 */
-    int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr)); /* 136 */
-    int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *expr, double *ptr)); /* 137 */
-    int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr)); /* 138 */
-    int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *expr, long *ptr)); /* 139 */
-    int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)); /* 140 */
-    int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr)); /* 141 */
-    int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *expr)); /* 142 */
-    void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */
-    void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char *argv0)); /* 144 */
-    Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr)); /* 145 */
-    int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */
-    void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp *interp)); /* 147 */
-    int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr)); /* 148 */
-    int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv)); /* 149 */
-    ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr)); /* 150 */
-    Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *chanName, int *modePtr)); /* 151 */
-    int (*tcl_GetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan)); /* 152 */
-    int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData *handlePtr)); /* 153 */
-    ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */
-    int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */
-    CONST84_RETURN char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
-    int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr)); /* 157 */
-    Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */
-    int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr)); /* 159 */
-    CONST84_RETURN char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Command command)); /* 160 */
-    int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */
-    CONST84_RETURN char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
-    int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)); /* 163 */
-    Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp *interp)); /* 164 */
-    CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */
-    Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp *interp)); /* 166 */
+    void (*tcl_SetTimer) (Tcl_Time *timePtr); /* 11 */
+    void (*tcl_Sleep) (int ms); /* 12 */
+    int (*tcl_WaitForEvent) (Tcl_Time *timePtr); /* 13 */
+    int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */
+    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
+    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, CONST char *bytes, int length); /* 16 */
+    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *CONST objv[]); /* 17 */
+    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr); /* 18 */
+    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, CONST char *file, int line); /* 19 */
+    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, CONST char *file, int line); /* 20 */
+    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, CONST char *file, int line); /* 21 */
+    Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, CONST char *file, int line); /* 22 */
+    Tcl_Obj * (*tcl_DbNewByteArrayObj) (CONST unsigned char *bytes, int length, CONST char *file, int line); /* 23 */
+    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, CONST char *file, int line); /* 24 */
+    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *CONST *objv, CONST char *file, int line); /* 25 */
+    Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, CONST char *file, int line); /* 26 */
+    Tcl_Obj * (*tcl_DbNewObj) (CONST char *file, int line); /* 27 */
+    Tcl_Obj * (*tcl_DbNewStringObj) (CONST char *bytes, int length, CONST char *file, int line); /* 28 */
+    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
+    void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
+    int (*tcl_GetBoolean) (Tcl_Interp *interp, CONST char *src, int *boolPtr); /* 31 */
+    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
+    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
+    int (*tcl_GetDouble) (Tcl_Interp *interp, CONST char *src, double *doublePtr); /* 34 */
+    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
+    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr); /* 36 */
+    int (*tcl_GetInt) (Tcl_Interp *interp, CONST char *src, int *intPtr); /* 37 */
+    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
+    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
+    Tcl_ObjType * (*tcl_GetObjType) (CONST char *typeName); /* 40 */
+    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
+    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
+    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
+    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
+    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
+    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
+    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
+    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]); /* 48 */
+    Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+    Tcl_Obj * (*tcl_NewByteArrayObj) (CONST unsigned char *bytes, int length); /* 50 */
+    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
+    Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *CONST objv[]); /* 53 */
+    Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
+    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
+    Tcl_Obj * (*tcl_NewStringObj) (CONST char *bytes, int length); /* 56 */
+    void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
+    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, CONST unsigned char *bytes, int length); /* 59 */
+    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
+    void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]); /* 62 */
+    void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
+    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
+    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, CONST char *bytes, int length); /* 65 */
+    void (*tcl_AddErrorInfo) (Tcl_Interp *interp, CONST char *message); /* 66 */
+    void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, CONST char *message, int length); /* 67 */
+    void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
+    void (*tcl_AppendElement) (Tcl_Interp *interp, CONST char *element); /* 69 */
+    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
+    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
+    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
+    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
+    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
+    int (*tcl_AsyncReady) (void); /* 75 */
+    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
+    char (*tcl_Backslash) (CONST char *src, int *readPtr); /* 77 */
+    int (*tcl_BadChannelOption) (Tcl_Interp *interp, CONST char *optionName, CONST char *optionList); /* 78 */
+    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
+    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
+    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
+    int (*tcl_CommandComplete) (CONST char *cmd); /* 82 */
+    char * (*tcl_Concat) (int argc, CONST84 char *CONST *argv); /* 83 */
+    int (*tcl_ConvertElement) (CONST char *src, char *dst, int flags); /* 84 */
+    int (*tcl_ConvertCountedElement) (CONST char *src, int length, char *dst, int flags); /* 85 */
+    int (*tcl_CreateAlias) (Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv); /* 86 */
+    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]); /* 87 */
+    Tcl_Channel (*tcl_CreateChannel) (Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask); /* 88 */
+    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
+    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
+    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
+    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
+    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
+    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
+    void (*tcl_CreateMathFunc) (Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
+    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
+    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, CONST char *slaveName, int isSafe); /* 97 */
+    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
+    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
+    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, CONST char *name); /* 100 */
+    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
+    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
+    int (*tcl_DeleteCommand) (Tcl_Interp *interp, CONST char *cmdName); /* 103 */
+    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
+    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */
+    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */
+    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */
+    void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */
+    void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */
+    void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */
+    void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */
+    void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */
+    void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */
+    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */
+    int (*tcl_DoOneEvent) (int flags); /* 115 */
+    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */
+    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, CONST char *bytes, int length); /* 117 */
+    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, CONST char *element); /* 118 */
+    void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */
+    void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
+    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
+    void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
+    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
+    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
+    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
+    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
+    CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
+    CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
+    int (*tcl_Eval) (Tcl_Interp *interp, CONST char *script); /* 129 */
+    int (*tcl_EvalFile) (Tcl_Interp *interp, CONST char *fileName); /* 130 */
+    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
+    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
+    void (*tcl_Exit) (int status); /* 133 */
+    int (*tcl_ExposeCommand) (Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName); /* 134 */
+    int (*tcl_ExprBoolean) (Tcl_Interp *interp, CONST char *expr, int *ptr); /* 135 */
+    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
+    int (*tcl_ExprDouble) (Tcl_Interp *interp, CONST char *expr, double *ptr); /* 137 */
+    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
+    int (*tcl_ExprLong) (Tcl_Interp *interp, CONST char *expr, long *ptr); /* 139 */
+    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
+    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
+    int (*tcl_ExprString) (Tcl_Interp *interp, CONST char *expr); /* 142 */
+    void (*tcl_Finalize) (void); /* 143 */
+    void (*tcl_FindExecutable) (CONST char *argv0); /* 144 */
+    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
+    int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
+    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
+    int (*tcl_GetAlias) (Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
+    int (*tcl_GetAliasObj) (Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
+    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, CONST char *chanName, int *modePtr); /* 151 */
+    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
+    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
+    ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
+    int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
+    CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
+    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr); /* 157 */
+    Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
+    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
+    CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
+    int (*tcl_GetErrno) (void); /* 161 */
+    CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
+    int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
+    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
+    CONST char * (*tcl_GetNameOfExecutable) (void); /* 165 */
+    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
 #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-    int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr)); /* 167 */
+    int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
 #endif /* UNIX */
 #if defined(__WIN32__) /* WIN */
     VOID *reserved167;
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-    int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr)); /* 167 */
+    int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
 #endif /* MACOSX */
-    Tcl_PathType (*tcl_GetPathType) _ANSI_ARGS_((CONST char *path)); /* 168 */
-    int (*tcl_Gets) _ANSI_ARGS_((Tcl_Channel chan, Tcl_DString *dsPtr)); /* 169 */
-    int (*tcl_GetsObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj *objPtr)); /* 170 */
-    int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */
-    Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *slaveName)); /* 172 */
-    Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */
-    CONST84_RETURN char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp *interp)); /* 174 */
-    CONST84_RETURN char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags)); /* 175 */
-    CONST84_RETURN char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)); /* 176 */
-    int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *command)); /* 177 */
-    int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* 178 */
-    int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken)); /* 179 */
-    int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp *interp)); /* 180 */
-    void (*tcl_InitHashTable) _ANSI_ARGS_((Tcl_HashTable *tablePtr, int keyType)); /* 181 */
-    int (*tcl_InputBlocked) _ANSI_ARGS_((Tcl_Channel chan)); /* 182 */
-    int (*tcl_InputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 183 */
-    int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp *interp)); /* 184 */
-    int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp *interp)); /* 185 */
-    char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr)); /* 186 */
-    int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, char *addr, int type)); /* 187 */
+    Tcl_PathType (*tcl_GetPathType) (CONST char *path); /* 168 */
+    int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
+    int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
+    int (*tcl_GetServiceMode) (void); /* 171 */
+    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, CONST char *slaveName); /* 172 */
+    Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
+    CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
+    CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, CONST char *varName, int flags); /* 175 */
+    CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 176 */
+    int (*tcl_GlobalEval) (Tcl_Interp *interp, CONST char *command); /* 177 */
+    int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
+    int (*tcl_HideCommand) (Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken); /* 179 */
+    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
+    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
+    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
+    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
+    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
+    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
+    char * (*tcl_JoinPath) (int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr); /* 186 */
+    int (*tcl_LinkVar) (Tcl_Interp *interp, CONST char *varName, char *addr, int type); /* 187 */
     VOID *reserved188;
-    Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */
-    int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp *interp)); /* 190 */
-    Tcl_Channel (*tcl_MakeTcpClientChannel) _ANSI_ARGS_((ClientData tcpSocket)); /* 191 */
-    char * (*tcl_Merge) _ANSI_ARGS_((int argc, CONST84 char *CONST *argv)); /* 192 */
-    Tcl_HashEntry * (*tcl_NextHashEntry) _ANSI_ARGS_((Tcl_HashSearch *searchPtr)); /* 193 */
-    void (*tcl_NotifyChannel) _ANSI_ARGS_((Tcl_Channel channel, int mask)); /* 194 */
-    Tcl_Obj * (*tcl_ObjGetVar2) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags)); /* 195 */
-    Tcl_Obj * (*tcl_ObjSetVar2) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)); /* 196 */
-    Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)); /* 197 */
-    Tcl_Channel (*tcl_OpenFileChannel) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)); /* 198 */
-    Tcl_Channel (*tcl_OpenTcpClient) _ANSI_ARGS_((Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async)); /* 199 */
-    Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData)); /* 200 */
-    void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */
-    void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp *interp, double value, char *dst)); /* 202 */
-    int (*tcl_PutEnv) _ANSI_ARGS_((CONST char *assignment)); /* 203 */
-    CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp *interp)); /* 204 */
-    void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event *evPtr, Tcl_QueuePosition position)); /* 205 */
-    int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char *bufPtr, int toRead)); /* 206 */
-    void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
-    int (*tcl_RecordAndEval) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmd, int flags)); /* 208 */
-    int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)); /* 209 */
-    void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 210 */
-    void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType *typePtr)); /* 211 */
-    Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pattern)); /* 212 */
-    int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *text, CONST char *start)); /* 213 */
-    int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *text, CONST char *pattern)); /* 214 */
-    void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr)); /* 215 */
-    void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */
-    void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp *interp)); /* 217 */
-    int (*tcl_ScanElement) _ANSI_ARGS_((CONST char *src, int *flagPtr)); /* 218 */
-    int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char *src, int length, int *flagPtr)); /* 219 */
-    int (*tcl_SeekOld) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */
-    int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */
-    int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */
-    void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData)); /* 223 */
-    void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */
-    int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue)); /* 225 */
-    int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr)); /* 226 */
-    void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */
-    void (*tcl_SetErrorCode) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 228 */
-    void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time *timePtr)); /* 229 */
-    void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc *panicProc)); /* 230 */
-    int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp *interp, int depth)); /* 231 */
-    void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc)); /* 232 */
-    int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */
-    void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *errorObjPtr)); /* 234 */
-    void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultObjPtr)); /* 235 */
-    void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */
-    CONST84_RETURN char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags)); /* 237 */
-    CONST84_RETURN char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags)); /* 238 */
-    CONST84_RETURN char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
-    CONST84_RETURN char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
-    void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp *interp)); /* 241 */
-    int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr)); /* 242 */
-    void (*tcl_SplitPath) _ANSI_ARGS_((CONST char *path, int *argcPtr, CONST84 char ***argvPtr)); /* 243 */
-    void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)); /* 244 */
-    int (*tcl_StringMatch) _ANSI_ARGS_((CONST char *str, CONST char *pattern)); /* 245 */
-    int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */
-    int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData)); /* 247 */
-    int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData)); /* 248 */
-    char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr)); /* 249 */
-    int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, CONST char *str, int len, int atHead)); /* 250 */
-    void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName)); /* 251 */
-    int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 252 */
-    int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags)); /* 253 */
-    int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)); /* 254 */
-    void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData)); /* 255 */
-    void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData)); /* 256 */
-    void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName)); /* 257 */
-    int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags)); /* 258 */
-    int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags)); /* 259 */
-    int (*tcl_VarEval) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 260 */
-    ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)); /* 261 */
-    ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)); /* 262 */
-    int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char *s, int slen)); /* 263 */
-    void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message)); /* 264 */
-    int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char *fileName)); /* 265 */
-    void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char *file, int line)); /* 266 */
-    void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp *interp, va_list argList)); /* 267 */
-    void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj *objPtr, va_list argList)); /* 268 */
-    char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable *tablePtr)); /* 269 */
-    CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr)); /* 270 */
-    CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact)); /* 271 */
-    CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr)); /* 272 */
-    int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version)); /* 273 */
-    CONST84_RETURN char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact)); /* 274 */
-    void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp *interp, va_list argList)); /* 275 */
-    int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp *interp, va_list argList)); /* 276 */
-    Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int *statPtr, int options)); /* 277 */
-    void (*tcl_PanicVA) _ANSI_ARGS_((CONST char *format, va_list argList)); /* 278 */
-    void (*tcl_GetVersion) _ANSI_ARGS_((int *major, int *minor, int *patchLevel, int *type)); /* 279 */
-    void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp *interp)); /* 280 */
-    Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
-    int (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 282 */
-    Tcl_Channel (*tcl_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 283 */
-    void (*tcl_SetMainLoop) _ANSI_ARGS_((Tcl_MainLoopProc *proc)); /* 284 */
+    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
+    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
+    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
+    char * (*tcl_Merge) (int argc, CONST84 char *CONST *argv); /* 192 */
+    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
+    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
+    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
+    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
+    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
+    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions); /* 198 */
+    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async); /* 199 */
+    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
+    void (*tcl_Preserve) (ClientData data); /* 201 */
+    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
+    int (*tcl_PutEnv) (CONST char *assignment); /* 203 */
+    CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
+    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
+    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
+    void (*tcl_ReapDetachedProcs) (void); /* 207 */
+    int (*tcl_RecordAndEval) (Tcl_Interp *interp, CONST char *cmd, int flags); /* 208 */
+    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
+    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
+    void (*tcl_RegisterObjType) (Tcl_ObjType *typePtr); /* 211 */
+    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, CONST char *pattern); /* 212 */
+    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *text, CONST char *start); /* 213 */
+    int (*tcl_RegExpMatch) (Tcl_Interp *interp, CONST char *text, CONST char *pattern); /* 214 */
+    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
+    void (*tcl_Release) (ClientData clientData); /* 216 */
+    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
+    int (*tcl_ScanElement) (CONST char *src, int *flagPtr); /* 218 */
+    int (*tcl_ScanCountedElement) (CONST char *src, int length, int *flagPtr); /* 219 */
+    int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
+    int (*tcl_ServiceAll) (void); /* 221 */
+    int (*tcl_ServiceEvent) (int flags); /* 222 */
+    void (*tcl_SetAssocData) (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
+    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
+    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue); /* 225 */
+    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr); /* 226 */
+    void (*tcl_SetErrno) (int err); /* 227 */
+    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
+    void (*tcl_SetMaxBlockTime) (Tcl_Time *timePtr); /* 229 */
+    void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
+    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
+    void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
+    int (*tcl_SetServiceMode) (int mode); /* 233 */
+    void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
+    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
+    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
+    CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags); /* 237 */
+    CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags); /* 238 */
+    CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
+    CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
+    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
+    int (*tcl_SplitList) (Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
+    void (*tcl_SplitPath) (CONST char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
+    void (*tcl_StaticPackage) (Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
+    int (*tcl_StringMatch) (CONST char *str, CONST char *pattern); /* 245 */
+    int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
+    int (*tcl_TraceVar) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
+    int (*tcl_TraceVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
+    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr); /* 249 */
+    int (*tcl_Ungets) (Tcl_Channel chan, CONST char *str, int len, int atHead); /* 250 */
+    void (*tcl_UnlinkVar) (Tcl_Interp *interp, CONST char *varName); /* 251 */
+    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
+    int (*tcl_UnsetVar) (Tcl_Interp *interp, CONST char *varName, int flags); /* 253 */
+    int (*tcl_UnsetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 254 */
+    void (*tcl_UntraceVar) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+    void (*tcl_UntraceVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
+    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, CONST char *varName); /* 257 */
+    int (*tcl_UpVar) (Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags); /* 258 */
+    int (*tcl_UpVar2) (Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags); /* 259 */
+    int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
+    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
+    int (*tcl_Write) (Tcl_Channel chan, CONST char *s, int slen); /* 263 */
+    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message); /* 264 */
+    int (*tcl_DumpActiveMemory) (CONST char *fileName); /* 265 */
+    void (*tcl_ValidateAllMemory) (CONST char *file, int line); /* 266 */
+    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
+    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
+    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
+    CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr); /* 270 */
+    CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 271 */
+    CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 272 */
+    int (*tcl_PkgProvide) (Tcl_Interp *interp, CONST char *name, CONST char *version); /* 273 */
+    CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 274 */
+    void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
+    int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
+    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
+    void (*tcl_PanicVA) (CONST char *format, va_list argList); /* 278 */
+    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
+    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
+    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
+    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
+    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
+    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
     VOID *reserved285;
-    void (*tcl_AppendObjToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)); /* 286 */
-    Tcl_Encoding (*tcl_CreateEncoding) _ANSI_ARGS_((Tcl_EncodingType *typePtr)); /* 287 */
-    void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc *proc, ClientData clientData)); /* 288 */
-    void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc *proc, ClientData clientData)); /* 289 */
-    void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult *statePtr)); /* 290 */
-    int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script, int numBytes, int flags)); /* 291 */
-    int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */
-    int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)); /* 293 */
-    void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */
-    int (*tcl_ExternalToUtf) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); /* 295 */
-    char * (*tcl_ExternalToUtfDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr)); /* 296 */
-    void (*tcl_FinalizeThread) _ANSI_ARGS_((void)); /* 297 */
-    void (*tcl_FinalizeNotifier) _ANSI_ARGS_((ClientData clientData)); /* 298 */
-    void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */
-    Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */
-    Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); /* 301 */
-    CONST84_RETURN char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
-    void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp *interp)); /* 303 */
-    int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr)); /* 304 */
-    VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr, int size)); /* 305 */
-    Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)); /* 306 */
-    ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */
-    void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex *mutexPtr)); /* 308 */
-    void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex *mutexPtr)); /* 309 */
-    void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition *condPtr)); /* 310 */
-    void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr)); /* 311 */
-    int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char *src, int length)); /* 312 */
-    int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag)); /* 313 */
-    void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_SavedResult *statePtr)); /* 314 */
-    void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_SavedResult *statePtr)); /* 315 */
-    int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); /* 316 */
-    Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags)); /* 317 */
-    void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */
-    void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position)); /* 319 */
-    Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char *src, int index)); /* 320 */
-    Tcl_UniChar (*tcl_UniCharToLower) _ANSI_ARGS_((int ch)); /* 321 */
-    Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */
-    Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */
-    int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char *buf)); /* 324 */
-    CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char *src, int index)); /* 325 */
-    int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char *src, int length)); /* 326 */
-    int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char *src, int *readPtr, char *dst)); /* 327 */
-    CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char *src, int ch)); /* 328 */
-    CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char *src, int ch)); /* 329 */
-    CONST84_RETURN char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char *src)); /* 330 */
-    CONST84_RETURN char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char *src, CONST char *start)); /* 331 */
-    int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); /* 332 */
-    char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr)); /* 333 */
-    int (*tcl_UtfToLower) _ANSI_ARGS_((char *src)); /* 334 */
-    int (*tcl_UtfToTitle) _ANSI_ARGS_((char *src)); /* 335 */
-    int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char *src, Tcl_UniChar *chPtr)); /* 336 */
-    int (*tcl_UtfToUpper) _ANSI_ARGS_((char *src)); /* 337 */
-    int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char *src, int srcLen)); /* 338 */
-    int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj *objPtr)); /* 339 */
-    char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 340 */
-    CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
-    void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((CONST char *path)); /* 342 */
-    void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
-    void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
-    int (*tcl_UniCharIsAlnum) _ANSI_ARGS_((int ch)); /* 345 */
-    int (*tcl_UniCharIsAlpha) _ANSI_ARGS_((int ch)); /* 346 */
-    int (*tcl_UniCharIsDigit) _ANSI_ARGS_((int ch)); /* 347 */
-    int (*tcl_UniCharIsLower) _ANSI_ARGS_((int ch)); /* 348 */
-    int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */
-    int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */
-    int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */
-    int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar *uniStr)); /* 352 */
-    int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars)); /* 353 */
-    char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr)); /* 354 */
-    Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char *src, int length, Tcl_DString *dsPtr)); /* 355 */
-    Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *patObj, int flags)); /* 356 */
-    Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)); /* 357 */
-    void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse *parsePtr)); /* 358 */
-    void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script, CONST char *command, int length)); /* 359 */
-    int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)); /* 360 */
-    int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, int numBytes, int nested, Tcl_Parse *parsePtr)); /* 361 */
-    int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr)); /* 362 */
-    int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)); /* 363 */
-    int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append)); /* 364 */
-    char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *cwdPtr)); /* 365 */
-    int (*tcl_Chdir) _ANSI_ARGS_((CONST char *dirName)); /* 366 */
-    int (*tcl_Access) _ANSI_ARGS_((CONST char *path, int mode)); /* 367 */
-    int (*tcl_Stat) _ANSI_ARGS_((CONST char *path, struct stat *bufPtr)); /* 368 */
-    int (*tcl_UtfNcmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2, unsigned long n)); /* 369 */
-    int (*tcl_UtfNcasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2, unsigned long n)); /* 370 */
-    int (*tcl_StringCaseMatch) _ANSI_ARGS_((CONST char *str, CONST char *pattern, int nocase)); /* 371 */
-    int (*tcl_UniCharIsControl) _ANSI_ARGS_((int ch)); /* 372 */
-    int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */
-    int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */
-    int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */
-    int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags)); /* 376 */
-    void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)); /* 377 */
-    Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((CONST Tcl_UniChar *unicode, int numChars)); /* 378 */
-    void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars)); /* 379 */
-    int (*tcl_GetCharLength) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 380 */
-    Tcl_UniChar (*tcl_GetUniChar) _ANSI_ARGS_((Tcl_Obj *objPtr, int index)); /* 381 */
-    Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj *objPtr)); /* 382 */
-    Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj *objPtr, int first, int last)); /* 383 */
-    void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length)); /* 384 */
-    int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj)); /* 385 */
-    void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs *notifierProcPtr)); /* 386 */
-    Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */
-    int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp *interp)); /* 388 */
-    int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pattern)); /* 389 */
-    int (*tcl_ProcObjCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* 390 */
-    void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition *condPtr)); /* 391 */
-    void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex *mutex)); /* 392 */
-    int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */
-    int (*tcl_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char *dst, int bytesToRead)); /* 394 */
-    int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, CONST char *src, int srcLen)); /* 395 */
-    Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */
-    int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */
-    CONST84_RETURN char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 398 */
-    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 399 */
-    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 400 */
-    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 401 */
-    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 402 */
-    Tcl_DriverInputProc * (*tcl_ChannelInputProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 403 */
-    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 404 */
-    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 405 */
-    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 406 */
-    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 407 */
-    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 408 */
-    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 409 */
-    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 410 */
-    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 411 */
-    int (*tcl_JoinThread) _ANSI_ARGS_((Tcl_ThreadId threadId, int *result)); /* 412 */
-    int (*tcl_IsChannelShared) _ANSI_ARGS_((Tcl_Channel channel)); /* 413 */
-    int (*tcl_IsChannelRegistered) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel channel)); /* 414 */
-    void (*tcl_CutChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 415 */
-    void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */
-    void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */
-    int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char *channelName)); /* 418 */
-    int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars)); /* 419 */
-    int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar *uniStr, CONST Tcl_UniChar *uniPattern, int nocase)); /* 420 */
-    Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key)); /* 421 */
-    Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)); /* 422 */
-    void (*tcl_InitCustomHashTable) _ANSI_ARGS_((Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr)); /* 423 */
-    void (*tcl_InitObjHashTable) _ANSI_ARGS_((Tcl_HashTable *tablePtr)); /* 424 */
-    ClientData (*tcl_CommandTraceInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData)); /* 425 */
-    int (*tcl_TraceCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData)); /* 426 */
-    void (*tcl_UntraceCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData)); /* 427 */
-    char * (*tcl_AttemptAlloc) _ANSI_ARGS_((unsigned int size)); /* 428 */
-    char * (*tcl_AttemptDbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char *file, int line)); /* 429 */
-    char * (*tcl_AttemptRealloc) _ANSI_ARGS_((char *ptr, unsigned int size)); /* 430 */
-    char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char *ptr, unsigned int size, CONST char *file, int line)); /* 431 */
-    int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj *objPtr, int length)); /* 432 */
-    Tcl_ThreadId (*tcl_GetChannelThread) _ANSI_ARGS_((Tcl_Channel channel)); /* 433 */
-    Tcl_UniChar * (*tcl_GetUnicodeFromObj) _ANSI_ARGS_((Tcl_Obj *objPtr, int *lengthPtr)); /* 434 */
-    int (*tcl_GetMathFuncInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr)); /* 435 */
-    Tcl_Obj * (*tcl_ListMathFuncs) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pattern)); /* 436 */
-    Tcl_Obj * (*tcl_SubstObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)); /* 437 */
-    int (*tcl_DetachChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel channel)); /* 438 */
-    int (*tcl_IsStandardChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 439 */
-    int (*tcl_FSCopyFile) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); /* 440 */
-    int (*tcl_FSCopyDirectory) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)); /* 441 */
-    int (*tcl_FSCreateDirectory) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 442 */
-    int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 443 */
-    int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr)); /* 444 */
-    int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); /* 445 */
-    Tcl_Obj * (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction)); /* 446 */
-    int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)); /* 447 */
-    int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); /* 448 */
-    int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); /* 449 */
-    int (*tcl_FSUtime) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct utimbuf *tval)); /* 450 */
-    int (*tcl_FSFileAttrsGet) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)); /* 451 */
-    int (*tcl_FSFileAttrsSet) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)); /* 452 */
-    CONST char ** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)); /* 453 */
-    int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); /* 454 */
-    int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)); /* 455 */
-    Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions)); /* 456 */
-    Tcl_Obj * (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp *interp)); /* 457 */
-    int (*tcl_FSChdir) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 458 */
-    int (*tcl_FSConvertToPathType) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr)); /* 459 */
-    Tcl_Obj * (*tcl_FSJoinPath) _ANSI_ARGS_((Tcl_Obj *listObj, int elements)); /* 460 */
-    Tcl_Obj * (*tcl_FSSplitPath) _ANSI_ARGS_((Tcl_Obj *pathPtr, int *lenPtr)); /* 461 */
-    int (*tcl_FSEqualPaths) _ANSI_ARGS_((Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)); /* 462 */
-    Tcl_Obj * (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr)); /* 463 */
-    Tcl_Obj * (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj *pathPtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */
-    ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr)); /* 465 */
-    Tcl_Obj * (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr)); /* 466 */
-    int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *fileName)); /* 467 */
-    Tcl_Obj * (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Filesystem *fromFilesystem, ClientData clientData)); /* 468 */
-    CONST char * (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 469 */
-    Tcl_Obj * (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 470 */
-    Tcl_Obj * (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 471 */
-    Tcl_Obj * (*tcl_FSListVolumes) _ANSI_ARGS_((void)); /* 472 */
-    int (*tcl_FSRegister) _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem *fsPtr)); /* 473 */
-    int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem *fsPtr)); /* 474 */
-    ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem *fsPtr)); /* 475 */
-    CONST char * (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr)); /* 476 */
-    Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 477 */
-    Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 478 */
-    int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */
-    void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem *fsPtr)); /* 480 */
-    int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)); /* 481 */
-    void (*tcl_GetTime) _ANSI_ARGS_((Tcl_Time *timeBuf)); /* 482 */
-    Tcl_Trace (*tcl_CreateObjTrace) _ANSI_ARGS_((Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc)); /* 483 */
-    int (*tcl_GetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, Tcl_CmdInfo *infoPtr)); /* 484 */
-    int (*tcl_SetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, CONST Tcl_CmdInfo *infoPtr)); /* 485 */
-    Tcl_Obj * (*tcl_DbNewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue, CONST char *file, int line)); /* 486 */
-    int (*tcl_GetWideIntFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr)); /* 487 */
-    Tcl_Obj * (*tcl_NewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue)); /* 488 */
-    void (*tcl_SetWideIntObj) _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_WideInt wideValue)); /* 489 */
-    Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */
-    Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */
-    Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */
-    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 493 */
-    VOID *reserved494;
-    VOID *reserved495;
-    VOID *reserved496;
-    VOID *reserved497;
-    VOID *reserved498;
-    VOID *reserved499;
-    VOID *reserved500;
-    VOID *reserved501;
-    VOID *reserved502;
-    VOID *reserved503;
-    VOID *reserved504;
-    VOID *reserved505;
-    VOID *reserved506;
-    VOID *reserved507;
-    VOID *reserved508;
-    VOID *reserved509;
-    VOID *reserved510;
-    VOID *reserved511;
-    VOID *reserved512;
-    VOID *reserved513;
-    VOID *reserved514;
-    VOID *reserved515;
-    VOID *reserved516;
-    VOID *reserved517;
-    VOID *reserved518;
-    VOID *reserved519;
-    VOID *reserved520;
-    VOID *reserved521;
-    VOID *reserved522;
-    VOID *reserved523;
-    VOID *reserved524;
-    VOID *reserved525;
-    VOID *reserved526;
-    VOID *reserved527;
-    VOID *reserved528;
-    VOID *reserved529;
-    VOID *reserved530;
-    VOID *reserved531;
-    VOID *reserved532;
-    VOID *reserved533;
-    VOID *reserved534;
-    VOID *reserved535;
-    VOID *reserved536;
-    VOID *reserved537;
-    VOID *reserved538;
-    VOID *reserved539;
-    VOID *reserved540;
-    VOID *reserved541;
-    VOID *reserved542;
-    VOID *reserved543;
-    VOID *reserved544;
-    VOID *reserved545;
-    VOID *reserved546;
-    VOID *reserved547;
-    VOID *reserved548;
-    VOID *reserved549;
-    VOID *reserved550;
-    VOID *reserved551;
-    VOID *reserved552;
-    VOID *reserved553;
-    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType *chanTypePtr)); /* 554 */
-    VOID *reserved555;
-    VOID *reserved556;
-    VOID *reserved557;
-    VOID *reserved558;
-    VOID *reserved559;
-    VOID *reserved560;
-    VOID *reserved561;
-    VOID *reserved562;
-    VOID *reserved563;
-    VOID *reserved564;
-    VOID *reserved565;
-    VOID *reserved566;
-    VOID *reserved567;
-    VOID *reserved568;
-    VOID *reserved569;
-    VOID *reserved570;
-    VOID *reserved571;
-    VOID *reserved572;
-    int (*tcl_PkgRequireProc) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr)); /* 573 */
-    VOID *reserved574;
-    VOID *reserved575;
-    VOID *reserved576;
-    VOID *reserved577;
-    VOID *reserved578;
-    VOID *reserved579;
+    void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
+    Tcl_Encoding (*tcl_CreateEncoding) (CONST Tcl_EncodingType *typePtr); /* 287 */
+    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
+    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
+    void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */
+    int (*tcl_EvalEx) (Tcl_Interp *interp, CONST char *script, int numBytes, int flags); /* 291 */
+    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags); /* 292 */
+    int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
+    void (*tcl_ExitThread) (int status); /* 294 */
+    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
+    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
+    void (*tcl_FinalizeThread) (void); /* 297 */
+    void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
+    void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
+    Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
+    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, CONST char *name); /* 301 */
+    CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
+    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
+    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr); /* 304 */
+    VOID * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
+    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 306 */
+    ClientData (*tcl_InitNotifier) (void); /* 307 */
+    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
+    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
+    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
+    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr); /* 311 */
+    int (*tcl_NumUtfChars) (CONST char *src, int length); /* 312 */
+    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
+    void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
+    void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
+    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, CONST char *name); /* 316 */
+    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
+    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
+    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
+    Tcl_UniChar (*tcl_UniCharAtIndex) (CONST char *src, int index); /* 320 */
+    Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
+    Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
+    Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
+    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
+    CONST84_RETURN char * (*tcl_UtfAtIndex) (CONST char *src, int index); /* 325 */
+    int (*tcl_UtfCharComplete) (CONST char *src, int length); /* 326 */
+    int (*tcl_UtfBackslash) (CONST char *src, int *readPtr, char *dst); /* 327 */
+    CONST84_RETURN char * (*tcl_UtfFindFirst) (CONST char *src, int ch); /* 328 */
+    CONST84_RETURN char * (*tcl_UtfFindLast) (CONST char *src, int ch); /* 329 */
+    CONST84_RETURN char * (*tcl_UtfNext) (CONST char *src); /* 330 */
+    CONST84_RETURN char * (*tcl_UtfPrev) (CONST char *src, CONST char *start); /* 331 */
+    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
+    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
+    int (*tcl_UtfToLower) (char *src); /* 334 */
+    int (*tcl_UtfToTitle) (char *src); /* 335 */
+    int (*tcl_UtfToUniChar) (CONST char *src, Tcl_UniChar *chPtr); /* 336 */
+    int (*tcl_UtfToUpper) (char *src); /* 337 */
+    int (*tcl_WriteChars) (Tcl_Channel chan, CONST char *src, int srcLen); /* 338 */
+    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
+    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
+    CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
+    void (*tcl_SetDefaultEncodingDir) (CONST char *path); /* 342 */
+    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
+    void (*tcl_ServiceModeHook) (int mode); /* 344 */
+    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
+    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
+    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
+    int (*tcl_UniCharIsLower) (int ch); /* 348 */
+    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
+    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
+    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
+    int (*tcl_UniCharLen) (CONST Tcl_UniChar *uniStr); /* 352 */
+    int (*tcl_UniCharNcmp) (CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars); /* 353 */
+    char * (*tcl_UniCharToUtfDString) (CONST Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
+    Tcl_UniChar * (*tcl_UtfToUniCharDString) (CONST char *src, int length, Tcl_DString *dsPtr); /* 355 */
+    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
+    Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
+    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
+    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, CONST char *script, CONST char *command, int length); /* 359 */
+    int (*tcl_ParseBraces) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
+    int (*tcl_ParseCommand) (Tcl_Interp *interp, CONST char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
+    int (*tcl_ParseExpr) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
+    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
+    int (*tcl_ParseVarName) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
+    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
+    int (*tcl_Chdir) (CONST char *dirName); /* 366 */
+    int (*tcl_Access) (CONST char *path, int mode); /* 367 */
+    int (*tcl_Stat) (CONST char *path, struct stat *bufPtr); /* 368 */
+    int (*tcl_UtfNcmp) (CONST char *s1, CONST char *s2, unsigned long n); /* 369 */
+    int (*tcl_UtfNcasecmp) (CONST char *s1, CONST char *s2, unsigned long n); /* 370 */
+    int (*tcl_StringCaseMatch) (CONST char *str, CONST char *pattern, int nocase); /* 371 */
+    int (*tcl_UniCharIsControl) (int ch); /* 372 */
+    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
+    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
+    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
+    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
+    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
+    Tcl_Obj * (*tcl_NewUnicodeObj) (CONST Tcl_UniChar *unicode, int numChars); /* 378 */
+    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars); /* 379 */
+    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
+    Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
+    Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
+    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
+    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length); /* 384 */
+    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
+    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
+    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
+    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
+    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, CONST char *pattern); /* 389 */
+    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 390 */
+    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
+    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
+    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags); /* 393 */
+    int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
+    int (*tcl_WriteRaw) (Tcl_Channel chan, CONST char *src, int srcLen); /* 395 */
+    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
+    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
+    CONST84_RETURN char * (*tcl_ChannelName) (CONST Tcl_ChannelType *chanTypePtr); /* 398 */
+    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (CONST Tcl_ChannelType *chanTypePtr); /* 399 */
+    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (CONST Tcl_ChannelType *chanTypePtr); /* 400 */
+    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (CONST Tcl_ChannelType *chanTypePtr); /* 401 */
+    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (CONST Tcl_ChannelType *chanTypePtr); /* 402 */
+    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (CONST Tcl_ChannelType *chanTypePtr); /* 403 */
+    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (CONST Tcl_ChannelType *chanTypePtr); /* 404 */
+    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (CONST Tcl_ChannelType *chanTypePtr); /* 405 */
+    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 406 */
+    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 407 */
+    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (CONST Tcl_ChannelType *chanTypePtr); /* 408 */
+    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (CONST Tcl_ChannelType *chanTypePtr); /* 409 */
+    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (CONST Tcl_ChannelType *chanTypePtr); /* 410 */
+    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (CONST Tcl_ChannelType *chanTypePtr); /* 411 */
+    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
+    int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
+    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
+    void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
+    void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
+    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
+    int (*tcl_IsChannelExisting) (CONST char *channelName); /* 418 */
+    int (*tcl_UniCharNcasecmp) (CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars); /* 419 */
+    int (*tcl_UniCharCaseMatch) (CONST Tcl_UniChar *uniStr, CONST Tcl_UniChar *uniPattern, int nocase); /* 420 */
+    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, CONST char *key); /* 421 */
+    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, CONST char *key, int *newPtr); /* 422 */
+    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr); /* 423 */
+    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
+    ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
+    int (*tcl_TraceCommand) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
+    void (*tcl_UntraceCommand) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
+    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
+    char * (*tcl_AttemptDbCkalloc) (unsigned int size, CONST char *file, int line); /* 429 */
+    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
+    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 431 */
+    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
+    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
+    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
+    int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
+    Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, CONST char *pattern); /* 436 */
+    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
+    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
+    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
+    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
+    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
+    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
+    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
+    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
+    int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types); /* 445 */
+    Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
+    int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
+    int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */
+    int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */
+    int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
+    int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
+    int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
+    CONST char ** (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
+    int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
+    int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
+    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions); /* 456 */
+    Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
+    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
+    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
+    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
+    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
+    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
+    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
+    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *CONST objv[]); /* 464 */
+    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr); /* 465 */
+    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
+    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
+    Tcl_Obj * (*tcl_FSNewNativePath) (Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
+    CONST char * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
+    Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
+    Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
+    Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
+    int (*tcl_FSRegister) (ClientData clientData, Tcl_Filesystem *fsPtr); /* 473 */
+    int (*tcl_FSUnregister) (Tcl_Filesystem *fsPtr); /* 474 */
+    ClientData (*tcl_FSData) (Tcl_Filesystem *fsPtr); /* 475 */
+    CONST char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
+    Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
+    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
+    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
+    void (*tcl_FSMountsChanged) (Tcl_Filesystem *fsPtr); /* 480 */
+    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */
+    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
+    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
+    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
+    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, CONST Tcl_CmdInfo *infoPtr); /* 485 */
+    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, CONST char *file, int line); /* 486 */
+    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
+    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
+    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
+    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
+    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
+    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
+    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (CONST Tcl_ChannelType *chanTypePtr); /* 493 */
+    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
+    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
+    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
+    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
+    int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
+    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
+    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
+    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr); /* 501 */
+    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *CONST *keyv); /* 502 */
+    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
+    Tcl_Obj * (*tcl_DbNewDictObj) (CONST char *file, int line); /* 504 */
+    void (*tcl_RegisterConfig) (Tcl_Interp *interp, CONST char *pkgName, Tcl_Config *configuration, CONST char *valEncoding); /* 505 */
+    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
+    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */
+    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */
+    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst); /* 509 */
+    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite); /* 510 */
+    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern); /* 511 */
+    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */
+    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */
+    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
+    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
+    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
+    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
+    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, CONST char *encodingName); /* 518 */
+    Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc); /* 519 */
+    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
+    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
+    int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
+    int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
+    int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
+    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
+    void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
+    void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
+    int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */
+    int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */
+    void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */
+    void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */
+    int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
+    void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */
+    int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */
+    Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */
+    int (*tcl_RestoreInterpState) (Tcl_Interp *interp, Tcl_InterpState state); /* 536 */
+    void (*tcl_DiscardInterpState) (Tcl_InterpState state); /* 537 */
+    int (*tcl_SetReturnOptions) (Tcl_Interp *interp, Tcl_Obj *options); /* 538 */
+    Tcl_Obj * (*tcl_GetReturnOptions) (Tcl_Interp *interp, int result); /* 539 */
+    int (*tcl_IsEnsemble) (Tcl_Command token); /* 540 */
+    Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *namespacePtr, int flags); /* 541 */
+    Tcl_Command (*tcl_FindEnsemble) (Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 542 */
+    int (*tcl_SetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 543 */
+    int (*tcl_SetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 544 */
+    int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */
+    int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */
+    int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */
+    int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */
+    int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */
+    int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */
+    int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */
+    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */
+    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */
+    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 554 */
+    Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */
+    Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, CONST char *file, int line); /* 556 */
+    void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */
+    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */
+    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */
+    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
+    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (CONST Tcl_ChannelType *chanTypePtr); /* 561 */
+    void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
+    void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
+    void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */
+    void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */
+    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit); /* 566 */
+    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */
+    int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */
+    int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
+    Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
+    int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
+    CONST char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
+    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr); /* 573 */
+    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
+    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, CONST char *bytes, int length, int limit, CONST char *ellipsis); /* 575 */
+    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 576 */
+    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 577 */
+    Tcl_Obj * (*tcl_ObjPrintf) (CONST char *format, ...); /* 578 */
+    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
     VOID *reserved580;
     VOID *reserved581;
     VOID *reserved582;
@@ -2352,7 +4128,7 @@ typedef struct TclStubs {
     VOID *reserved627;
     VOID *reserved628;
     VOID *reserved629;
-    void (*tclUnusedStubEntry) _ANSI_ARGS_((void)); /* 630 */
+    void (*tclUnusedStubEntry) (void); /* 630 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -4363,98 +6139,350 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_ChannelWideSeekProc \
 	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
 #endif
-/* Slot 494 is reserved */
-/* Slot 495 is reserved */
-/* Slot 496 is reserved */
-/* Slot 497 is reserved */
-/* Slot 498 is reserved */
-/* Slot 499 is reserved */
-/* Slot 500 is reserved */
-/* Slot 501 is reserved */
-/* Slot 502 is reserved */
-/* Slot 503 is reserved */
-/* Slot 504 is reserved */
-/* Slot 505 is reserved */
-/* Slot 506 is reserved */
-/* Slot 507 is reserved */
-/* Slot 508 is reserved */
-/* Slot 509 is reserved */
-/* Slot 510 is reserved */
-/* Slot 511 is reserved */
-/* Slot 512 is reserved */
-/* Slot 513 is reserved */
-/* Slot 514 is reserved */
-/* Slot 515 is reserved */
-/* Slot 516 is reserved */
-/* Slot 517 is reserved */
-/* Slot 518 is reserved */
-/* Slot 519 is reserved */
-/* Slot 520 is reserved */
-/* Slot 521 is reserved */
-/* Slot 522 is reserved */
-/* Slot 523 is reserved */
-/* Slot 524 is reserved */
-/* Slot 525 is reserved */
-/* Slot 526 is reserved */
-/* Slot 527 is reserved */
-/* Slot 528 is reserved */
-/* Slot 529 is reserved */
-/* Slot 530 is reserved */
-/* Slot 531 is reserved */
-/* Slot 532 is reserved */
-/* Slot 533 is reserved */
-/* Slot 534 is reserved */
-/* Slot 535 is reserved */
-/* Slot 536 is reserved */
-/* Slot 537 is reserved */
-/* Slot 538 is reserved */
-/* Slot 539 is reserved */
-/* Slot 540 is reserved */
-/* Slot 541 is reserved */
-/* Slot 542 is reserved */
-/* Slot 543 is reserved */
-/* Slot 544 is reserved */
-/* Slot 545 is reserved */
-/* Slot 546 is reserved */
-/* Slot 547 is reserved */
-/* Slot 548 is reserved */
-/* Slot 549 is reserved */
-/* Slot 550 is reserved */
-/* Slot 551 is reserved */
-/* Slot 552 is reserved */
-/* Slot 553 is reserved */
+#ifndef Tcl_DictObjPut
+#define Tcl_DictObjPut \
+	(tclStubsPtr->tcl_DictObjPut) /* 494 */
+#endif
+#ifndef Tcl_DictObjGet
+#define Tcl_DictObjGet \
+	(tclStubsPtr->tcl_DictObjGet) /* 495 */
+#endif
+#ifndef Tcl_DictObjRemove
+#define Tcl_DictObjRemove \
+	(tclStubsPtr->tcl_DictObjRemove) /* 496 */
+#endif
+#ifndef Tcl_DictObjSize
+#define Tcl_DictObjSize \
+	(tclStubsPtr->tcl_DictObjSize) /* 497 */
+#endif
+#ifndef Tcl_DictObjFirst
+#define Tcl_DictObjFirst \
+	(tclStubsPtr->tcl_DictObjFirst) /* 498 */
+#endif
+#ifndef Tcl_DictObjNext
+#define Tcl_DictObjNext \
+	(tclStubsPtr->tcl_DictObjNext) /* 499 */
+#endif
+#ifndef Tcl_DictObjDone
+#define Tcl_DictObjDone \
+	(tclStubsPtr->tcl_DictObjDone) /* 500 */
+#endif
+#ifndef Tcl_DictObjPutKeyList
+#define Tcl_DictObjPutKeyList \
+	(tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */
+#endif
+#ifndef Tcl_DictObjRemoveKeyList
+#define Tcl_DictObjRemoveKeyList \
+	(tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */
+#endif
+#ifndef Tcl_NewDictObj
+#define Tcl_NewDictObj \
+	(tclStubsPtr->tcl_NewDictObj) /* 503 */
+#endif
+#ifndef Tcl_DbNewDictObj
+#define Tcl_DbNewDictObj \
+	(tclStubsPtr->tcl_DbNewDictObj) /* 504 */
+#endif
+#ifndef Tcl_RegisterConfig
+#define Tcl_RegisterConfig \
+	(tclStubsPtr->tcl_RegisterConfig) /* 505 */
+#endif
+#ifndef Tcl_CreateNamespace
+#define Tcl_CreateNamespace \
+	(tclStubsPtr->tcl_CreateNamespace) /* 506 */
+#endif
+#ifndef Tcl_DeleteNamespace
+#define Tcl_DeleteNamespace \
+	(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+#endif
+#ifndef Tcl_AppendExportList
+#define Tcl_AppendExportList \
+	(tclStubsPtr->tcl_AppendExportList) /* 508 */
+#endif
+#ifndef Tcl_Export
+#define Tcl_Export \
+	(tclStubsPtr->tcl_Export) /* 509 */
+#endif
+#ifndef Tcl_Import
+#define Tcl_Import \
+	(tclStubsPtr->tcl_Import) /* 510 */
+#endif
+#ifndef Tcl_ForgetImport
+#define Tcl_ForgetImport \
+	(tclStubsPtr->tcl_ForgetImport) /* 511 */
+#endif
+#ifndef Tcl_GetCurrentNamespace
+#define Tcl_GetCurrentNamespace \
+	(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+#endif
+#ifndef Tcl_GetGlobalNamespace
+#define Tcl_GetGlobalNamespace \
+	(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+#endif
+#ifndef Tcl_FindNamespace
+#define Tcl_FindNamespace \
+	(tclStubsPtr->tcl_FindNamespace) /* 514 */
+#endif
+#ifndef Tcl_FindCommand
+#define Tcl_FindCommand \
+	(tclStubsPtr->tcl_FindCommand) /* 515 */
+#endif
+#ifndef Tcl_GetCommandFromObj
+#define Tcl_GetCommandFromObj \
+	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+#endif
+#ifndef Tcl_GetCommandFullName
+#define Tcl_GetCommandFullName \
+	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#endif
+#ifndef Tcl_FSEvalFileEx
+#define Tcl_FSEvalFileEx \
+	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
+#endif
+#ifndef Tcl_SetExitProc
+#define Tcl_SetExitProc \
+	(tclStubsPtr->tcl_SetExitProc) /* 519 */
+#endif
+#ifndef Tcl_LimitAddHandler
+#define Tcl_LimitAddHandler \
+	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
+#endif
+#ifndef Tcl_LimitRemoveHandler
+#define Tcl_LimitRemoveHandler \
+	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
+#endif
+#ifndef Tcl_LimitReady
+#define Tcl_LimitReady \
+	(tclStubsPtr->tcl_LimitReady) /* 522 */
+#endif
+#ifndef Tcl_LimitCheck
+#define Tcl_LimitCheck \
+	(tclStubsPtr->tcl_LimitCheck) /* 523 */
+#endif
+#ifndef Tcl_LimitExceeded
+#define Tcl_LimitExceeded \
+	(tclStubsPtr->tcl_LimitExceeded) /* 524 */
+#endif
+#ifndef Tcl_LimitSetCommands
+#define Tcl_LimitSetCommands \
+	(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
+#endif
+#ifndef Tcl_LimitSetTime
+#define Tcl_LimitSetTime \
+	(tclStubsPtr->tcl_LimitSetTime) /* 526 */
+#endif
+#ifndef Tcl_LimitSetGranularity
+#define Tcl_LimitSetGranularity \
+	(tclStubsPtr->tcl_LimitSetGranularity) /* 527 */
+#endif
+#ifndef Tcl_LimitTypeEnabled
+#define Tcl_LimitTypeEnabled \
+	(tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */
+#endif
+#ifndef Tcl_LimitTypeExceeded
+#define Tcl_LimitTypeExceeded \
+	(tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */
+#endif
+#ifndef Tcl_LimitTypeSet
+#define Tcl_LimitTypeSet \
+	(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
+#endif
+#ifndef Tcl_LimitTypeReset
+#define Tcl_LimitTypeReset \
+	(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
+#endif
+#ifndef Tcl_LimitGetCommands
+#define Tcl_LimitGetCommands \
+	(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
+#endif
+#ifndef Tcl_LimitGetTime
+#define Tcl_LimitGetTime \
+	(tclStubsPtr->tcl_LimitGetTime) /* 533 */
+#endif
+#ifndef Tcl_LimitGetGranularity
+#define Tcl_LimitGetGranularity \
+	(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
+#endif
+#ifndef Tcl_SaveInterpState
+#define Tcl_SaveInterpState \
+	(tclStubsPtr->tcl_SaveInterpState) /* 535 */
+#endif
+#ifndef Tcl_RestoreInterpState
+#define Tcl_RestoreInterpState \
+	(tclStubsPtr->tcl_RestoreInterpState) /* 536 */
+#endif
+#ifndef Tcl_DiscardInterpState
+#define Tcl_DiscardInterpState \
+	(tclStubsPtr->tcl_DiscardInterpState) /* 537 */
+#endif
+#ifndef Tcl_SetReturnOptions
+#define Tcl_SetReturnOptions \
+	(tclStubsPtr->tcl_SetReturnOptions) /* 538 */
+#endif
+#ifndef Tcl_GetReturnOptions
+#define Tcl_GetReturnOptions \
+	(tclStubsPtr->tcl_GetReturnOptions) /* 539 */
+#endif
+#ifndef Tcl_IsEnsemble
+#define Tcl_IsEnsemble \
+	(tclStubsPtr->tcl_IsEnsemble) /* 540 */
+#endif
+#ifndef Tcl_CreateEnsemble
+#define Tcl_CreateEnsemble \
+	(tclStubsPtr->tcl_CreateEnsemble) /* 541 */
+#endif
+#ifndef Tcl_FindEnsemble
+#define Tcl_FindEnsemble \
+	(tclStubsPtr->tcl_FindEnsemble) /* 542 */
+#endif
+#ifndef Tcl_SetEnsembleSubcommandList
+#define Tcl_SetEnsembleSubcommandList \
+	(tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */
+#endif
+#ifndef Tcl_SetEnsembleMappingDict
+#define Tcl_SetEnsembleMappingDict \
+	(tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */
+#endif
+#ifndef Tcl_SetEnsembleUnknownHandler
+#define Tcl_SetEnsembleUnknownHandler \
+	(tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */
+#endif
+#ifndef Tcl_SetEnsembleFlags
+#define Tcl_SetEnsembleFlags \
+	(tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */
+#endif
+#ifndef Tcl_GetEnsembleSubcommandList
+#define Tcl_GetEnsembleSubcommandList \
+	(tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */
+#endif
+#ifndef Tcl_GetEnsembleMappingDict
+#define Tcl_GetEnsembleMappingDict \
+	(tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */
+#endif
+#ifndef Tcl_GetEnsembleUnknownHandler
+#define Tcl_GetEnsembleUnknownHandler \
+	(tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */
+#endif
+#ifndef Tcl_GetEnsembleFlags
+#define Tcl_GetEnsembleFlags \
+	(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
+#endif
+#ifndef Tcl_GetEnsembleNamespace
+#define Tcl_GetEnsembleNamespace \
+	(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
+#endif
+#ifndef Tcl_SetTimeProc
+#define Tcl_SetTimeProc \
+	(tclStubsPtr->tcl_SetTimeProc) /* 552 */
+#endif
+#ifndef Tcl_QueryTimeProc
+#define Tcl_QueryTimeProc \
+	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
+#endif
 #ifndef Tcl_ChannelThreadActionProc
 #define Tcl_ChannelThreadActionProc \
 	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
 #endif
-/* Slot 555 is reserved */
-/* Slot 556 is reserved */
-/* Slot 557 is reserved */
-/* Slot 558 is reserved */
-/* Slot 559 is reserved */
-/* Slot 560 is reserved */
-/* Slot 561 is reserved */
-/* Slot 562 is reserved */
-/* Slot 563 is reserved */
-/* Slot 564 is reserved */
-/* Slot 565 is reserved */
-/* Slot 566 is reserved */
-/* Slot 567 is reserved */
-/* Slot 568 is reserved */
-/* Slot 569 is reserved */
-/* Slot 570 is reserved */
-/* Slot 571 is reserved */
-/* Slot 572 is reserved */
+#ifndef Tcl_NewBignumObj
+#define Tcl_NewBignumObj \
+	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
+#endif
+#ifndef Tcl_DbNewBignumObj
+#define Tcl_DbNewBignumObj \
+	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
+#endif
+#ifndef Tcl_SetBignumObj
+#define Tcl_SetBignumObj \
+	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
+#endif
+#ifndef Tcl_GetBignumFromObj
+#define Tcl_GetBignumFromObj \
+	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
+#endif
+#ifndef Tcl_TakeBignumFromObj
+#define Tcl_TakeBignumFromObj \
+	(tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
+#endif
+#ifndef Tcl_TruncateChannel
+#define Tcl_TruncateChannel \
+	(tclStubsPtr->tcl_TruncateChannel) /* 560 */
+#endif
+#ifndef Tcl_ChannelTruncateProc
+#define Tcl_ChannelTruncateProc \
+	(tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
+#endif
+#ifndef Tcl_SetChannelErrorInterp
+#define Tcl_SetChannelErrorInterp \
+	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
+#endif
+#ifndef Tcl_GetChannelErrorInterp
+#define Tcl_GetChannelErrorInterp \
+	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
+#endif
+#ifndef Tcl_SetChannelError
+#define Tcl_SetChannelError \
+	(tclStubsPtr->tcl_SetChannelError) /* 564 */
+#endif
+#ifndef Tcl_GetChannelError
+#define Tcl_GetChannelError \
+	(tclStubsPtr->tcl_GetChannelError) /* 565 */
+#endif
+#ifndef Tcl_InitBignumFromDouble
+#define Tcl_InitBignumFromDouble \
+	(tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
+#endif
+#ifndef Tcl_GetNamespaceUnknownHandler
+#define Tcl_GetNamespaceUnknownHandler \
+	(tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
+#endif
+#ifndef Tcl_SetNamespaceUnknownHandler
+#define Tcl_SetNamespaceUnknownHandler \
+	(tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
+#endif
+#ifndef Tcl_GetEncodingFromObj
+#define Tcl_GetEncodingFromObj \
+	(tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */
+#endif
+#ifndef Tcl_GetEncodingSearchPath
+#define Tcl_GetEncodingSearchPath \
+	(tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */
+#endif
+#ifndef Tcl_SetEncodingSearchPath
+#define Tcl_SetEncodingSearchPath \
+	(tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */
+#endif
+#ifndef Tcl_GetEncodingNameFromEnvironment
+#define Tcl_GetEncodingNameFromEnvironment \
+	(tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */
+#endif
 #ifndef Tcl_PkgRequireProc
 #define Tcl_PkgRequireProc \
 	(tclStubsPtr->tcl_PkgRequireProc) /* 573 */
 #endif
-/* Slot 574 is reserved */
-/* Slot 575 is reserved */
-/* Slot 576 is reserved */
-/* Slot 577 is reserved */
-/* Slot 578 is reserved */
-/* Slot 579 is reserved */
+#ifndef Tcl_AppendObjToErrorInfo
+#define Tcl_AppendObjToErrorInfo \
+	(tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */
+#endif
+#ifndef Tcl_AppendLimitedToObj
+#define Tcl_AppendLimitedToObj \
+	(tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */
+#endif
+#ifndef Tcl_Format
+#define Tcl_Format \
+	(tclStubsPtr->tcl_Format) /* 576 */
+#endif
+#ifndef Tcl_AppendFormatToObj
+#define Tcl_AppendFormatToObj \
+	(tclStubsPtr->tcl_AppendFormatToObj) /* 577 */
+#endif
+#ifndef Tcl_ObjPrintf
+#define Tcl_ObjPrintf \
+	(tclStubsPtr->tcl_ObjPrintf) /* 578 */
+#endif
+#ifndef Tcl_AppendPrintfToObj
+#define Tcl_AppendPrintfToObj \
+	(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
+#endif
 /* Slot 580 is reserved */
 /* Slot 581 is reserved */
 /* Slot 582 is reserved */
@@ -4516,6 +6544,9 @@ extern TclStubs *tclStubsPtr;
 
 #undef TclUnusedStubEntry
 
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
 /*
  * Deprecated Tcl procedures:
  */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
new file mode 100644
index 0000000..4adc5ce
--- /dev/null
+++ b/generic/tclDictObj.c
@@ -0,0 +1,3169 @@
+/*
+ * tclDictObj.c --
+ *
+ *	This file contains functions that implement the Tcl dict object type
+ *	and its accessor command.
+ *
+ * Copyright (c) 2002 by Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tommath.h"
+
+/*
+ * Forward declaration.
+ */
+struct Dict;
+
+/*
+ * Prototypes for functions defined later in this file:
+ */
+
+static void		DeleteDict(struct Dict *dict);
+static int		DictAppendCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictCreateCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictForCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictMergeCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictRemoveCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictReplaceCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictSetCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictValuesCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
+static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
+static void		InvalidateDictChain(Tcl_Obj *dictObj);
+static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
+static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
+static inline void	InitChainTable(struct Dict *dict);
+static inline void	DeleteChainTable(struct Dict *dict);
+static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
+			    Tcl_Obj *keyPtr, int *newPtr);
+static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+
+/*
+ * Table of dict subcommand names and implementations.
+ */
+
+static const EnsembleImplMap implementationMap[] = {
+    {"append",	DictAppendCmd,	TclCompileDictAppendCmd },
+    {"create",	DictCreateCmd,	NULL },
+    {"exists",	DictExistsCmd,	NULL },
+    {"filter",	DictFilterCmd,	NULL },
+    {"for",	DictForCmd,	TclCompileDictForCmd },
+    {"get",	DictGetCmd,	TclCompileDictGetCmd },
+    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd },
+    {"info",	DictInfoCmd,	NULL },
+    {"keys",	DictKeysCmd,	NULL },
+    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd },
+    {"merge",	DictMergeCmd,	NULL },
+    {"remove",	DictRemoveCmd,	NULL },
+    {"replace",	DictReplaceCmd,	NULL },
+    {"set",	DictSetCmd,	TclCompileDictSetCmd },
+    {"size",	DictSizeCmd,	NULL },
+    {"unset",	DictUnsetCmd,	NULL },
+    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd },
+    {"values",	DictValuesCmd,	NULL },
+    {"with",	DictWithCmd,	NULL },
+    {NULL, NULL, NULL}
+};
+
+/*
+ * Internal representation of the entries in the hash table that backs a
+ * dictionary.
+ */
+
+typedef struct ChainEntry {
+    Tcl_HashEntry entry;
+    struct ChainEntry *prevPtr;
+    struct ChainEntry *nextPtr;
+} ChainEntry;
+
+/*
+ * Internal representation of a dictionary.
+ *
+ * The internal representation of a dictionary object is a hash table (with
+ * Tcl_Objs for both keys and values), a reference count and epoch number for
+ * detecting concurrent modifications of the dictionary, and a pointer to the
+ * parent object (used when invalidating string reps of pathed dictionary
+ * trees) which is NULL in normal use. The fact that hash tables know (with
+ * appropriate initialisation) already about objects makes key management /so/
+ * much easier!
+ *
+ * Reference counts are used to enable safe iteration across hashes while
+ * allowing the type of the containing object to be modified.
+ */
+
+typedef struct Dict {
+    Tcl_HashTable table;	/* Object hash table to store mapping in. */
+    ChainEntry *entryChainHead;	/* Linked list of all entries in the
+				 * dictionary. Used for doing traversal of the
+				 * entries in the order that they are
+				 * created. */
+    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
+				 * the dictionary. Used for doing traversal of
+				 * the entries in the order that they are
+				 * created. */
+    int epoch;			/* Epoch counter */
+    int refcount;		/* Reference counter (see above) */
+    Tcl_Obj *chain;		/* Linked list used for invalidating the
+				 * string representations of updated nested
+				 * dictionaries. */
+} Dict;
+
+/*
+ * The structure below defines the dictionary object type by means of
+ * functions that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclDictType = {
+    "dict",
+    FreeDictInternalRep,		/* freeIntRepProc */
+    DupDictInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfDict,			/* updateStringProc */
+    SetDictFromAny			/* setFromAnyProc */
+};
+
+/*
+ * The type of the specially adapted version of the Tcl_Obj*-containing hash
+ * table defined in the tclObj.c code. This version differs in that it
+ * allocates a bit more space in each hash entry in order to hold the pointers
+ * used to keep the hash entries in a linked list.
+ *
+ * Note that this type of hash table is *only* suitable for direct use in
+ * *this* file. Everything else should use the dict iterator API.
+ */
+
+static Tcl_HashKeyType chainHashType = {
+    TCL_HASH_KEY_TYPE_VERSION,
+    0,
+    TclHashObjKey,
+    TclCompareObjKeys,
+    AllocChainEntry,
+    TclFreeObjEntry
+};
+
+/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocChainEntry --
+ *
+ *	Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key, and
+ *	which has a bit of extra space afterwards for storing pointers to the
+ *	rest of the chain of entries (the extra pointers are left NULL).
+ *
+ * Results:
+ *	The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ *	Increments the reference count on the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocChainEntry(
+    Tcl_HashTable *tablePtr,
+    void *keyPtr)
+{
+    Tcl_Obj *objPtr = keyPtr;
+    ChainEntry *cPtr;
+
+    cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
+    cPtr->entry.key.oneWordValue = (char *) objPtr;
+    Tcl_IncrRefCount(objPtr);
+    cPtr->entry.clientData = NULL;
+    cPtr->prevPtr = cPtr->nextPtr = NULL;
+
+    return &cPtr->entry;
+}
+
+/*
+ * Helper functions that disguise most of the details relating to how the
+ * linked list of hash entries is managed. In particular, these manage the
+ * creation of the table and initializing of the chain, the deletion of the
+ * table and chain, the adding of an entry to the chain, and the removal of an
+ * entry from the chain.
+ */
+
+static inline void
+InitChainTable(
+    Dict *dict)
+{
+    Tcl_InitCustomHashTable(&dict->table, TCL_CUSTOM_PTR_KEYS,
+	    &chainHashType);
+    dict->entryChainHead = dict->entryChainTail = NULL;
+}
+
+static inline void
+DeleteChainTable(
+    Dict *dict)
+{
+    ChainEntry *cPtr;
+
+    for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
+	TclDecrRefCount(valuePtr);
+    }
+    Tcl_DeleteHashTable(&dict->table);
+}
+
+static inline Tcl_HashEntry *
+CreateChainEntry(
+    Dict *dict,
+    Tcl_Obj *keyPtr,
+    int *newPtr)
+{
+    ChainEntry *cPtr = (ChainEntry *)
+	    Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
+
+    /*
+     * If this is a new entry in the hash table, stitch it into the chain.
+     */
+
+    if (*newPtr) {
+	cPtr->nextPtr = NULL;
+	if (dict->entryChainHead == NULL) {
+	    cPtr->prevPtr = NULL;
+	    dict->entryChainHead = cPtr;
+	    dict->entryChainTail = cPtr;
+	} else {
+	    cPtr->prevPtr = dict->entryChainTail;
+	    dict->entryChainTail->nextPtr = cPtr;
+	    dict->entryChainTail = cPtr;
+	}
+    }
+
+    return &cPtr->entry;
+}
+
+static inline int
+DeleteChainEntry(
+    Dict *dict,
+    Tcl_Obj *keyPtr)
+{
+    ChainEntry *cPtr = (ChainEntry *)
+	    Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+
+    if (cPtr == NULL) {
+	return 0;
+    } else {
+	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+	TclDecrRefCount(valuePtr);
+    }
+
+    /*
+     * Unstitch from the chain.
+     */
+
+    if (cPtr->nextPtr) {
+	cPtr->nextPtr->prevPtr = cPtr->prevPtr;
+    } else {
+	dict->entryChainTail = cPtr->prevPtr;
+    }
+    if (cPtr->prevPtr) {
+	cPtr->prevPtr->nextPtr = cPtr->nextPtr;
+    } else {
+	dict->entryChainHead = cPtr->nextPtr;
+    }
+
+    Tcl_DeleteHashEntry(&cPtr->entry);
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupDictInternalRep --
+ *
+ *	Initialize the internal representation of a dictionary Tcl_Obj to a
+ *	copy of the internal representation of an existing dictionary object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	"srcPtr"s dictionary internal rep pointer should not be NULL and we
+ *	assume it is not NULL. We set "copyPtr"s internal rep to a pointer to
+ *	a newly allocated dictionary rep that, in turn, points to "srcPtr"s
+ *	key and value objects. Those objects are not actually copied but are
+ *	shared between "srcPtr" and "copyPtr". The ref count of each key and
+ *	value object is incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupDictInternalRep(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *copyPtr)
+{
+    Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+    Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
+    ChainEntry *cPtr;
+
+    /*
+     * Copy values across from the old hash table.
+     */
+
+    InitChainTable(newDict);
+    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+	void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+	int n;
+	Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
+
+	/*
+	 * Fill in the contents.
+	 */
+
+	Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
+	Tcl_IncrRefCount(valuePtr);
+    }
+
+    /*
+     * Initialise other fields.
+     */
+
+    newDict->epoch = 0;
+    newDict->chain = NULL;
+    newDict->refcount = 1;
+
+    /*
+     * Store in the object.
+     */
+
+    copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+    copyPtr->typePtr = &tclDictType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeDictInternalRep --
+ *
+ *	Deallocate the storage associated with a dictionary object's internal
+ *	representation.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Frees the memory holding the dictionary's internal hash table unless
+ *	it is locked by an iteration going over it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeDictInternalRep(
+    Tcl_Obj *dictPtr)
+{
+    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+
+    --dict->refcount;
+    if (dict->refcount <= 0) {
+	DeleteDict(dict);
+    }
+    dictPtr->typePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteDict --
+ *
+ *	Delete the structure that is used to implement a dictionary's internal
+ *	representation. Called when either the dictionary object loses its
+ *	internal representation or when the last iteration over the dictionary
+ *	completes.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Decrements the reference count of all key and value objects in the
+ *	dictionary, which may free them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteDict(
+    Dict *dict)
+{
+    DeleteChainTable(dict);
+    ckfree((char *) dict);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfDict --
+ *
+ *	Update the string representation for a dictionary object. Note: This
+ *	function does not invalidate an existing old string rep so storage
+ *	will be lost if this has not already been done. This code is based on
+ *	UpdateStringOfList in tclListObj.c
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from the
+ *	dict-to-string conversion. This string will be empty if the dictionary
+ *	has no key/value pairs. The dictionary internal representation should
+ *	not be NULL and we assume it is not NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfDict(
+    Tcl_Obj *dictPtr)
+{
+#define LOCAL_SIZE 20
+    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    ChainEntry *cPtr;
+    Tcl_Obj *keyPtr, *valuePtr;
+    int i, length, bytesNeeded = 0;
+    char *elem, *dst;
+    const int maxFlags = UINT_MAX / sizeof(int);
+
+    /*
+     * This field is the most useful one in the whole hash structure, and it
+     * is not exposed by any API function...
+     */
+
+    int numElems = dict->table.numEntries * 2;
+
+    /* Handle empty list case first, simplifies what follows */
+    if (numElems == 0) {
+	dictPtr->bytes = tclEmptyStringRep;
+	dictPtr->length = 0;
+	return;
+    }
+
+    /*
+     * Pass 1: estimate space, gather flags.
+     */
+
+    if (numElems <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else if (numElems > maxFlags) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    } else {
+	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+    }
+    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+	/*
+	 * Assume that cPtr is never NULL since we know the number of array
+	 * elements already.
+	 */
+
+	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+	elem = TclGetStringFromObj(keyPtr, &length);
+	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+	if (bytesNeeded < 0) {
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
+
+	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
+	valuePtr = Tcl_GetHashValue(&cPtr->entry);
+	elem = TclGetStringFromObj(valuePtr, &length);
+	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
+	if (bytesNeeded < 0) {
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
+    }
+    if (bytesNeeded > INT_MAX - numElems + 1) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+    bytesNeeded += numElems;
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    dictPtr->length = bytesNeeded - 1;
+    dictPtr->bytes = ckalloc((unsigned) bytesNeeded);
+    dst = dictPtr->bytes;
+    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+	elem = TclGetStringFromObj(keyPtr, &length);
+	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+	*dst++ = ' ';
+
+	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
+	valuePtr = Tcl_GetHashValue(&cPtr->entry);
+	elem = TclGetStringFromObj(valuePtr, &length);
+	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
+	*dst++ = ' ';
+    }
+    dictPtr->bytes[dictPtr->length] = '\0';
+
+    if (flagPtr != localFlags) {
+	ckfree((char *) flagPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetDictFromAny --
+ *
+ *	Convert a non-dictionary object into a dictionary object. This code is
+ *	very closely related to SetListFromAny in tclListObj.c but does not
+ *	actually guarantee that a dictionary object will have a string rep (as
+ *	conversions from lists are handled with a special case.)
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	If the string can be converted, it loses any old internal
+ *	representation that it had and gains a dictionary's internalRep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetDictFromAny(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
+{
+    Tcl_HashEntry *hPtr;
+    int isNew, result;
+    Dict *dict = (Dict *) ckalloc(sizeof(Dict));
+
+    InitChainTable(dict);
+
+    /*
+     * Since lists and dictionaries have very closely-related string
+     * representations (i.e. the same parsing code) we can safely special-case
+     * the conversion from lists to dictionaries.
+     */
+
+    if (objPtr->typePtr == &tclListType) {
+	int objc, i;
+	Tcl_Obj **objv;
+
+	/* Cannot fail, we already know the Tcl_ObjType is "list". */
+	TclListObjGetElements(NULL, objPtr, &objc, &objv);
+	if (objc & 1) {
+	    goto missingValue;
+	}
+
+	for (i=0 ; i<objc ; i+=2) {
+	
+	    /* Store key and value in the hash table we're building. */
+	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
+	    if (!isNew) {
+		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
+		/*
+		 * Not really a well-formed dictionary as there are duplicate
+		 * keys, so better get the string rep here so that we can
+		 * convert back.
+		 */
+
+		(void) Tcl_GetString(objPtr);
+
+		TclDecrRefCount(discardedValue);
+	    }
+	    Tcl_SetHashValue(hPtr, objv[i+1]);
+	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
+	}
+    } else {
+	int length;
+	const char *nextElem = TclGetStringFromObj(objPtr, &length);
+	const char *limit = (nextElem + length);
+
+	while (nextElem < limit) {
+	    Tcl_Obj *keyPtr, *valuePtr;
+	    const char *elemStart;
+	    int elemSize, literal;
+
+	    result = TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal);
+	    if (result != TCL_OK) {
+		goto errorExit;
+	    }
+	    if (elemStart == limit) {
+		break;
+	    }
+	    if (nextElem == limit) {
+		goto missingValue;
+	    }
+
+	    if (literal) {
+		TclNewStringObj(keyPtr, elemStart, elemSize);
+	    } else {
+		/* Avoid double copy */
+		TclNewObj(keyPtr);
+		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
+		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
+			keyPtr->bytes);
+	    }
+
+	    result = TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal);
+	    if (result != TCL_OK) {
+		TclDecrRefCount(keyPtr);
+		goto errorExit;
+	    }
+
+	    if (literal) {
+		TclNewStringObj(valuePtr, elemStart, elemSize);
+	    } else {
+		/* Avoid double copy */
+		TclNewObj(valuePtr);
+		valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
+		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
+			valuePtr->bytes);
+	    }
+
+	    /* Store key and value in the hash table we're building. */
+	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+	    if (!isNew) {
+		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
+		TclDecrRefCount(keyPtr);
+		TclDecrRefCount(discardedValue);
+	    }
+	    Tcl_SetHashValue(hPtr, valuePtr);
+	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
+	}
+    }
+
+    /*
+     * Free the old internalRep before setting the new one. We do this as late
+     * as possible to allow the conversion code, in particular
+     * Tcl_GetStringFromObj, to use that old internalRep.
+     */
+
+    TclFreeIntRep(objPtr);
+    dict->epoch = 0;
+    dict->chain = NULL;
+    dict->refcount = 1;
+    objPtr->internalRep.twoPtrValue.ptr1 = dict;
+    objPtr->typePtr = &tclDictType;
+    return TCL_OK;
+
+  missingValue:
+    if (interp != NULL) {
+	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+    }
+    result = TCL_ERROR;
+
+  errorExit:
+    DeleteChainTable(dict);
+    ckfree((char *) dict);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceDictPath --
+ *
+ *	Trace through a tree of dictionaries using the array of keys given. If
+ *	the flags argument has the DICT_PATH_UPDATE flag is set, a
+ *	backward-pointing chain of dictionaries is also built (in the Dict's
+ *	chain field) and the chained dictionaries are made into unshared
+ *	dictionaries (if they aren't already.)
+ *
+ * Results:
+ *	The object at the end of the path, or NULL if there was an error. Note
+ *	that this it is an error for an intermediate dictionary on the path to
+ *	not exist. If the flags argument has the DICT_PATH_EXISTS set, a
+ *	non-existent path gives a DICT_PATH_NON_EXISTENT result.
+ *
+ * Side effects:
+ *	If the flags argument is zero or DICT_PATH_EXISTS, there are no side
+ *	effects (other than potential conversion of objects to dictionaries.)
+ *	If the flags argument is DICT_PATH_UPDATE, the following additional
+ *	side effects occur. Shared dictionaries along the path are converted
+ *	into unshared objects, and a backward-pointing chain is built using
+ *	the chain fields of the dictionaries (for easy invalidation of string
+ *	representations using InvalidateDictChain). If the flags argument has
+ *	the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
+ *	non-existant keys will be inserted with a value of an empty
+ *	dictionary, resulting in the path being built.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclTraceDictPath(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    int keyc,
+    Tcl_Obj *const keyv[],
+    int flags)
+{
+    Dict *dict, *newDict;
+    int i;
+
+    if (dictPtr->typePtr != &tclDictType) {
+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	    return NULL;
+	}
+    }
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    if (flags & DICT_PATH_UPDATE) {
+	dict->chain = NULL;
+    }
+
+    for (i=0 ; i<keyc ; i++) {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
+	Tcl_Obj *tmpObj;
+
+	if (hPtr == NULL) {
+	    int isNew;			/* Dummy */
+
+	    if (flags & DICT_PATH_EXISTS) {
+		return DICT_PATH_NON_EXISTENT;
+	    }
+	    if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
+		if (interp != NULL) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]),
+			    "\" not known in dictionary", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+			    TclGetString(keyv[i]), NULL);
+		}
+		return NULL;
+	    }
+
+	    /*
+	     * The next line should always set isNew to 1.
+	     */
+
+	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
+	    tmpObj = Tcl_NewDictObj();
+	    Tcl_IncrRefCount(tmpObj);
+	    Tcl_SetHashValue(hPtr, tmpObj);
+	} else {
+	    tmpObj = Tcl_GetHashValue(hPtr);
+	    if (tmpObj->typePtr != &tclDictType) {
+		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
+		    return NULL;
+		}
+	    }
+	}
+
+	newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+	if (flags & DICT_PATH_UPDATE) {
+	    if (Tcl_IsShared(tmpObj)) {
+		TclDecrRefCount(tmpObj);
+		tmpObj = Tcl_DuplicateObj(tmpObj);
+		Tcl_IncrRefCount(tmpObj);
+		Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+		dict->epoch++;
+		newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+	    }
+
+	    newDict->chain = dictPtr;
+	}
+	dict = newDict;
+	dictPtr = tmpObj;
+    }
+    return dictPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvalidateDictChain --
+ *
+ *	Go through a dictionary chain (built by an updating invokation of
+ *	TclTraceDictPath) and invalidate the string representations of all the
+ *	dictionaries on the chain.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	String reps are invalidated and epoch counters (for detecting illegal
+ *	concurrent modifications) are updated through the chain of updated
+ *	dictionaries.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InvalidateDictChain(
+    Tcl_Obj *dictObj)
+{
+    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
+
+    do {
+	TclInvalidateStringRep(dictObj);
+	dict->epoch++;
+	dictObj = dict->chain;
+	if (dictObj == NULL) {
+	    break;
+	}
+	dict->chain = NULL;
+	dict = dictObj->internalRep.twoPtrValue.ptr1;
+    } while (dict != NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjPut --
+ *
+ *	Add a key,value pair to a dictionary, or update the value for a key if
+ *	that key already has a mapping in the dictionary.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	The object pointed to by dictPtr is converted to a dictionary if it is
+ *	not already one, and any string representation that it has is
+ *	invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjPut(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    Tcl_Obj *keyPtr,
+    Tcl_Obj *valuePtr)
+{
+    Dict *dict;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    if (Tcl_IsShared(dictPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
+    }
+
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
+    }
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+    Tcl_IncrRefCount(valuePtr);
+    if (!isNew) {
+	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
+	TclDecrRefCount(oldValuePtr);
+    }
+    Tcl_SetHashValue(hPtr, valuePtr);
+    dict->epoch++;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjGet --
+ *
+ *	Given a key, get its value from the dictionary (or NULL if key is not
+ *	found in dictionary.)
+ *
+ * Results:
+ *	A standard Tcl result. The variable pointed to by valuePtrPtr is
+ *	updated with the value for the key. Note that it is not an error for
+ *	the key to have no mapping in the dictionary.
+ *
+ * Side effects:
+ *	The object pointed to by dictPtr is converted to a dictionary if it is
+ *	not already one.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjGet(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    Tcl_Obj *keyPtr,
+    Tcl_Obj **valuePtrPtr)
+{
+    Dict *dict;
+    Tcl_HashEntry *hPtr;
+
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    *valuePtrPtr = NULL;
+	    return result;
+	}
+    }
+
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+    if (hPtr == NULL) {
+	*valuePtrPtr = NULL;
+    } else {
+	*valuePtrPtr = Tcl_GetHashValue(hPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjRemove --
+ *
+ *	Remove the key,value pair with the given key from the dictionary; the
+ *	key does not need to be present in the dictionary.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	The object pointed to by dictPtr is converted to a dictionary if it is
+ *	not already one, and any string representation that it has is
+ *	invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjRemove(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    Tcl_Obj *keyPtr)
+{
+    Dict *dict;
+
+    if (Tcl_IsShared(dictPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
+    }
+
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
+    }
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    if (DeleteChainEntry(dict, keyPtr)) {
+	dict->epoch++;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjSize --
+ *
+ *	How many key,value pairs are there in the dictionary?
+ *
+ * Results:
+ *	A standard Tcl result. Updates the variable pointed to by sizePtr with
+ *	the number of key,value pairs in the dictionary.
+ *
+ * Side effects:
+ *	The dictPtr object is converted to a dictionary type if it is not a
+ *	dictionary already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjSize(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    int *sizePtr)
+{
+    Dict *dict;
+
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    *sizePtr = dict->table.numEntries;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjFirst --
+ *
+ *	Start a traversal of the dictionary. Caller must supply the search
+ *	context, pointers for returning key and value, and a pointer to allow
+ *	indication of whether the dictionary has been traversed (i.e. the
+ *	dictionary is empty). The order of traversal is undefined.
+ *
+ * Results:
+ *	A standard Tcl result. Updates the variables pointed to by keyPtrPtr,
+ *	valuePtrPtr and donePtr. Either of keyPtrPtr and valuePtrPtr may be
+ *	NULL, in which case the key/value is not made available to the caller.
+ *
+ * Side effects:
+ *	The dictPtr object is converted to a dictionary type if it is not a
+ *	dictionary already. The search context is initialised if the search
+ *	has not finished. The dictionary's internal rep is Tcl_Preserve()d if
+ *	the dictionary has at least one element.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjFirst(
+    Tcl_Interp *interp,		/* For error messages, or NULL if no error
+				 * messages desired. */
+    Tcl_Obj *dictPtr,		/* Dictionary to traverse. */
+    Tcl_DictSearch *searchPtr,	/* Pointer to a dict search context. */
+    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the first key
+				 * written into, or NULL. */
+    Tcl_Obj **valuePtrPtr,	/* Pointer to a variable to have the first
+				 * value written into, or NULL.*/
+    int *donePtr)		/* Pointer to a variable which will have a 1
+				 * written into when there are no further
+				 * values in the dictionary, or a 0
+				 * otherwise. */
+{
+    Dict *dict;
+    ChainEntry *cPtr;
+
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    cPtr = dict->entryChainHead;
+    if (cPtr == NULL) {
+	searchPtr->epoch = -1;
+	*donePtr = 1;
+    } else {
+	*donePtr = 0;
+	searchPtr->dictionaryPtr = (Tcl_Dict) dict;
+	searchPtr->epoch = dict->epoch;
+	searchPtr->next = cPtr->nextPtr;
+	dict->refcount++;
+	if (keyPtrPtr != NULL) {
+	    *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
+		    &cPtr->entry);
+	}
+	if (valuePtrPtr != NULL) {
+	    *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjNext --
+ *
+ *	Continue a traversal of a dictionary previously started with
+ *	Tcl_DictObjFirst. This function is safe against concurrent
+ *	modification of the underlying object (including type shimmering),
+ *	treating such situations as if the search has terminated, though it is
+ *	up to the caller to ensure that the object itself is not disposed
+ *	until the search has finished. It is _not_ safe against modifications
+ *	from other threads.
+ *
+ * Results:
+ *	Updates the variables pointed to by keyPtrPtr, valuePtrPtr and
+ *	donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in which
+ *	case the key/value is not made available to the caller.
+ *
+ * Side effects:
+ *	Removes a reference to the dictionary's internal rep if the search
+ *	terminates.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DictObjNext(
+    Tcl_DictSearch *searchPtr,	/* Pointer to a hash search context. */
+    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the first key
+				 * written into, or NULL. */
+    Tcl_Obj **valuePtrPtr,	/* Pointer to a variable to have the first
+				 * value written into, or NULL.*/
+    int *donePtr)		/* Pointer to a variable which will have a 1
+				 * written into when there are no further
+				 * values in the dictionary, or a 0
+				 * otherwise. */
+{
+    ChainEntry *cPtr;
+
+    /*
+     * If the searh is done; we do no work.
+     */
+
+    if (searchPtr->epoch == -1) {
+	*donePtr = 1;
+	return;
+    }
+
+    /*
+     * Bail out if the dictionary has had any elements added, modified or
+     * removed. This *shouldn't* happen, but...
+     */
+
+    if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
+	Tcl_Panic("concurrent dictionary modification and search");
+    }
+
+    cPtr = searchPtr->next;
+    if (cPtr == NULL) {
+	Tcl_DictObjDone(searchPtr);
+	*donePtr = 1;
+	return;
+    }
+
+    searchPtr->next = cPtr->nextPtr;
+    *donePtr = 0;
+    if (keyPtrPtr != NULL) {
+	*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
+		&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
+    }
+    if (valuePtrPtr != NULL) {
+	*valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjDone --
+ *
+ *	Call this if you want to stop a search before you reach the end of the
+ *	dictionary (e.g. because of abnormal termination of the search). It
+ *	need not be used if the search reaches its natural end (i.e. if either
+ *	Tcl_DictObjFirst or Tcl_DictObjNext sets its donePtr variable to 1).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Removes a reference to the dictionary's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DictObjDone(
+    Tcl_DictSearch *searchPtr)		/* Pointer to a hash search context. */
+{
+    Dict *dict;
+
+    if (searchPtr->epoch != -1) {
+	searchPtr->epoch = -1;
+	dict = (Dict *) searchPtr->dictionaryPtr;
+	dict->refcount--;
+	if (dict->refcount <= 0) {
+	    DeleteDict(dict);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjPutKeyList --
+ *
+ *	Add a key...key,value pair to a dictionary tree. The main dictionary
+ *	value must not be shared, though sub-dictionaries may be. All
+ *	intermediate dictionaries on the path must exist.
+ *
+ * Results:
+ *	A standard Tcl result. Note that in the error case, a message is left
+ *	in interp unless that is NULL.
+ *
+ * Side effects:
+ *	If the dictionary and any of its sub-dictionaries on the path have
+ *	string representations, these are invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjPutKeyList(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    int keyc,
+    Tcl_Obj *const keyv[],
+    Tcl_Obj *valuePtr)
+{
+    Dict *dict;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    if (Tcl_IsShared(dictPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList");
+    }
+    if (keyc < 1) {
+	Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList");
+    }
+
+    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
+    if (dictPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
+    Tcl_IncrRefCount(valuePtr);
+    if (!isNew) {
+	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+	TclDecrRefCount(oldValuePtr);
+    }
+    Tcl_SetHashValue(hPtr, valuePtr);
+    InvalidateDictChain(dictPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DictObjRemoveKeyList --
+ *
+ *	Remove a key...key,value pair from a dictionary tree (the value
+ *	removed is implicit in the key path). The main dictionary value must
+ *	not be shared, though sub-dictionaries may be. It is not an error if
+ *	there is no value associated with the given key list, but all
+ *	intermediate dictionaries on the key path must exist.
+ *
+ * Results:
+ *	A standard Tcl result. Note that in the error case, a message is left
+ *	in interp unless that is NULL.
+ *
+ * Side effects:
+ *	If the dictionary and any of its sub-dictionaries on the key path have
+ *	string representations, these are invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DictObjRemoveKeyList(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr,
+    int keyc,
+    Tcl_Obj *const keyv[])
+{
+    Dict *dict;
+
+    if (Tcl_IsShared(dictPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
+    }
+    if (keyc < 1) {
+	Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList");
+    }
+
+    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
+    if (dictPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    DeleteChainEntry(dict, keyv[keyc-1]);
+    InvalidateDictChain(dictPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewDictObj --
+ *
+ *	This function is normally called when not debugging: i.e., when
+ *	TCL_MEM_DEBUG is not defined. It creates a new dict object without any
+ *	content.
+ *
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewDictObj.
+ *
+ * Results:
+ *	A new dict object is returned; it has no keys defined in it. The new
+ *	object's string representation is left NULL, and the ref count of the
+ *	object is 0.
+ *
+ * Side Effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_NewDictObj(void)
+{
+#ifdef TCL_MEM_DEBUG
+    return Tcl_DbNewDictObj("unknown", 0);
+#else /* !TCL_MEM_DEBUG */
+
+    Tcl_Obj *dictPtr;
+    Dict *dict;
+
+    TclNewObj(dictPtr);
+    TclInvalidateStringRep(dictPtr);
+    dict = (Dict *) ckalloc(sizeof(Dict));
+    InitChainTable(dict);
+    dict->epoch = 0;
+    dict->chain = NULL;
+    dict->refcount = 1;
+    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    dictPtr->typePtr = &tclDictType;
+    return dictPtr;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewDictObj --
+ *
+ *	This function is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new dict objects. It is the same
+ *	as the Tcl_NewDictObj function above except that it calls
+ *	Tcl_DbCkalloc directly with the file name and line number from its
+ *	caller. This simplifies debugging since then the [memory active]
+ *	command will report the correct file name and line number when
+ *	reporting objects that haven't been freed.
+ *
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
+ *	result of calling Tcl_NewDictObj.
+ *
+ * Results:
+ *	A new dict object is returned; it has no keys defined in it. The new
+ *	object's string representation is left NULL, and the ref count of the
+ *	object is 0.
+ *
+ * Side Effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_DbNewDictObj(
+    const char *file,
+    int line)
+{
+#ifdef TCL_MEM_DEBUG
+    Tcl_Obj *dictPtr;
+    Dict *dict;
+
+    TclDbNewObj(dictPtr, file, line);
+    TclInvalidateStringRep(dictPtr);
+    dict = (Dict *) ckalloc(sizeof(Dict));
+    InitChainTable(dict);
+    dict->epoch = 0;
+    dict->chain = NULL;
+    dict->refcount = 1;
+    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    dictPtr->typePtr = &tclDictType;
+    return dictPtr;
+#else /* !TCL_MEM_DEBUG */
+    return Tcl_NewDictObj();
+#endif
+}
+
+/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictCreateCmd --
+ *
+ *	This function implements the "dict create" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictCreateCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictObj;
+    int i;
+
+    /*
+     * Must have an even number of arguments; note that number of preceding
+     * arguments (i.e. "dict create" is also even, which makes this much
+     * easier.)
+     */
+
+    if ((objc & 1) == 0) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?key value ...?");
+	return TCL_ERROR;
+    }
+
+    dictObj = Tcl_NewDictObj();
+    for (i=1 ; i<objc ; i+=2) {
+	/*
+	 * The next command is assumed to never fail...
+	 */
+	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
+    }
+    Tcl_SetObjResult(interp, dictObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictGetCmd --
+ *
+ *	This function implements the "dict get" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictGetCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *valuePtr = NULL;
+    int result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Test for the special case of no keys, which returns a *list* of all
+     * key,value pairs. We produce a copy here because that makes subsequent
+     * list handling more efficient.
+     */
+
+    if (objc == 2) {
+	Tcl_Obj *keyPtr, *listPtr;
+	Tcl_DictSearch search;
+	int done;
+
+	result = Tcl_DictObjFirst(interp, objv[1], &search,
+		&keyPtr, &valuePtr, &done);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	listPtr = Tcl_NewListObj(0, NULL);
+	while (!done) {
+	    /*
+	     * Assume these won't fail as we have complete control over the
+	     * types of things here.
+	     */
+
+	    Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
+	    Tcl_ListObjAppendElement(interp, listPtr, valuePtr);
+
+	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
+	}
+	Tcl_SetObjResult(interp, listPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * Loop through the list of keys, looking up the key at the current index
+     * in the current dictionary each time. Once we've done the lookup, we set
+     * the current dictionary to be the value we looked up (in case the value
+     * was not the last one and we are going through a chain of searches.)
+     * Note that this loop always executes at least once.
+     */
+
+    dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ);
+    if (dictPtr == NULL) {
+	return TCL_ERROR;
+    }
+    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (valuePtr == NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
+		"\" not known in dictionary", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, valuePtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictReplaceCmd --
+ *
+ *	This function implements the "dict replace" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictReplaceCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr;
+    int i, result;
+    int allocatedDict = 0;
+
+    if ((objc < 2) || (objc & 1)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = objv[1];
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+	allocatedDict = 1;
+    }
+    for (i=2 ; i<objc ; i+=2) {
+	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
+	if (result != TCL_OK) {
+	    if (allocatedDict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, dictPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictRemoveCmd --
+ *
+ *	This function implements the "dict remove" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictRemoveCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr;
+    int i, result;
+    int allocatedDict = 0;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = objv[1];
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+	allocatedDict = 1;
+    }
+    for (i=2 ; i<objc ; i++) {
+	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+	if (result != TCL_OK) {
+	    if (allocatedDict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, dictPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictMergeCmd --
+ *
+ *	This function implements the "dict merge" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#163 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictMergeCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *targetObj, *keyObj, *valueObj;
+    int allocatedDict = 0;
+    int i, done;
+    Tcl_DictSearch search;
+
+    if (objc == 1) {
+	/*
+	 * No dictionary arguments; return default (empty value).
+	 */
+
+	return TCL_OK;
+    }
+
+    /*
+     * Make sure first argument is a dictionary.
+     */
+
+    targetObj = objv[1];
+    if (targetObj->typePtr != &tclDictType) {
+	if (SetDictFromAny(interp, targetObj) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
+    if (objc == 2) {
+	/*
+	 * Single argument, return it.
+	 */
+
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+
+    /*
+     * Normal behaviour: combining two (or more) dictionaries.
+     */
+
+    if (Tcl_IsShared(targetObj)) {
+	targetObj = Tcl_DuplicateObj(targetObj);
+	allocatedDict = 1;
+    }
+    for (i=2 ; i<objc ; i++) {
+	if (Tcl_DictObjFirst(interp, objv[i], &search, &keyObj, &valueObj,
+		&done) != TCL_OK) {
+	    if (allocatedDict) {
+		TclDecrRefCount(targetObj);
+	    }
+	    return TCL_ERROR;
+	}
+	while (!done) {
+	    /*
+	     * Next line can't fail; already know we have a dictionary in
+	     * targetObj.
+	     */
+
+	    Tcl_DictObjPut(NULL, targetObj, keyObj, valueObj);
+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+	}
+	Tcl_DictObjDone(&search);
+    }
+    Tcl_SetObjResult(interp, targetObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictKeysCmd --
+ *
+ *	This function implements the "dict keys" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictKeysCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *listPtr;
+    char *pattern = NULL;
+
+    if (objc!=2 && objc!=3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * A direct check that we have a dictionary. We don't start the iteration
+     * yet because that might allocate memory or set locks that we do not
+     * need. [Bug 1705778, leak K04]
+     */
+
+    if (objv[1]->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, objv[1]);
+
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+
+    if (objc == 3) {
+	pattern = TclGetString(objv[2]);
+    }
+    listPtr = Tcl_NewListObj(0, NULL);
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	Tcl_Obj *valuePtr = NULL;
+
+	Tcl_DictObjGet(interp, objv[1], objv[2], &valuePtr);
+	if (valuePtr != NULL) {
+	    Tcl_ListObjAppendElement(NULL, listPtr, objv[2]);
+	}
+    } else {
+	Tcl_DictSearch search;
+	Tcl_Obj *keyPtr;
+	int done;
+
+	/*
+	 * At this point, we know we have a dictionary (or at least something
+	 * that can be represented; it could theoretically have shimmered away
+	 * when the pattern was fetched, but that shouldn't be damaging) so we
+	 * can start the iteration process without checking for failures.
+	 */
+
+	Tcl_DictObjFirst(NULL, objv[1], &search, &keyPtr, NULL, &done);
+	for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {
+	    if (!pattern || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {
+		Tcl_ListObjAppendElement(NULL, listPtr, keyPtr);
+	    }
+	}
+	Tcl_DictObjDone(&search);
+    }
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictValuesCmd --
+ *
+ *	This function implements the "dict values" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictValuesCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *valuePtr, *listPtr;
+    Tcl_DictSearch search;
+    int done;
+    char *pattern;
+
+    if (objc!=2 && objc!=3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr,
+	    &done) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (objc == 3) {
+	pattern = TclGetString(objv[2]);
+    } else {
+	pattern = NULL;
+    }
+    listPtr = Tcl_NewListObj(0, NULL);
+    for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
+	if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) {
+	    /*
+	     * Assume this operation always succeeds.
+	     */
+
+	    Tcl_ListObjAppendElement(interp, listPtr, valuePtr);
+	}
+    }
+    Tcl_DictObjDone(&search);
+
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictSizeCmd --
+ *
+ *	This function implements the "dict size" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictSizeCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int result, size;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
+	return TCL_ERROR;
+    }
+    result = Tcl_DictObjSize(interp, objv[1], &size);
+    if (result == TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictExistsCmd --
+ *
+ *	This function implements the "dict exists" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictExistsCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *valuePtr;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
+	    DICT_PATH_EXISTS);
+    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
+	    || Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
+		    &valuePtr) != TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictInfoCmd --
+ *
+ *	This function implements the "dict info" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictInfoCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr;
+    Dict *dict;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
+	return TCL_ERROR;
+    }
+
+    dictPtr = objv[1];
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+
+    /*
+     * This next cast is actually OK.
+     */
+
+    Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictIncrCmd --
+ *
+ *	This function implements the "dict incr" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictIncrCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int code = TCL_OK;
+    Tcl_Obj *dictPtr, *valuePtr = NULL;
+
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	/*
+	 * Variable didn't yet exist. Create new dictionary value.
+	 */
+
+	dictPtr = Tcl_NewDictObj();
+    } else if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
+	/*
+	 * Variable contents are not a dict, report error.
+	 */
+
+	return TCL_ERROR;
+    }
+    if (Tcl_IsShared(dictPtr)) {
+	/*
+	 * A little internals surgery to avoid copying a string rep that will
+	 * soon be no good.
+	 */
+
+	char *saved = dictPtr->bytes;
+	Tcl_Obj *oldPtr = dictPtr;
+
+	dictPtr->bytes = NULL;
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+	oldPtr->bytes = saved;
+    }
+    if (valuePtr == NULL) {
+	/*
+	 * Key not in dictionary. Create new key with increment as value.
+	 */
+
+	if (objc == 4) {
+	    /*
+	     * Verify increment is an integer.
+	     */
+
+	    mp_int increment;
+
+	    code = Tcl_GetBignumFromObj(interp, objv[3], &increment);
+	    if (code != TCL_OK) {
+		Tcl_AddErrorInfo(interp, "\n    (reading increment)");
+	    } else {
+		/*
+		 * Remember to dispose with the bignum as we're not actually
+		 * using it directly. [Bug 2874678]
+		 */
+
+		mp_clear(&increment);
+		Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+	    }
+	} else {
+	    Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+	}
+    } else {
+	/*
+	 * Key in dictionary. Increment its value with minimum dup.
+	 */
+
+	if (Tcl_IsShared(valuePtr)) {
+	    valuePtr = Tcl_DuplicateObj(valuePtr);
+	    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+	}
+	if (objc == 4) {
+	    code = TclIncrObj(interp, valuePtr, objv[3]);
+	} else {
+	    Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
+
+	    Tcl_IncrRefCount(incrPtr);
+	    code = TclIncrObj(interp, valuePtr, incrPtr);
+	    Tcl_DecrRefCount(incrPtr);
+	}
+    }
+    if (code == TCL_OK) {
+	TclInvalidateStringRep(dictPtr);
+	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
+		dictPtr, TCL_LEAVE_ERR_MSG);
+	if (valuePtr == NULL) {
+	    code = TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, valuePtr);
+	}
+    } else if (dictPtr->refCount == 0) {
+	Tcl_DecrRefCount(dictPtr);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictLappendCmd --
+ *
+ *	This function implements the "dict lappend" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictLappendCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
+    int i, allocatedDict = 0, allocatedValue = 0;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	allocatedDict = 1;
+	dictPtr = Tcl_NewDictObj();
+    } else if (Tcl_IsShared(dictPtr)) {
+	allocatedDict = 1;
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+
+    if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
+	if (allocatedDict) {
+	    TclDecrRefCount(dictPtr);
+	}
+	return TCL_ERROR;
+    }
+
+    if (valuePtr == NULL) {
+	valuePtr = Tcl_NewListObj(objc-3, objv+3);
+	allocatedValue = 1;
+    } else {
+	if (Tcl_IsShared(valuePtr)) {
+	    allocatedValue = 1;
+	    valuePtr = Tcl_DuplicateObj(valuePtr);
+	}
+
+	for (i=3 ; i<objc ; i++) {
+	    if (Tcl_ListObjAppendElement(interp, valuePtr,
+		    objv[i]) != TCL_OK) {
+		if (allocatedValue) {
+		    TclDecrRefCount(valuePtr);
+		}
+		if (allocatedDict) {
+		    TclDecrRefCount(dictPtr);
+		}
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    if (allocatedValue) {
+	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+    } else if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
+    }
+
+    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG);
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictAppendCmd --
+ *
+ *	This function implements the "dict append" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictAppendCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
+    int i, allocatedDict = 0;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	allocatedDict = 1;
+	dictPtr = Tcl_NewDictObj();
+    } else if (Tcl_IsShared(dictPtr)) {
+	allocatedDict = 1;
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+
+    if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
+	if (allocatedDict) {
+	    TclDecrRefCount(dictPtr);
+	}
+	return TCL_ERROR;
+    }
+
+    if (valuePtr == NULL) {
+	TclNewObj(valuePtr);
+    } else {
+	if (Tcl_IsShared(valuePtr)) {
+	    valuePtr = Tcl_DuplicateObj(valuePtr);
+	}
+    }
+
+    for (i=3 ; i<objc ; i++) {
+	Tcl_AppendObjToObj(valuePtr, objv[i]);
+    }
+
+    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+
+    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG);
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictForCmd --
+ *
+ *	This function implements the "dict for" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictForCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
+    Tcl_Obj **varv, *keyObj, *valueObj;
+    Tcl_DictSearch search;
+    int varc, done, result;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"{keyVar valueVar} dictionary script");
+	return TCL_ERROR;
+    }
+
+    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (varc != 2) {
+	Tcl_SetResult(interp, "must have exactly two variable names",
+		TCL_STATIC);
+	return TCL_ERROR;
+    }
+    keyVarObj = varv[0];
+    valueVarObj = varv[1];
+    scriptObj = objv[3];
+
+    if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
+	    &done) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that these objects (which we need throughout the body of the
+     * loop) don't vanish. Note that the dictionary internal rep is locked
+     * internally so that updates, shimmering, etc are not a problem.
+     */
+
+    Tcl_IncrRefCount(keyVarObj);
+    Tcl_IncrRefCount(valueVarObj);
+    Tcl_IncrRefCount(scriptObj);
+
+    result = TCL_OK;
+    while (!done) {
+	/*
+	 * Stop the value from getting hit in any way by any traces on the key
+	 * variable.
+	 */
+
+	Tcl_IncrRefCount(valueObj);
+	if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "couldn't set key variable: \"",
+		    TclGetString(keyVarObj), "\"", NULL);
+	    TclDecrRefCount(valueObj);
+	    result = TCL_ERROR;
+	    break;
+	}
+	TclDecrRefCount(valueObj);
+	if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "couldn't set value variable: \"",
+		    TclGetString(valueVarObj), "\"", NULL);
+	    result = TCL_ERROR;
+	    break;
+	}
+
+	/*
+	 * TIP #280. Make invoking context available to loop body.
+	 */
+
+	result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+	if (result == TCL_CONTINUE) {
+	    result = TCL_OK;
+	} else if (result != TCL_OK) {
+	    if (result == TCL_BREAK) {
+		result = TCL_OK;
+	    } else if (result == TCL_ERROR) {
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"dict for\" body line %d)",
+			interp->errorLine));
+	    }
+	    break;
+	}
+
+	Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+    }
+
+    /*
+     * Stop holding a reference to these objects.
+     */
+
+    TclDecrRefCount(keyVarObj);
+    TclDecrRefCount(valueVarObj);
+    TclDecrRefCount(scriptObj);
+
+    Tcl_DictObjDone(&search);
+    if (result == TCL_OK) {
+	Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictSetCmd --
+ *
+ *	This function implements the "dict set" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictSetCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *resultPtr;
+    int result, allocatedDict = 0;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	allocatedDict = 1;
+	dictPtr = Tcl_NewDictObj();
+    } else if (Tcl_IsShared(dictPtr)) {
+	allocatedDict = 1;
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+
+    result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-3, objv+2,
+	    objv[objc-1]);
+    if (result != TCL_OK) {
+	if (allocatedDict) {
+	    TclDecrRefCount(dictPtr);
+	}
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG);
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictUnsetCmd --
+ *
+ *	This function implements the "dict unset" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictUnsetCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Obj *dictPtr, *resultPtr;
+    int result, allocatedDict = 0;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	allocatedDict = 1;
+	dictPtr = Tcl_NewDictObj();
+    } else if (Tcl_IsShared(dictPtr)) {
+	allocatedDict = 1;
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+
+    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-2, objv+2);
+    if (result != TCL_OK) {
+	if (allocatedDict) {
+	    TclDecrRefCount(dictPtr);
+	}
+	return TCL_ERROR;
+    }
+
+    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG);
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictFilterCmd --
+ *
+ *	This function implements the "dict filter" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictFilterCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    static const char *filters[] = {
+	"key", "script", "value", NULL
+    };
+    enum FilterTypes {
+	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
+    };
+    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
+    Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
+    Tcl_DictSearch search;
+    int index, varc, done, result, satisfied;
+    char *pattern;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ...");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
+	     0, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum FilterTypes) index) {
+    case FILTER_KEYS:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Create a dictionary whose keys all match a certain pattern.
+	 */
+
+	if (Tcl_DictObjFirst(interp, objv[1], &search,
+		&keyObj, &valueObj, &done) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	pattern = TclGetString(objv[3]);
+	resultObj = Tcl_NewDictObj();
+	if (TclMatchIsTrivial(pattern)) {
+	    /*
+	     * Must release the search lock here to prevent a memory leak
+	     * since we are not exhausing the search. [Bug 1705778, leak K05]
+	     */
+
+	    Tcl_DictObjDone(&search);
+	    Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
+	    if (valueObj != NULL) {
+		Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+	    }
+	} else {
+	    while (!done) {
+		if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		}
+		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+	    }
+	}
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+
+    case FILTER_VALUES:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Create a dictionary whose values all match a certain pattern.
+	 */
+
+	if (Tcl_DictObjFirst(interp, objv[1], &search,
+		&keyObj, &valueObj, &done) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	pattern = TclGetString(objv[3]);
+	resultObj = Tcl_NewDictObj();
+	while (!done) {
+	    if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
+		Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+	    }
+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+	}
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+
+    case FILTER_SCRIPT:
+	if (objc != 5) {
+	    Tcl_WrongNumArgs(interp, 1, objv,
+		    "dictionary script {keyVar valueVar} filterScript");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Create a dictionary whose key,value pairs all satisfy a script
+	 * (i.e. get a true boolean result from its evaluation). Massive
+	 * copying from the "dict for" implementation has occurred!
+	 */
+
+	if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (varc != 2) {
+	    Tcl_SetResult(interp, "must have exactly two variable names",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	keyVarObj = varv[0];
+	valueVarObj = varv[1];
+	scriptObj = objv[4];
+
+	/*
+	 * Make sure that these objects (which we need throughout the body of
+	 * the loop) don't vanish. Note that the dictionary internal rep is
+	 * locked internally so that updates, shimmering, etc are not a
+	 * problem.
+	 */
+
+	Tcl_IncrRefCount(keyVarObj);
+	Tcl_IncrRefCount(valueVarObj);
+	Tcl_IncrRefCount(scriptObj);
+
+	result = Tcl_DictObjFirst(interp, objv[1],
+		&search, &keyObj, &valueObj, &done);
+	if (result != TCL_OK) {
+	    TclDecrRefCount(keyVarObj);
+	    TclDecrRefCount(valueVarObj);
+	    TclDecrRefCount(scriptObj);
+	    return TCL_ERROR;
+	}
+
+	resultObj = Tcl_NewDictObj();
+
+	while (!done) {
+	    /*
+	     * Stop the value from getting hit in any way by any traces on the
+	     * key variable.
+	     */
+
+	    Tcl_IncrRefCount(keyObj);
+	    Tcl_IncrRefCount(valueObj);
+	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+		    TCL_LEAVE_ERR_MSG) == NULL) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "couldn't set key variable: \"",
+			TclGetString(keyVarObj), "\"", NULL);
+		result = TCL_ERROR;
+		goto abnormalResult;
+	    }
+	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+		    TCL_LEAVE_ERR_MSG) == NULL) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "couldn't set value variable: \"",
+			TclGetString(valueVarObj), "\"", NULL);
+		goto abnormalResult;
+	    }
+
+	    /*
+	     * TIP #280. Make invoking context available to loop body.
+	     */
+
+	    result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4);
+	    switch (result) {
+	    case TCL_OK:
+		boolObj = Tcl_GetObjResult(interp);
+		Tcl_IncrRefCount(boolObj);
+		Tcl_ResetResult(interp);
+		if (Tcl_GetBooleanFromObj(interp, boolObj,
+			&satisfied) != TCL_OK) {
+		    TclDecrRefCount(boolObj);
+		    result = TCL_ERROR;
+		    goto abnormalResult;
+		}
+		TclDecrRefCount(boolObj);
+		if (satisfied) {
+		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		}
+		break;
+	    case TCL_BREAK:
+		/*
+		 * Force loop termination by calling Tcl_DictObjDone; this
+		 * makes the next Tcl_DictObjNext say there is nothing more to
+		 * do.
+		 */
+
+		Tcl_ResetResult(interp);
+		Tcl_DictObjDone(&search);
+	    case TCL_CONTINUE:
+		result = TCL_OK;
+		break;
+	    case TCL_ERROR:
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"dict filter\" script line %d)",
+			interp->errorLine));
+	    default:
+		goto abnormalResult;
+	    }
+
+	    TclDecrRefCount(keyObj);
+	    TclDecrRefCount(valueObj);
+
+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+	}
+
+	/*
+	 * Stop holding a reference to these objects.
+	 */
+
+	TclDecrRefCount(keyVarObj);
+	TclDecrRefCount(valueVarObj);
+	TclDecrRefCount(scriptObj);
+	Tcl_DictObjDone(&search);
+
+	if (result == TCL_OK) {
+	    Tcl_SetObjResult(interp, resultObj);
+	} else {
+	    TclDecrRefCount(resultObj);
+	}
+	return result;
+
+    abnormalResult:
+	Tcl_DictObjDone(&search);
+	TclDecrRefCount(keyObj);
+	TclDecrRefCount(valueObj);
+	TclDecrRefCount(keyVarObj);
+	TclDecrRefCount(valueVarObj);
+	TclDecrRefCount(scriptObj);
+	TclDecrRefCount(resultObj);
+	return result;
+    }
+    Tcl_Panic("unexpected fallthrough");
+    /* Control never reaches this point. */
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictUpdateCmd --
+ *
+ *	This function implements the "dict update" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#212 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictUpdateCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *dictPtr, *objPtr;
+    int i, result, dummy;
+    Tcl_InterpState state;
+
+    if (objc < 5 || !(objc & 1)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"varName key varName ?key varName ...? script");
+	return TCL_ERROR;
+    }
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+    if (dictPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    Tcl_IncrRefCount(dictPtr);
+    for (i=2 ; i+2<objc ; i+=2) {
+	if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) {
+	    TclDecrRefCount(dictPtr);
+	    return TCL_ERROR;
+	}
+	if (objPtr == NULL) {
+	    /* ??? */
+	    Tcl_UnsetVar(interp, Tcl_GetString(objv[i+1]), 0);
+	} else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr,
+		TCL_LEAVE_ERR_MSG) == NULL) {
+	    TclDecrRefCount(dictPtr);
+	    return TCL_ERROR;
+	}
+    }
+    TclDecrRefCount(dictPtr);
+
+    /*
+     * Execute the body.
+     */
+
+    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+    if (result == TCL_ERROR) {
+	Tcl_AddErrorInfo(interp, "\n    (body of \"dict update\")");
+    }
+
+    /*
+     * If the dictionary variable doesn't exist, drop everything silently.
+     */
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	return result;
+    }
+
+    /*
+     * Double-check that it is still a dictionary.
+     */
+
+    state = Tcl_SaveInterpState(interp, result);
+    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+	Tcl_DiscardInterpState(state);
+	return TCL_ERROR;
+    }
+
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+
+    /*
+     * Write back the values from the variables, treating failure to read as
+     * an instruction to remove the key.
+     */
+
+    for (i=2 ; i+2<objc ; i+=2) {
+	objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
+	if (objPtr == NULL) {
+	    Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+	} else if (objPtr == dictPtr) {
+	    /*
+	     * Someone is messing us around, trying to build a recursive
+	     * structure. [Bug 1786481]
+	     */
+
+	    Tcl_DictObjPut(interp, dictPtr, objv[i],
+		    Tcl_DuplicateObj(objPtr));
+	} else {
+	    /* Shouldn't fail */
+	    Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
+	}
+    }
+
+    /*
+     * Write the dictionary back to its variable.
+     */
+
+    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	Tcl_DiscardInterpState(state);
+	return TCL_ERROR;
+    }
+
+    return Tcl_RestoreInterpState(interp, state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictWithCmd --
+ *
+ *	This function implements the "dict with" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#212 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictWithCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
+    Tcl_DictSearch s;
+    Tcl_InterpState state;
+    int done, result, keyc, i, allocdict = 0;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the dictionary to open out.
+     */
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+    if (dictPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (objc > 3) {
+	dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
+		DICT_PATH_READ);
+	if (dictPtr == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Go over the list of keys and write each corresponding value to a
+     * variable in the current context with the same name. Also keep a copy of
+     * the keys so we can write back properly later on even if the dictionary
+     * has been structurally modified.
+     */
+
+    if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
+	    &done) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    TclNewObj(keysPtr);
+    Tcl_IncrRefCount(keysPtr);
+
+    for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
+	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
+	if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
+		TCL_LEAVE_ERR_MSG) == NULL) {
+	    TclDecrRefCount(keysPtr);
+	    Tcl_DictObjDone(&s);
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Execute the body, while making the invoking context available to the
+     * loop body (TIP#280).
+     */
+
+    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+    if (result == TCL_ERROR) {
+	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
+    }
+
+    /*
+     * If the dictionary variable doesn't exist, drop everything silently.
+     */
+
+    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    if (dictPtr == NULL) {
+	TclDecrRefCount(keysPtr);
+	return result;
+    }
+
+    /*
+     * Double-check that it is still a dictionary.
+     */
+
+    state = Tcl_SaveInterpState(interp, result);
+    if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
+	TclDecrRefCount(keysPtr);
+	Tcl_DiscardInterpState(state);
+	return TCL_ERROR;
+    }
+
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+	allocdict = 1;
+    }
+
+    if (objc > 3) {
+	/*
+	 * Want to get to the dictionary which we will update; need to do
+	 * prepare-for-update de-sharing along the path *but* avoid generating
+	 * an error on a non-existant path (we'll treat that the same as a
+	 * non-existant variable. Luckily, the de-sharing operation isn't
+	 * deeply damaging if we don't go on to update; it's just less than
+	 * perfectly efficient (but no memory should be leaked).
+	 */
+
+	leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
+		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
+	if (leafPtr == NULL) {
+	    TclDecrRefCount(keysPtr);
+	    if (allocdict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    Tcl_DiscardInterpState(state);
+	    return TCL_ERROR;
+	}
+	if (leafPtr == DICT_PATH_NON_EXISTENT) {
+	    TclDecrRefCount(keysPtr);
+	    if (allocdict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    return Tcl_RestoreInterpState(interp, state);
+	}
+    } else {
+	leafPtr = dictPtr;
+    }
+
+    /*
+     * Now process our updates on the leaf dictionary.
+     */
+
+    TclListObjGetElements(NULL, keysPtr, &keyc, &keyv);
+    for (i=0 ; i<keyc ; i++) {
+	valPtr = Tcl_ObjGetVar2(interp, keyv[i], NULL, 0);
+	if (valPtr == NULL) {
+	    Tcl_DictObjRemove(NULL, leafPtr, keyv[i]);
+	} else if (leafPtr == valPtr) {
+	    /*
+	     * Someone is messing us around, trying to build a recursive
+	     * structure. [Bug 1786481]
+	     */
+
+	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], Tcl_DuplicateObj(valPtr));
+	} else {
+	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
+	}
+    }
+    TclDecrRefCount(keysPtr);
+
+    /*
+     * Ensure that none of the dictionaries in the chain still have a string
+     * rep.
+     */
+
+    if (objc > 3) {
+	InvalidateDictChain(leafPtr);
+    }
+
+    /*
+     * Write back the outermost dictionary to the variable.
+     */
+
+    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	Tcl_DiscardInterpState(state);
+	return TCL_ERROR;
+    }
+    return Tcl_RestoreInterpState(interp, state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitDictCmd --
+ *
+ *	This function is create the "dict" Tcl command. See the user
+ *	documentation for details on what it does, and TIP#111 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A Tcl command handle.
+ *
+ * Side effects:
+ *	May advance compilation epoch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitDictCmd(
+    Tcl_Interp *interp)
+{
+    return TclMakeEnsemble(interp, "dict", implementationMap);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 73c4067..c2f1b4b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -5,43 +5,41 @@
  *
  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
-typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
+typedef size_t (LengthProc)(const char *src);
 
 /*
- * The following data structure represents an encoding, which describes how
- * to convert between various character sets and UTF-8.
+ * The following data structure represents an encoding, which describes how to
+ * convert between various character sets and UTF-8.
  */
 
 typedef struct Encoding {
-    char *name;			/* Name of encoding.  Malloced because (1)
-				 * hash table entry that owns this encoding
-				 * may be freed prior to this encoding being
-				 * freed, (2) string passed in the
-				 * Tcl_EncodingType structure may not be
-				 * persistent. */
+    char *name;			/* Name of encoding. Malloced because (1) hash
+				 * table entry that owns this encoding may be
+				 * freed prior to this encoding being freed,
+				 * (2) string passed in the Tcl_EncodingType
+				 * structure may not be persistent. */
     Tcl_EncodingConvertProc *toUtfProc;
-				/* Procedure to convert from external
-				 * encoding into UTF-8. */
+				/* Function to convert from external encoding
+				 * into UTF-8. */
     Tcl_EncodingConvertProc *fromUtfProc;
-				/* Procedure to convert from UTF-8 into
+				/* Function to convert from UTF-8 into
 				 * external encoding. */
     Tcl_EncodingFreeProc *freeProc;
-				/* If non-NULL, procedure to call when this
+				/* If non-NULL, function to call when this
 				 * encoding is deleted. */
     int nullSize;		/* Number of 0x00 bytes that signify
-				 * end-of-string in this encoding.  This
-				 * number is used to determine the source
-				 * string length when the srcLen argument is
-				 * negative.  This number can be 1 or 2. */
+				 * end-of-string in this encoding. This number
+				 * is used to determine the source string
+				 * length when the srcLen argument is
+				 * negative. This number can be 1 or 2. */
     ClientData clientData;	/* Arbitrary value associated with encoding
-				 * type.  Passed to conversion procedures. */
+				 * type. Passed to conversion functions. */
     LengthProc *lengthProc;	/* Function to compute length of
 				 * null-terminated strings in this encoding.
 				 * If nullSize is 1, this is strlen; if
@@ -54,15 +52,15 @@ typedef struct Encoding {
 
 /*
  * The following structure is the clientData for a dynamically-loaded,
- * table-driven encoding created by LoadTableEncoding().  It maps between
+ * table-driven encoding created by LoadTableEncoding(). It maps between
  * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
  * encoding.
  */
 
 typedef struct TableEncodingData {
-    int fallback;		/* Character (in this encoding) to
-				 * substitute when this encoding cannot
-				 * represent a UTF-8 character. */
+    int fallback;		/* Character (in this encoding) to substitute
+				 * when this encoding cannot represent a UTF-8
+				 * character. */
     char prefixBytes[256];	/* If a byte in the input stream is a lead
 				 * byte for a 2-byte sequence, the
 				 * corresponding entry in this array is 1,
@@ -70,14 +68,15 @@ typedef struct TableEncodingData {
     unsigned short **toUnicode;	/* Two dimensional sparse matrix to map
 				 * characters from the encoding to Unicode.
 				 * Each element of the toUnicode array points
-				 * to an array of 256 shorts.  If there is no
+				 * to an array of 256 shorts. If there is no
 				 * corresponding character in Unicode, the
-				 * value in the matrix is 0x0000.  malloc'd. */
+				 * value in the matrix is 0x0000.
+				 * malloc'd. */
     unsigned short **fromUnicode;
 				/* Two dimensional sparse matrix to map
 				 * characters from Unicode to the encoding.
 				 * Each element of the fromUnicode array
-				 * points to an array of 256 shorts.  If there
+				 * points to an array of 256 shorts. If there
 				 * is no corresponding character the encoding,
 				 * the value in the matrix is 0x0000.
 				 * malloc'd. */
@@ -85,11 +84,11 @@ typedef struct TableEncodingData {
 
 /*
  * The following structures is the clientData for a dynamically-loaded,
- * escape-driven encoding that is itself comprised of other simpler
- * encodings.  An example is "iso-2022-jp", which uses escape sequences to
- * switch between ascii, jis0208, jis0212, gb2312, and ksc5601.  Note that
- * "escape-driven" does not necessarily mean that the ESCAPE character is
- * the character used for switching character sets.
+ * escape-driven encoding that is itself comprised of other simpler encodings.
+ * An example is "iso-2022-jp", which uses escape sequences to switch between
+ * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
+ * does not necessarily mean that the ESCAPE character is the character used
+ * for switching character sets.
  */
 
 typedef struct EscapeSubTable {
@@ -102,29 +101,29 @@ typedef struct EscapeSubTable {
 } EscapeSubTable;
 
 typedef struct EscapeEncodingData {
-    int fallback;		/* Character (in this encoding) to
-				 * substitute when this encoding cannot
-				 * represent a UTF-8 character. */
+    int fallback;		/* Character (in this encoding) to substitute
+				 * when this encoding cannot represent a UTF-8
+				 * character. */
     unsigned int initLen;	/* Length of following string. */
     char init[16];		/* String to emit or expect before first char
 				 * in conversion. */
     unsigned int finalLen;	/* Length of following string. */
-    char final[16];		/* String to emit or expect after last char
-				 * in conversion. */
-    char prefixBytes[256];	/* If a byte in the input stream is the 
-				 * first character of one of the escape 
-				 * sequences in the following array, the 
-				 * corresponding entry in this array is 1,
-				 * otherwise it is 0. */
+    char final[16];		/* String to emit or expect after last char in
+				 * conversion. */
+    char prefixBytes[256];	/* If a byte in the input stream is the first
+				 * character of one of the escape sequences in
+				 * the following array, the corresponding
+				 * entry in this array is 1, otherwise it is
+				 * 0. */
     int numSubTables;		/* Length of following array. */
-    EscapeSubTable subTables[1];/* Information about each EscapeSubTable
-				 * used by this encoding type.  The actual 
-				 * size will be as large as necessary to 
-				 * hold all EscapeSubTables. */
+    EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
+				 * by this encoding type. The actual size will
+				 * be as large as necessary to hold all
+				 * EscapeSubTables. */
 } EscapeEncodingData;
 
 /*
- * Constants used when loading an encoding file to identify the type of the
+ * constants used when loading an encoding file to identify the type of the
  * file.
  */
 
@@ -134,27 +133,51 @@ typedef struct EscapeEncodingData {
 #define ENCODING_ESCAPE		3
 
 /*
- * Initialize the default encoding directory.  If this variable contains
- * a non NULL value, it will be the first path used to locate the
- * system encoding files.
+ * A list of directories in which Tcl should look for *.enc files. This list
+ * is shared by all threads. Access is governed by a mutex lock.
  */
 
-char *tclDefaultEncodingDir = NULL;
+static TclInitProcessGlobalValueProc InitializeEncodingSearchPath;
+static ProcessGlobalValue encodingSearchPath = {
+    0, 0, NULL, NULL, InitializeEncodingSearchPath, NULL, NULL
+};
 
-static int encodingsInitialized  = 0;
+/*
+ * A map from encoding names to the directories in which their data files have
+ * been seen. The string value of the map is shared by all threads. Access to
+ * the shared string is governed by a mutex lock.
+ */
+
+static ProcessGlobalValue encodingFileMap = {
+    0, 0, NULL, NULL, NULL, NULL, NULL
+};
 
 /*
- * Hash table that keeps track of all loaded Encodings.  Keys are
- * the string names that represent the encoding, values are (Encoding *).
+ * A list of directories making up the "library path". Historically this
+ * search path has served many uses, but the only one remaining is a base for
+ * the encodingSearchPath above. If the application does not explicitly set
+ * the encodingSearchPath, then it will be initialized by appending /encoding
+ * to each directory in this "libraryPath".
  */
- 
+
+static ProcessGlobalValue libraryPath = {
+    0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL
+};
+
+static int encodingsInitialized = 0;
+
+/*
+ * Hash table that keeps track of all loaded Encodings. Keys are the string
+ * names that represent the encoding, values are (Encoding *).
+ */
+
 static Tcl_HashTable encodingTable;
 TCL_DECLARE_MUTEX(encodingMutex)
 
 /*
- * The following are used to hold the default and current system encodings.  
- * If NULL is passed to one of the conversion routines, the current setting 
- * of the system encoding will be used to perform the conversion.
+ * The following are used to hold the default and current system encodings.
+ * If NULL is passed to one of the conversion routines, the current setting of
+ * the system encoding will be used to perform the conversion.
  */
 
 static Tcl_Encoding defaultEncoding;
@@ -168,125 +191,129 @@ static Tcl_Encoding systemEncoding;
 static unsigned short emptyPage[256];
 
 /*
- * Procedures used only in this module.
+ * Functions used only in this module.
  */
 
-static int		BinaryProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+static int		BinaryProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static void		DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *dupPtr));
-static void		EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
-static int		EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static void		DupEncodingIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void		EscapeFreeProc(ClientData clientData);
+static int		EscapeFromUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		EscapeToUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static void		FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
-static void		FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static Encoding *	GetTableEncoding _ANSI_ARGS_((
-			    EscapeEncodingData *dataPtr, int state));
-static Tcl_Encoding	LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *name));
-static Tcl_Encoding	LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *name, int type, Tcl_Channel chan));
-static Tcl_Encoding	LoadEscapeEncoding _ANSI_ARGS_((CONST char *name, 
-			    Tcl_Channel chan));
-static Tcl_Channel	OpenEncodingFile _ANSI_ARGS_((CONST char *dir,
-			    CONST char *name));
-static void		TableFreeProc _ANSI_ARGS_((ClientData clientData));
-static int		TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static void		FillEncodingFileMap(void);
+static void		FreeEncoding(Tcl_Encoding encoding);
+static void		FreeEncodingIntRep(Tcl_Obj *objPtr);
+static Encoding *	GetTableEncoding(EscapeEncodingData *dataPtr,
+			    int state);
+static Tcl_Encoding	LoadEncodingFile(Tcl_Interp *interp, const char *name);
+static Tcl_Encoding	LoadTableEncoding(const char *name, int type,
+			    Tcl_Channel chan);
+static Tcl_Encoding	LoadEscapeEncoding(const char *name, Tcl_Channel chan);
+static Tcl_Channel	OpenEncodingFileChannel(Tcl_Interp *interp,
+			    const char *name);
+static void		TableFreeProc(ClientData clientData);
+static int		TableFromUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		TableToUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		TableToUtfProc(ClientData clientData, const char *src,
+			    int srcLen, int flags, Tcl_EncodingState *statePtr,
+			    char *dst, int dstLen, int *srcReadPtr,
+			    int *dstWrotePtr, int *dstCharsPtr);
+static size_t		unilen(const char *src);
+static int		UnicodeToUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static size_t		unilen _ANSI_ARGS_((CONST char *src));
-static int		UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		UtfToUnicodeProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		UtfToUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		UtfToUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr, int pureNullMode);
+static int		UtfIntToUtfExtProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr, int pureNullMode));
-static int		UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		UtfExtToUtfIntProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		Iso88591FromUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
+			    int *dstCharsPtr);
+static int		Iso88591ToUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
+			    Tcl_EncodingState *statePtr, char *dst,
+			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
+			    int *dstCharsPtr);
 
 /*
- * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
- * This should help the lifetime of encodings be more useful.  
+ * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
+ * of the intrep. This should help the lifetime of encodings be more useful.
  * See concerns raised in [Bug 1077262].
  */
 
-static Tcl_ObjType EncodingType = {
+static Tcl_ObjType encodingType = {
     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
 };
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetEncodingFromObj --
+ * Tcl_GetEncodingFromObj --
  *
- *      Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr),
- *      if possible, and returns TCL_OK.  If no such encoding exists,
- *      TCL_ERROR is returned, and if interp is non-NULL, an error message
- *      is written there.
+ *	Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), if
+ *	possible, and returns TCL_OK. If no such encoding exists, TCL_ERROR is
+ *	returned, and if interp is non-NULL, an error message is written
+ *	there.
  *
  * Results:
- *      Standard Tcl return code.
+ *	Standard Tcl return code.
  *
  * Side effects:
  * 	Caches the Tcl_Encoding value as the internal rep of (*objPtr).
  *
  *----------------------------------------------------------------------
  */
-int 
-TclGetEncodingFromObj(interp, objPtr, encodingPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj *objPtr;
-    Tcl_Encoding *encodingPtr;
+
+int
+Tcl_GetEncodingFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Encoding *encodingPtr)
 {
-    CONST char *name = Tcl_GetString(objPtr);
-    if (objPtr->typePtr != &EncodingType) {
+    const char *name = Tcl_GetString(objPtr);
+    if (objPtr->typePtr != &encodingType) {
 	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
 
 	if (encoding == NULL) {
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
-	    objPtr->typePtr->freeIntRepProc(objPtr);
-	}
-	objPtr->internalRep.otherValuePtr = (VOID *) encoding;
-	objPtr->typePtr = &EncodingType;
+	TclFreeIntRep(objPtr);
+	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) encoding;
+	objPtr->typePtr = &encodingType;
     }
     *encodingPtr = Tcl_GetEncoding(NULL, name);
     return TCL_OK;
@@ -297,15 +324,17 @@ TclGetEncodingFromObj(interp, objPtr, encodingPtr)
  *
  * FreeEncodingIntRep --
  *
- *      The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
+ *	The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
  *
  *----------------------------------------------------------------------
  */
+
 static void
-FreeEncodingIntRep(objPtr)
-    Tcl_Obj *objPtr;
+FreeEncodingIntRep(
+    Tcl_Obj *objPtr)
 {
-    Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
+    Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.twoPtrValue.ptr1);
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -313,26 +342,193 @@ FreeEncodingIntRep(objPtr)
  *
  * DupEncodingIntRep --
  *
- *      The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
+ *	The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
  *
  *----------------------------------------------------------------------
  */
+
 static void
-DupEncodingIntRep(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr;
-    Tcl_Obj *dupPtr;
+DupEncodingIntRep(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dupPtr)
 {
-    dupPtr->internalRep.otherValuePtr = (VOID *)
+    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *)
 	    Tcl_GetEncoding(NULL, srcPtr->bytes);
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEncodingSearchPath --
+ *
+ *	Keeps the per-thread copy of the encoding search path current with
+ *	changes to the global copy.
+ *
+ * Results:
+ *	Returns a "list" (Tcl_Obj *) that contains the encoding search path.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetEncodingSearchPath(void)
+{
+    return TclGetProcessGlobalValue(&encodingSearchPath);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEncodingSearchPath --
+ *
+ *	Keeps the per-thread copy of the encoding search path current with
+ *	changes to the global copy.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEncodingSearchPath(
+    Tcl_Obj *searchPath)
+{
+    int dummy;
+
+    if (TCL_ERROR == Tcl_ListObjLength(NULL, searchPath, &dummy)) {
+	return TCL_ERROR;
+    }
+    TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetLibraryPath --
+ *
+ *	Keeps the per-thread copy of the library path current with changes to
+ *	the global copy.
+ *
+ * Results:
+ *	Returns a "list" (Tcl_Obj *) that contains the library path.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetLibraryPath(void)
+{
+    return TclGetProcessGlobalValue(&libraryPath);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetLibraryPath --
+ *
+ *	Keeps the per-thread copy of the library path current with changes to
+ *	the global copy.
+ *
+ *	NOTE: this routine returns void, so there's no way to report the error
+ *	that searchPath is not a valid list. In that case, this routine will
+ *	silently do nothing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetLibraryPath(
+    Tcl_Obj *path)
+{
+    int dummy;
+
+    if (TCL_ERROR == Tcl_ListObjLength(NULL, path, &dummy)) {
+	return;
+    }
+    TclSetProcessGlobalValue(&libraryPath, path, NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FillEncodingFileMap --
+ *
+ * 	Called to bring the encoding file map in sync with the current value
+ * 	of the encoding search path.
+ *
+ *	Scan the directories on the encoding search path, find the *.enc
+ *	files, and store the found pathnames in a map associated with the
+ *	encoding name.
+ *
+ *	In particular, if $dir is on the encoding search path, and the file
+ *	$dir/foo.enc is found, then store a "foo" -> $dir entry in the map.
+ *	Later, any need for the "foo" encoding will quickly * be able to
+ *	construct the $dir/foo.enc pathname for reading the encoding data.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Entries are added to the encoding file map.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FillEncodingFileMap(void)
+{
+    int i, numDirs = 0;
+    Tcl_Obj *map, *searchPath;
+
+    searchPath = Tcl_GetEncodingSearchPath();
+    Tcl_IncrRefCount(searchPath);
+    Tcl_ListObjLength(NULL, searchPath, &numDirs);
+    map = Tcl_NewDictObj();
+    Tcl_IncrRefCount(map);
+
+    for (i = numDirs-1; i >= 0; i--) {
+	/*
+	 * Iterate backwards through the search path so as we overwrite
+	 * entries found, we favor files earlier on the search path.
+	 */
+
+	int j, numFiles;
+	Tcl_Obj *directory, *matchFileList = Tcl_NewObj();
+	Tcl_Obj **filev;
+	Tcl_GlobTypeData readableFiles = {
+	    TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL
+	};
+
+	Tcl_ListObjIndex(NULL, searchPath, i, &directory);
+	Tcl_IncrRefCount(directory);
+	Tcl_IncrRefCount(matchFileList);
+	Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc",
+		&readableFiles);
+
+	Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev);
+	for (j=0; j<numFiles; j++) {
+	    Tcl_Obj *encodingName, *file;
+
+	    file = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
+	    encodingName = TclPathPart(NULL, file, TCL_PATH_ROOT);
+	    Tcl_DictObjPut(NULL, map, encodingName, directory);
+	    Tcl_DecrRefCount(file);
+	    Tcl_DecrRefCount(encodingName);
+	}
+	Tcl_DecrRefCount(matchFileList);
+	Tcl_DecrRefCount(directory);
+    }
+    Tcl_DecrRefCount(searchPath);
+    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+    Tcl_DecrRefCount(map);
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * TclInitEncodingSubsystem --
  *
  *	Initialize all resources used by this subsystem on a per-process
- *	basis.  
+ *	basis.
  *
  * Results:
  *	None.
@@ -344,18 +540,22 @@ DupEncodingIntRep(srcPtr, dupPtr)
  */
 
 void
-TclInitEncodingSubsystem()
+TclInitEncodingSubsystem(void)
 {
     Tcl_EncodingType type;
 
+    if (encodingsInitialized) {
+	return;
+    }
+
     Tcl_MutexLock(&encodingMutex);
     Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
     Tcl_MutexUnlock(&encodingMutex);
-    
+
     /*
-     * Create a few initial encodings.  Note that the UTF-8 to UTF-8 
-     * translation is not a no-op, because it will turn a stream of
-     * improperly formed UTF-8 into a properly formed stream.
+     * Create a few initial encodings. Note that the UTF-8 to UTF-8
+     * translation is not a no-op, because it will turn a stream of improperly
+     * formed UTF-8 into a properly formed stream.
      */
 
     type.encodingName	= "identity";
@@ -383,8 +583,53 @@ TclInitEncodingSubsystem()
     type.nullSize	= 2;
     type.clientData	= NULL;
     Tcl_CreateEncoding(&type);
-}
 
+    /*
+     * Need the iso8859-1 encoding in order to process binary data, so force
+     * it to always be embedded. Note that this encoding *must* be a proper
+     * table encoding or some of the escape encodings crash! Hence the ugly
+     * code to duplicate the structure of a table encoding here.
+     */
+
+    {
+	TableEncodingData *dataPtr = (TableEncodingData *)
+		ckalloc(sizeof(TableEncodingData));
+	unsigned size;
+	unsigned short i;
+
+	memset(dataPtr, 0, sizeof(TableEncodingData));
+	dataPtr->fallback = '?';
+
+	size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
+	dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+	memset(dataPtr->toUnicode, 0, size);
+	dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+	memset(dataPtr->fromUnicode, 0, size);
+
+	dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
+	dataPtr->fromUnicode[0] = (unsigned short *)
+		(dataPtr->fromUnicode + 256);
+	for (i=1 ; i<256 ; i++) {
+	    dataPtr->toUnicode[i] = emptyPage;
+	    dataPtr->fromUnicode[i] = emptyPage;
+	}
+
+	for (i=0 ; i<256 ; i++) {
+	    dataPtr->toUnicode[0][i] = i;
+	    dataPtr->fromUnicode[0][i] = i;
+	}
+
+	type.encodingName	= "iso8859-1";
+	type.toUtfProc		= Iso88591ToUtfProc;
+	type.fromUtfProc	= Iso88591FromUtfProc;
+	type.freeProc		= TableFreeProc;
+	type.nullSize		= 1;
+	type.clientData		= dataPtr;
+	Tcl_CreateEncoding(&type);
+    }
+
+    encodingsInitialized = 1;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -403,25 +648,28 @@ TclInitEncodingSubsystem()
  */
 
 void
-TclFinalizeEncodingSubsystem()
+TclFinalizeEncodingSubsystem(void)
 {
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
 
     Tcl_MutexLock(&encodingMutex);
-    encodingsInitialized  = 0;
+    encodingsInitialized = 0;
     FreeEncoding(systemEncoding);
+
     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     while (hPtr != NULL) {
 	/*
 	 * Call FreeEncoding instead of doing it directly to handle refcounts
-	 * like escape encodings use.  [Bug #524674]
-	 * Make sure to call Tcl_FirstHashEntry repeatedly so that all
-	 * encodings are eventually cleaned up.
+	 * like escape encodings use. [Bug 524674] Make sure to call
+	 * Tcl_FirstHashEntry repeatedly so that all encodings are eventually
+	 * cleaned up.
 	 */
+
 	FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
 	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     }
+
     Tcl_DeleteHashTable(&encodingTable);
     Tcl_MutexUnlock(&encodingMutex);
 }
@@ -431,18 +679,32 @@ TclFinalizeEncodingSubsystem()
  *
  * Tcl_GetDefaultEncodingDir --
  *
+ * 	Legacy public interface to retrieve first directory in the encoding
+ * 	searchPath.
  *
  * Results:
+ *	The directory pathname, as a string, or NULL for an empty encoding
+ *	search path.
  *
  * Side effects:
+ * 	None.
  *
  *-------------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetDefaultEncodingDir()
+const char *
+Tcl_GetDefaultEncodingDir(void)
 {
-    return tclDefaultEncodingDir;
+    int numDirs;
+    Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
+
+    Tcl_ListObjLength(NULL, searchPath, &numDirs);
+    if (numDirs == 0) {
+	return NULL;
+    }
+    Tcl_ListObjIndex(NULL, searchPath, 0, &first);
+
+    return Tcl_GetString(first);
 }
 
 /*
@@ -450,20 +712,28 @@ Tcl_GetDefaultEncodingDir()
  *
  * Tcl_SetDefaultEncodingDir --
  *
+ * 	Legacy public interface to set the first directory in the encoding
+ * 	search path.
  *
  * Results:
+ * 	None.
  *
  * Side effects:
+ * 	Modifies the encoding search path.
  *
  *-------------------------------------------------------------------------
  */
 
 void
-Tcl_SetDefaultEncodingDir(path)
-    CONST char *path;
+Tcl_SetDefaultEncodingDir(
+    const char *path)
 {
-    tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
-    strcpy(tclDefaultEncodingDir, path);
+    Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
+    Tcl_Obj *directory = Tcl_NewStringObj(path, -1);
+
+    searchPath = Tcl_DuplicateObj(searchPath);
+    Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
+    Tcl_SetEncodingSearchPath(searchPath);
 }
 
 /*
@@ -472,29 +742,29 @@ Tcl_SetDefaultEncodingDir(path)
  * Tcl_GetEncoding --
  *
  *	Given the name of a encoding, find the corresponding Tcl_Encoding
- *	token.  If the encoding did not already exist, Tcl attempts to
+ *	token. If the encoding did not already exist, Tcl attempts to
  *	dynamically load an encoding by that name.
  *
  * Results:
- *	Returns a token that represents the encoding.  If the name didn't
- *	refer to any known or loadable encoding, NULL is returned.  If
- *	NULL was returned, an error message is left in interp's result
- *	object, unless interp was NULL.
+ *	Returns a token that represents the encoding. If the name didn't refer
+ *	to any known or loadable encoding, NULL is returned. If NULL was
+ *	returned, an error message is left in interp's result object, unless
+ *	interp was NULL.
  *
  * Side effects:
  *	The new encoding type is entered into a table visible to all
- *	interpreters, keyed off the encoding's name.  For each call to
- *	this procedure, there should eventually be a call to
- *	Tcl_FreeEncoding, so that the database can be cleaned up when
- *	encodings aren't needed anymore.
+ *	interpreters, keyed off the encoding's name. For each call to this
+ *	function, there should eventually be a call to Tcl_FreeEncoding, so
+ *	that the database can be cleaned up when encodings aren't needed
+ *	anymore.
  *
  *-------------------------------------------------------------------------
  */
 
 Tcl_Encoding
-Tcl_GetEncoding(interp, name)
-    Tcl_Interp *interp;		/* Interp for error reporting, if not NULL. */
-    CONST char *name;		/* The name of the desired encoding. */
+Tcl_GetEncoding(
+    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
+    const char *name)		/* The name of the desired encoding. */
 {
     Tcl_HashEntry *hPtr;
     Encoding *encodingPtr;
@@ -515,6 +785,7 @@ Tcl_GetEncoding(interp, name)
 	return (Tcl_Encoding) encodingPtr;
     }
     Tcl_MutexUnlock(&encodingMutex);
+
     return LoadEncodingFile(interp, name);
 }
 
@@ -523,22 +794,22 @@ Tcl_GetEncoding(interp, name)
  *
  * Tcl_FreeEncoding --
  *
- *	This procedure is called to release an encoding allocated by
+ *	This function is called to release an encoding allocated by
  *	Tcl_CreateEncoding() or Tcl_GetEncoding().
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The reference count associated with the encoding is decremented
- *	and the encoding may be deleted if nothing is using it anymore.
+ *	The reference count associated with the encoding is decremented and
+ *	the encoding may be deleted if nothing is using it anymore.
  *
  *---------------------------------------------------------------------------
  */
 
 void
-Tcl_FreeEncoding(encoding)
-    Tcl_Encoding encoding;
+Tcl_FreeEncoding(
+    Tcl_Encoding encoding)
 {
     Tcl_MutexLock(&encodingMutex);
     FreeEncoding(encoding);
@@ -550,25 +821,25 @@ Tcl_FreeEncoding(encoding)
  *
  * FreeEncoding --
  *
- *	This procedure is called to release an encoding by procedures
- *	that already have the encodingMutex.
+ *	This function is called to release an encoding by functions that
+ *	already have the encodingMutex.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The reference count associated with the encoding is decremented
- *	and the encoding may be deleted if nothing is using it anymore.
+ *	The reference count associated with the encoding is decremented and
+ *	the encoding may be deleted if nothing is using it anymore.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeEncoding(encoding)
-    Tcl_Encoding encoding;
+FreeEncoding(
+    Tcl_Encoding encoding)
 {
     Encoding *encodingPtr;
-    
+
     encodingPtr = (Encoding *) encoding;
     if (encodingPtr == NULL) {
 	return;
@@ -594,8 +865,8 @@ FreeEncoding(encoding)
  *
  * Tcl_GetEncodingName --
  *
- *	Given an encoding, return the name that was used to constuct
- *	the encoding.
+ *	Given an encoding, return the name that was used to constuct the
+ *	encoding.
  *
  * Results:
  *	The name of the encoding.
@@ -606,17 +877,15 @@ FreeEncoding(encoding)
  *---------------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetEncodingName(encoding)
-    Tcl_Encoding encoding;	/* The encoding whose name to fetch. */
+const char *
+Tcl_GetEncodingName(
+    Tcl_Encoding encoding)	/* The encoding whose name to fetch. */
 {
-    Encoding *encodingPtr;
-
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
-    encodingPtr = (Encoding *) encoding;
-    return encodingPtr->name;
+
+    return ((Encoding *) encoding)->name;
 }
 
 /*
@@ -624,8 +893,8 @@ Tcl_GetEncodingName(encoding)
  *
  * Tcl_GetEncodingNames --
  *
- *	Get the list of all known encodings, including the ones stored
- *	as files on disk in the encoding path.
+ *	Get the list of all known encodings, including the ones stored as
+ *	files on disk in the encoding path.
  *
  * Results:
  *	Modifies interp's result object to hold a list of all the available
@@ -638,102 +907,53 @@ Tcl_GetEncodingName(encoding)
  */
 
 void
-Tcl_GetEncodingNames(interp)
-    Tcl_Interp *interp;		/* Interp to hold result. */
+Tcl_GetEncodingNames(
+    Tcl_Interp *interp)		/* Interp to hold result. */
 {
+    Tcl_HashTable table;
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
-    Tcl_Obj *pathPtr, *resultPtr;
-    int dummy;
+    Tcl_Obj *map, *name, *result = Tcl_NewObj();
+    Tcl_DictSearch mapSearch;
+    int dummy, done = 0;
 
-    Tcl_HashTable table;
+    Tcl_InitObjHashTable(&table);
+
+    /*
+     * Copy encoding names from loaded encoding table to table.
+     */
 
     Tcl_MutexLock(&encodingMutex);
-    Tcl_InitHashTable(&table, TCL_STRING_KEYS);
-    hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
-    while (hPtr != NULL) {
-	Encoding *encodingPtr;
-	
-	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
-	Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
-	hPtr = Tcl_NextHashEntry(&search);
+    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&search)) {
+	Encoding *encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+	Tcl_CreateHashEntry(&table,
+		(char *) Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
     }
     Tcl_MutexUnlock(&encodingMutex);
 
-    pathPtr = TclGetLibraryPath();
-    if (pathPtr != NULL) {
-	int i, objc;
-	Tcl_Obj **objv;
-	char globArgString[10];
-	Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
-	Tcl_IncrRefCount(encodingObj);
-	
-	objc = 0;
-	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
-
-	for (i = 0; i < objc; i++) {
-	    Tcl_Obj *searchIn;
-	    
-	    /* 
-	     * Construct the path from the element of pathPtr,
-	     * joined with 'encoding'.
-	     */
-	    searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
-	    Tcl_IncrRefCount(searchIn);
-	    Tcl_ResetResult(interp);
+    FillEncodingFileMap();
+    map = TclGetProcessGlobalValue(&encodingFileMap);
 
-	    /*
-	     * TclGlob() changes the contents of globArgString, which causes
-	     * a segfault if we pass in a pointer to non-writeable memory.
-	     * TclGlob() puts its results directly into interp.
-	     */
+    /*
+     * Copy encoding names from encoding file map to table.
+     */
 
-	    strcpy(globArgString, "*.enc");
-	    /* 
-	     * The GLOBMODE_TAILS flag returns just the tail of each file
-	     * which is the encoding name with a .enc extension 
-	     */
-	    if ((TclGlob(interp, globArgString, searchIn, 
-			 TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
-		int objc2 = 0;
-		Tcl_Obj **objv2;
-		int j;
-
-		Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
-			&objv2);
-
-		for (j = 0; j < objc2; j++) {
-		    int length;
-		    char *string;
-		    string = Tcl_GetStringFromObj(objv2[j], &length);
-		    length -= 4;
-		    if (length > 0) {
-			string[length] = '\0';
-			Tcl_CreateHashEntry(&table, string, &dummy);
-			string[length] = '.';
-		    }
-		}
-	    }
-	    Tcl_DecrRefCount(searchIn);
-	}
-	Tcl_DecrRefCount(encodingObj);
+    Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
+    for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
+	Tcl_CreateHashEntry(&table, (char *) name, &dummy);
     }
 
     /*
-     * Clear any values placed in the result by globbing.
+     * Pull all encoding names from table into the result list.
      */
 
-    Tcl_ResetResult(interp);
-    resultPtr = Tcl_GetObjResult(interp);
-
-    hPtr = Tcl_FirstHashEntry(&table, &search);
-    while (hPtr != NULL) {
-	Tcl_Obj *strPtr;
-
-	strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&table, hPtr), -1);
-	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
-	hPtr = Tcl_NextHashEntry(&search);
+    for (hPtr = Tcl_FirstHashEntry(&table, &search); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_ListObjAppendElement(NULL, result,
+		(Tcl_Obj *) Tcl_GetHashKey(&table, hPtr));
     }
+    Tcl_SetObjResult(interp, result);
     Tcl_DeleteHashTable(&table);
 }
 
@@ -742,29 +962,29 @@ Tcl_GetEncodingNames(interp)
  *
  * Tcl_SetSystemEncoding --
  *
- *	Sets the default encoding that should be used whenever the user
- *	passes a NULL value in to one of the conversion routines.
- *	If the supplied name is NULL, the system encoding is reset to the
- *	default system encoding.
+ *	Sets the default encoding that should be used whenever the user passes
+ *	a NULL value in to one of the conversion routines. If the supplied
+ *	name is NULL, the system encoding is reset to the default system
+ *	encoding.
  *
  * Results:
- *	The return value is TCL_OK if the system encoding was successfully
- *	set to the encoding specified by name, TCL_ERROR otherwise.  If
- *	TCL_ERROR is returned, an error message is left in interp's result
- *	object, unless interp was NULL.
+ *	The return value is TCL_OK if the system encoding was successfully set
+ *	to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR
+ *	is returned, an error message is left in interp's result object,
+ *	unless interp was NULL.
  *
  * Side effects:
- *	The reference count of the new system encoding is incremented.
- *	The reference count of the old system encoding is decremented and 
- *	it may be freed.  
+ *	The reference count of the new system encoding is incremented. The
+ *	reference count of the old system encoding is decremented and it may
+ *	be freed.
  *
  *------------------------------------------------------------------------
  */
 
 int
-Tcl_SetSystemEncoding(interp, name)
-    Tcl_Interp *interp;		/* Interp for error reporting, if not NULL. */
-    CONST char *name;		/* The name of the desired encoding, or NULL/""
+Tcl_SetSystemEncoding(
+    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
+    const char *name)		/* The name of the desired encoding, or NULL/""
 				 * to reset to default encoding. */
 {
     Tcl_Encoding encoding;
@@ -796,50 +1016,51 @@ Tcl_SetSystemEncoding(interp, name)
  *
  * Tcl_CreateEncoding --
  *
- *	This procedure is called to define a new encoding and the procedures
- *	that are used to convert between the specified encoding and Unicode.  
+ *	This function is called to define a new encoding and the functions
+ *	that are used to convert between the specified encoding and Unicode.
  *
  * Results:
- *	Returns a token that represents the encoding.  If an encoding with
- *	the same name already existed, the old encoding token remains
- *	valid and continues to behave as it used to, and will eventually
- *	be garbage collected when the last reference to it goes away.  Any
- *	subsequent calls to Tcl_GetEncoding with the specified name will
- *	retrieve the most recent encoding token.
+ *	Returns a token that represents the encoding. If an encoding with the
+ *	same name already existed, the old encoding token remains valid and
+ *	continues to behave as it used to, and will eventually be garbage
+ *	collected when the last reference to it goes away. Any subsequent
+ *	calls to Tcl_GetEncoding with the specified name will retrieve the
+ *	most recent encoding token.
  *
  * Side effects:
  *	The new encoding type is entered into a table visible to all
- *	interpreters, keyed off the encoding's name.  For each call to
- *	this procedure, there should eventually be a call to
- *	Tcl_FreeEncoding, so that the database can be cleaned up when
- *	encodings aren't needed anymore.
+ *	interpreters, keyed off the encoding's name. For each call to this
+ *	function, there should eventually be a call to Tcl_FreeEncoding, so
+ *	that the database can be cleaned up when encodings aren't needed
+ *	anymore.
  *
  *---------------------------------------------------------------------------
- */ 
+ */
 
 Tcl_Encoding
-Tcl_CreateEncoding(typePtr)
-    Tcl_EncodingType *typePtr;	/* The encoding type. */
+Tcl_CreateEncoding(
+    const Tcl_EncodingType *typePtr)
+				/* The encoding type. */
 {
     Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
     Encoding *encodingPtr;
     char *name;
 
     Tcl_MutexLock(&encodingMutex);
-    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
-    if (new == 0) {
+    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
+    if (isNew == 0) {
 	/*
-	 * Remove old encoding from hash table, but don't delete it until
-	 * last reference goes away.
+	 * Remove old encoding from hash table, but don't delete it until last
+	 * reference goes away.
 	 */
-	 
+
 	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
 	encodingPtr->hPtr = NULL;
     }
 
     name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
-    
+
     encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
     encodingPtr->name		= strcpy(name, typePtr->encodingName);
     encodingPtr->toUtfProc	= typePtr->toUtfProc;
@@ -866,15 +1087,15 @@ Tcl_CreateEncoding(typePtr)
  *
  * Tcl_ExternalToUtfDString --
  *
- *	Convert a source buffer from the specified encoding into UTF-8.
- *	If any of the bytes in the source buffer are invalid or cannot
- *	be represented in the target encoding, a default fallback
- *	character will be substituted.
+ *	Convert a source buffer from the specified encoding into UTF-8. If any
+ *	of the bytes in the source buffer are invalid or cannot be represented
+ *	in the target encoding, a default fallback character will be
+ *	substituted.
  *
  * Results:
  *	The converted bytes are stored in the DString, which is then NULL
- *	terminated.  The return value is a pointer to the value stored 
- *	in the DString.
+ *	terminated. The return value is a pointer to the value stored in the
+ *	DString.
  *
  * Side effects:
  *	None.
@@ -882,15 +1103,15 @@ Tcl_CreateEncoding(typePtr)
  *-------------------------------------------------------------------------
  */
 
-char * 
-Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
-    Tcl_Encoding encoding;	/* The encoding for the source string, or
-				 * NULL for the default system encoding. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes, or < 0 for
+char *
+Tcl_ExternalToUtfDString(
+    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
+				 * for the default system encoding. */
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes, or < 0 for
 				 * encoding-specific string length. */
-    Tcl_DString *dstPtr;	/* Uninitialized or free DString in which 
-				 * the converted string is stored. */
+    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
+				 * converted string is stored. */
 {
     char *dst;
     Tcl_EncodingState state;
@@ -900,7 +1121,7 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
     Tcl_DStringInit(dstPtr);
     dst = Tcl_DStringValue(dstPtr);
     dstLen = dstPtr->spaceAvl - 1;
-    
+
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -911,16 +1132,20 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
     } else if (srcLen < 0) {
 	srcLen = (*encodingPtr->lengthProc)(src);
     }
+
     flags = TCL_ENCODING_START | TCL_ENCODING_END;
+
     while (1) {
 	result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
 		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
 		&dstChars);
 	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+
 	if (result != TCL_CONVERT_NOSPACE) {
 	    Tcl_DStringSetLength(dstPtr, soFar);
 	    return Tcl_DStringValue(dstPtr);
 	}
+
 	flags &= ~TCL_ENCODING_START;
 	src += srcRead;
 	srcLen -= srcRead;
@@ -942,50 +1167,49 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
  *
  * Results:
  *	The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
- *	TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
- *	as documented in tcl.h.
+ *	TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE, as
+ *	documented in tcl.h.
  *
  * Side effects:
- *	The converted bytes are stored in the output buffer.  
+ *	The converted bytes are stored in the output buffer.
  *
  *-------------------------------------------------------------------------
  */
 
 int
-Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
-	dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
-    Tcl_Interp *interp;		/* Interp for error return, if not NULL. */
-    Tcl_Encoding encoding;	/* The encoding for the source string, or
-				 * NULL for the default system encoding. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes, or < 0 for
+Tcl_ExternalToUtf(
+    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
+    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
+				 * for the default system encoding. */
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes, or < 0 for
 				 * encoding-specific string length. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
     Encoding *encodingPtr;
     int result, srcRead, dstWrote, dstChars;
     Tcl_EncodingState state;
-    
+
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -1012,8 +1236,8 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
 
     /*
      * If there are any null characters in the middle of the buffer, they will
-     * converted to the UTF-8 null character (\xC080).  To get the actual 
-     * \0 at the end of the destination buffer, we need to append it manually.
+     * converted to the UTF-8 null character (\xC080). To get the actual \0 at
+     * the end of the destination buffer, we need to append it manually.
      */
 
     dstLen--;
@@ -1021,6 +1245,7 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
 	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
 	    dstCharsPtr);
     dst[*dstWrotePtr] = '\0';
+
     return result;
 }
 
@@ -1029,15 +1254,15 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
  *
  * Tcl_UtfToExternalDString --
  *
- *	Convert a source buffer from UTF-8 into the specified encoding.
- *	If any of the bytes in the source buffer are invalid or cannot
- *	be represented in the target encoding, a default fallback
- *	character will be substituted.
+ *	Convert a source buffer from UTF-8 into the specified encoding. If any
+ *	of the bytes in the source buffer are invalid or cannot be represented
+ *	in the target encoding, a default fallback character will be
+ *	substituted.
  *
  * Results:
- *	The converted bytes are stored in the DString, which is then
- *	NULL terminated in an encoding-specific manner.  The return value 
- *	is a pointer to the value stored in the DString.
+ *	The converted bytes are stored in the DString, which is then NULL
+ *	terminated in an encoding-specific manner. The return value is a
+ *	pointer to the value stored in the DString.
  *
  * Side effects:
  *	None.
@@ -1046,20 +1271,20 @@ Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
  */
 
 char *
-Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
-    Tcl_Encoding encoding;	/* The encoding for the converted string,
-				 * or NULL for the default system encoding. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes, or < 0 for
+Tcl_UtfToExternalDString(
+    Tcl_Encoding encoding,	/* The encoding for the converted string, or
+				 * NULL for the default system encoding. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes, or < 0 for
 				 * strlen(). */
-    Tcl_DString *dstPtr;	/* Uninitialized or free DString in which 
-				 * the converted string is stored. */
+    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
+				 * converted string is stored. */
 {
     char *dst;
     Tcl_EncodingState state;
     Encoding *encodingPtr;
     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
-    
+
     Tcl_DStringInit(dstPtr);
     dst = Tcl_DStringValue(dstPtr);
     dstLen = dstPtr->spaceAvl - 1;
@@ -1080,13 +1305,15 @@ Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
 		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
 		&dstChars);
 	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+
 	if (result != TCL_CONVERT_NOSPACE) {
 	    if (encodingPtr->nullSize == 2) {
-	        Tcl_DStringSetLength(dstPtr, soFar + 1);
+		Tcl_DStringSetLength(dstPtr, soFar + 1);
 	    }
 	    Tcl_DStringSetLength(dstPtr, soFar);
 	    return Tcl_DStringValue(dstPtr);
 	}
+
 	flags &= ~TCL_ENCODING_START;
 	src += srcRead;
 	srcLen -= srcRead;
@@ -1108,50 +1335,49 @@ Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
  *
  * Results:
  *	The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
- *	TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
- *	as documented in tcl.h.
+ *	TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE, as
+ *	documented in tcl.h.
  *
  * Side effects:
- *	The converted bytes are stored in the output buffer.  
+ *	The converted bytes are stored in the output buffer.
  *
  *-------------------------------------------------------------------------
  */
 
 int
-Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
-	dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
-    Tcl_Interp *interp;		/* Interp for error return, if not NULL. */
-    Tcl_Encoding encoding;	/* The encoding for the converted string,
-				 * or NULL for the default system encoding. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes, or < 0 for
+Tcl_UtfToExternal(
+    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
+    Tcl_Encoding encoding,	/* The encoding for the converted string, or
+				 * NULL for the default system encoding. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes, or < 0 for
 				 * strlen(). */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
+    char *dst,			/* Output buffer in which converted string
 				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
     Encoding *encodingPtr;
     int result, srcRead, dstWrote, dstChars;
     Tcl_EncodingState state;
-    
+
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -1184,7 +1410,7 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
 	dst[*dstWrotePtr + 1] = '\0';
     }
     dst[*dstWrotePtr] = '\0';
-    
+
     return result;
 }
 
@@ -1193,78 +1419,142 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
  *
  * Tcl_FindExecutable --
  *
- *	This procedure computes the absolute path name of the current
+ *	This function computes the absolute path name of the current
  *	application, given its argv[0] value.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The variable tclExecutableName gets filled in with the file
- *	name for the application, if we figured it out.  If we couldn't
- *	figure it out, tclExecutableName is set to NULL.
+ *	The absolute pathname for the application is computed and stored to be
+ *	returned later be [info nameofexecutable].
  *
  *---------------------------------------------------------------------------
  */
 
 void
-Tcl_FindExecutable(argv0)
-    CONST char *argv0;		/* The value of the application's argv[0]
+Tcl_FindExecutable(
+    const char *argv0)		/* The value of the application's argv[0]
 				 * (native). */
 {
-    int mustCleanUtf;
-    CONST char *name;
-    Tcl_DString buffer, nameString;
+    TclInitSubsystems();
+    TclpSetInitialEncodings();
+    TclpFindExecutable(argv0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * OpenEncodingFileChannel --
+ *
+ *	Open the file believed to hold data for the encoding, "name".
+ *
+ * Results:
+ * 	Returns the readable Tcl_Channel from opening the file, or NULL if the
+ * 	file could not be successfully opened. If NULL was returned, an error
+ * 	message is left in interp's result object, unless interp was NULL.
+ *
+ * Side effects:
+ *	Channel may be opened. Information about the filesystem may be cached
+ *	to speed later calls.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+OpenEncodingFileChannel(
+    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
+    const char *name)		/* The name of the encoding file on disk and
+				 * also the name for new encoding. */
+{
+    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
+    Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
+    Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
+    Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
+    Tcl_Obj **dir, *path, *directory = NULL;
+    Tcl_Channel chan = NULL;
+    int i, numDirs;
+
+    Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir);
+    Tcl_IncrRefCount(nameObj);
+    Tcl_AppendToObj(fileNameObj, ".enc", -1);
+    Tcl_IncrRefCount(fileNameObj);
+    Tcl_DictObjGet(NULL, map, nameObj, &directory);
 
-    TclInitSubsystems(argv0);
+    /*
+     * Check that any cached directory is still on the encoding search path.
+     */
 
-    if (argv0 == NULL) {
-	goto done;
-    }
-    if (tclExecutableName != NULL) {
-	ckfree(tclExecutableName);
-	tclExecutableName = NULL;
+    if (NULL != directory) {
+	int verified = 0;
+
+	for (i=0; i<numDirs && !verified; i++) {
+	    if (dir[i] == directory) {
+		verified = 1;
+	    }
+	}
+	if (!verified) {
+	    const char *dirString = Tcl_GetString(directory);
+	    for (i=0; i<numDirs && !verified; i++) {
+		if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
+		    verified = 1;
+		}
+	    }
+	}
+	if (!verified) {
+	    /*
+	     * Directory no longer on the search path. Remove from cache.
+	     */
+
+	    map = Tcl_DuplicateObj(map);
+	    Tcl_DictObjRemove(NULL, map, nameObj);
+	    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+	    directory = NULL;
+	}
     }
-    if ((name = TclpFindExecutable(argv0)) == NULL) {
-	goto done;
+
+    if (NULL != directory) {
+	/*
+	 * Got a directory from the cache. Try to use it first.
+	 */
+
+	Tcl_IncrRefCount(directory);
+	path = Tcl_FSJoinToPath(directory, 1, &fileNameObj);
+	Tcl_IncrRefCount(path);
+	Tcl_DecrRefCount(directory);
+	chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+	Tcl_DecrRefCount(path);
     }
 
     /*
-     * The value returned from TclpNameOfExecutable is a UTF string that
-     * is possibly dirty depending on when it was initialized.
-     * TclFindEncodings will indicate whether we must "clean" the UTF (as
-     * reported by the underlying system).  To assure that the UTF string
-     * is a properly encoded native string for this system, convert the
-     * UTF string to the default native encoding before the default
-     * encoding is initialized.  Then, convert it back to UTF after the
-     * system encoding is loaded.
+     * Scan the search path until we find it.
      */
-    
-    Tcl_UtfToExternalDString(NULL, name, -1, &buffer);
-    mustCleanUtf = TclFindEncodings(argv0);
 
-    /*
-     * Now it is OK to convert the native string back to UTF and set
-     * the value of the tclExecutableName.
-     */
-    
-    if (mustCleanUtf) {
-	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1,
-		&nameString);
-	tclExecutableName = (char *)
-	    ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
-	strcpy(tclExecutableName, Tcl_DStringValue(&nameString));
-
-	Tcl_DStringFree(&nameString);
-    } else {
-	tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
-	strcpy(tclExecutableName, name);
-    }
-    Tcl_DStringFree(&buffer);
-    return;
-	
-    done:
-    (void) TclFindEncodings(argv0);
+    for (i=0; i<numDirs && (chan == NULL); i++) {
+	path = Tcl_FSJoinToPath(dir[i], 1, &fileNameObj);
+	Tcl_IncrRefCount(path);
+	chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+	Tcl_DecrRefCount(path);
+	if (chan != NULL) {
+	    /*
+	     * Save directory in the cache.
+	     */
+
+	    map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
+	    Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
+	    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+	}
+    }
+
+    if ((NULL == chan) && (interp != NULL)) {
+	Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
+    }
+    Tcl_DecrRefCount(fileNameObj);
+    Tcl_DecrRefCount(nameObj);
+    Tcl_DecrRefCount(searchPath);
+
+    return chan;
 }
 
 /*
@@ -1272,50 +1562,34 @@ Tcl_FindExecutable(argv0)
  *
  * LoadEncodingFile --
  *
- *	Read a file that describes an encoding and create a new Encoding
- *	from the data.  
+ *	Read a file that describes an encoding and create a new Encoding from
+ *	the data.
  *
  * Results:
- *	The return value is the newly loaded Encoding, or NULL if
- *	the file didn't exist of was in the incorrect format.  If NULL was
- *	returned, an error message is left in interp's result object,
- *	unless interp was NULL.
+ *	The return value is the newly loaded Encoding, or NULL if the file
+ *	didn't exist of was in the incorrect format. If NULL was returned, an
+ *	error message is left in interp's result object, unless interp was
+ *	NULL.
  *
  * Side effects:
- *	File read from disk.  
+ *	File read from disk.
  *
  *---------------------------------------------------------------------------
  */
 
 static Tcl_Encoding
-LoadEncodingFile(interp, name)
-    Tcl_Interp *interp;		/* Interp for error reporting, if not NULL. */
-    CONST char *name;		/* The name of the encoding file on disk
-				 * and also the name for new encoding. */
+LoadEncodingFile(
+    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
+    const char *name)		/* The name of the encoding file on disk and
+				 * also the name for new encoding. */
 {
-    int objc, i, ch;
-    Tcl_Obj **objv;
-    Tcl_Obj *pathPtr;
-    Tcl_Channel chan;
-    Tcl_Encoding encoding;
-
-    pathPtr = TclGetLibraryPath();
-    if (pathPtr == NULL) {
-	goto unknown;
-    }
-    objc = 0;
-    Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
-
-    chan = NULL;
-    for (i = 0; i < objc; i++) {
-	chan = OpenEncodingFile(Tcl_GetString(objv[i]), name);
-	if (chan != NULL) {
-	    break;
-	}
-    }
+    Tcl_Channel chan = NULL;
+    Tcl_Encoding encoding = NULL;
+    int ch;
 
+    chan = OpenEncodingFileChannel(interp, name);
     if (chan == NULL) {
-	goto unknown;
+	return NULL;
     }
 
     Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
@@ -1332,89 +1606,26 @@ LoadEncodingFile(interp, name)
 	}
     }
 
-    encoding = NULL;
     switch (ch) {
-	case 'S': {
-	    encoding = LoadTableEncoding(interp, name, ENCODING_SINGLEBYTE,
-		    chan);
-	    break;
-	}
-	case 'D': {
-	    encoding = LoadTableEncoding(interp, name, ENCODING_DOUBLEBYTE,
-		    chan);
-	    break;
-	}
-	case 'M': {
-	    encoding = LoadTableEncoding(interp, name, ENCODING_MULTIBYTE,
-		    chan);
-	    break;
-	}
-	case 'E': {
-	    encoding = LoadEscapeEncoding(name, chan);
-	    break;
-	}
+    case 'S':
+	encoding = LoadTableEncoding(name, ENCODING_SINGLEBYTE, chan);
+	break;
+    case 'D':
+	encoding = LoadTableEncoding(name, ENCODING_DOUBLEBYTE, chan);
+	break;
+    case 'M':
+	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
+	break;
+    case 'E':
+	encoding = LoadEscapeEncoding(name, chan);
+	break;
     }
     if ((encoding == NULL) && (interp != NULL)) {
 	Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
-	if (ch == 'E') {
-	    Tcl_AppendResult(interp, " or missing sub-encoding", NULL);
-	}
     }
     Tcl_Close(NULL, chan);
-    return encoding;
-
-    unknown:
-    if (interp != NULL) {
-	Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
-    }
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * OpenEncodingFile --
- *
- *	Look for the file encoding/<name>.enc in the specified
- *	directory.
- *
- * Results:
- *	Returns an open file channel if the file exists.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-static Tcl_Channel
-OpenEncodingFile(dir, name)
-    CONST char *dir;
-    CONST char *name;
-
-{
-    CONST char *argv[3];
-    Tcl_DString pathString;
-    CONST char *path;
-    Tcl_Channel chan;
-    Tcl_Obj *pathPtr;
-    
-    argv[0] = dir;
-    argv[1] = "encoding";
-    argv[2] = name;
-
-    Tcl_DStringInit(&pathString);
-    Tcl_JoinPath(3, argv, &pathString);
-    path = Tcl_DStringAppend(&pathString, ".enc", -1);
-    pathPtr = Tcl_NewStringObj(path,-1);
-
-    Tcl_IncrRefCount(pathPtr);
-    chan = Tcl_FSOpenFileChannel(NULL, pathPtr, "r", 0);
-    Tcl_DecrRefCount(pathPtr);
-
-    Tcl_DStringFree(&pathString);
-
-    return chan;
+    return encoding;
 }
 
 /*
@@ -1422,17 +1633,17 @@ OpenEncodingFile(dir, name)
  *
  * LoadTableEncoding --
  *
- *	Helper function for LoadEncodingTable().  Loads a table to that 
- *	converts between Unicode and some other encoding and creates an 
+ *	Helper function for LoadEncodingTable(). Loads a table to that
+ *	converts between Unicode and some other encoding and creates an
  *	encoding (using a TableEncoding structure) from that information.
  *
- *	File contains binary data, but begins with a marker to indicate 
- *	byte-ordering, so that same binary file can be read on either
- *	endian platforms.
+ *	File contains binary data, but begins with a marker to indicate
+ *	byte-ordering, so that same binary file can be read on either endian
+ *	platforms.
  *
  * Results:
- *	The return value is the new encoding, or NULL if the encoding 
- *	could not be created (because the file contained invalid data).
+ *	The return value is the new encoding, or NULL if the encoding could
+ *	not be created (because the file contained invalid data).
  *
  * Side effects:
  *	None.
@@ -1441,11 +1652,10 @@ OpenEncodingFile(dir, name)
  */
 
 static Tcl_Encoding
-LoadTableEncoding(interp, name, type, chan)
-    Tcl_Interp *interp;		/* Interp for temporary obj while reading. */
-    CONST char *name;		/* Name for new encoding. */
-    int type;			/* Type of encoding (ENCODING_?????). */
-    Tcl_Channel chan;		/* File containing new encoding. */
+LoadTableEncoding(
+    const char *name,		/* Name for new encoding. */
+    int type,			/* Type of encoding (ENCODING_?????). */
+    Tcl_Channel chan)		/* File containing new encoding. */
 {
     Tcl_DString lineString;
     Tcl_Obj *objPtr;
@@ -1462,7 +1672,7 @@ LoadTableEncoding(interp, name, type, chan)
      * sequences in the encoding files.
      */
 
-    static CONST char staticHex[] = {
+    static const char staticHex[] = {
       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*   0 ...  15 */
       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  16 ...  31 */
       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  32 ...  47 */
@@ -1507,9 +1717,9 @@ LoadTableEncoding(interp, name, type, chan)
     dataPtr->fallback = fallback;
 
     /*
-     * Read the table that maps characters to Unicode.  Performs a single
-     * malloc to get the memory for the array and all the pages needed by
-     * the array.
+     * Read the table that maps characters to Unicode. Performs a single
+     * malloc to get the memory for the array and all the pages needed by the
+     * array.
      */
 
     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
@@ -1517,26 +1727,23 @@ LoadTableEncoding(interp, name, type, chan)
     memset(dataPtr->toUnicode, 0, size);
     pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
 
-    if (interp == NULL) {
-	objPtr = Tcl_NewObj();
-    } else {
-	objPtr = Tcl_GetObjResult(interp);
-    }
+    TclNewObj(objPtr);
+    Tcl_IncrRefCount(objPtr);
     for (i = 0; i < numPages; i++) {
 	int ch;
 	char *p;
 
 	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
 	p = Tcl_GetString(objPtr);
-	hi = (staticHex[(unsigned int)p[0]] << 4) + staticHex[(unsigned int)p[1]];
+	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
 	dataPtr->toUnicode[hi] = pageMemPtr;
 	p += 2;
 	for (lo = 0; lo < 256; lo++) {
 	    if ((lo & 0x0f) == 0) {
 		p++;
 	    }
-	    ch = (staticHex[(unsigned int)p[0]] << 12) + (staticHex[(unsigned int)p[1]] << 8)
-		+ (staticHex[(unsigned int)p[2]] << 4) + staticHex[(unsigned int)p[3]];
+	    ch = (staticHex[UCHAR(p[0])] << 12) + (staticHex[UCHAR(p[1])] << 8)
+		    + (staticHex[UCHAR(p[2])] << 4) + staticHex[UCHAR(p[3])];
 	    if (ch != 0) {
 		used[ch >> 8] = 1;
 	    }
@@ -1545,12 +1752,8 @@ LoadTableEncoding(interp, name, type, chan)
 	    p += 4;
 	}
     }
-    if (interp == NULL) {
-	Tcl_DecrRefCount(objPtr);
-    } else {
-	Tcl_ResetResult(interp);
-    }
-	
+    TclDecrRefCount(objPtr);
+
     if (type == ENCODING_DOUBLEBYTE) {
 	memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes));
     } else {
@@ -1562,10 +1765,10 @@ LoadTableEncoding(interp, name, type, chan)
     }
 
     /*
-     * Invert toUnicode array to produce the fromUnicode array.  Performs a
-     * single malloc to get the memory for the array and all the pages
-     * needed by the array.  While reading in the toUnicode array, we
-     * remembered what pages that would be needed for the fromUnicode array.
+     * Invert toUnicode array to produce the fromUnicode array. Performs a
+     * single malloc to get the memory for the array and all the pages needed
+     * by the array. While reading in the toUnicode array, we remembered what
+     * pages that would be needed for the fromUnicode array.
      */
 
     if (symbol) {
@@ -1592,7 +1795,7 @@ LoadTableEncoding(interp, name, type, chan)
 		ch = dataPtr->toUnicode[hi][lo];
 		if (ch != 0) {
 		    unsigned short *page;
-		    
+
 		    page = dataPtr->fromUnicode[ch >> 8];
 		    if (page == NULL) {
 			page = pageMemPtr;
@@ -1607,7 +1810,7 @@ LoadTableEncoding(interp, name, type, chan)
     if (type == ENCODING_MULTIBYTE) {
 	/*
 	 * If multibyte encodings don't have a backslash character, define
-	 * one.  Otherwise, on Windows, native file names won't work because
+	 * one. Otherwise, on Windows, native file names won't work because
 	 * the backslash in the file name will map to the unknown character
 	 * (question mark) when converting from UTF-8 to external encoding.
 	 */
@@ -1620,16 +1823,15 @@ LoadTableEncoding(interp, name, type, chan)
     }
     if (symbol) {
 	unsigned short *page;
-	
+
 	/*
 	 * Make a special symbol encoding that not only maps the symbol
 	 * characters from their Unicode code points down into page 0, but
-	 * also ensure that the characters on page 0 map to themselves.
-	 * This is so that a symbol font can be used to display a simple
-	 * string like "abcd" and have alpha, beta, chi, delta show up,
-	 * rather than have "unknown" chars show up because strictly
-	 * speaking the symbol font doesn't have glyphs for those low ascii
-	 * chars.
+	 * also ensure that the characters on page 0 map to themselves. This
+	 * is so that a symbol font can be used to display a simple string
+	 * like "abcd" and have alpha, beta, chi, delta show up, rather than
+	 * have "unknown" chars show up because strictly speaking the symbol
+	 * font doesn't have glyphs for those low ascii chars.
 	 */
 
 	page = dataPtr->fromUnicode[0];
@@ -1648,15 +1850,23 @@ LoadTableEncoding(interp, name, type, chan)
 	    dataPtr->fromUnicode[hi] = emptyPage;
 	}
     }
+
     /*
-     * For trailing 'R'everse encoding, see [Patch #689341]
+     * For trailing 'R'everse encoding, see [Patch 689341]
      */
+
     Tcl_DStringInit(&lineString);
     do {
 	int len;
-	/* skip leading empty lines */
-	while ((len = Tcl_Gets(chan, &lineString)) == 0)
-	    ;
+
+	/*
+	 * Skip leading empty lines.
+	 */
+
+	while ((len = Tcl_Gets(chan, &lineString)) == 0) {
+	    /* empty body */
+	}
+
 	if (len < 0) {
 	    break;
 	}
@@ -1665,16 +1875,17 @@ LoadTableEncoding(interp, name, type, chan)
 	    break;
 	}
 	for (Tcl_DStringSetLength(&lineString, 0);
-	     (len = Tcl_Gets(chan, &lineString)) >= 0;
-	     Tcl_DStringSetLength(&lineString, 0)) {
+		(len = Tcl_Gets(chan, &lineString)) >= 0;
+		Tcl_DStringSetLength(&lineString, 0)) {
 	    unsigned char* p;
 	    int to, from;
+
 	    if (len < 5) {
 		continue;
 	    }
 	    p = (unsigned char*) Tcl_DStringValue(&lineString);
 	    to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
-		+ (staticHex[p[2]] << 4) + staticHex[p[3]];
+		    + (staticHex[p[2]] << 4) + staticHex[p[3]];
 	    if (to == 0) {
 	    	continue;
 	    }
@@ -1696,6 +1907,7 @@ LoadTableEncoding(interp, name, type, chan)
     encType.freeProc	    = TableFreeProc;
     encType.nullSize	    = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
     encType.clientData	    = (ClientData) dataPtr;
+
     return Tcl_CreateEncoding(&encType);
 }
 
@@ -1704,16 +1916,16 @@ LoadTableEncoding(interp, name, type, chan)
  *
  * LoadEscapeEncoding --
  *
- *	Helper function for LoadEncodingTable().  Loads a state machine
- *	that converts between Unicode and some other encoding.  
+ *	Helper function for LoadEncodingTable(). Loads a state machine that
+ *	converts between Unicode and some other encoding.
  *
- *	File contains text data that describes the escape sequences that
- *	are used to choose an encoding and the associated names for the 
+ *	File contains text data that describes the escape sequences that are
+ *	used to choose an encoding and the associated names for the
  *	sub-encodings.
  *
  * Results:
- *	The return value is the new encoding, or NULL if the encoding 
- *	could not be created (because the file contained invalid data).
+ *	The return value is the new encoding, or NULL if the encoding could
+ *	not be created (because the file contained invalid data).
  *
  * Side effects:
  *	None.
@@ -1722,11 +1934,11 @@ LoadTableEncoding(interp, name, type, chan)
  */
 
 static Tcl_Encoding
-LoadEscapeEncoding(name, chan)
-    CONST char *name;		/* Name for new encoding. */
-    Tcl_Channel chan;		/* File containing new encoding. */
+LoadEscapeEncoding(
+    const char *name,		/* Name for new encoding. */
+    Tcl_Channel chan)		/* File containing new encoding. */
 {
-    int i, missingSubEncoding = 0;
+    int i;
     unsigned int size;
     Tcl_DString escapeData;
     char init[16], final[16];
@@ -1739,21 +1951,21 @@ LoadEscapeEncoding(name, chan)
 
     while (1) {
 	int argc;
-	CONST char **argv;
+	const char **argv;
 	char *line;
 	Tcl_DString lineString;
-	
+
 	Tcl_DStringInit(&lineString);
 	if (Tcl_Gets(chan, &lineString) < 0) {
 	    break;
 	}
 	line = Tcl_DStringValue(&lineString);
-        if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
+	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
 	    continue;
 	}
 	if (argc >= 2) {
 	    if (strcmp(argv[0], "name") == 0) {
-		;
+		/* do nothing */
 	    } else if (strcmp(argv[0], "init") == 0) {
 		strncpy(init, argv[1], sizeof(init));
 		init[sizeof(init) - 1] = '\0';
@@ -1762,6 +1974,7 @@ LoadEscapeEncoding(name, chan)
 		final[sizeof(final) - 1] = '\0';
 	    } else {
 		EscapeSubTable est;
+		Encoding *e;
 
 		strncpy(est.sequence, argv[1], sizeof(est.sequence));
 		est.sequence[sizeof(est.sequence) - 1] = '\0';
@@ -1771,36 +1984,33 @@ LoadEscapeEncoding(name, chan)
 		est.name[sizeof(est.name) - 1] = '\0';
 
 		/*
-		 * Load the subencodings first so we're never stuck
-		 * trying to use a half-loaded system encoding to
-		 * open/read a *.enc file.
+		 * To avoid infinite recursion in [encoding system iso2022-*]
 		 */
 
-		est.encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, est.name);
-		if ((est.encodingPtr == NULL) 
-			|| (est.encodingPtr->toUtfProc != TableToUtfProc)) {
-		    missingSubEncoding = 1;
+		e = (Encoding *) Tcl_GetEncoding(NULL, est.name);
+		if (e && e->toUtfProc != TableToUtfProc &&
+			e->toUtfProc != Iso88591ToUtfProc) {
+		   Tcl_FreeEncoding((Tcl_Encoding) e);
+		   e = NULL;
 		}
+		est.encodingPtr = e;
 		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
 	    }
 	}
 	ckfree((char *) argv);
 	Tcl_DStringFree(&lineString);
     }
-    if (missingSubEncoding) {
-	Tcl_DStringFree(&escapeData);
-	return NULL;
-    }
 
-    size = sizeof(EscapeEncodingData)
-	    - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData);
+    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
+	    + Tcl_DStringLength(&escapeData);
     dataPtr = (EscapeEncodingData *) ckalloc(size);
     dataPtr->initLen = strlen(init);
     strcpy(dataPtr->init, init);
     dataPtr->finalLen = strlen(final);
     strcpy(dataPtr->final, final);
-    dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
-    memcpy((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
+    dataPtr->numSubTables =
+	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
+    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
 	    (size_t) Tcl_DStringLength(&escapeData));
     Tcl_DStringFree(&escapeData);
 
@@ -1830,9 +2040,9 @@ LoadEscapeEncoding(name, chan)
  *
  * BinaryProc --
  *
- *	The default conversion when no other conversion is specified.
- *	No translation is done; source bytes are copied directly to 
- *	destination bytes.
+ *	The default conversion when no other conversion is specified. No
+ *	translation is done; source bytes are copied directly to destination
+ *	bytes.
  *
  * Results:
  *	Returns TCL_OK if conversion was successful.
@@ -1844,27 +2054,26 @@ LoadEscapeEncoding(name, chan)
  */
 
 static int
-BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* Not used. */
-    CONST char *src;		/* Source string (unknown encoding). */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+BinaryProc(
+    ClientData clientData,	/* Not used. */
+    const char *src,		/* Source string (unknown encoding). */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
+    int *srcReadPtr,		/* Filled with the number of bytes from the
 				 * source string that were converted. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
@@ -1883,18 +2092,17 @@ BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     *srcReadPtr = srcLen;
     *dstWrotePtr = srcLen;
     *dstCharsPtr = srcLen;
-    memcpy((void *) dst, (void *) src, (size_t) srcLen);
+    memcpy(dst, src, (size_t) srcLen);
     return result;
 }
 
-
 /*
  *-------------------------------------------------------------------------
  *
  * UtfExtToUtfIntProc --
  *
- *	Convert from UTF-8 to UTF-8. While converting null-bytes from
- *	the Tcl's internal representation (0xc0, 0x80) to the official
+ *	Convert from UTF-8 to UTF-8. While converting null-bytes from the
+ *	Tcl's internal representation (0xc0, 0x80) to the official
  *	representation (0x00). See UtfToUtfProc for details.
  *
  * Results:
@@ -1905,36 +2113,36 @@ BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  *-------------------------------------------------------------------------
  */
-static int 
-UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	     srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* Not used. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+
+static int
+UtfIntToUtfExtProc(
+    ClientData clientData,	/* Not used. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
+    char *dst,			/* Output buffer in which converted string
 				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-			srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
+	    srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
 }
 
 /*
@@ -1942,9 +2150,9 @@ UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  * UtfExtToUtfIntProc --
  *
- *	Convert from UTF-8 to UTF-8 while converting null-bytes from
- *	the official representation (0x00) to Tcl's internal
- *	representation (0xc0, 0x80). See UtfToUtfProc for details.
+ *	Convert from UTF-8 to UTF-8 while converting null-bytes from the
+ *	official representation (0x00) to Tcl's internal representation (0xc0,
+ *	0x80). See UtfToUtfProc for details.
  *
  * Results:
  *	Returns TCL_OK if conversion was successful.
@@ -1954,36 +2162,35 @@ UtfIntToUtfExtProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  *-------------------------------------------------------------------------
  */
-static int 
-UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	     srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* Not used. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+static int
+UtfExtToUtfIntProc(
+    ClientData clientData,	/* Not used. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-			srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
+	    srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
 }
 
 /*
@@ -1991,9 +2198,9 @@ UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  * UtfToUtfProc --
  *
- *	Convert from UTF-8 to UTF-8.  Note that the UTF-8 to UTF-8 
- *	translation is not a no-op, because it will turn a stream of
- *	improperly formed UTF-8 into a properly formed stream.
+ *	Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
+ *	is not a no-op, because it will turn a stream of improperly formed
+ *	UTF-8 into a properly formed stream.
  *
  * Results:
  *	Returns TCL_OK if conversion was successful.
@@ -2004,45 +2211,43 @@ UtfExtToUtfIntProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	     srcReadPtr, dstWrotePtr, dstCharsPtr, pureNullMode)
-    ClientData clientData;	/* Not used. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+static int
+UtfToUtfProc(
+    ClientData clientData,	/* Not used. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr,		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
-    int pureNullMode;		/* Convert embedded nulls from
-				 * internal representation to real
-				 * null-bytes or vice versa */
-
+    int pureNullMode)		/* Convert embedded nulls from internal
+				 * representation to real null-bytes or vice
+				 * versa. */
 {
-    CONST char *srcStart, *srcEnd, *srcClose;
+    const char *srcStart, *srcEnd, *srcClose;
     char *dstStart, *dstEnd;
     int result, numChars;
     Tcl_UniChar ch;
 
     result = TCL_OK;
-    
+
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2067,26 +2272,26 @@ UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	if (UCHAR(*src) < 0x80 &&
-	    !(UCHAR(*src) == 0 && pureNullMode == 0)) {
+	if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
 	    /*
-	     * Copy 7bit chatacters, but skip null-bytes when we are
-	     * in input mode, so that they get converted to 0xc080.
+	     * Copy 7bit chatacters, but skip null-bytes when we are in input
+	     * mode, so that they get converted to 0xc080.
 	     */
+
 	    *dst++ = *src++;
-	} else if (pureNullMode == 1 &&
-		   UCHAR(*src) == 0xc0 &&
-		   UCHAR(*(src+1)) == 0x80) {
-	    /* 
+	} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
+		UCHAR(*(src+1)) == 0x80) {
+	    /*
 	     * Convert 0xc080 to real nulls when we are in output mode.
 	     */
+
 	    *dst++ = 0;
 	    src += 2;
 	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
-	    /* Always check before using Tcl_UtfToUniChar. Not doing
-	     * can so cause it run beyond the endof the buffer!  If we
-	     * happen such an incomplete char its bytes are made to
-	     * represent themselves.
+	    /*
+	     * Always check before using Tcl_UtfToUniChar. Not doing can so
+	     * cause it run beyond the endof the buffer! If we happen such an
+	     * incomplete char its byts are made to represent themselves.
 	     */
 
 	    ch = (unsigned char) *src;
@@ -2098,7 +2303,7 @@ UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	}
     }
 
-    *srcReadPtr  = src - srcStart;
+    *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
     return result;
@@ -2120,35 +2325,34 @@ UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* Not used. */
-    CONST char *src;		/* Source string in Unicode. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+static int
+UnicodeToUtfProc(
+    ClientData clientData,	/* Not used. */
+    const char *src,		/* Source string in Unicode. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    CONST char *srcStart, *srcEnd;
+    const char *srcStart, *srcEnd;
     char *dstEnd, *dstStart;
     int result, numChars;
     Tcl_UniChar ch;
@@ -2206,35 +2410,35 @@ UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* TableEncodingData that specifies encoding. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+static int
+UtfToUnicodeProc(
+    ClientData clientData,	/* TableEncodingData that specifies
+				 * encoding. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    CONST char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
+    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
     int result, numChars;
     Tcl_UniChar ch;
 
@@ -2300,43 +2504,42 @@ UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* TableEncodingData that specifies
+static int
+TableToUtfProc(
+    ClientData clientData,	/* TableEncodingData that specifies
 				 * encoding. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    CONST char *srcStart, *srcEnd;
+    const char *srcStart, *srcEnd;
     char *dstEnd, *dstStart, *prefixBytes;
     int result, byte, numChars;
     Tcl_UniChar ch;
     unsigned short **toUnicode;
     unsigned short *pageZero;
     TableEncodingData *dataPtr;
-    
+
     srcStart = src;
     srcEnd = src + srcLen;
 
@@ -2350,10 +2553,10 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 
     result = TCL_OK;
     for (numChars = 0; src < srcEnd; numChars++) {
-        if (dst > dstEnd) {
-            result = TCL_CONVERT_NOSPACE;
-            break;
-        }
+	if (dst > dstEnd) {
+	    result = TCL_CONVERT_NOSPACE;
+	    break;
+	}
 	byte = *((unsigned char *) src);
 	if (prefixBytes[byte]) {
 	    src++;
@@ -2384,8 +2587,9 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	} else {
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	}
-        src++;
+	src++;
     }
+
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -2409,48 +2613,47 @@ TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* TableEncodingData that specifies
+static int
+TableFromUtfProc(
+    ClientData clientData,	/* TableEncodingData that specifies
 				 * encoding. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    CONST char *srcStart, *srcEnd, *srcClose;
+    const char *srcStart, *srcEnd, *srcClose;
     char *dstStart, *dstEnd, *prefixBytes;
     Tcl_UniChar ch;
     int result, len, word, numChars;
     TableEncodingData *dataPtr;
     unsigned short **fromUnicode;
-    
-    result = TCL_OK;    
+
+    result = TCL_OK;
 
     dataPtr = (TableEncodingData *) clientData;
     prefixBytes = dataPtr->prefixBytes;
     fromUnicode = dataPtr->fromUnicode;
-    
+
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2475,9 +2678,10 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 
 #if TCL_UTF_MAX > 3
 	/*
-	 * This prevents a crash condition.  More evaluation is required
-	 * for full support of int Tcl_UniChar. [Bug 1004065]
+	 * This prevents a crash condition. More evaluation is required for
+	 * full support of int Tcl_UniChar. [Bug 1004065]
 	 */
+
 	if (ch & 0xffff0000) {
 	    word = 0;
 	} else
@@ -2489,7 +2693,7 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 		result = TCL_CONVERT_UNKNOWN;
 		break;
 	    }
-	    word = dataPtr->fallback; 
+	    word = dataPtr->fallback;
 	}
 	if (prefixBytes[(word >> 8)] != 0) {
 	    if (dst + 1 > dstEnd) {
@@ -2506,9 +2710,194 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    }
 	    dst[0] = (char) word;
 	    dst++;
-	} 
+	}
+	src += len;
+    }
+
+    *srcReadPtr = src - srcStart;
+    *dstWrotePtr = dst - dstStart;
+    *dstCharsPtr = numChars;
+    return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Iso88591ToUtfProc --
+ *
+ *	Convert from the "iso8859-1" encoding into UTF-8.
+ *
+ * Results:
+ *	Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Iso88591ToUtfProc(
+    ClientData clientData,	/* Ignored. */
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
+				 * initialized and/or reset by conversion
+				 * routine under control of flags argument. */
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
+				 * bytes. */
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
+				 * stored in the output buffer as a result of
+				 * the conversion. */
+    int *dstCharsPtr)		/* Filled with the number of characters that
+				 * correspond to the bytes stored in the
+				 * output buffer. */
+{
+    const char *srcStart, *srcEnd;
+    char *dstEnd, *dstStart;
+    int result, numChars;
+
+    srcStart = src;
+    srcEnd = src + srcLen;
+
+    dstStart = dst;
+    dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+    result = TCL_OK;
+    for (numChars = 0; src < srcEnd; numChars++) {
+	Tcl_UniChar ch;
+
+	if (dst > dstEnd) {
+	    result = TCL_CONVERT_NOSPACE;
+	    break;
+	}
+	ch = (Tcl_UniChar) *((unsigned char *) src);
+	/*
+	 * Special case for 1-byte utf chars for speed.
+	 */
+	if (ch && ch < 0x80) {
+	    *dst++ = (char) ch;
+	} else {
+	    dst += Tcl_UniCharToUtf(ch, dst);
+	}
+	src++;
+    }
+
+    *srcReadPtr = src - srcStart;
+    *dstWrotePtr = dst - dstStart;
+    *dstCharsPtr = numChars;
+    return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Iso88591FromUtfProc --
+ *
+ *	Convert from UTF-8 into the encoding "iso8859-1".
+ *
+ * Results:
+ *	Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Iso88591FromUtfProc(
+    ClientData clientData,	/* Ignored. */
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
+				 * initialized and/or reset by conversion
+				 * routine under control of flags argument. */
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
+				 * bytes. */
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
+				 * stored in the output buffer as a result of
+				 * the conversion. */
+    int *dstCharsPtr)		/* Filled with the number of characters that
+				 * correspond to the bytes stored in the
+				 * output buffer. */
+{
+    const char *srcStart, *srcEnd, *srcClose;
+    char *dstStart, *dstEnd;
+    int result, numChars;
+
+    result = TCL_OK;
+
+    srcStart = src;
+    srcEnd = src + srcLen;
+    srcClose = srcEnd;
+    if ((flags & TCL_ENCODING_END) == 0) {
+	srcClose -= TCL_UTF_MAX;
+    }
+
+    dstStart = dst;
+    dstEnd = dst + dstLen - 1;
+
+    for (numChars = 0; src < srcEnd; numChars++) {
+	Tcl_UniChar ch;
+	int len;
+
+	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+	    /*
+	     * If there is more string to follow, this will ensure that the
+	     * last UTF-8 character in the source buffer hasn't been cut off.
+	     */
+
+	    result = TCL_CONVERT_MULTIBYTE;
+	    break;
+	}
+	len = TclUtfToUniChar(src, &ch);
+
+	/*
+	 * Check for illegal characters.
+	 */
+
+	if (ch > 0xff) {
+	    if (flags & TCL_ENCODING_STOPONERROR) {
+		result = TCL_CONVERT_UNKNOWN;
+		break;
+	    }
+
+	    /*
+	     * Plunge on, using '?' as a fallback character.
+	     */
+
+	    ch = (Tcl_UniChar) '?';
+	}
+
+	if (dst > dstEnd) {
+	    result = TCL_CONVERT_NOSPACE;
+	    break;
+	}
+	*(dst++) = (char) ch;
 	src += len;
     }
+
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -2520,8 +2909,8 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  * TableFreeProc --
  *
- *	This procedure is invoked when an encoding is deleted.  It deletes
- *	the memory used by the TableEncodingData.
+ *	This function is invoked when an encoding is deleted. It deletes the
+ *	memory used by the TableEncodingData.
  *
  * Results:
  *	None.
@@ -2533,14 +2922,14 @@ TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  */
 
 static void
-TableFreeProc(clientData)
-    ClientData clientData;	/* TableEncodingData that specifies
+TableFreeProc(
+    ClientData clientData)	/* TableEncodingData that specifies
 				 * encoding. */
 {
     TableEncodingData *dataPtr;
 
     /*
-     * Make sure we aren't freeing twice on shutdown.  [Bug #219314]
+     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
      */
 
     dataPtr = (TableEncodingData *) clientData;
@@ -2566,32 +2955,31 @@ TableFreeProc(clientData)
  *-------------------------------------------------------------------------
  */
 
-static int 
-EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* EscapeEncodingData that specifies
+static int
+EscapeToUtfProc(
+    ClientData clientData,	/* EscapeEncodingData that specifies
 				 * encoding. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
@@ -2600,7 +2988,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     unsigned short **tableToUnicode;
     Encoding *encodingPtr;
     int state, result, numChars;
-    CONST char *srcStart, *srcEnd;
+    const char *srcStart, *srcEnd;
     char *dstStart, *dstEnd;
 
     result = TCL_OK;
@@ -2618,7 +3006,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    state = (int) *statePtr;
+    state = PTR2INT(*statePtr);
     if (flags & TCL_ENCODING_START) {
 	state = 0;
     }
@@ -2626,54 +3014,56 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     for (numChars = 0; src < srcEnd; ) {
 	int byte, hi, lo, ch;
 
-        if (dst > dstEnd) {
-            result = TCL_CONVERT_NOSPACE;
-            break;
-        }
+	if (dst > dstEnd) {
+	    result = TCL_CONVERT_NOSPACE;
+	    break;
+	}
 	byte = *((unsigned char *) src);
 	if (prefixBytes[byte]) {
 	    unsigned int left, len, longest;
 	    int checked, i;
 	    EscapeSubTable *subTablePtr;
-	    
+
 	    /*
-	     * Saw the beginning of an escape sequence. 
+	     * Saw the beginning of an escape sequence.
 	     */
-	     
+
 	    left = srcEnd - src;
 	    len = dataPtr->initLen;
 	    longest = len;
 	    checked = 0;
+
 	    if (len <= left) {
 		checked++;
-		if ((len > 0) && 
-			(memcmp(src, dataPtr->init, len) == 0)) {
+		if ((len > 0) && (memcmp(src, dataPtr->init, len) == 0)) {
 		    /*
 		     * If we see initialization string, skip it, even if we're
-		     * not at the beginning of the buffer. 
+		     * not at the beginning of the buffer.
 		     */
-		     
+
 		    src += len;
 		    continue;
 		}
 	    }
+
 	    len = dataPtr->finalLen;
 	    if (len > longest) {
 		longest = len;
 	    }
+
 	    if (len <= left) {
 		checked++;
-		if ((len > 0) && 
-			(memcmp(src, dataPtr->final, len) == 0)) {
+		if ((len > 0) && (memcmp(src, dataPtr->final, len) == 0)) {
 		    /*
 		     * If we see finalization string, skip it, even if we're
-		     * not at the end of the buffer. 
+		     * not at the end of the buffer.
 		     */
-		     
+
 		    src += len;
 		    continue;
 		}
 	    }
+
 	    subTablePtr = dataPtr->subTables;
 	    for (i = 0; i < dataPtr->numSubTables; i++) {
 		len = subTablePtr->sequenceLen;
@@ -2682,7 +3072,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 		}
 		if (len <= left) {
 		    checked++;
-		    if ((len > 0) && 
+		    if ((len > 0) &&
 			    (memcmp(src, subTablePtr->sequence, len) == 0)) {
 			state = i;
 			encodingPtr = NULL;
@@ -2693,6 +3083,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 		}
 		subTablePtr++;
 	    }
+
 	    if (subTablePtr == NULL) {
 		/*
 		 * A match was found, the escape sequence was consumed, and
@@ -2703,9 +3094,9 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    }
 
 	    /*
-	     * We have a split-up or unrecognized escape sequence.  If we
-	     * checked all the sequences, then it's a syntax error,
-	     * otherwise we need more bytes to determine a match.
+	     * We have a split-up or unrecognized escape sequence. If we
+	     * checked all the sequences, then it's a syntax error, otherwise
+	     * we need more bytes to determine a match.
 	     */
 
 	    if ((checked == dataPtr->numSubTables + 2)
@@ -2733,6 +3124,7 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    tablePrefixBytes = tableDataPtr->prefixBytes;
 	    tableToUnicode = tableDataPtr->toUnicode;
 	}
+
 	if (tablePrefixBytes[byte]) {
 	    src++;
 	    if (src >= srcEnd) {
@@ -2746,13 +3138,14 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    hi = 0;
 	    lo = byte;
 	}
+
 	ch = tableToUnicode[hi][lo];
 	dst += Tcl_UniCharToUtf(ch, dst);
 	src++;
 	numChars++;
     }
 
-    *statePtr = (Tcl_EncodingState) state;
+    *statePtr = (Tcl_EncodingState) INT2PTR(state);
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -2776,45 +3169,44 @@ EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *-------------------------------------------------------------------------
  */
 
-static int 
-EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* EscapeEncodingData that specifies
+static int
+EscapeFromUtfProc(
+    ClientData clientData,	/* EscapeEncodingData that specifies
 				 * encoding. */
-    CONST char *src;		/* Source string in UTF-8. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
-				 * state information used during a piecewise
-				 * conversion.  Contents of statePtr are
+    const char *src,		/* Source string in UTF-8. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
+				 * information used during a piecewise
+				 * conversion. Contents of statePtr are
 				 * initialized and/or reset by conversion
 				 * routine under control of flags argument. */
-    char *dst;			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen;			/* The maximum length of output buffer in
+    char *dst,			/* Output buffer in which converted string is
+				 * stored. */
+    int dstLen,			/* The maximum length of output buffer in
 				 * bytes. */
-    int *srcReadPtr;		/* Filled with the number of bytes from the
-				 * source string that were converted.  This
-				 * may be less than the original source length
-				 * if there was a problem converting some
-				 * source characters. */
-    int *dstWrotePtr;		/* Filled with the number of bytes that were
+    int *srcReadPtr,		/* Filled with the number of bytes from the
+				 * source string that were converted. This may
+				 * be less than the original source length if
+				 * there was a problem converting some source
+				 * characters. */
+    int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr;		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
     EscapeEncodingData *dataPtr;
     Encoding *encodingPtr;
-    CONST char *srcStart, *srcEnd, *srcClose;
+    const char *srcStart, *srcEnd, *srcClose;
     char *dstStart, *dstEnd;
     int state, result, numChars;
     TableEncodingData *tableDataPtr;
     char *tablePrefixBytes;
     unsigned short **tableFromUnicode;
-    
-    result = TCL_OK;    
+
+    result = TCL_OK;
 
     dataPtr = (EscapeEncodingData *) clientData;
 
@@ -2830,7 +3222,7 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 
     /*
      * RFC1468 states that the text starts in ASCII, and switches to Japanese
-     * characters, and that the text must end in ASCII. [Patch #474358]
+     * characters, and that the text must end in ASCII. [Patch 474358]
      */
 
     if (flags & TCL_ENCODING_START) {
@@ -2840,11 +3232,10 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    *dstWrotePtr = 0;
 	    return TCL_CONVERT_NOSPACE;
 	}
-	memcpy((VOID *) dst, (VOID *) dataPtr->init,
-		(size_t) dataPtr->initLen);
+	memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen);
 	dst += dataPtr->initLen;
     } else {
-        state = (int) *statePtr;
+	state = PTR2INT(*statePtr);
     }
 
     encodingPtr = GetTableEncoding(dataPtr, state);
@@ -2856,7 +3247,7 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	unsigned int len;
 	int word;
 	Tcl_UniChar ch;
-	
+
 	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
 	    /*
 	     * If there is more string to follow, this will ensure that the
@@ -2872,7 +3263,7 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	if ((word == 0) && (ch != 0)) {
 	    int oldState;
 	    EscapeSubTable *subTablePtr;
-	    
+
 	    oldState = state;
 	    for (state = 0; state < dataPtr->numSubTables; state++) {
 		encodingPtr = GetTableEncoding(dataPtr, state);
@@ -2892,16 +3283,17 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 		encodingPtr = GetTableEncoding(dataPtr, state);
 		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
 		word = tableDataPtr->fallback;
-	    } 
-	    
+	    }
+
 	    tablePrefixBytes = tableDataPtr->prefixBytes;
 	    tableFromUnicode = tableDataPtr->fromUnicode;
 
 	    /*
 	     * The state variable has the value of oldState when word is 0.
-	     * In this case, the escape sequense should not be copied to dst 
+	     * In this case, the escape sequense should not be copied to dst
 	     * because the current character set is not changed.
 	     */
+
 	    if (state != oldState) {
 		subTablePtr = &dataPtr->subTables[state];
 		if ((dst + subTablePtr->sequenceLen) > dstEnd) {
@@ -2911,11 +3303,12 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 		     * variable because this escape sequence must be written
 		     * in the next conversion.
 		     */
+
 		    state = oldState;
 		    result = TCL_CONVERT_NOSPACE;
 		    break;
 		}
-		memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
+		memcpy(dst, subTablePtr->sequence,
 			(size_t) subTablePtr->sequenceLen);
 		dst += subTablePtr->sequenceLen;
 	    }
@@ -2936,14 +3329,13 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    }
 	    dst[0] = (char) word;
 	    dst++;
-	} 
+	}
 	src += len;
     }
 
     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
 	unsigned int len = dataPtr->subTables[0].sequenceLen;
 	/*
-	 * [Bug 1516109].
 	 * Certain encodings like iso2022-jp need to write
 	 * an escape sequence after all characters have
 	 * been converted. This logic checks that enough
@@ -2957,18 +3349,16 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
 	    result = TCL_CONVERT_NOSPACE;
 	} else {
 	    if (state) {
-		memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
-			(size_t) len);
+		memcpy(dst, dataPtr->subTables[0].sequence, (size_t) len);
 		dst += len;
 	    }
-	    memcpy((VOID *) dst, (VOID *) dataPtr->final,
-		    (size_t) dataPtr->finalLen);
+	    memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
 	    dst += dataPtr->finalLen;
 	    state &= ~TCL_ENCODING_END;
 	}
     }
 
-    *statePtr = (Tcl_EncodingState) state;
+    *statePtr = (Tcl_EncodingState) INT2PTR(state);
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -2980,8 +3370,8 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  *
  * EscapeFreeProc --
  *
- *	This procedure is invoked when an EscapeEncodingData encoding is 
- *	deleted.  It deletes the memory used by the encoding.
+ *	This function is invoked when an EscapeEncodingData encoding is
+ *	deleted. It deletes the memory used by the encoding.
  *
  * Results:
  *	None.
@@ -2993,8 +3383,9 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
  */
 
 static void
-EscapeFreeProc(clientData)
-    ClientData clientData;	/* EscapeEncodingData that specifies encoding. */
+EscapeFreeProc(
+    ClientData clientData)	/* EscapeEncodingData that specifies
+				 * encoding. */
 {
     EscapeEncodingData *dataPtr;
     EscapeSubTable *subTablePtr;
@@ -3030,7 +3421,7 @@ EscapeFreeProc(clientData)
  *
  * GetTableEncoding --
  *
- *	Helper function for the EscapeEncodingData conversions.  Gets the
+ *	Helper function for the EscapeEncodingData conversions. Gets the
  *	encoding (of type TextEncodingData) that represents the specified
  *	state.
  *
@@ -3038,36 +3429,34 @@ EscapeFreeProc(clientData)
  *	The return value is the encoding.
  *
  * Side effects:
- *	If the encoding that represents the specified state has not
- *	already been used by this EscapeEncoding, it will be loaded
- *	and cached in the dataPtr.
+ *	If the encoding that represents the specified state has not already
+ *	been used by this EscapeEncoding, it will be loaded and cached in the
+ *	dataPtr.
  *
  *---------------------------------------------------------------------------
  */
 
 static Encoding *
-GetTableEncoding(dataPtr, state)
-    EscapeEncodingData *dataPtr;/* Contains names of encodings. */
-    int state;			/* Index in dataPtr of desired Encoding. */
+GetTableEncoding(
+    EscapeEncodingData *dataPtr,/* Contains names of encodings. */
+    int state)			/* Index in dataPtr of desired Encoding. */
 {
     EscapeSubTable *subTablePtr;
     Encoding *encodingPtr;
-    
+
     subTablePtr = &dataPtr->subTables[state];
     encodingPtr = subTablePtr->encodingPtr;
+
     if (encodingPtr == NULL) {
-	/*
-	 * Now that escape encodings load their sub-encodings first, and
-	 * fail to load if any sub-encodings are missing, this branch should
-	 * never happen.  
-	 */
 	encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
-	if ((encodingPtr == NULL) 
-		|| (encodingPtr->toUtfProc != TableToUtfProc)) {
-	    panic("EscapeToUtfProc: invalid sub table");
+	if ((encodingPtr == NULL)
+		|| (encodingPtr->toUtfProc != TableToUtfProc
+		&& encodingPtr->toUtfProc != Iso88591ToUtfProc)) {
+	    Tcl_Panic("EscapeToUtfProc: invalid sub table");
 	}
 	subTablePtr->encodingPtr = encodingPtr;
     }
+
     return encodingPtr;
 }
 
@@ -3076,9 +3465,9 @@ GetTableEncoding(dataPtr, state)
  *
  * unilen --
  *
- *	A helper function for the Tcl_ExternalToUtf functions.  This
- *	function is similar to strlen for double-byte characters: it
- *	returns the number of bytes in a 0x0000 terminated string.
+ *	A helper function for the Tcl_ExternalToUtf functions. This function
+ *	is similar to strlen for double-byte characters: it returns the number
+ *	of bytes in a 0x0000 terminated string.
  *
  * Results:
  *	As above.
@@ -3090,8 +3479,8 @@ GetTableEncoding(dataPtr, state)
  */
 
 static size_t
-unilen(src)
-    CONST char *src;
+unilen(
+    const char *src)
 {
     unsigned short *p;
 
@@ -3105,83 +3494,76 @@ unilen(src)
 /*
  *-------------------------------------------------------------------------
  *
- * TclFindEncodings --
+ * InitializeEncodingSearchPath	--
  *
- *	Find and load the encoding file for this operating system.
- *	Before this is called, Tcl makes assumptions about the
- *	native string representation, but the true encoding is not
- *	assured.
+ *	This is the fallback routine that sets the default value of the
+ *	encoding search path if the application has not set one via a call to
+ *	Tcl_SetEncodingSearchPath() by the first time the search path is needed
+ *	to load encoding data.
+ *
+ *	The default encoding search path is produced by taking each directory
+ *	in the library path, appending a subdirectory named "encoding", and if
+ *	the resulting directory exists, adding it to the encoding search path.
  *
  * Results:
- *	Return result of TclpInitLibraryPath, which reports whether the
- *	path is clean (0) or dirty (1) UTF.
+ *	None.
  *
  * Side effects:
- *	Varied, see the respective initialization routines.
+ *	Sets the encoding search path to an initial value.
  *
  *-------------------------------------------------------------------------
  */
 
-static int
-TclFindEncodings(argv0)
-    CONST char *argv0;		/* Name of executable from argv[0] to main()
-				 * in native multi-byte encoding. */
+static void
+InitializeEncodingSearchPath(
+    char **valuePtr,
+    int *lengthPtr,
+    Tcl_Encoding *encodingPtr)
 {
-    int mustCleanUtf = 0;
-
-    if (encodingsInitialized == 0) {
-	/* 
-	 * Double check inside the mutex.  There may be calls
-	 * back into this routine from some of the procedures below.
-	 */
-
-	TclpInitLock();
-	if (encodingsInitialized == 0) {
-	    char *native;
-	    Tcl_Obj *pathPtr;
-	    Tcl_DString libPath, buffer;
-
-	    /*
-	     * Have to set this bit here to avoid deadlock with the
-	     * routines below us that call into TclInitSubsystems.
-	     */
-
-	    encodingsInitialized = 1;
-
-	    native = TclpFindExecutable(argv0);
-	    mustCleanUtf = TclpInitLibraryPath(native);
-
-	    /*
-	     * The library path was set in the TclpInitLibraryPath routine.
-	     * The string set is a dirty UTF string.  To preserve the value
-	     * convert the UTF string back to native before setting the new
-	     * default encoding.
-	     */
-
-	    pathPtr = TclGetLibraryPath();
-	    if ((pathPtr != NULL) && mustCleanUtf) {
-		Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
-			&libPath);
-	    }
-
-	    TclpSetInitialEncodings();
-
-	    /*
-	     * Now convert the native string back to UTF.
-	     */
-
-	    if ((pathPtr != NULL) && mustCleanUtf) {
-		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
-			&buffer);
-		pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
-		TclSetLibraryPath(pathPtr);
-
-		Tcl_DStringFree(&libPath);
-		Tcl_DStringFree(&buffer);
-	    }
+    char *bytes;
+    int i, numDirs, numBytes;
+    Tcl_Obj *libPath, *encodingObj, *searchPath;
+
+    TclNewLiteralStringObj(encodingObj, "encoding");
+    TclNewObj(searchPath);
+    Tcl_IncrRefCount(encodingObj);
+    Tcl_IncrRefCount(searchPath);
+    libPath = TclGetLibraryPath();
+    Tcl_IncrRefCount(libPath);
+    Tcl_ListObjLength(NULL, libPath, &numDirs);
+
+    for (i = 0; i < numDirs; i++) {
+	Tcl_Obj *directory, *path;
+	Tcl_StatBuf stat;
+
+	Tcl_ListObjIndex(NULL, libPath, i, &directory);
+	path = Tcl_FSJoinToPath(directory, 1, &encodingObj);
+	Tcl_IncrRefCount(path);
+	if ((0 == Tcl_FSStat(path, &stat)) && S_ISDIR(stat.st_mode)) {
+	    Tcl_ListObjAppendElement(NULL, searchPath, path);
 	}
-	TclpInitUnlock();
+	Tcl_DecrRefCount(path);
+    }
+
+    Tcl_DecrRefCount(libPath);
+    Tcl_DecrRefCount(encodingObj);
+    *encodingPtr = libraryPath.encoding;
+    if (*encodingPtr) {
+	((Encoding *)(*encodingPtr))->refCount++;
     }
+    bytes = Tcl_GetStringFromObj(searchPath, &numBytes);
 
-    return mustCleanUtf;
+    *lengthPtr = numBytes;
+    *valuePtr = ckalloc((unsigned int) numBytes + 1);
+    memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
+    Tcl_DecrRefCount(searchPath);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 7108436..f2395e6 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -1,80 +1,79 @@
 /*
  * tclEnv.c --
  *
- *	Tcl support for environment variables, including a setenv
- *	procedure.  This file contains the generic portion of the
- *	environment module.  It is primarily responsible for keeping
- *	the "env" arrays in sync with the system environment variables.
+ *	Tcl support for environment variables, including a setenv function.
+ *	This file contains the generic portion of the environment module. It
+ *	is primarily responsible for keeping the "env" arrays in sync with the
+ *	system environment variables.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
-TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ */
+TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */
 
-static int cacheSize = 0;	/* Number of env strings in environCache. */
-static char **environCache = NULL;
-				/* Array containing all of the environment
+static struct {
+    int cacheSize;		/* Number of env strings in cache. */
+    char **cache;		/* Array containing all of the environment
 				 * strings that Tcl has allocated. */
-
 #ifndef USE_PUTENV
-static char **ourEnviron = NULL;/* Cache of the array that we allocate.
-				 * We need to track this in case another
+    char **ourEnviron;		/* Cache of the array that we allocate. We
+				 * need to track this in case another
 				 * subsystem swaps around the environ array
-				 * like we do.
-				 */
-static int environSize = 0;	/* Non-zero means that the environ array was
+				 * like we do. */
+    int ourEnvironSize;		/* Non-zero means that the environ array was
 				 * malloced and has this many total entries
 				 * allocated to it (not all may be in use at
-				 * once).  Zero means that the environment
+				 * once). Zero means that the environment
 				 * array is in its original static state. */
 #endif
+} env;
 
 /*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
  */
 
-static char *		EnvTraceProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, CONST char *name1, 
-			    CONST char *name2, int flags));
-static void		ReplaceString _ANSI_ARGS_((CONST char *oldStr,
-			    char *newStr));
-void			TclSetEnv _ANSI_ARGS_((CONST char *name,
-			    CONST char *value));
-void			TclUnsetEnv _ANSI_ARGS_((CONST char *name));
+static char *		EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
+			    const char *name1, const char *name2, int flags);
+static void		ReplaceString(const char *oldStr, char *newStr);
+MODULE_SCOPE void	TclSetEnv(const char *name, const char *value);
+MODULE_SCOPE void	TclUnsetEnv(const char *name);
+
+#if defined(__CYGWIN__)
+    static void TclCygwinPutenv(char *string);
+#   define putenv TclCygwinPutenv
+#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * TclSetupEnv --
  *
- *	This procedure is invoked for an interpreter to make environment
- *	variables accessible from that interpreter via the "env"
- *	associative array.
+ *	This function is invoked for an interpreter to make environment
+ *	variables accessible from that interpreter via the "env" associative
+ *	array.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The interpreter is added to a list of interpreters managed
- *	by us, so that its view of envariables can be kept consistent
- *	with the view in other interpreters.  If this is the first
- *	call to TclSetupEnv, then additional initialization happens,
- *	such as copying the environment to dynamically-allocated space
- *	for ease of management.
+ *	The interpreter is added to a list of interpreters managed by us, so
+ *	that its view of envariables can be kept consistent with the view in
+ *	other interpreters. If this is the first call to TclSetupEnv, then
+ *	additional initialization happens, such as copying the environment to
+ *	dynamically-allocated space for ease of management.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclSetupEnv(interp)
-    Tcl_Interp *interp;		/* Interpreter whose "env" array is to be
+TclSetupEnv(
+    Tcl_Interp *interp)		/* Interpreter whose "env" array is to be
 				 * managed. */
 {
     Tcl_DString envString;
@@ -82,28 +81,27 @@ TclSetupEnv(interp)
     int i;
 
     /*
-     * Synchronize the values in the environ array with the contents
-     * of the Tcl "env" variable.  To do this:
+     * Synchronize the values in the environ array with the contents of the
+     * Tcl "env" variable. To do this:
      *    1) Remove the trace that fires when the "env" var is unset.
      *    2) Unset the "env" variable.
-     *    3) If there are no environ variables, create an empty "env"
-     *       array.  Otherwise populate the array with current values.
+     *    3) If there are no environ variables, create an empty "env" array.
+     *	     Otherwise populate the array with current values.
      *    4) Add a trace that synchronizes the "env" array.
      */
-    
-    Tcl_UntraceVar2(interp, "env", (char *) NULL,
+
+    Tcl_UntraceVar2(interp, "env", NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
-	    (ClientData) NULL);
-    
-    Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 
-    
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
+
+    Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
+
     if (environ[0] == NULL) {
 	Tcl_Obj *varNamePtr;
-	
-	varNamePtr = Tcl_NewStringObj("env", -1);
+
+	TclNewLiteralStringObj(varNamePtr, "env");
 	Tcl_IncrRefCount(varNamePtr);
-	TclArraySet(interp, varNamePtr, NULL);	
+	TclArraySet(interp, varNamePtr, NULL);
 	Tcl_DecrRefCount(varNamePtr);
     } else {
 	Tcl_MutexLock(&envMutex);
@@ -113,23 +111,23 @@ TclSetupEnv(interp)
 	    if (p2 == NULL) {
 		/*
 		 * This condition seem to happen occasionally under some
-		 * versions of Solaris; ignore the entry.
+		 * versions of Solaris, or when encoding accidents swallow the
+		 * '='; ignore the entry.
 		 */
-		
+
 		continue;
 	    }
 	    p2++;
 	    p2[-1] = '\0';
-	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);	
+	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
 	    Tcl_DStringFree(&envString);
 	}
 	Tcl_MutexUnlock(&envMutex);
     }
 
-    Tcl_TraceVar2(interp, "env", (char *) NULL,
+    Tcl_TraceVar2(interp, "env", NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
-	    (ClientData) NULL);
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
 }
 
 /*
@@ -137,12 +135,12 @@ TclSetupEnv(interp)
  *
  * TclSetEnv --
  *
- *	Set an environment variable, replacing an existing value
- *	or creating a new variable if there doesn't exist a variable
- *	by the given name.  This procedure is intended to be a
- *	stand-in for the  UNIX "setenv" procedure so that applications
- *	using that procedure will interface properly to Tcl.  To make
- *	it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
+ *	Set an environment variable, replacing an existing value or creating a
+ *	new variable if there doesn't exist a variable by the given name. This
+ *	function is intended to be a stand-in for the UNIX "setenv" function
+ *	so that applications using that function will interface properly to
+ *	Tcl. To make it a stand-in, the Makefile must define "TclSetEnv" to
+ *	"setenv".
  *
  * Results:
  *	None.
@@ -154,20 +152,20 @@ TclSetupEnv(interp)
  */
 
 void
-TclSetEnv(name, value)
-    CONST char *name;		/* Name of variable whose value is to be
-				 * set (UTF-8). */
-    CONST char *value;		/* New value for variable (UTF-8). */
+TclSetEnv(
+    const char *name,		/* Name of variable whose value is to be set
+				 * (UTF-8). */
+    const char *value)		/* New value for variable (UTF-8). */
 {
     Tcl_DString envString;
     int index, length, nameLength;
     char *p, *oldValue;
-    CONST char *p2;
+    const char *p2;
 
     /*
-     * Figure out where the entry is going to go.  If the name doesn't
-     * already exist, enlarge the array if necessary to make room.  If the
-     * name exists, free its old entry.
+     * Figure out where the entry is going to go. If the name doesn't already
+     * exist, enlarge the array if necessary to make room. If the name exists,
+     * free its old entry.
      */
 
     Tcl_MutexLock(&envMutex);
@@ -177,40 +175,39 @@ TclSetEnv(name, value)
 #ifndef USE_PUTENV
 	/*
 	 * We need to handle the case where the environment may be changed
-	 * outside our control.  environSize is only valid if the current
+	 * outside our control. ourEnvironSize is only valid if the current
 	 * environment is the one we allocated. [Bug 979640]
 	 */
-	if ((ourEnviron != environ) || ((length + 2) > environSize)) {
-	    char **newEnviron;
-
-	    newEnviron = (char **) ckalloc((unsigned)
-		    ((length + 5) * sizeof(char *)));
-	    memcpy((VOID *) newEnviron, (VOID *) environ,
-		    length*sizeof(char *));
-	    if ((environSize != 0) && (ourEnviron != NULL)) {
-		ckfree((char *) ourEnviron);
+
+	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
+	    char **newEnviron = (char **)
+		    ckalloc(((unsigned) length + 5) * sizeof(char *));
+
+	    memcpy(newEnviron, environ, length * sizeof(char *));
+	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
+		ckfree((char *) env.ourEnviron);
 	    }
-	    environ = ourEnviron = newEnviron;
-	    environSize = length + 5;
+	    environ = env.ourEnviron = newEnviron;
+	    env.ourEnvironSize = length + 5;
 	}
 	index = length;
 	environ[index + 1] = NULL;
-#endif
+#endif /* USE_PUTENV */
 	oldValue = NULL;
 	nameLength = strlen(name);
     } else {
-	CONST char *env;
+	const char *env;
 
 	/*
-	 * Compare the new value to the existing value.  If they're
-	 * the same then quit immediately (e.g. don't rewrite the
-	 * value or propagate it to other interpreters).  Otherwise,
-	 * when there are N interpreters there will be N! propagations
-	 * of the same value among the interpreters.
+	 * Compare the new value to the existing value. If they're the same
+	 * then quit immediately (e.g. don't rewrite the value or propagate it
+	 * to other interpreters). Otherwise, when there are N interpreters
+	 * there will be N! propagations of the same value among the
+	 * interpreters.
 	 */
 
 	env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
-	if (strcmp(value, (env + length + 1)) == 0) {
+	if (strcmp(value, env + (length + 1)) == 0) {
 	    Tcl_DStringFree(&envString);
 	    Tcl_MutexUnlock(&envMutex);
 	    return;
@@ -222,12 +219,12 @@ TclSetEnv(name, value)
     }
 
     /*
-     * Create a new entry.  Build a complete UTF string that contains
-     * a "name=value" pattern.  Then convert the string to the native
-     * encoding, and set the environ array value.
+     * Create a new entry. Build a complete UTF string that contains a
+     * "name=value" pattern. Then convert the string to the native encoding,
+     * and set the environ array value.
      */
 
-    p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
+    p = ckalloc((unsigned) nameLength + strlen(value) + 2);
     strcpy(p, name);
     p[nameLength] = '=';
     strcpy(p+nameLength+1, value);
@@ -236,8 +233,8 @@ TclSetEnv(name, value)
     /*
      * Copy the native string to heap memory.
      */
-    
-    p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
+
+    p = ckrealloc(p, strlen(p2) + 1);
     strcpy(p, p2);
     Tcl_DStringFree(&envString);
 
@@ -250,32 +247,35 @@ TclSetEnv(name, value)
     index = TclpFindVariable(name, &length);
 #else
     environ[index] = p;
-#endif
+#endif /* USE_PUTENV */
 
     /*
-     * Watch out for versions of putenv that copy the string (e.g. VC++).
-     * In this case we need to free the string immediately.  Otherwise
-     * update the string in the cache.
+     * Watch out for versions of putenv that copy the string (e.g. VC++). In
+     * this case we need to free the string immediately. Otherwise update the
+     * string in the cache.
      */
 
     if ((index != -1) && (environ[index] == p)) {
 	ReplaceString(oldValue, p);
 #ifdef HAVE_PUTENV_THAT_COPIES
     } else {
-	/* This putenv() copies instead of taking ownership */
+	/*
+	 * This putenv() copies instead of taking ownership.
+	 */
+
 	ckfree(p);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
     }
 
     Tcl_MutexUnlock(&envMutex);
-    
+
     if (!strcmp(name, "HOME")) {
-	/* 
-	 * If the user's home directory has changed, we must invalidate
-	 * the filesystem cache, because '~' expansions will now be
-	 * incorrect.
+	/*
+	 * If the user's home directory has changed, we must invalidate the
+	 * filesystem cache, because '~' expansions will now be incorrect.
 	 */
-        Tcl_FSMountsChanged(NULL);
+
+	Tcl_FSMountsChanged(NULL);
     }
 }
 
@@ -284,44 +284,42 @@ TclSetEnv(name, value)
  *
  * Tcl_PutEnv --
  *
- *	Set an environment variable.  Similar to setenv except that
- *	the information is passed in a single string of the form
- *	NAME=value, rather than as separate name strings.  This procedure
- *	is intended to be a stand-in for the  UNIX "putenv" procedure
- *	so that applications using that procedure will interface
- *	properly to Tcl.  To make it a stand-in, the Makefile will
- *	define "Tcl_PutEnv" to "putenv".
+ *	Set an environment variable. Similar to setenv except that the
+ *	information is passed in a single string of the form NAME=value,
+ *	rather than as separate name strings. This function is intended to be
+ *	a stand-in for the UNIX "putenv" function so that applications using
+ *	that function will interface properly to Tcl. To make it a stand-in,
+ *	the Makefile will define "Tcl_PutEnv" to "putenv".
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The environ array gets updated, as do all of the interpreters
- *	that we manage.
+ *	The environ array gets updated, as do all of the interpreters that we
+ *	manage.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_PutEnv(string)
-    CONST char *string;		/* Info about environment variable in the
-				 * form NAME=value. (native) */
+Tcl_PutEnv(
+    const char *assignment)	/* Info about environment variable in the form
+				 * NAME=value. (native) */
 {
-    Tcl_DString nameString;   
-    CONST char *name;
+    Tcl_DString nameString;
+    const char *name;
     char *value;
 
-    if (string == NULL) {
+    if (assignment == NULL) {
 	return 0;
     }
 
     /*
-     * First convert the native string to UTF.  Then separate the
-     * string into name and value parts, and call TclSetEnv to do
-     * all of the real work.
+     * First convert the native string to UTF. Then separate the string into
+     * name and value parts, and call TclSetEnv to do all of the real work.
      */
 
-    name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
+    name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
     value = strchr(name, '=');
 
     if ((value != NULL) && (value != name)) {
@@ -338,11 +336,10 @@ Tcl_PutEnv(string)
  *
  * TclUnsetEnv --
  *
- *	Remove an environment variable, updating the "env" arrays
- *	in all interpreters managed by us.  This function is intended
- *	to replace the UNIX "unsetenv" function (but to do this the
- *	Makefile must be modified to redefine "TclUnsetEnv" to
- *	"unsetenv".
+ *	Remove an environment variable, updating the "env" arrays in all
+ *	interpreters managed by us. This function is intended to replace the
+ *	UNIX "unsetenv" function (but to do this the Makefile must be modified
+ *	to redefine "TclUnsetEnv" to "unsetenv".
  *
  * Results:
  *	None.
@@ -354,8 +351,8 @@ Tcl_PutEnv(string)
  */
 
 void
-TclUnsetEnv(name)
-    CONST char *name;		/* Name of variable to remove (UTF-8). */
+TclUnsetEnv(
+    const char *name)		/* Name of variable to remove (UTF-8). */
 {
     char *oldValue;
     int length;
@@ -365,20 +362,21 @@ TclUnsetEnv(name)
     char *string;
 #else
     char **envPtr;
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
 
     Tcl_MutexLock(&envMutex);
     index = TclpFindVariable(name, &length);
 
     /*
-     * First make sure that the environment variable exists to avoid
-     * doing needless work and to avoid recursion on the unset.
+     * First make sure that the environment variable exists to avoid doing
+     * needless work and to avoid recursion on the unset.
      */
 
     if (index == -1) {
 	Tcl_MutexUnlock(&envMutex);
 	return;
     }
+
     /*
      * Remember the old value so we can free it if Tcl created the string.
      */
@@ -386,8 +384,8 @@ TclUnsetEnv(name)
     oldValue = environ[index];
 
     /*
-     * Update the system environment.  This must be done before we 
-     * update the interpreters or we will recurse.
+     * Update the system environment. This must be done before we update the
+     * interpreters or we will recurse.
      */
 
 #ifdef USE_PUTENV_FOR_UNSET
@@ -395,39 +393,43 @@ TclUnsetEnv(name)
      * For those platforms that support putenv to unset, Linux indicates
      * that no = should be included, and Windows requires it.
      */
-#ifdef WIN32
-    string = ckalloc((unsigned int) length+2);
-    memcpy((VOID *) string, (VOID *) name, (size_t) length);
+
+#if defined(__WIN32__) || defined(__CYGWIN__)
+    string = ckalloc((unsigned) length+2);
+    memcpy(string, name, (size_t) length);
     string[length] = '=';
     string[length+1] = '\0';
 #else
-    string = ckalloc((unsigned int) length+1);
-    memcpy((VOID *) string, (VOID *) name, (size_t) length);
+    string = ckalloc((unsigned) length+1);
+    memcpy(string, name, (size_t) length);
     string[length] = '\0';
-#endif
+#endif /* WIN32 */
 
     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
-    string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
+    string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
     strcpy(string, Tcl_DStringValue(&envString));
     Tcl_DStringFree(&envString);
 
     putenv(string);
 
     /*
-     * Watch out for versions of putenv that copy the string (e.g. VC++).
-     * In this case we need to free the string immediately.  Otherwise
-     * update the string in the cache.
+     * Watch out for versions of putenv that copy the string (e.g. VC++). In
+     * this case we need to free the string immediately. Otherwise update the
+     * string in the cache.
      */
 
     if (environ[index] == string) {
 	ReplaceString(oldValue, string);
 #ifdef HAVE_PUTENV_THAT_COPIES
     } else {
-	/* This putenv() copies instead of taking ownership */
+	/*
+	 * This putenv() copies instead of taking ownership.
+	 */
+
 	ckfree(string);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
     }
-#else
+#else /* !USE_PUTENV_FOR_UNSET */
     for (envPtr = environ+index+1; ; envPtr++) {
 	envPtr[-1] = *envPtr;
 	if (*envPtr == NULL) {
@@ -435,7 +437,7 @@ TclUnsetEnv(name)
 	}
     }
     ReplaceString(oldValue, NULL);
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
 
     Tcl_MutexUnlock(&envMutex);
 }
@@ -449,10 +451,10 @@ TclUnsetEnv(name)
  *
  * Results:
  *	The result is a pointer to a string specifying the value of the
- *	environment variable, or NULL if that environment variable does
- *	not exist.  Storage for the result string is allocated in valuePtr;
- *	the caller must call Tcl_DStringFree() when the result is no
- *	longer needed.
+ *	environment variable, or NULL if that environment variable does not
+ *	exist. Storage for the result string is allocated in valuePtr; the
+ *	caller must call Tcl_DStringFree() when the result is no longer
+ *	needed.
  *
  * Side effects:
  *	None.
@@ -460,23 +462,23 @@ TclUnsetEnv(name)
  *----------------------------------------------------------------------
  */
 
-CONST char *
-TclGetEnv(name, valuePtr)
-    CONST char *name;		/* Name of environment variable to find
+const char *
+TclGetEnv(
+    const char *name,		/* Name of environment variable to find
 				 * (UTF-8). */
-    Tcl_DString *valuePtr;	/* Uninitialized or free DString in which
-				 * the value of the environment variable is
+    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
+				 * value of the environment variable is
 				 * stored. */
 {
     int length, index;
-    CONST char *result;
+    const char *result;
 
     Tcl_MutexLock(&envMutex);
     index = TclpFindVariable(name, &length);
     result = NULL;
     if (index != -1) {
 	Tcl_DString envStr;
-	
+
 	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
 	result += length;
 	if (*result == '=') {
@@ -498,32 +500,31 @@ TclGetEnv(name, valuePtr)
  *
  * EnvTraceProc --
  *
- *	This procedure is invoked whenever an environment variable
- *	is read, modified or deleted.  It propagates the change to the global
- *	"environ" array.
+ *	This function is invoked whenever an environment variable is read,
+ *	modified or deleted. It propagates the change to the global "environ"
+ *	array.
  *
  * Results:
  *	Always returns NULL to indicate success.
  *
  * Side effects:
- *	Environment variable changes get propagated.  If the whole
- *	"env" array is deleted, then we stop managing things for
- *	this interpreter (usually this happens because the whole
- *	interpreter is being deleted).
+ *	Environment variable changes get propagated. If the whole "env" array
+ *	is deleted, then we stop managing things for this interpreter (usually
+ *	this happens because the whole interpreter is being deleted).
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 static char *
-EnvTraceProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Interpreter whose "env" variable is
-				 * being modified. */
-    CONST char *name1;		/* Better be "env". */
-    CONST char *name2;		/* Name of variable being modified, or NULL
-				 * if whole array is being deleted (UTF-8). */
-    int flags;			/* Indicates what's happening. */
+EnvTraceProc(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Interpreter whose "env" variable is being
+				 * modified. */
+    const char *name1,		/* Better be "env". */
+    const char *name2,		/* Name of variable being modified, or NULL if
+				 * whole array is being deleted (UTF-8). */
+    int flags)			/* Indicates what's happening. */
 {
     /*
      * For array traces, let TclSetupEnv do all the work.
@@ -537,7 +538,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
     /*
      * If name2 is NULL, then return and do nothing.
      */
-     
+
     if (name2 == NULL) {
 	return NULL;
     }
@@ -547,8 +548,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
      */
 
     if (flags & TCL_TRACE_WRITES) {
-	CONST char *value;
-	
+	const char *value;
+
 	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
 	TclSetEnv(name2, value);
     }
@@ -559,9 +560,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
 
     if (flags & TCL_TRACE_READS) {
 	Tcl_DString valueString;
-	CONST char *value;
+	const char *value = TclGetEnv(name2, &valueString);
 
-	value = TclGetEnv(name2, &valueString);
 	if (value == NULL) {
 	    return "no such variable";
 	}
@@ -584,9 +584,9 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
  *
  * ReplaceString --
  *
- *	Replace one string with another in the environment variable
- *	cache.  The cache keeps track of all of the environment
- *	variables that Tcl has modified so they can be freed later.
+ *	Replace one string with another in the environment variable cache. The
+ *	cache keeps track of all of the environment variables that Tcl has
+ *	modified so they can be freed later.
  *
  * Results:
  *	None.
@@ -598,61 +598,54 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
  */
 
 static void
-ReplaceString(oldStr, newStr)
-    CONST char *oldStr;		/* Old environment string. */
-    char *newStr;		/* New environment string. */
+ReplaceString(
+    const char *oldStr,		/* Old environment string. */
+    char *newStr)		/* New environment string. */
 {
     int i;
-    char **newCache;
 
     /*
-     * Check to see if the old value was allocated by Tcl.  If so,
-     * it needs to be deallocated to avoid memory leaks.  Note that this
-     * algorithm is O(n), not O(1).  This will result in n-squared behavior
-     * if lots of environment changes are being made.
+     * Check to see if the old value was allocated by Tcl. If so, it needs to
+     * be deallocated to avoid memory leaks. Note that this algorithm is O(n),
+     * not O(1). This will result in n-squared behavior if lots of environment
+     * changes are being made.
      */
 
-    for (i = 0; i < cacheSize; i++) {
-	if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
+    for (i = 0; i < env.cacheSize; i++) {
+	if (env.cache[i]==oldStr || env.cache[i]==NULL) {
 	    break;
 	}
     }
-    if (i < cacheSize) {
+    if (i < env.cacheSize) {
 	/*
 	 * Replace or delete the old value.
 	 */
 
-	if (environCache[i]) {
-	    ckfree(environCache[i]);
+	if (env.cache[i]) {
+	    ckfree(env.cache[i]);
 	}
 
 	if (newStr) {
-	    environCache[i] = newStr;
+	    env.cache[i] = newStr;
 	} else {
-	    for (; i < cacheSize-1; i++) {
-		environCache[i] = environCache[i+1];
+	    for (; i < env.cacheSize-1; i++) {
+		env.cache[i] = env.cache[i+1];
 	    }
-	    environCache[cacheSize-1] = NULL;
+	    env.cache[env.cacheSize-1] = NULL;
 	}
     } else {
-        int allocatedSize = (cacheSize + 5) * sizeof(char *);
-
 	/*
 	 * We need to grow the cache in order to hold the new string.
 	 */
 
-	newCache = (char **) ckalloc((unsigned) allocatedSize);
-        (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
+	const int growth = 5;
 
-	if (environCache) {
-	    memcpy((VOID *) newCache, (VOID *) environCache,
-		    (size_t) (cacheSize * sizeof(char*)));
-	    ckfree((char *) environCache);
-	}
-	environCache = newCache;
-	environCache[cacheSize] = newStr;
-	environCache[cacheSize+1] = NULL;
-	cacheSize += 5;
+	env.cache = (char **) ckrealloc((char *) env.cache,
+		(env.cacheSize + growth) * sizeof(char *));
+	env.cache[env.cacheSize] = newStr;
+	(void) memset(env.cache+env.cacheSize+1, (int) 0,
+		(size_t) (growth-1) * sizeof(char*));
+	env.cacheSize += growth;
     }
 }
 
@@ -661,9 +654,9 @@ ReplaceString(oldStr, newStr)
  *
  * TclFinalizeEnvironment --
  *
- *	This function releases any storage allocated by this module
- *	that isn't still in use by the global environment.  Any
- *	strings that are still in the environment will be leaked.
+ *	This function releases any storage allocated by this module that isn't
+ *	still in use by the global environment. Any strings that are still in
+ *	the environment will be leaked.
  *
  * Results:
  *	None.
@@ -675,26 +668,119 @@ ReplaceString(oldStr, newStr)
  */
 
 void
-TclFinalizeEnvironment()
+TclFinalizeEnvironment(void)
 {
     /*
      * For now we just deallocate the cache array and none of the environment
-     * strings.  This may leak more memory that strictly necessary, since some
-     * of the strings may no longer be in the environment.  However,
+     * strings. This may leak more memory that strictly necessary, since some
+     * of the strings may no longer be in the environment. However,
      * determining which ones are ok to delete is n-squared, and is pretty
      * unlikely, so we don't bother.
      */
 
-    if (environCache) {
-	ckfree((char *) environCache);
-	environCache = NULL;
-	cacheSize    = 0;
+    if (env.cache) {
+	ckfree((char *) env.cache);
+	env.cache = NULL;
+	env.cacheSize = 0;
 #ifndef USE_PUTENV
-	environSize  = 0;
+	env.ourEnvironSize = 0;
 #endif
     }
 }
 
+#if defined(__CYGWIN__)
+
+/*
+ * When using cygwin, when an environment variable changes, we need to synch
+ * with both the cygwin environment (in case the application C code calls
+ * fork) and the Windows environment (in case the application TCL code calls
+ * exec, which calls the Windows CreateProcess function).
+ */
+DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
+
+static void
+TclCygwinPutenv(
+    char *str)
+{
+    char *name, *value;
+
+    /*
+     * Get the name and value, so that we can change the environment variable
+     * for Windows.
+     */
+
+    name = alloca(strlen(str) + 1);
+    strcpy(name, str);
+    for (value=name ; *value!='=' && *value!='\0' ; ++value) {
+	/* Empty body */
+    }
+    if (*value == '\0') {
+	/* Can't happen. */
+	return;
+    }
+    *value = '\0';
+    ++value;
+    if (*value == '\0') {
+	value = NULL;
+    }
+
+    /*
+     * Set the cygwin environment variable.
+     */
+
+#undef putenv
+    if (value == NULL) {
+	unsetenv(name);
+    } else {
+	putenv(str);
+    }
+
+    /*
+     * Before changing the environment variable in Windows, if this is PATH,
+     * we need to convert the value back to a Windows style path.
+     *
+     * FIXME: The calling program may know it is running under windows, and
+     * may have set the path to a Windows path, or, worse, appended or
+     * prepended a Windows path to PATH.
+     */
+
+    if (strcmp(name, "PATH") != 0) {
+	/*
+	 * If this is Path, eliminate any PATH variable, to prevent any
+	 * confusion.
+	 */
+
+	if (strcmp(name, "Path") == 0) {
+	    SetEnvironmentVariableA("PATH", NULL);
+	    unsetenv("PATH");
+	}
+
+	SetEnvironmentVariableA(name, value);
+    } else {
+	char *buf;
+
+	/*
+	 * Eliminate any Path variable, to prevent any confusion.
+	 */
+
+	SetEnvironmentVariableA("Path", NULL);
+	unsetenv("Path");
+
+	if (value == NULL) {
+	    buf = NULL;
+	} else {
+	    int size;
+
+	    size = cygwin_conv_path_list(0, value, NULL, 0);
+	    buf = alloca(size + 1);
+	    cygwin_conv_path_list(0, value, buf, size);
+	}
+
+	SetEnvironmentVariableA(name, buf);
+    }
+}
+#endif /* __CYGWIN__ */
+
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 06b3a4c..7daa7bb 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1,50 +1,45 @@
-/* 
+/*
  * tclEvent.c --
  *
  *	This file implements some general event related interfaces including
- *	background errors, exit handlers, and the "vwait" and "update"
- *	command procedures. 
+ *	background errors, exit handlers, and the "vwait" and "update" command
+ *	functions.
  *
  * Copyright (c) 1990-1994 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Zoran Vasiljevic.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * The data structure below is used to report background errors.  One
- * such structure is allocated for each error;  it holds information
- * about the interpreter and the error until bgerror can be invoked
- * later as an idle handler.
+ * The data structure below is used to report background errors. One such
+ * structure is allocated for each error; it holds information about the
+ * interpreter and the error until an idle handler command can be invoked.
  */
 
 typedef struct BgError {
-    Tcl_Interp *interp;		/* Interpreter in which error occurred.  NULL
-				 * means this error report has been cancelled
-				 * (a previous report generated a break). */
-    char *errorMsg;		/* Copy of the error message (the interp's
-				 * result when the error occurred).
-				 * Malloc-ed. */
-    char *errorInfo;		/* Value of the errorInfo variable
-				 * (malloc-ed). */
-    char *errorCode;		/* Value of the errorCode variable
-				 * (malloc-ed). */
-    struct BgError *nextPtr;	/* Next in list of all pending error
-				 * reports for this interpreter, or NULL
-				 * for end of list. */
+    Tcl_Obj *errorMsg;		/* Copy of the error message (the interp's
+				 * result when the error occurred). */
+    Tcl_Obj *returnOpts;	/* Active return options when the error
+				 * occurred */
+    struct BgError *nextPtr;	/* Next in list of all pending error reports
+				 * for this interpreter, or NULL for end of
+				 * list. */
 } BgError;
 
 /*
- * One of the structures below is associated with the "tclBgError"
- * assoc data for each interpreter.  It keeps track of the head and
- * tail of the list of pending background errors for the interpreter.
+ * One of the structures below is associated with the "tclBgError" assoc data
+ * for each interpreter. It keeps track of the head and tail of the list of
+ * pending background errors for the interpreter.
  */
 
 typedef struct ErrAssocData {
+    Tcl_Interp *interp;		/* Interpreter in which error occurred. */
+    Tcl_Obj *cmdPrefix;		/* First word(s) of the handler command */
     BgError *firstBgPtr;	/* First in list of all background errors
 				 * waiting to be processed for this
 				 * interpreter (NULL if none). */
@@ -59,16 +54,15 @@ typedef struct ErrAssocData {
  */
 
 typedef struct ExitHandler {
-    Tcl_ExitProc *proc;		/* Procedure to call when process exits. */
+    Tcl_ExitProc *proc;		/* Function to call when process exits. */
     ClientData clientData;	/* One word of information to pass to proc. */
-    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for
-				 * this application, or NULL for end of list. */
+    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
+				 * application, or NULL for end of list. */
 } ExitHandler;
 
 /*
- * There is both per-process and per-thread exit handlers.
- * The first list is controlled by a mutex.  The other is in
- * thread local storage.
+ * There is both per-process and per-thread exit handlers. The first list is
+ * controlled by a mutex. The other is in thread local storage.
  */
 
 static ExitHandler *firstExitPtr = NULL;
@@ -81,128 +75,96 @@ TCL_DECLARE_MUTEX(exitMutex)
 
 /*
  * This variable is set to 1 when Tcl_Finalize is called, and at the end of
- * its work, it is reset to 0. The variable is checked by TclInExit() to
- * allow different behavior for exit-time processing, e.g. in closing of
- * files and pipes.
+ * its work, it is reset to 0. The variable is checked by TclInExit() to allow
+ * different behavior for exit-time processing, e.g. in closing of files and
+ * pipes.
  */
 
 static int inFinalize = 0;
 static int subsystemsInitialized = 0;
 
-typedef struct ThreadSpecificData {
-    ExitHandler *firstExitPtr;  /* First in list of all exit handlers for
-				 * this thread. */
-    int inExit;			/* True when this thread is exiting. This
-				 * is used as a hack to decide to close
-				 * the standard channels. */
-    Tcl_Obj *tclLibraryPath;	/* Path(s) to the Tcl library */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
 /*
- * Common string for the library path for sharing across threads.
- * This is ckalloc'd and cleared in Tcl_Finalize.
+ * This variable contains the application wide exit handler. It will be
+ * called by Tcl_Exit instead of the C-runtime exit if this variable is set
+ * to a non-NULL value.
  */
-static char *tclLibraryPathStr = NULL;
 
+static Tcl_ExitProc *appExitPtr = NULL;
 
-#ifdef TCL_THREADS
+typedef struct ThreadSpecificData {
+    ExitHandler *firstExitPtr;	/* First in list of all exit handlers for this
+				 * thread. */
+    int inExit;			/* True when this thread is exiting. This is
+				 * used as a hack to decide to close the
+				 * standard channels. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
 
+#ifdef TCL_THREADS
 typedef struct {
     Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
     ClientData clientData;	/* The one argument to Main() */
 } ThreadClientData;
-static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
-           ClientData clientData));
-#endif
+static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
+#endif /* TCL_THREADS */
 
 /*
- * Prototypes for procedures referenced only in this file:
+ * Prototypes for functions referenced only in this file:
  */
 
-static void		BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
-static void		HandleBgErrors _ANSI_ARGS_((ClientData clientData));
-static char *		VwaitVarProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, CONST char *name1, 
-			    CONST char *name2, int flags));
+static void		BgErrorDeleteProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		HandleBgErrors(ClientData clientData);
+static char *		VwaitVarProc(ClientData clientData, Tcl_Interp *interp,
+			    CONST char *name1, CONST char *name2, int flags);
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_BackgroundError --
  *
- *	This procedure is invoked to handle errors that occur in Tcl
- *	commands that are invoked in "background" (e.g. from event or
- *	timer bindings).
+ *	This function is invoked to handle errors that occur in Tcl commands
+ *	that are invoked in "background" (e.g. from event or timer bindings).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The command "bgerror" is invoked later as an idle handler to
- *	process the error, passing it the error message.  If that fails,
- *	then an error message is output on stderr.
+ *	A handler command is invoked later as an idle handler to process the
+ *	error, passing it the interp result and return options.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_BackgroundError(interp)
-    Tcl_Interp *interp;		/* Interpreter in which an error has
+Tcl_BackgroundError(
+    Tcl_Interp *interp)		/* Interpreter in which an error has
+				 * occurred. */
+{
+    TclBackgroundException(interp, TCL_ERROR);
+}
+void
+TclBackgroundException(
+    Tcl_Interp *interp,		/* Interpreter in which an exception has
 				 * occurred. */
+    int code)			/* The exception code value */
 {
     BgError *errPtr;
-    CONST char *errResult, *varValue;
     ErrAssocData *assocPtr;
-    int length;
 
-    /*
-     * The Tcl_AddErrorInfo call below (with an empty string) ensures that
-     * errorInfo gets properly set.  It's needed in cases where the error
-     * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
-     * in these cases errorInfo still won't have been set when this
-     * procedure is called.
-     */
-
-    Tcl_AddErrorInfo(interp, "");
+    if (code == TCL_OK) {
+	return;
+    }
 
-    errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
-	
     errPtr = (BgError *) ckalloc(sizeof(BgError));
-    errPtr->interp = interp;
-    errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
-    memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
-    varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
-    if (varValue == NULL) {
-	varValue = errPtr->errorMsg;
-    }
-    errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
-    strcpy(errPtr->errorInfo, varValue);
-    varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
-    if (varValue == NULL) {
-	varValue = "";
-    }
-    errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
-    strcpy(errPtr->errorCode, varValue);
+    errPtr->errorMsg = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(errPtr->errorMsg);
+    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
+    Tcl_IncrRefCount(errPtr->returnOpts);
     errPtr->nextPtr = NULL;
 
-    assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
-	    (Tcl_InterpDeleteProc **) NULL);
-    if (assocPtr == NULL) {
-
-	/*
-	 * This is the first time a background error has occurred in
-	 * this interpreter.  Create associated data to keep track of
-	 * pending error reports.
-	 */
-
-	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
-	assocPtr->firstBgPtr = NULL;
-	assocPtr->lastBgPtr = NULL;
-	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
-		(ClientData) assocPtr);
-    }
+    (void) TclGetBgErrorHandler(interp);
+    assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL);
     if (assocPtr->firstBgPtr == NULL) {
 	assocPtr->firstBgPtr = errPtr;
 	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
@@ -218,145 +180,383 @@ Tcl_BackgroundError(interp)
  *
  * HandleBgErrors --
  *
- *	This procedure is invoked as an idle handler to process all of
- *	the accumulated background errors.
+ *	This function is invoked as an idle handler to process all of the
+ *	accumulated background errors.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Depends on what actions "bgerror" takes for the errors.
+ *	Depends on what actions the handler command takes for the errors.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-HandleBgErrors(clientData)
-    ClientData clientData;	/* Pointer to ErrAssocData structure. */
+HandleBgErrors(
+    ClientData clientData)	/* Pointer to ErrAssocData structure. */
 {
-    Tcl_Interp *interp;
-    CONST char *argv[2];
-    int code;
-    BgError *errPtr;
     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
-    Tcl_Channel errChannel;
+    Tcl_Interp *interp = assocPtr->interp;
+    BgError *errPtr;
+
+    /*
+     * Not bothering to save/restore the interp state. Assume that any code
+     * that has interp state it needs to keep will make its own
+     * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent()
+     * that could lead us here.
+     */
 
     Tcl_Preserve((ClientData) assocPtr);
-    
+    Tcl_Preserve((ClientData) interp);
     while (assocPtr->firstBgPtr != NULL) {
-	interp = assocPtr->firstBgPtr->interp;
-	if (interp == NULL) {
-	    goto doneWithInterp;
-	}
+	int code, prefixObjc;
+	Tcl_Obj **prefixObjv, **tempObjv;
 
 	/*
-	 * Restore important state variables to what they were at
-	 * the time the error occurred.
+	 * Note we copy the handler command prefix each pass through, so
+	 * we do support one handler setting another handler.
 	 */
 
-	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
-		TCL_GLOBAL_ONLY);
-	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
-		TCL_GLOBAL_ONLY);
+	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
+
+	errPtr = assocPtr->firstBgPtr;
+
+	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+	tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *));
+	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
+	tempObjv[prefixObjc] = errPtr->errorMsg;
+	tempObjv[prefixObjc+1] = errPtr->returnOpts;
+	Tcl_AllowExceptions(interp);
+	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);
 
 	/*
-	 * Create and invoke the bgerror command.
+	 * Discard the command and the information about the error report.
 	 */
 
-	argv[0] = "bgerror";
-	argv[1] = assocPtr->firstBgPtr->errorMsg;
-	
-	Tcl_AllowExceptions(interp);
-        Tcl_Preserve((ClientData) interp);
-	code = TclGlobalInvoke(interp, 2, argv, 0);
-	if (code == TCL_ERROR) {
-
-            /*
-             * If the interpreter is safe, we look for a hidden command
-             * named "bgerror" and call that with the error information.
-             * Otherwise, simply ignore the error. The rationale is that
-             * this could be an error caused by a malicious applet trying
-             * to cause an infinite barrage of error messages. The hidden
-             * "bgerror" command can be used by a security policy to
-             * interpose on such attacks and e.g. kill the applet after a
-             * few attempts.
-             */
-
-            if (Tcl_IsSafe(interp)) {
-		Tcl_SavedResult save;
-		
-		Tcl_SaveResult(interp, &save);
-                TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
-		Tcl_RestoreResult(interp, &save);
-
-                goto doneWithInterp;
-            } 
-
-            /*
-             * We have to get the error output channel at the latest possible
-             * time, because the eval (above) might have changed the channel.
-             */
-            
-            errChannel = Tcl_GetStdChannel(TCL_STDERR);
-            if (errChannel != (Tcl_Channel) NULL) {
-		char *string;
-		int len;
-
-		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
-		if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
-                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                } else {
-                    Tcl_WriteChars(errChannel,
-                            "bgerror failed to handle background error.\n",
-                            -1);
-                    Tcl_WriteChars(errChannel, "    Original error: ", -1);
-                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
-                            -1);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
-                    Tcl_WriteChars(errChannel, string, len);
-                    Tcl_WriteChars(errChannel, "\n", -1);
-                }
-                Tcl_Flush(errChannel);
-            }
-	} else if (code == TCL_BREAK) {
+	Tcl_DecrRefCount(copyObj);
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->returnOpts);
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	ckfree((char *) errPtr);
+	ckfree((char *) tempObjv);
 
+	if (code == TCL_BREAK) {
 	    /*
 	     * Break means cancel any remaining error reports for this
 	     * interpreter.
 	     */
 
-	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
-		    errPtr = errPtr->nextPtr) {
-		if (errPtr->interp == interp) {
-		    errPtr->interp = NULL;
+	    while (assocPtr->firstBgPtr != NULL) {
+		errPtr = assocPtr->firstBgPtr;
+		assocPtr->firstBgPtr = errPtr->nextPtr;
+		Tcl_DecrRefCount(errPtr->errorMsg);
+		Tcl_DecrRefCount(errPtr->returnOpts);
+		ckfree((char *) errPtr);
+	    }
+	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
+	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+
+	    if (errChannel != (Tcl_Channel) NULL) {
+		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
+		Tcl_Obj *keyPtr, *valuePtr;
+
+		TclNewLiteralStringObj(keyPtr, "-errorinfo");
+		Tcl_IncrRefCount(keyPtr);
+		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
+		Tcl_DecrRefCount(keyPtr);
+
+		Tcl_WriteChars(errChannel,
+			"error in background error handler:\n", -1);
+		if (valuePtr) {
+		    Tcl_WriteObj(errChannel, valuePtr);
+		} else {
+		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
 		}
+		Tcl_WriteChars(errChannel, "\n", 1);
+		Tcl_Flush(errChannel);
+		Tcl_DecrRefCount(options);
 	    }
 	}
+    }
+    assocPtr->lastBgPtr = NULL;
+    Tcl_Release((ClientData) interp);
+    Tcl_Release((ClientData) assocPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDefaultBgErrorHandlerObjCmd --
+ *
+ *	This function is invoked to process the "::tcl::Bgerror" Tcl command.
+ *	It is the default handler command registered with [interp bgerror] for
+ *	the sake of compatibility with older Tcl releases.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Depends on what actions the "bgerror" command takes for the errors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDefaultBgErrorHandlerObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Tcl_Obj *keyPtr, *valuePtr;
+    Tcl_Obj *tempObjv[2];
+    int code, level;
+    Tcl_InterpState saved;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "msg options");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check for a valid return options dictionary.
+     */
+
+    TclNewLiteralStringObj(keyPtr, "-level");
+    Tcl_IncrRefCount(keyPtr);
+    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (valuePtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"missing return option \"-level\"", -1));
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    TclNewLiteralStringObj(keyPtr, "-code");
+    Tcl_IncrRefCount(keyPtr);
+    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (valuePtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"missing return option \"-code\"", -1));
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
 
+    if (level != 0) {
+	/* We're handling a TCL_RETURN exception */
+	code = TCL_RETURN;
+    }
+    if (code == TCL_OK) {
 	/*
-	 * Discard the command and the information about the error report.
+	 * Somehow we got to exception handling with no exception.
+	 * (Pass TCL_OK to TclBackgroundException()?)
+	 * Just return without doing anything.
 	 */
+	return TCL_OK;
+    }
+
+    /* Construct the bgerror command */
+    TclNewLiteralStringObj(tempObjv[0], "bgerror");
+    Tcl_IncrRefCount(tempObjv[0]);
+
+    /*
+     * Determine error message argument.  Check the return options in case
+     * a non-error exception brought us here.
+     */
+
+    switch (code) {
+    case TCL_ERROR:
+	tempObjv[1] = objv[1];
+	break;
+    case TCL_BREAK:
+	TclNewLiteralStringObj(tempObjv[1],
+		"invoked \"break\" outside of a loop");
+	break;
+    case TCL_CONTINUE:
+	TclNewLiteralStringObj(tempObjv[1],
+		"invoked \"continue\" outside of a loop");
+	break;
+    default:
+	tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code);
+	break;
+    }
+    Tcl_IncrRefCount(tempObjv[1]);
+
+    if (code != TCL_ERROR) {
+	Tcl_SetObjResult(interp, tempObjv[1]);
+    }
 
-doneWithInterp:
+    TclNewLiteralStringObj(keyPtr, "-errorcode");
+    Tcl_IncrRefCount(keyPtr);
+    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (valuePtr) {
+	Tcl_SetObjErrorCode(interp, valuePtr);
+    }
+
+    TclNewLiteralStringObj(keyPtr, "-errorinfo");
+    Tcl_IncrRefCount(keyPtr);
+    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (valuePtr) {
+	Tcl_AppendObjToErrorInfo(interp, valuePtr);
+    }
+
+    if (code == TCL_ERROR) {
+	Tcl_SetObjResult(interp, tempObjv[1]);
+    }
+
+    /*
+     * Save interpreter state so we can restore it if multiple handler
+     * attempts are needed.
+     */
+
+    saved = Tcl_SaveInterpState(interp, code);
+    
+    /* Invoke the bgerror command. */
+    Tcl_AllowExceptions(interp);
+    code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL);
+    if (code == TCL_ERROR) {
+	/*
+	 * If the interpreter is safe, we look for a hidden command named
+	 * "bgerror" and call that with the error information. Otherwise,
+	 * simply ignore the error. The rationale is that this could be an
+	 * error caused by a malicious applet trying to cause an infinite
+	 * barrage of error messages. The hidden "bgerror" command can be used
+	 * by a security policy to interpose on such attacks and e.g. kill the
+	 * applet after a few attempts.
+	 */
 
-	if (assocPtr->firstBgPtr) {
-	    ckfree(assocPtr->firstBgPtr->errorMsg);
-	    ckfree(assocPtr->firstBgPtr->errorInfo);
-	    ckfree(assocPtr->firstBgPtr->errorCode);
-	    errPtr = assocPtr->firstBgPtr->nextPtr;
-	    ckfree((char *) assocPtr->firstBgPtr);
-	    assocPtr->firstBgPtr = errPtr;
+	if (Tcl_IsSafe(interp)) {
+	    Tcl_RestoreInterpState(interp, saved);
+	    TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
+	} else {
+	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	    if (errChannel != (Tcl_Channel) NULL) {
+		Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+		Tcl_IncrRefCount(resultPtr);
+		if (Tcl_FindCommand(interp, "bgerror", NULL,
+			TCL_GLOBAL_ONLY) == NULL) {
+		    Tcl_RestoreInterpState(interp, saved);
+		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
+			    "errorInfo", NULL, TCL_GLOBAL_ONLY));
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		} else {
+		    Tcl_DiscardInterpState(saved);
+		    Tcl_WriteChars(errChannel,
+			    "bgerror failed to handle background error.\n",-1);
+		    Tcl_WriteChars(errChannel, "    Original error: ", -1);
+		    Tcl_WriteObj(errChannel, tempObjv[1]);
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
+		    Tcl_WriteObj(errChannel, resultPtr);
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		}
+		Tcl_DecrRefCount(resultPtr);
+		Tcl_Flush(errChannel);
+	    } else {
+		Tcl_DiscardInterpState(saved);
+	    }
 	}
-        
-        if (interp != NULL) {
-            Tcl_Release((ClientData) interp);
-        }
+	code = TCL_OK;
+    } else {
+	Tcl_DiscardInterpState(saved);
     }
-    assocPtr->lastBgPtr = NULL;
 
-    Tcl_Release((ClientData) assocPtr);
+    Tcl_DecrRefCount(tempObjv[0]);
+    Tcl_DecrRefCount(tempObjv[1]);
+    Tcl_ResetResult(interp);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetBgErrorHandler --
+ *
+ *	This function sets the command prefix to be used to handle background
+ *	errors in interp.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Error handler is registered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetBgErrorHandler(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdPrefix)
+{
+    ErrAssocData *assocPtr = (ErrAssocData *)
+	    Tcl_GetAssocData(interp, "tclBgError", NULL);
+
+    if (cmdPrefix == NULL) {
+	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
+    }
+    if (assocPtr == NULL) {
+	/*
+	 * First access: initialize.
+	 */
+
+	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+	assocPtr->interp = interp;
+	assocPtr->cmdPrefix = NULL;
+	assocPtr->firstBgPtr = NULL;
+	assocPtr->lastBgPtr = NULL;
+	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
+		(ClientData) assocPtr);
+    }
+    if (assocPtr->cmdPrefix) {
+	Tcl_DecrRefCount(assocPtr->cmdPrefix);
+    }
+    assocPtr->cmdPrefix = cmdPrefix;
+    Tcl_IncrRefCount(assocPtr->cmdPrefix);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetBgErrorHandler --
+ *
+ *	This function retrieves the command prefix currently used to handle
+ *	background errors in interp.
+ *
+ * Results:
+ *	A (Tcl_Obj *) to a list of words (command prefix).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetBgErrorHandler(
+    Tcl_Interp *interp)
+{
+    ErrAssocData *assocPtr = (ErrAssocData *)
+	    Tcl_GetAssocData(interp, "tclBgError", NULL);
+
+    if (assocPtr == NULL) {
+	Tcl_Obj *bgerrorObj;
+
+	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
+	TclSetBgErrorHandler(interp, bgerrorObj);
+	assocPtr = (ErrAssocData *)
+		Tcl_GetAssocData(interp, "tclBgError", NULL);
+    }
+    return assocPtr->cmdPrefix;
 }
 
 /*
@@ -364,25 +564,24 @@ doneWithInterp:
  *
  * BgErrorDeleteProc --
  *
- *	This procedure is associated with the "tclBgError" assoc data
- *	for an interpreter;  it is invoked when the interpreter is
- *	deleted in order to free the information assoicated with any
- *	pending error reports.
+ *	This function is associated with the "tclBgError" assoc data for an
+ *	interpreter; it is invoked when the interpreter is deleted in order to
+ *	free the information assoicated with any pending error reports.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Background error information is freed: if there were any
- *	pending error reports, they are cancelled.
+ *	Background error information is freed: if there were any pending error
+ *	reports, they are cancelled.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-BgErrorDeleteProc(clientData, interp)
-    ClientData clientData;	/* Pointer to ErrAssocData structure. */
-    Tcl_Interp *interp;		/* Interpreter being deleted. */
+BgErrorDeleteProc(
+    ClientData clientData,	/* Pointer to ErrAssocData structure. */
+    Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
     BgError *errPtr;
@@ -390,12 +589,12 @@ BgErrorDeleteProc(clientData, interp)
     while (assocPtr->firstBgPtr != NULL) {
 	errPtr = assocPtr->firstBgPtr;
 	assocPtr->firstBgPtr = errPtr->nextPtr;
-	ckfree(errPtr->errorMsg);
-	ckfree(errPtr->errorInfo);
-	ckfree(errPtr->errorCode);
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->returnOpts);
 	ckfree((char *) errPtr);
     }
     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+    Tcl_DecrRefCount(assocPtr->cmdPrefix);
     Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
 }
 
@@ -404,23 +603,23 @@ BgErrorDeleteProc(clientData, interp)
  *
  * Tcl_CreateExitHandler --
  *
- *	Arrange for a given procedure to be invoked just before the
- *	application exits.
+ *	Arrange for a given function to be invoked just before the application
+ *	exits.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Proc will be invoked with clientData as argument when the
- *	application exits.
+ *	Proc will be invoked with clientData as argument when the application
+ *	exits.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CreateExitHandler(proc, clientData)
-    Tcl_ExitProc *proc;		/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_CreateExitHandler(
+    Tcl_ExitProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr;
 
@@ -471,24 +670,23 @@ TclCreateLateExitHandler(
  *
  * Tcl_DeleteExitHandler --
  *
- *	This procedure cancels an existing exit handler matching proc
- *	and clientData, if such a handler exits.
+ *	This function cancels an existing exit handler matching proc and
+ *	clientData, if such a handler exits.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If there is an exit handler corresponding to proc and clientData
- *	then it is cancelled;  if no such handler exists then nothing
- *	happens.
+ *	If there is an exit handler corresponding to proc and clientData then
+ *	it is cancelled; if no such handler exists then nothing happens.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteExitHandler(proc, clientData)
-    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_DeleteExitHandler(
+    Tcl_ExitProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr, *prevPtr;
 
@@ -558,23 +756,23 @@ TclDeleteLateExitHandler(
  *
  * Tcl_CreateThreadExitHandler --
  *
- *	Arrange for a given procedure to be invoked just before the
- *	current thread exits.
+ *	Arrange for a given function to be invoked just before the current
+ *	thread exits.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Proc will be invoked with clientData as argument when the
- *	application exits.
+ *	Proc will be invoked with clientData as argument when the application
+ *	exits.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CreateThreadExitHandler(proc, clientData)
-    Tcl_ExitProc *proc;		/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_CreateThreadExitHandler(
+    Tcl_ExitProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -591,24 +789,23 @@ Tcl_CreateThreadExitHandler(proc, clientData)
  *
  * Tcl_DeleteThreadExitHandler --
  *
- *	This procedure cancels an existing exit handler matching proc
- *	and clientData, if such a handler exits.
+ *	This function cancels an existing exit handler matching proc and
+ *	clientData, if such a handler exits.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If there is an exit handler corresponding to proc and clientData
- *	then it is cancelled;  if no such handler exists then nothing
- *	happens.
+ *	If there is an exit handler corresponding to proc and clientData then
+ *	it is cancelled; if no such handler exists then nothing happens.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteThreadExitHandler(proc, clientData)
-    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_DeleteThreadExitHandler(
+    Tcl_ExitProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr, *prevPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -631,113 +828,85 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_Exit --
+ * Tcl_SetExitProc --
  *
- *	This procedure is called to terminate the application.
+ *	This function sets the application wide exit handler that will be
+ *	called by Tcl_Exit in place of the C-runtime exit. If the application
+ *	wide exit handler is NULL, the C-runtime exit will be used instead.
  *
  * Results:
- *	None.
+ *	The previously set application wide exit handler.
  *
  * Side effects:
- *	All existing exit handlers are invoked, then the application
- *	ends.
+ *	Sets the application wide exit handler to the specified value.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_Exit(status)
-    int status;			/* Exit status for application;  typically
-				 * 0 for normal return, 1 for error return. */
-{
-    Tcl_Finalize();
-    TclpExit(status);
-}
-
-/*
- *-------------------------------------------------------------------------
- * 
- * TclSetLibraryPath --
- *
- *	Set the path that will be used for searching for init.tcl and 
- *	encodings when an interp is being created.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Changing the library path will affect what directories are
- *	examined when looking for encodings for all interps from that
- *	point forward.
- *
- *	The refcount of the new library path is incremented and the 
- *	refcount of the old path is decremented.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-TclSetLibraryPath(pathPtr)
-    Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
-				 * the new library path. */
+Tcl_ExitProc *
+Tcl_SetExitProc(
+    Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    const char *toDupe;
-    int size;
-
-    if (pathPtr != NULL) {
-	Tcl_IncrRefCount(pathPtr);
-    }
-    if (tsdPtr->tclLibraryPath != NULL) {
-	Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
-    }
-    tsdPtr->tclLibraryPath = pathPtr;
+    Tcl_ExitProc *prevExitProc;
 
     /*
-     *  No mutex locking is needed here as up the stack we're within
-     *  TclpInitLock().
+     * Swap the old exit proc for the new one, saving the old one for our
+     * return value.
      */
-    if (tclLibraryPathStr != NULL) {
-	ckfree(tclLibraryPathStr);
-    }
-    toDupe = Tcl_GetStringFromObj(pathPtr, &size);
-    tclLibraryPathStr = ckalloc((unsigned)size+1);
-    memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1);
+
+    Tcl_MutexLock(&exitMutex);
+    prevExitProc = appExitPtr;
+    appExitPtr = proc;
+    Tcl_MutexUnlock(&exitMutex);
+
+    return prevExitProc;
 }
 
 /*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
- * TclGetLibraryPath --
+ * Tcl_Exit --
  *
- *	Return a Tcl list object whose elements are the library path.
- *	The caller should not modify the contents of the returned object.
+ *	This function is called to terminate the application.
  *
  * Results:
- *	As above.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	All existing exit handlers are invoked, then the application ends.
  *
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclGetLibraryPath()
+void
+Tcl_Exit(
+    int status)			/* Exit status for application; typically 0
+				 * for normal return, 1 for error return. */
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Tcl_ExitProc *currentAppExitPtr;
 
-    if (tsdPtr->tclLibraryPath == NULL) {
+    Tcl_MutexLock(&exitMutex);
+    currentAppExitPtr = appExitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+
+    if (currentAppExitPtr) {
+	/*
+	 * Warning: this code SHOULD NOT return, as there is code that depends
+	 * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
+	 * returns, so critical is this dependcy.
+	 */
+
+	currentAppExitPtr((ClientData) INT2PTR(status));
+	Tcl_Panic("AppExitProc returned unexpectedly");
+    } else {
 	/*
-	 * Grab the shared string and place it into a new thread specific
-	 * Tcl_Obj.
+	 * Use default handling.
 	 */
-	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);
 
-	/* take ownership */
-	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
+	Tcl_Finalize();
+	TclpExit(status);
+	Tcl_Panic("OS exit failed!");
     }
-    return tsdPtr->tclLibraryPath;
 }
 
 /*
@@ -745,17 +914,16 @@ TclGetLibraryPath()
  *
  * TclInitSubsystems --
  *
- *	Initialize various subsytems in Tcl.  This should be called the
- *	first time an interp is created, or before any of the subsystems
- *	are used.  This function ensures an order for the initialization 
- *	of subsystems:
+ *	Initialize various subsytems in Tcl. This should be called the first
+ *	time an interp is created, or before any of the subsystems are used.
+ *	This function ensures an order for the initialization of subsystems:
  *
- *	1. that cannot be initialized in lazy order because they are 
- *	mutually dependent.
+ *	1. that cannot be initialized in lazy order because they are mutually
+ *	dependent.
  *
- *	2. so that they can be finalized in a known order w/o causing
- *	the subsequent re-initialization of a subsystem in the act of
- *	shutting down another.
+ *	2. so that they can be finalized in a known order w/o causing the
+ *	subsequent re-initialization of a subsystem in the act of shutting
+ *	down another.
  *
  * Results:
  *	None.
@@ -767,74 +935,55 @@ TclGetLibraryPath()
  */
 
 void
-TclInitSubsystems(argv0)
-    CONST char *argv0;		/* Name of executable from argv[0] to main()
-				 * in native multi-byte encoding. */
+TclInitSubsystems(void)
 {
-    ThreadSpecificData *tsdPtr;
-
     if (inFinalize != 0) {
-	panic("TclInitSubsystems called while finalizing");
+	Tcl_Panic("TclInitSubsystems called while finalizing");
     }
 
-    /*
-     * Grab the thread local storage pointer before doing anything because
-     * the initialization routines will be registering exit handlers.
-     * We use this pointer to detect if this is the first time this
-     * thread has created an interpreter.
-     */
-
-    tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
-
     if (subsystemsInitialized == 0) {
-	/* 
-	 * Double check inside the mutex.  There are definitly calls
-	 * back into this routine from some of the procedures below.
+	/*
+	 * Double check inside the mutex. There are definitly calls back into
+	 * this routine from some of the functions below.
 	 */
 
 	TclpInitLock();
 	if (subsystemsInitialized == 0) {
 	    /*
-	     * Have to set this bit here to avoid deadlock with the
-	     * routines below us that call into TclInitSubsystems.
+	     * Have to set this bit here to avoid deadlock with the routines
+	     * below us that call into TclInitSubsystems.
 	     */
 
 	    subsystemsInitialized = 1;
 
-	    tclExecutableName = NULL;
-
 	    /*
 	     * Initialize locks used by the memory allocators before anything
 	     * interesting happens so we can use the allocators in the
 	     * implementation of self-initializing locks.
 	     */
 
+	    TclInitThreadStorage();     /* Creates master hash table for
+					 * thread local storage */
 #if USE_TCLALLOC
-	    TclInitAlloc(); /* process wide mutex init */
+	    TclInitAlloc();		/* Process wide mutex init */
 #endif
 #ifdef TCL_MEM_DEBUG
-	    TclInitDbCkalloc(); /* process wide mutex init */
+	    TclInitDbCkalloc();		/* Process wide mutex init */
 #endif
 
-	    TclpInitPlatform(); /* creates signal handler(s) */
-	    TclInitObjSubsystem(); /* register obj types, create mutexes */
-	    TclInitIOSubsystem(); /* inits a tsd key (noop) */
-	    TclInitEncodingSubsystem(); /* process wide encoding init */
-	    TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
+	    TclpInitPlatform();		/* Creates signal handler(s) */
+	    TclInitDoubleConversion();	/* Initializes constants for
+					 * converting to/from double. */
+    	    TclInitObjSubsystem();	/* Register obj types, create
+					 * mutexes. */
+	    TclInitIOSubsystem();	/* Inits a tsd key (noop). */
+	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
+	    TclpSetInterfaces();
+    	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
 	}
 	TclpInitUnlock();
     }
-
-    if (tsdPtr == NULL) {
-	/*
-	 * First time this thread has created an interpreter.
-	 * We fetch the key again just in case no exit handlers were
-	 * registered by this point.
-	 */
-
-	(void) TCL_TSD_INIT(&dataKey);
-	TclInitNotifier();
-     }
+    TclInitNotifier();
 }
 
 /*
@@ -842,10 +991,9 @@ TclInitSubsystems(argv0)
  *
  * Tcl_Finalize --
  *
- *	Shut down Tcl.  First calls registered exit handlers, then
- *	carefully shuts down various subsystems.
- *	Called by Tcl_Exit or when the Tcl shared library is being 
- *	unloaded.
+ *	Shut down Tcl. First calls registered exit handlers, then carefully
+ *	shuts down various subsystems. Called by Tcl_Exit or when the Tcl
+ *	shared library is being unloaded.
  *
  * Results:
  *	None.
@@ -857,10 +1005,10 @@ TclInitSubsystems(argv0)
  */
 
 void
-Tcl_Finalize()
+Tcl_Finalize(void)
 {
     ExitHandler *exitPtr;
-    
+
     /*
      * Invoke exit handlers first.
      */
@@ -869,10 +1017,9 @@ Tcl_Finalize()
     inFinalize = 1;
     for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
 	/*
-	 * Be careful to remove the handler from the list before
-	 * invoking its callback.  This protects us against
-	 * double-freeing if the callback should call
-	 * Tcl_DeleteExitHandler on itself.
+	 * Be careful to remove the handler from the list before invoking its
+	 * callback. This protects us against double-freeing if the callback
+	 * should call Tcl_DeleteExitHandler on itself.
 	 */
 
 	firstExitPtr = exitPtr->nextPtr;
@@ -880,27 +1027,29 @@ Tcl_Finalize()
 	(*exitPtr->proc)(exitPtr->clientData);
 	ckfree((char *) exitPtr);
 	Tcl_MutexLock(&exitMutex);
-    }    
+    }
     firstExitPtr = NULL;
     Tcl_MutexUnlock(&exitMutex);
 
     TclpInitLock();
-    if (subsystemsInitialized != 0) {
-	subsystemsInitialized = 0;
+    if (subsystemsInitialized == 0) {
+	goto alreadyFinalized;
+    }
+    subsystemsInitialized = 0;
 
-	/*
-	 * Ensure the thread-specific data is initialised as it is
-	 * used in Tcl_FinalizeThread()
-	 */
+    /*
+     * Ensure the thread-specific data is initialised as it is used in
+     * Tcl_FinalizeThread()
+     */
 
-	(void) TCL_TSD_INIT(&dataKey);
+    (void) TCL_TSD_INIT(&dataKey);
 
-	/*
-	 * Clean up after the current thread now, after exit handlers.
-	 * In particular, the testexithandler command sets up something
-	 * that writes to standard output, which gets closed.
-	 * Note that there is no thread-local storage after this call.
-	 */
+    /*
+     * Clean up after the current thread now, after exit handlers. In
+     * particular, the testexithandler command sets up something that writes
+     * to standard output, which gets closed. Note that there is no
+     * thread-local storage or IO subsystem after this call.
+     */
 
     Tcl_FinalizeThread();
 
@@ -930,110 +1079,114 @@ Tcl_Finalize()
      * after the exit handlers, because there are order dependencies.
      */
 
-	TclFinalizeCompilation();
-	TclFinalizeExecution();
-	TclFinalizeEnvironment();
+    TclFinalizeExecution();
+    TclFinalizeEnvironment();
 
-	/* 
-	 * Finalizing the filesystem must come after anything which
-	 * might conceivably interact with the 'Tcl_FS' API. 
-	 */
+    /*
+     * Finalizing the filesystem must come after anything which might
+     * conceivably interact with the 'Tcl_FS' API.
+     */
 
-	TclFinalizeFilesystem();
+    TclFinalizeFilesystem();
 
-	/*
-	 * Undo all the Tcl_ObjType registrations, and reset the master list
-	 * of free Tcl_Obj's.  After this returns, no more Tcl_Obj's should
-	 * be allocated or freed.
-	 *
-	 * Note in particular that TclFinalizeObjects() must follow
-	 * TclFinalizeFilesystem() because TclFinalizeFilesystem free's
-	 * the Tcl_Obj that holds the path of the current working directory.
-	 */
+    /*
+     * Undo all Tcl_ObjType registrations, and reset the master list of free
+     * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
+     * freed.
+     *
+     * Note in particular that TclFinalizeObjects() must follow
+     * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the
+     * Tcl_Obj that holds the path of the current working directory.
+     */
 
-	TclFinalizeObjects();
+    TclFinalizeObjects();
 
-	/* 
-	 * We must be sure the encoding finalization doesn't need
-	 * to examine the filesystem in any way.  Since it only
-	 * needs to clean up internal data structures, this is
-	 * fine.
-	 */
-	TclFinalizeEncodingSubsystem();
+    /*
+     * We must be sure the encoding finalization doesn't need to examine the
+     * filesystem in any way. Since it only needs to clean up internal data
+     * structures, this is fine.
+     */
 
-	if (tclExecutableName != NULL) {
-	    ckfree(tclExecutableName);
-	    tclExecutableName = NULL;
-	}
-	if (tclNativeExecutableName != NULL) {
-	    ckfree(tclNativeExecutableName);
-	    tclNativeExecutableName = NULL;
-	}
-	if (tclDefaultEncodingDir != NULL) {
-	    ckfree(tclDefaultEncodingDir);
-	    tclDefaultEncodingDir = NULL;
-	}
-	if (tclLibraryPathStr != NULL) {
-	    ckfree(tclLibraryPathStr);
-	    tclLibraryPathStr = NULL;
-	}
-	
-	Tcl_SetPanicProc(NULL);
+    TclFinalizeEncodingSubsystem();
 
-	/*
-	 * There have been several bugs in the past that cause
-	 * exit handlers to be established during Tcl_Finalize
-	 * processing.  Such exit handlers leave malloc'ed memory,
-	 * and Tcl_FinalizeThreadAlloc or Tcl_FinalizeMemorySubsystem
-	 * will result in a corrupted heap.  The result can be a
-	 * mysterious crash on process exit.  Check here that
-	 * nobody's done this.
-	 */
+    Tcl_SetPanicProc(NULL);
 
-#ifdef TCL_MEM_DEBUG
-	if ( firstExitPtr != NULL ) {
-	    Tcl_Panic( "exit handlers were created during Tcl_Finalize" );
-	}
-#endif
+    /*
+     * Repeat finalization of the thread local storage once more. Although
+     * this step is already done by the Tcl_FinalizeThread call above, series
+     * of events happening afterwards may re-initialize TSD slots. Those need
+     * to be finalized again, otherwise we're leaking memory chunks. Very
+     * important to note is that things happening afterwards should not
+     * reference anything which may re-initialize TSD's. This includes freeing
+     * Tcl_Objs's, among other things.
+     *
+     * This fixes the Tcl Bug #990552.
+     */
 
-	TclFinalizePreserve();
+    TclFinalizeThreadData();
 
-	/*
-	 * Free synchronization objects.  There really should only be one
-	 * thread alive at this moment.
-	 */
+    /*
+     * Now we can free constants for conversions to/from double.
+     */
+
+    TclFinalizeDoubleConversion();
+
+    /*
+     * There have been several bugs in the past that cause exit handlers to be
+     * established during Tcl_Finalize processing. Such exit handlers leave
+     * malloc'ed memory, and Tcl_FinalizeThreadAlloc or
+     * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The result
+     * can be a mysterious crash on process exit. Check here that nobody's
+     * done this.
+     */
+
+    if (firstExitPtr != NULL) {
+	Tcl_Panic("exit handlers were created during Tcl_Finalize");
+    }
+
+    TclFinalizePreserve();
+
+    /*
+     * Free synchronization objects. There really should only be one thread
+     * alive at this moment.
+     */
 
-	TclFinalizeSynchronization();
+    TclFinalizeSynchronization();
 
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY)
-	TclFinalizeThreadAlloc();
+    /*
+     * Close down the thread-specific object allocator.
+     */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    TclFinalizeThreadAlloc();
 #endif
 
-	/*
-	 * We defer unloading of packages until very late 
-	 * to avoid memory access issues.  Both exit callbacks and
-	 * synchronization variables may be stored in packages.
-	 * 
-	 * Note that TclFinalizeLoad unloads packages in the reverse
-	 * of the order they were loaded in (i.e. last to be loaded
-	 * is the first to be unloaded).  This can be important for
-	 * correct unloading when dependencies exist.
-	 * 
-	 * Once load has been finalized, we will have deleted any
-	 * temporary copies of shared libraries and can therefore
-	 * reset the filesystem to its original state.
-	 */
+    /*
+     * We defer unloading of packages until very late to avoid memory access
+     * issues. Both exit callbacks and synchronization variables may be stored
+     * in packages.
+     *
+     * Note that TclFinalizeLoad unloads packages in the reverse of the order
+     * they were loaded in (i.e. last to be loaded is the first to be
+     * unloaded). This can be important for correct unloading when
+     * dependencies exist.
+     *
+     * Once load has been finalized, we will have deleted any temporary copies
+     * of shared libraries and can therefore reset the filesystem to its
+     * original state.
+     */
 
-	TclFinalizeLoad();
-	TclResetFilesystem();
-	
-	/*
-	 * At this point, there should no longer be any ckalloc'ed memory.
-	 */
+    TclFinalizeLoad();
+    TclResetFilesystem();
 
-	TclFinalizeMemorySubsystem();
-	inFinalize = 0;
-    }
+    /*
+     * At this point, there should no longer be any ckalloc'ed memory.
+     */
+
+    TclFinalizeMemorySubsystem();
+    inFinalize = 0;
+
+  alreadyFinalized:
     TclFinalizeLock();
 }
 
@@ -1042,8 +1195,8 @@ Tcl_Finalize()
  *
  * Tcl_FinalizeThread --
  *
- *	Runs the exit handlers to allow Tcl to clean up its state
- *	about a particular thread.
+ *	Runs the exit handlers to allow Tcl to clean up its state about a
+ *	particular thread.
  *
  * Results:
  *	None.
@@ -1055,30 +1208,26 @@ Tcl_Finalize()
  */
 
 void
-Tcl_FinalizeThread()
+Tcl_FinalizeThread(void)
 {
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr;
 
+    /*
+     * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
+     * we don't want to initialize the data block if it hasn't been
+     * initialized already.
+     */
+
     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
     if (tsdPtr != NULL) {
 	tsdPtr->inExit = 1;
 
-	/*
-	 * Clean up the library path now, before we invalidate thread-local
-	 * storage or calling thread exit handlers.
-	 */
-
-	if (tsdPtr->tclLibraryPath != NULL) {
-	    Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
-	    tsdPtr->tclLibraryPath = NULL;
-	}
-
 	for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
 		exitPtr = tsdPtr->firstExitPtr) {
 	    /*
 	     * Be careful to remove the handler from the list before invoking
-	     * its callback.  This protects us against double-freeing if the
+	     * its callback. This protects us against double-freeing if the
 	     * callback should call Tcl_DeleteThreadExitHandler on itself.
 	     */
 
@@ -1089,14 +1238,15 @@ Tcl_FinalizeThread()
 	TclFinalizeIOSubsystem();
 	TclFinalizeNotifier();
 	TclFinalizeAsync();
+	TclFinalizeThreadObjects();
     }
 
     /*
      * Blow away all thread local storage blocks.
      *
-     * Note that Tcl API allows creation of threads which do not use any
-     * Tcl interp or other Tcl subsytems. Those threads might, however,
-     * use thread local storage, so we must unconditionally finalize it.
+     * Note that Tcl API allows creation of threads which do not use any Tcl
+     * interp or other Tcl subsytems. Those threads might, however, use thread
+     * local storage, so we must unconditionally finalize it.
      *
      * Fix [Bug #571002]
      */
@@ -1121,7 +1271,7 @@ Tcl_FinalizeThread()
  */
 
 int
-TclInExit()
+TclInExit(void)
 {
     return inFinalize;
 }
@@ -1143,7 +1293,7 @@ TclInExit()
  */
 
 int
-TclInThreadExit()
+TclInThreadExit(void)
 {
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    TclThreadDataKeyGet(&dataKey);
@@ -1159,8 +1309,8 @@ TclInThreadExit()
  *
  * Tcl_VwaitObjCmd --
  *
- *	This procedure is invoked to process the "vwait" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "vwait" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1173,17 +1323,17 @@ TclInThreadExit()
 
 	/* ARGSUSED */
 int
-Tcl_VwaitObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_VwaitObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     int done, foundEvent;
     char *nameString;
 
     if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "name");
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
     nameString = Tcl_GetString(objv[1]);
@@ -1196,20 +1346,27 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv)
     foundEvent = 1;
     while (!done && foundEvent) {
 	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+	if (Tcl_LimitExceeded(interp)) {
+	    break;
+	}
     }
     Tcl_UntraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, (ClientData) &done);
 
     /*
-     * Clear out the interpreter's result, since it may have been set
-     * by event handlers.
+     * Clear out the interpreter's result, since it may have been set by event
+     * handlers.
      */
 
     Tcl_ResetResult(interp);
     if (!foundEvent) {
 	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
-		"\":  would wait forever", (char *) NULL);
+		"\": would wait forever", NULL);
+	return TCL_ERROR;
+    }
+    if (!done) {
+	Tcl_AppendResult(interp, "limit exceeded", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1217,17 +1374,17 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 static char *
-VwaitVarProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Pointer to integer to set to 1. */
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *name1;		/* Name of variable. */
-    CONST char *name2;		/* Second part of variable name. */
-    int flags;			/* Information about what happened. */
+VwaitVarProc(
+    ClientData clientData,	/* Pointer to integer to set to 1. */
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    CONST char *name1,		/* Name of variable. */
+    CONST char *name2,		/* Second part of variable name. */
+    int flags)			/* Information about what happened. */
 {
     int *donePtr = (int *) clientData;
 
     *donePtr = 1;
-    return (char *) NULL;
+    return NULL;
 }
 
 /*
@@ -1235,8 +1392,8 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
  *
  * Tcl_UpdateObjCmd --
  *
- *	This procedure is invoked to process the "update" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "update" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1249,15 +1406,15 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
 
 	/* ARGSUSED */
 int
-Tcl_UpdateObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_UpdateObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     int optionIndex;
     int flags = 0;		/* Initialized to avoid compiler warning. */
-    static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+    static CONST char *updateOptions[] = {"idletasks", NULL};
     enum updateOptions {REGEXP_IDLETASKS};
 
     if (objc == 1) {
@@ -1268,37 +1425,39 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
 	    return TCL_ERROR;
 	}
 	switch ((enum updateOptions) optionIndex) {
-	    case REGEXP_IDLETASKS: {
-		flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
-		break;
-	    }
-	    default: {
-		panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
-	    }
+	case REGEXP_IDLETASKS:
+	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	    break;
+	default:
+	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
 	}
     } else {
-        Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
 	return TCL_ERROR;
     }
-    
+
     while (Tcl_DoOneEvent(flags) != 0) {
-	/* Empty loop body */
+	if (Tcl_LimitExceeded(interp)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "limit exceeded", NULL);
+	    return TCL_ERROR;
+	}
     }
 
     /*
-     * Must clear the interpreter's result because event handlers could
-     * have executed commands.
+     * Must clear the interpreter's result because event handlers could have
+     * executed commands.
      */
 
     Tcl_ResetResult(interp);
     return TCL_OK;
 }
-
+
 #ifdef TCL_THREADS
 /*
  *-----------------------------------------------------------------------------
  *
- *  NewThreadProc --
+ * NewThreadProc --
  *
  * 	Bootstrap function of a new Tcl thread.
  *
@@ -1312,34 +1471,36 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
  */
 
 static Tcl_ThreadCreateType
-NewThreadProc(ClientData clientData)
+NewThreadProc(
+    ClientData clientData)
 {
     ThreadClientData *cdPtr;
     ClientData threadClientData;
     Tcl_ThreadCreateProc *threadProc;
 
-    cdPtr = (ThreadClientData*)clientData;
+    cdPtr = (ThreadClientData *) clientData;
     threadProc = cdPtr->proc;
     threadClientData = cdPtr->clientData;
-    ckfree((char*)clientData); /* Allocated in Tcl_CreateThread() */
+    ckfree((char *) clientData);	/* Allocated in Tcl_CreateThread() */
 
     (*threadProc)(threadClientData);
 
     TCL_THREAD_CREATE_RETURN;
 }
 #endif
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_CreateThread --
  *
- *	This procedure creates a new thread. This actually belongs
- *	to the tclThread.c file but since we use some private 
- *	data structures local to this file, it is placed here.
+ *	This function creates a new thread. This actually belongs to the
+ *	tclThread.c file but since we use some private data structures local
+ *	to this file, it is placed here.
  *
  * Results:
- *	TCL_OK if the thread could be created.  The thread ID is
- *	returned in a parameter.
+ *	TCL_OK if the thread could be created. The thread ID is returned in a
+ *	parameter.
  *
  * Side effects:
  *	A new thread is created.
@@ -1348,24 +1509,32 @@ NewThreadProc(ClientData clientData)
  */
 
 int
-Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
-    Tcl_ThreadId *idPtr;		/* Return, the ID of the thread */
-    Tcl_ThreadCreateProc proc;		/* Main() function of the thread */
-    ClientData clientData;		/* The one argument to Main() */
-    int stackSize;			/* Size of stack for the new thread */
-    int flags;				/* Flags controlling behaviour of
-					 * the new thread */
+Tcl_CreateThread(
+    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
+    Tcl_ThreadCreateProc proc,	/* Main() function of the thread */
+    ClientData clientData,	/* The one argument to Main() */
+    int stackSize,		/* Size of stack for the new thread */
+    int flags)			/* Flags controlling behaviour of the new
+				 * thread. */
 {
 #ifdef TCL_THREADS
     ThreadClientData *cdPtr;
 
-    cdPtr = (ThreadClientData*)ckalloc(sizeof(ThreadClientData));
+    cdPtr = (ThreadClientData *) ckalloc(sizeof(ThreadClientData));
     cdPtr->proc = proc;
     cdPtr->clientData = clientData;
 
-    return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
-                           stackSize, flags);
+    return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr,
+	    stackSize, flags);
 #else
     return TCL_ERROR;
 #endif /* TCL_THREADS */
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c09b73e..904c368 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1,63 +1,46 @@
-/* 
+/*
  * tclExecute.c --
  *
- *	This file contains procedures that execute byte-compiled Tcl
- *	commands.
+ *	This file contains procedures that execute byte-compiled Tcl commands.
  *
  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2002-2005 by Miguel Sofer.
+ * Copyright (c) 2005-2007 by Donal K. Fellows.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include "tommath.h"
 
-#ifndef TCL_NO_MATH
-#   include <math.h>
-#endif
+#include <math.h>
+#include <float.h>
 
 /*
- * 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.
+ * Hack to determine whether we may expect IEEE floating point. The hack is
+ * formally incorrect in that non-IEEE platforms might have the same precision
+ * and range, but VAX, IBM, and Cray do not; are there any other floating
+ * point units that we might care about?
  */
 
-#ifndef TCL_GENERIC_ONLY
-#   include "tclPort.h"
-#else /* TCL_GENERIC_ONLY */
-#   ifndef NO_FLOAT_H
-#	include <float.h>
-#   else /* NO_FLOAT_H */
-#	ifndef NO_VALUES_H
-#	    include <values.h>
-#	endif /* !NO_VALUES_H */
-#   endif /* !NO_FLOAT_H */
-#   define NO_ERRNO_H
-#endif /* !TCL_GENERIC_ONLY */
-
-#ifdef NO_ERRNO_H
-int errno;
-#   define EDOM   33
-#   define ERANGE 34
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+#define IEEE_FLOATING_POINT
 #endif
 
 /*
- * Need DBL_MAX for IS_INF() macro...
- */
-#ifndef DBL_MAX
-#   ifdef MAXDOUBLE
-#	define DBL_MAX MAXDOUBLE
-#   else /* !MAXDOUBLE */
-/*
- * This value is from the Solaris headers, but doubles seem to be the
- * same size everywhere.  Long doubles aren't, but we don't use those.
+ * A mask (should be 2**n-1) that is used to work out when the bytecode engine
+ * should call Tcl_AsyncReady() to see whether there is a signal that needs
+ * handling.
  */
-#	define DBL_MAX 1.79769313486231570e+308
-#   endif /* MAXDOUBLE */
-#endif /* !DBL_MAX */
+
+#ifndef ASYNC_CHECK_COUNT_MASK
+#   define ASYNC_CHECK_COUNT_MASK	63
+#endif /* !ASYNC_CHECK_COUNT_MASK */
 
 /*
  * Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -85,22 +68,25 @@ int tclTraceExec = 0;
  * Mapping from expression instruction opcodes to strings; used for error
  * messages. Note that these entries must match the order and number of the
  * expression opcodes (e.g., INST_LOR) in tclCompile.h.
+ *
+ * Does not include the string for INST_EXPON (and beyond), as that is
+ * disjoint for backward-compatability reasons.
  */
 
-static CONST char *CONST operatorStrings[] = {
+static const char *operatorStrings[] = {
     "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
     "+", "-", "*", "/", "%", "+", "-", "~", "!",
     "BUILTIN FUNCTION", "FUNCTION",
-    "", "", "", "", "", "", "", "", "eq", "ne",
+    "", "", "", "", "", "", "", "", "eq", "ne"
 };
 
 /*
  * Mapping from Tcl result codes to strings; used for error and debugging
- * messages. 
+ * messages.
  */
 
 #ifdef TCL_COMPILE_DEBUG
-static CONST char *CONST resultStrings[] = {
+static const char *resultStrings[] = {
     "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
 };
 #endif
@@ -111,70 +97,142 @@ static CONST char *CONST resultStrings[] = {
 
 #ifdef TCL_COMPILE_STATS
 long		tclObjsAlloced = 0;
-long		tclObjsFreed   = 0;
-#define TCL_MAX_SHARED_OBJ_STATS 5
+long		tclObjsFreed = 0;
 long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #endif /* TCL_COMPILE_STATS */
 
 /*
- * 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.
+ * Support pre-8.5 bytecodes unless specifically requested otherwise.
+ */
+
+#ifndef TCL_SUPPORT_84_BYTECODE
+#define TCL_SUPPORT_84_BYTECODE 1
+#endif
+
+#if TCL_SUPPORT_84_BYTECODE
+/*
+ * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
+ * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
  */
 
-#define IS_NAN(v) ((v) != (v))
-#define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
+typedef struct {
+    const char *name;		/* Name of function. */
+    int numArgs;	/* Number of arguments for function. */
+} BuiltinFunc;
 
 /*
- * The new macro for ending an instruction; note that a
- * reasonable C-optimiser will resolve all branches
- * at compile time. (result) is always a constant; the macro 
- * NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is
- * resolved at runtime for variable (nCleanup).
+ * Table describing the built-in math functions. Entries in this table are
+ * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
+ * operand byte.
+ */
+
+static const BuiltinFunc tclBuiltinFuncTable[] = {
+    {"acos", 1},
+    {"asin", 1},
+    {"atan", 1},
+    {"atan2", 2},
+    {"ceil", 1},
+    {"cos", 1},
+    {"cosh", 1},
+    {"exp", 1},
+    {"floor", 1},
+    {"fmod", 2},
+    {"hypot", 2},
+    {"log", 1},
+    {"log10", 1},
+    {"pow", 2},
+    {"sin", 1},
+    {"sinh", 1},
+    {"sqrt", 1},
+    {"tan", 1},
+    {"tanh", 1},
+    {"abs", 1},
+    {"double", 1},
+    {"int", 1},
+    {"rand", 0},
+    {"round", 1},
+    {"srand", 1},
+    {"wide", 1},
+    {NULL, 0},
+};
+
+#define LAST_BUILTIN_FUNC	25
+#endif
+
+/*
+ * These variable-access macros have to coincide with those in tclVar.c
+ */
+
+#define VarHashGetValue(hPtr) \
+    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+static inline Var *
+VarHashCreateVar(
+    TclVarHashTable *tablePtr,
+    Tcl_Obj *key,
+    int *newPtr)
+{
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
+	    (char *) key, newPtr);
+
+    if (!hPtr) {
+	return NULL;
+    }
+    return VarHashGetValue(hPtr);
+}
+
+#define VarHashFindVar(tablePtr, key) \
+    VarHashCreateVar((tablePtr), (key), NULL)
+
+/*
+ * The new macro for ending an instruction; note that a reasonable C-optimiser
+ * will resolve all branches at compile time. (result) is always a constant;
+ * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved
+ * at runtime for variable (nCleanup).
  *
  * ARGUMENTS:
  *    pcAdjustment: how much to increment pc
  *    nCleanup: how many objects to remove from the stack
- *    result: 0 indicates no object should be pushed on the
- *       stack; otherwise, push objResultPtr. If (result < 0),
- *       objResultPtr already has the correct reference count.
+ *    resultHandling: 0 indicates no object should be pushed on the stack;
+ *	otherwise, push objResultPtr. If (result < 0), objResultPtr already
+ *	has the correct reference count.
  */
 
-#define NEXT_INST_F(pcAdjustment, nCleanup, result) \
-     if (nCleanup == 0) {\
-	 if (result != 0) {\
-	     if ((result) > 0) {\
-		 PUSH_OBJECT(objResultPtr);\
-	     } else {\
-		 stackPtr[++stackTop] = objResultPtr;\
-	     }\
-	 } \
-	 pc += (pcAdjustment);\
-	 goto cleanup0;\
-     } else if (result != 0) {\
-	 if ((result) > 0) {\
-	     Tcl_IncrRefCount(objResultPtr);\
-	 }\
-	 pc += (pcAdjustment);\
-	 switch (nCleanup) {\
-	     case 1: goto cleanup1_pushObjResultPtr;\
-	     case 2: goto cleanup2_pushObjResultPtr;\
-	     default: panic("ERROR: bad usage of macro NEXT_INST_F");\
-	 }\
-     } else {\
-	 pc += (pcAdjustment);\
-	 switch (nCleanup) {\
-	     case 1: goto cleanup1;\
-	     case 2: goto cleanup2;\
-	     default: panic("ERROR: bad usage of macro NEXT_INST_F");\
-	 }\
-     }
-
-#define NEXT_INST_V(pcAdjustment, nCleanup, result) \
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
+    if (nCleanup == 0) {\
+	if (resultHandling != 0) {\
+	    if ((resultHandling) > 0) {\
+		PUSH_OBJECT(objResultPtr);\
+	    } else {\
+		*(++tosPtr) = objResultPtr;\
+	    }\
+	} \
+	pc += (pcAdjustment);\
+	goto cleanup0;\
+    } else if (resultHandling != 0) {\
+	if ((resultHandling) > 0) {\
+	    Tcl_IncrRefCount(objResultPtr);\
+	}\
+	pc += (pcAdjustment);\
+	switch (nCleanup) {\
+	    case 1: goto cleanup1_pushObjResultPtr;\
+	    case 2: goto cleanup2_pushObjResultPtr;\
+	    default: Tcl_Panic("bad usage of macro NEXT_INST_F");\
+	}\
+    } else {\
+	pc += (pcAdjustment);\
+	switch (nCleanup) {\
+	    case 1: goto cleanup1;\
+	    case 2: goto cleanup2;\
+	    default: Tcl_Panic("bad usage of macro NEXT_INST_F");\
+	}\
+    }
+
+#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
     pc += (pcAdjustment);\
     cleanup = (nCleanup);\
-    if (result) {\
-	if ((result) > 0) {\
+    if (resultHandling) {\
+	if ((resultHandling) > 0) {\
 	    Tcl_IncrRefCount(objResultPtr);\
 	}\
 	goto cleanupV_pushObjResultPtr;\
@@ -182,7 +240,6 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 	goto cleanupV;\
     }
 
-
 /*
  * Macros used to cache often-referenced Tcl evaluation stack information
  * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
@@ -192,46 +249,52 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
  */
 
 #define CACHE_STACK_INFO() \
-    stackPtr = eePtr->stackPtr; \
-    stackTop = eePtr->stackTop
+    checkInterp = 1
 
 #define DECACHE_STACK_INFO() \
-    eePtr->stackTop = stackTop
-
+    esPtr->tosPtr = tosPtr
 
 /*
  * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
  * increments the object's ref count since it makes the stack have another
  * reference pointing to the object. However, POP_OBJECT does not decrement
- * the ref count. This is because the stack may hold the only reference to
- * the object, so the object would be destroyed if its ref count were
- * decremented before the caller had a chance to, e.g., store it in a
- * variable. It is the caller's responsibility to decrement the ref count
- * when it is finished with an object.
+ * the ref count. This is because the stack may hold the only reference to the
+ * object, so the object would be destroyed if its ref count were decremented
+ * before the caller had a chance to, e.g., store it in a variable. It is the
+ * caller's responsibility to decrement the ref count when it is finished with
+ * an object.
  *
  * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
- * macro. The actual parameter might be an expression with side effects,
- * and this ensures that it will be executed only once. 
+ * macro. The actual parameter might be an expression with side effects, and
+ * this ensures that it will be executed only once.
  */
-    
+
 #define PUSH_OBJECT(objPtr) \
-    Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))
-    
-#define POP_OBJECT() \
-    (stackPtr[stackTop--])
+    Tcl_IncrRefCount(*(++tosPtr) = (objPtr))
+
+#define POP_OBJECT()	*(tosPtr--)
+
+#define OBJ_AT_TOS	*tosPtr
+
+#define OBJ_UNDER_TOS	*(tosPtr-1)
+
+#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))
+
+#define CURR_DEPTH	(tosPtr - initTosPtr)
 
 /*
  * Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
- * O2S is only used in TRACE* calls to get a string from an object.
+ * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * only used in TRACE* calls to get a string from an object.
  */
 
 #ifdef TCL_COMPILE_DEBUG
 #   define TRACE(a) \
     if (traceInstructions) { \
-        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
-	       (unsigned int)(pc - codePtr->codeStart), \
-	       GetOpcodeName(pc)); \
+	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+		(int) CURR_DEPTH, \
+		(unsigned)(pc - codePtr->codeStart), \
+		GetOpcodeName(pc)); \
 	printf a; \
     }
 #   define TRACE_APPEND(a) \
@@ -240,18 +303,19 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
     }
 #   define TRACE_WITH_OBJ(a, objPtr) \
     if (traceInstructions) { \
-        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
-	       (unsigned int)(pc - codePtr->codeStart), \
-	       GetOpcodeName(pc)); \
+	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+		(int) CURR_DEPTH, \
+		(unsigned)(pc - codePtr->codeStart), \
+		GetOpcodeName(pc)); \
 	printf a; \
-        TclPrintObject(stdout, objPtr, 30); \
-        fprintf(stdout, "\n"); \
+	TclPrintObject(stdout, objPtr, 30); \
+	fprintf(stdout, "\n"); \
     }
 #   define O2S(objPtr) \
     (objPtr ? TclGetString(objPtr) : "")
 #else /* !TCL_COMPILE_DEBUG */
 #   define TRACE(a)
-#   define TRACE_APPEND(a) 
+#   define TRACE_APPEND(a)
 #   define TRACE_WITH_OBJ(a, objPtr)
 #   define O2S(objPtr)
 #endif /* TCL_COMPILE_DEBUG */
@@ -263,147 +327,308 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #define TCL_DTRACE_INST_NEXT() \
     if (TCL_DTRACE_INST_DONE_ENABLED()) {\
 	if (curInstName) {\
-	    TCL_DTRACE_INST_DONE(curInstName, stackTop - initStackTop,\
-		    stackPtr + stackTop);\
+	    TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
 	}\
 	curInstName = tclInstructionTable[*pc].name;\
 	if (TCL_DTRACE_INST_START_ENABLED()) {\
-	    TCL_DTRACE_INST_START(curInstName, stackTop - initStackTop,\
-		    stackPtr + stackTop);\
+	    TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, tosPtr);\
 	}\
     } else if (TCL_DTRACE_INST_START_ENABLED()) {\
-	TCL_DTRACE_INST_START(tclInstructionTable[*pc].name,\
-		stackTop - initStackTop, stackPtr + stackTop);\
+	TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, (int) CURR_DEPTH,\
+		tosPtr);\
     }
 #define TCL_DTRACE_INST_LAST() \
     if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
-	TCL_DTRACE_INST_DONE(curInstName, stackTop - initStackTop,\
-		stackPtr + stackTop);\
+	TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
     }
 
 /*
- * Macro to read a string containing either a wide or an int and
- * decide which it is while decoding it at the same time.  This
- * enforces the policy that integer constants between LONG_MIN and
- * LONG_MAX (inclusive) are represented by normal longs, and integer
- * constants outside that range are represented by wide ints.
+ * Macro used in this file to save a function call for common uses of
+ * TclGetNumberFromObj(). The ANSI C "prototype" is:
  *
- * GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never
- * generates an error message.
+ * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ *			ClientData *ptrPtr, int *tPtr);
  */
-#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)	\
-    (resultVar) = Tcl_GetWideIntFromObj(interp, (objPtr), &(wideVar));	\
-    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)	\
-	    && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {			\
-	(objPtr)->typePtr = &tclIntType;				\
-	(objPtr)->internalRep.longValue = (longVar)			\
-		= Tcl_WideAsLong(wideVar);				\
-    }
-#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)		\
-    (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr),	\
-	    &(wideVar));						\
-    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)	\
-	    && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {			\
-	(objPtr)->typePtr = &tclIntType;				\
-	(objPtr)->internalRep.longValue = (longVar)			\
-		= Tcl_WideAsLong(wideVar);				\
-    }
+
+#ifdef NO_WIDE_TYPE
+
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr)			\
+    (((objPtr)->typePtr == &tclIntType)					\
+	?	(*(tPtr) = TCL_NUMBER_LONG,				\
+		*(ptrPtr) = (ClientData)				\
+		    (&((objPtr)->internalRep.longValue)), TCL_OK) :	\
+    ((objPtr)->typePtr == &tclDoubleType)				\
+	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
+		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
+		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
+		*(ptrPtr) = (ClientData)				\
+		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
+    ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
+	? TCL_ERROR :							\
+    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+
+#else
+
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr)			\
+    (((objPtr)->typePtr == &tclIntType)					\
+	?	(*(tPtr) = TCL_NUMBER_LONG,				\
+		*(ptrPtr) = (ClientData)				\
+		    (&((objPtr)->internalRep.longValue)), TCL_OK) :	\
+    ((objPtr)->typePtr == &tclWideIntType)				\
+	?	(*(tPtr) = TCL_NUMBER_WIDE,				\
+		*(ptrPtr) = (ClientData)				\
+		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
+    ((objPtr)->typePtr == &tclDoubleType)				\
+	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
+		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
+		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
+		*(ptrPtr) = (ClientData)				\
+		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
+    ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
+	? TCL_ERROR :							\
+    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+
+#endif
+
 /*
- * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from
- * an obj.
+ * Macro used in this file to save a function call for common uses of
+ * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ *			int *boolPtr);
  */
-#define FORCE_LONG(objPtr, longVar, wideVar)				\
-    if ((objPtr)->typePtr == &tclWideIntType) {				\
-	(longVar) = Tcl_WideAsLong(wideVar);				\
-    }
-#define IS_INTEGER_TYPE(typePtr)					\
-	((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
-#define IS_NUMERIC_TYPE(typePtr)					\
-	(IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
 
-#define W0	Tcl_LongAsWide(0)
+#define TclGetBooleanFromObj(interp, objPtr, boolPtr)			\
+    ((((objPtr)->typePtr == &tclIntType)				\
+	|| ((objPtr)->typePtr == &tclBooleanType))			\
+	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
+	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
+
 /*
- * For tracing that uses wide values.
+ * Macro used in this file to save a function call for common uses of
+ * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ *			Tcl_WideInt *wideIntPtr);
  */
-#define LLD				"%" TCL_LL_MODIFIER "d"
 
-#ifndef TCL_WIDE_INT_IS_LONG
+#ifdef NO_WIDE_TYPE
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr)		\
+    (((objPtr)->typePtr == &tclIntType)					\
+	? (*(wideIntPtr) = (Tcl_WideInt)				\
+		((objPtr)->internalRep.longValue), TCL_OK) :		\
+	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#else
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr)		\
+    (((objPtr)->typePtr == &tclWideIntType)				\
+	? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) :	\
+    ((objPtr)->typePtr == &tclIntType)					\
+	? (*(wideIntPtr) = (Tcl_WideInt)				\
+		((objPtr)->internalRep.longValue), TCL_OK) :		\
+	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#endif
+
 /*
- * Extract a double value from a general numeric object.
+ * Macro used to make the check for type overflow more mnemonic. This works by
+ * comparing sign bits; the rest of the word is irrelevant. The ANSI C
+ * "prototype" (where inttype_t is any integer type) is:
+ *
+ * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum);
+ *
+ * Check first the condition most likely to fail in usual code (at least for
+ * usage in [incr]: do the first summand and the sum have != signs?
  */
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
-    if ((typePtr) == &tclIntType) {					\
-	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
-    } else if ((typePtr) == &tclWideIntType) {				\
-	(doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
-    } else {								\
-	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
-    }
-#else /* TCL_WIDE_INT_IS_LONG */
-#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
-    if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \
-	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
-    } else {								\
-	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
-    }
-#endif /* TCL_WIDE_INT_IS_LONG */
+
+#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0))
+
+/*
+ * Custom object type only used in this file; values of its type should never
+ * be seen by user scripts.
+ */
+
+static Tcl_ObjType dictIteratorType = {
+    "dictIterator",
+    NULL, NULL, NULL, NULL
+};
+
+/*
+ * Auxiliary tables used to compute powers of small integers
+ */
+
+#if (LONG_MAX == 0x7fffffff)
+
+/*
+ * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit
+ * signed integer
+ */
+
+static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
+static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);
+
+/*
+ * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they
+ * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of
+ * powers of i+3; Exp32Value[i] gives the corresponding powers.
+ */
+
+static const unsigned short Exp32Index[] = {
+    0, 11, 18, 23, 26, 29, 31, 32, 33
+};
+static const size_t Exp32IndexSize = sizeof(Exp32Index)/sizeof(unsigned short);
+static const long Exp32Value[] = {
+    19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721,
+    129140163, 387420489, 1162261467, 262144, 1048576, 4194304,
+    16777216, 67108864, 268435456, 1073741824, 1953125, 9765625,
+    48828125, 244140625, 1220703125, 10077696, 60466176, 362797056,
+    40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489,
+    1000000000
+};
+static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long);
+
+#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */
+
+#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
+
+/*
+ * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
+ * Tcl_WideInt.
+ */
+
+static const Tcl_WideInt MaxBase64[] = {
+    (Tcl_WideInt)46340*65536+62259,	/* 3037000499 == isqrt(2**63-1) */
+    (Tcl_WideInt)2097151, (Tcl_WideInt)55108, (Tcl_WideInt)6208,
+    (Tcl_WideInt)1448, (Tcl_WideInt)511, (Tcl_WideInt)234, (Tcl_WideInt)127,
+    (Tcl_WideInt)78, (Tcl_WideInt)52, (Tcl_WideInt)38, (Tcl_WideInt)28,
+    (Tcl_WideInt)22, (Tcl_WideInt)18, (Tcl_WideInt)15
+};
+static const size_t MaxBase64Size = sizeof(MaxBase64)/sizeof(Tcl_WideInt);
+
+/*
+ *Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
+ * results fit in a 64-bit signed integer.
+ */
+
+static const unsigned short Exp64Index[] = {
+    0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76
+};
+static const size_t Exp64IndexSize = sizeof(Exp64Index)/sizeof(unsigned short);
+static const Tcl_WideInt Exp64Value[] = {
+    (Tcl_WideInt)243*243*243*3*3,
+    (Tcl_WideInt)243*243*243*3*3*3,
+    (Tcl_WideInt)243*243*243*3*3*3*3,
+    (Tcl_WideInt)243*243*243*243,
+    (Tcl_WideInt)243*243*243*243*3,
+    (Tcl_WideInt)243*243*243*243*3*3,
+    (Tcl_WideInt)243*243*243*243*3*3*3,
+    (Tcl_WideInt)243*243*243*243*3*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243,
+    (Tcl_WideInt)243*243*243*243*243*3,
+    (Tcl_WideInt)243*243*243*243*243*3*3,
+    (Tcl_WideInt)243*243*243*243*243*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243*3*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243,
+    (Tcl_WideInt)243*243*243*243*243*243*3,
+    (Tcl_WideInt)243*243*243*243*243*243*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243*3*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243*243,
+    (Tcl_WideInt)243*243*243*243*243*243*243*3,
+    (Tcl_WideInt)243*243*243*243*243*243*243*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3,
+    (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3*3,
+    (Tcl_WideInt)1024*1024*1024*4*4,
+    (Tcl_WideInt)1024*1024*1024*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*4*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024,
+    (Tcl_WideInt)1024*1024*1024*1024*4,
+    (Tcl_WideInt)1024*1024*1024*1024*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*4*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*1024,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*4,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4*4,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*1024,
+    (Tcl_WideInt)1024*1024*1024*1024*1024*1024*4,
+    (Tcl_WideInt)3125*3125*3125*5*5,
+    (Tcl_WideInt)3125*3125*3125*5*5*5,
+    (Tcl_WideInt)3125*3125*3125*5*5*5*5,
+    (Tcl_WideInt)3125*3125*3125*3125,
+    (Tcl_WideInt)3125*3125*3125*3125*5,
+    (Tcl_WideInt)3125*3125*3125*3125*5*5,
+    (Tcl_WideInt)3125*3125*3125*3125*5*5*5,
+    (Tcl_WideInt)3125*3125*3125*3125*5*5*5*5,
+    (Tcl_WideInt)3125*3125*3125*3125*3125,
+    (Tcl_WideInt)3125*3125*3125*3125*3125*5,
+    (Tcl_WideInt)3125*3125*3125*3125*3125*5*5,
+    (Tcl_WideInt)7776*7776*7776*6*6,
+    (Tcl_WideInt)7776*7776*7776*6*6*6,
+    (Tcl_WideInt)7776*7776*7776*6*6*6*6,
+    (Tcl_WideInt)7776*7776*7776*7776,
+    (Tcl_WideInt)7776*7776*7776*7776*6,
+    (Tcl_WideInt)7776*7776*7776*7776*6*6,
+    (Tcl_WideInt)7776*7776*7776*7776*6*6*6,
+    (Tcl_WideInt)7776*7776*7776*7776*6*6*6*6,
+    (Tcl_WideInt)16807*16807*16807*7*7,
+    (Tcl_WideInt)16807*16807*16807*7*7*7,
+    (Tcl_WideInt)16807*16807*16807*7*7*7*7,
+    (Tcl_WideInt)16807*16807*16807*16807,
+    (Tcl_WideInt)16807*16807*16807*16807*7,
+    (Tcl_WideInt)16807*16807*16807*16807*7*7,
+    (Tcl_WideInt)32768*32768*32768*8*8,
+    (Tcl_WideInt)32768*32768*32768*8*8*8,
+    (Tcl_WideInt)32768*32768*32768*8*8*8*8,
+    (Tcl_WideInt)32768*32768*32768*32768,
+    (Tcl_WideInt)59049*59049*59049*9*9,
+    (Tcl_WideInt)59049*59049*59049*9*9*9,
+    (Tcl_WideInt)59049*59049*59049*9*9*9*9,
+    (Tcl_WideInt)100000*100000*100000*10*10,
+    (Tcl_WideInt)100000*100000*100000*10*10*10,
+    (Tcl_WideInt)161051*161051*161051*11*11,
+    (Tcl_WideInt)161051*161051*161051*11*11*11,
+    (Tcl_WideInt)248832*248832*248832*12*12,
+    (Tcl_WideInt)371293*371293*371293*13*13
+};
+static const size_t Exp64ValueSize = sizeof(Exp64Value)/sizeof(Tcl_WideInt);
+
+#endif
 
 /*
  * Declarations for local procedures to this file:
  */
 
-static int		TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
-			    ByteCode *codePtr));
-static void		DupExprCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, int objc, Tcl_Obj **objv));
-static int		ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprRandFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
-static int		ExprWideFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExecEnv *eePtr, ClientData clientData));
 #ifdef TCL_COMPILE_STATS
-static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
+static int		EvalStatsCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 #endif /* TCL_COMPILE_STATS */
-static void		FreeExprCodeInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr));
-#ifdef TCL_COMPILE_DEBUG
-static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
-#endif /* TCL_COMPILE_DEBUG */
-static ExceptionRange *	GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
-			    int catchOnly, ByteCode* codePtr));
-static char *		GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
-        		    ByteCode* codePtr, int *lengthPtr));
-static void		GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
-static void		IllegalExprOperandType _ANSI_ARGS_((
-			    Tcl_Interp *interp, unsigned char *pc,
-			    Tcl_Obj *opndPtr));
-static void		InitByteCodeExecution _ANSI_ARGS_((
-			    Tcl_Interp *interp));
 #ifdef TCL_COMPILE_DEBUG
-static void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
-static CONST char *	StringForResultCode _ANSI_ARGS_((int result));
-static void		ValidatePcAndStackTop _ANSI_ARGS_((
-			    ByteCode *codePtr, unsigned char *pc,
-			    int stackTop, int stackLowerBound));
+static char *		GetOpcodeName(unsigned char *pc);
+static void		PrintByteCodeInfo(ByteCode *codePtr);
+static const char *	StringForResultCode(int result);
+static void		ValidatePcAndStackTop(ByteCode *codePtr,
+			    unsigned char *pc, int stackTop,
+			    int stackLowerBound, int checkStack);
 #endif /* TCL_COMPILE_DEBUG */
-static int		VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
+static void		DeleteExecStack(ExecStack *esPtr);
+static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
+static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
+static ExceptionRange *	GetExceptRangeForPc(unsigned char *pc, int catchOnly,
+			    ByteCode *codePtr);
+static const char *	GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr,
+			    int *lengthPtr);
+static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
+			    int move);
+static void		IllegalExprOperandType(Tcl_Interp *interp,
+			    unsigned char *pc, Tcl_Obj *opndPtr);
+static void		InitByteCodeExecution(Tcl_Interp *interp);
+/* Useful elsewhere, make available in tclInt.h or stubs? */
+static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
+static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
 
 /*
  * The structure below defines a bytecode Tcl object type to hold the
@@ -417,44 +642,6 @@ static Tcl_ObjType exprCodeType = {
     NULL,			/* updateStringProc */
     NULL			/* setFromAnyProc */
 };
-
-/*
- * Table describing the built-in math functions. Entries in this table are
- * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
- * operand byte.
- */
-
-BuiltinFunc tclBuiltinFuncTable[] = {
-#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},
-    {"rand", 0, {TCL_EITHER}, ExprRandFunc, 0},	/* NOTE: rand takes no args. */
-    {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
-    {"srand", 1, {TCL_INT}, ExprSrandFunc, 0},
-    {"wide", 1, {TCL_EITHER}, ExprWideFunc, 0},
-    {0, 0, {TCL_INT}, 0, 0},
-};
 
 /*
  *----------------------------------------------------------------------
@@ -469,29 +656,28 @@ BuiltinFunc tclBuiltinFuncTable[] = {
  *
  * Side effects:
  *	This procedure initializes the array of instruction names. If
- *	compiling with the TCL_COMPILE_STATS flag, it initializes the
- *	array that counts the executions of each instruction and it
- *	creates the "evalstats" command. It also establishes the link 
- *      between the Tcl "tcl_traceExec" and C "tclTraceExec" variables.
+ *	compiling with the TCL_COMPILE_STATS flag, it initializes the array
+ *	that counts the executions of each instruction and it creates the
+ *	"evalstats" command. It also establishes the link between the Tcl
+ *	"tcl_traceExec" and C "tclTraceExec" variables.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-InitByteCodeExecution(interp)
-    Tcl_Interp *interp;		/* Interpreter for which the Tcl variable
+InitByteCodeExecution(
+    Tcl_Interp *interp)		/* Interpreter for which the Tcl variable
 				 * "tcl_traceExec" is linked to control
 				 * instruction tracing. */
 {
 #ifdef TCL_COMPILE_DEBUG
     if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
-		    TCL_LINK_INT) != TCL_OK) {
-	panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
+	    TCL_LINK_INT) != TCL_OK) {
+	Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
     }
 #endif
-#ifdef TCL_COMPILE_STATS    
-    Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd,
-	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+#ifdef TCL_COMPILE_STATS
+    Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL);
 #endif /* TCL_COMPILE_STATS */
 }
 
@@ -501,18 +687,18 @@ InitByteCodeExecution(interp)
  * TclCreateExecEnv --
  *
  *	This procedure creates a new execution environment for Tcl bytecode
- *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
- *	is typically created once for each Tcl interpreter (Interp
- *	structure) and recursively passed to TclExecuteByteCode to execute
- *	ByteCode sequences for nested commands.
+ *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
+ *	typically created once for each Tcl interpreter (Interp structure) and
+ *	recursively passed to TclExecuteByteCode to execute ByteCode sequences
+ *	for nested commands.
  *
  * Results:
  *	A newly allocated ExecEnv is returned. This points to an empty
  *	evaluation stack of the standard initial size.
  *
  * Side effects:
- *	The bytecode interpreter is also initialized here, as this
- *	procedure will be called before any call to TclExecuteByteCode.
+ *	The bytecode interpreter is also initialized here, as this procedure
+ *	will be called before any call to TclExecuteByteCode.
  *
  *----------------------------------------------------------------------
  */
@@ -520,33 +706,25 @@ InitByteCodeExecution(interp)
 #define TCL_STACK_INITIAL_SIZE 2000
 
 ExecEnv *
-TclCreateExecEnv(interp)
-    Tcl_Interp *interp;		/* Interpreter for which the execution
+TclCreateExecEnv(
+    Tcl_Interp *interp)		/* Interpreter for which the execution
 				 * environment is being created. */
 {
     ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
-    Tcl_Obj **stackPtr;
+    ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack)
+	    + (size_t) (TCL_STACK_INITIAL_SIZE-1) * sizeof(Tcl_Obj *));
 
-    stackPtr = (Tcl_Obj **)
-	ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
+    eePtr->execStackPtr = esPtr;
+    TclNewBooleanObj(eePtr->constants[0], 0);
+    Tcl_IncrRefCount(eePtr->constants[0]);
+    TclNewBooleanObj(eePtr->constants[1], 1);
+    Tcl_IncrRefCount(eePtr->constants[1]);
 
-    /*
-     * Use the bottom pointer to keep a reference count; the 
-     * execution environment holds a reference.
-     */
-
-    stackPtr++;
-    eePtr->stackPtr = stackPtr;
-    stackPtr[-1] = (Tcl_Obj *) ((char *) 1);
-
-    eePtr->stackTop = -1;
-    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 2);
-
-    eePtr->errorInfo = Tcl_NewStringObj("::errorInfo", -1);
-    Tcl_IncrRefCount(eePtr->errorInfo);
-
-    eePtr->errorCode = Tcl_NewStringObj("::errorCode", -1);
-    Tcl_IncrRefCount(eePtr->errorCode);
+    esPtr->prevPtr = NULL;
+    esPtr->nextPtr = NULL;
+    esPtr->markerPtr = NULL;
+    esPtr->endPtr = &esPtr->stackWords[TCL_STACK_INITIAL_SIZE-1];
+    esPtr->tosPtr = &esPtr->stackWords[-1];
 
     Tcl_MutexLock(&execMutex);
     if (!execInitialized) {
@@ -571,23 +749,50 @@ TclCreateExecEnv(interp)
  *	None.
  *
  * Side effects:
- *	Storage for an ExecEnv and its contained storage (e.g. the
- *	evaluation stack) is freed.
+ *	Storage for an ExecEnv and its contained storage (e.g. the evaluation
+ *	stack) is freed.
  *
  *----------------------------------------------------------------------
  */
 
+static void
+DeleteExecStack(
+    ExecStack *esPtr)
+{
+    if (esPtr->markerPtr) {
+	Tcl_Panic("freeing an execStack which is still in use");
+    }
+
+    if (esPtr->prevPtr) {
+	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
+    }
+    if (esPtr->nextPtr) {
+	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
+    }
+    ckfree((char *) esPtr);
+}
+
 void
-TclDeleteExecEnv(eePtr)
-    ExecEnv *eePtr;		/* Execution environment to free. */
+TclDeleteExecEnv(
+    ExecEnv *eePtr)		/* Execution environment to free. */
 {
-    if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) {
-	ckfree((char *) (eePtr->stackPtr-1));
-    } else {
-	panic("ERROR: freeing an execEnv whose stack is still in use.\n");
+    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
+
+    /*
+     * Delete all stacks in this exec env.
+     */
+
+    while (esPtr->nextPtr) {
+	esPtr = esPtr->nextPtr;
+    }
+    while (esPtr) {
+	tmpPtr = esPtr;
+	esPtr = tmpPtr->prevPtr;
+	DeleteExecStack(tmpPtr);
     }
-    TclDecrRefCount(eePtr->errorInfo);
-    TclDecrRefCount(eePtr->errorCode);
+
+    TclDecrRefCount(eePtr->constants[0]);
+    TclDecrRefCount(eePtr->constants[1]);
     ckfree((char *) eePtr);
 }
 
@@ -596,21 +801,21 @@ TclDeleteExecEnv(eePtr)
  *
  * TclFinalizeExecution --
  *
- *	Finalizes the execution environment setup so that it can be
- *	later reinitialized.
+ *	Finalizes the execution environment setup so that it can be later
+ *	reinitialized.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	After this call, the next time TclCreateExecEnv will be called
- *	it will call InitByteCodeExecution.
+ *	After this call, the next time TclCreateExecEnv will be called it will
+ *	call InitByteCodeExecution.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclFinalizeExecution()
+TclFinalizeExecution(void)
 {
     Tcl_MutexLock(&execMutex);
     execInitialized = 0;
@@ -619,69 +824,326 @@ TclFinalizeExecution()
 }
 
 /*
+ * Auxiliary code to insure that GrowEvaluationStack always returns correctly 
+ * aligned memory.
+ *
+ * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
+ * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
+ * multiple of the wordsize 'sizeof(Tcl_Obj *)'. 
+ */
+
+#define WALLOCALIGN \
+    (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
+
+/*
+ * OFFSET computes how many words have to be skipped until the next aligned
+ * word. Note that we are only interested in the low order bits of ptr, so
+ * that any possible information loss in PTR2INT is of no consequence.
+ */
+
+static inline int
+OFFSET(
+    void *ptr)
+{
+    int mask = TCL_ALLOCALIGN-1;
+    int base = PTR2INT(ptr) & mask;
+    return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
+}
+
+/*
+ * Given a marker, compute where the following aligned memory starts. 
+ */
+
+#define MEMSTART(markerPtr)			\
+    ((markerPtr) + OFFSET(markerPtr))
+
+
+/*
  *----------------------------------------------------------------------
  *
  * GrowEvaluationStack --
  *
- *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
+ *	This procedure grows a Tcl evaluation stack stored in an ExecEnv,
+ *	copying over the words since the last mark if so requested. A mark is
+ *	set at the beginning of the new area when no copying is requested.
  *
  * Results:
- *	None.
+ *	Returns a pointer to the first usable word in the (possibly) grown
+ *	stack.
  *
  * Side effects:
- *	The size of the evaluation stack is doubled.
+ *	The size of the evaluation stack may be grown, a marker is set
  *
  *----------------------------------------------------------------------
  */
 
-static void
-GrowEvaluationStack(eePtr)
-    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
-			      * stack to enlarge. */
+static Tcl_Obj **
+GrowEvaluationStack(
+    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
+				 * stack to enlarge. */
+    int growth,			/* How much larger than the current used
+				 * size. */
+    int move)			/* 1 if move words since last marker. */
 {
+    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
+    int newBytes, newElems, currElems;
+    int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
+    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
+    int moveWords = 0;
+
+    if (move) {
+	if (!markerPtr) {
+	    Tcl_Panic("STACK: Reallocating with no previous alloc");
+	}
+	if (needed <= 0) {
+	    return MEMSTART(markerPtr);
+	}
+    } else {
+	Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
+	int offset = OFFSET(tmpMarkerPtr);
+
+	if (needed + offset < 0) {
+	    /*
+	     * Put a marker pointing to the previous marker in this stack, and 
+	     * store it in esPtr as the current marker. Return a pointer to
+	     * the start of aligned memory.
+	     */
+
+	    esPtr->markerPtr = tmpMarkerPtr;
+	    memStart = tmpMarkerPtr + offset; 
+	    esPtr->tosPtr = memStart - 1;
+	    *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
+	    return memStart;
+	}
+    }
+
     /*
-     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
-     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
+     * Reset move to hold the number of words to be moved to new stack (if
+     * any) and growth to hold the complete stack requirements: add one for
+     * the marker, (WALLOCALIGN-1) for the maximal possible offset.
      */
 
-    int currElems = (eePtr->stackEnd + 1);
-    int newElems  = 2*currElems;
-    int currBytes = currElems * sizeof(Tcl_Obj *);
-    int newBytes  = 2*currBytes;
-    Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
-    Tcl_Obj **oldStackPtr = eePtr->stackPtr;
+    if (move) {
+	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
+    }
+    needed = growth + moveWords + WALLOCALIGN;
 
     /*
-     * We keep the stack reference count as a (char *), as that
-     * works nicely as a portable pointer-sized counter.
+     * Check if there is enough room in the next stack (if there is one, it
+     * should be both empty and the last one!)
      */
 
-    char *refCount = (char *) oldStackPtr[-1];
+    if (esPtr->nextPtr) {
+	oldPtr = esPtr;
+	esPtr = oldPtr->nextPtr;
+	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+	if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
+	    Tcl_Panic("STACK: Stack after current is in use");
+	}
+	if (esPtr->nextPtr) {
+	    Tcl_Panic("STACK: Stack after current is not last");
+	}
+	if (needed <= currElems) {
+	    goto newStackReady;
+	}
+	DeleteExecStack(esPtr);
+	esPtr = oldPtr;
+    } else {
+	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+    }
 
     /*
-     * Copy the existing stack items to the new stack space, free the old
-     * storage if appropriate, and record the refCount of the new stack
-     * held by the environment.
+     * We need to allocate a new stack! It needs to store 'growth' words,
+     * including the elements to be copied over and the new marker.
      */
- 
-    newStackPtr++;
-    memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
-	   (size_t) currBytes);
 
-    if (refCount == (char *) 1) {
-	ckfree((VOID *) (oldStackPtr-1));
-    } else {
-	/*
-	 * Remove the reference corresponding to the
-	 * environment pointer.
-	 */
-	
-	oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
+    newElems = 2*currElems;
+    while (needed > newElems) {
+	newElems *= 2;
     }
+    newBytes = sizeof (ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
+
+    oldPtr = esPtr;
+    esPtr = (ExecStack *) ckalloc(newBytes);
+
+    oldPtr->nextPtr = esPtr;
+    esPtr->prevPtr = oldPtr;
+    esPtr->nextPtr = NULL;
+    esPtr->endPtr = &esPtr->stackWords[newElems-1];
 
-    eePtr->stackPtr = newStackPtr;
-    eePtr->stackEnd = (newElems - 2); /* index of last usable item */
-    newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);	
+  newStackReady:
+    eePtr->execStackPtr = esPtr;
+
+    /*
+     * Store a NULL marker at the beginning of the stack, to indicate that
+     * this is the first marker in this stack and that rewinding to here
+     * should actually be a return to the previous stack.
+     */
+
+    esPtr->stackWords[0] = NULL;
+    esPtr->markerPtr = &esPtr->stackWords[0];
+    memStart = MEMSTART(esPtr->markerPtr);
+    esPtr->tosPtr = memStart - 1;
+    
+    if (move) {
+	memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
+	esPtr->tosPtr += moveWords;
+	oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
+	oldPtr->tosPtr = markerPtr-1;
+    }
+
+    /*
+     * Free the old stack if it is now unused.
+     */
+
+    if (!oldPtr->markerPtr) {
+	DeleteExecStack(oldPtr);
+    }
+
+    return memStart;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclStackAlloc, TclStackRealloc, TclStackFree --
+ *
+ *	Allocate memory from the execution stack; it has to be returned later
+ *	with a call to TclStackFree.
+ *
+ * Results:
+ *	A pointer to the first byte allocated, or panics if the allocation did
+ *	not succeed.
+ *
+ * Side effects:
+ *	The execution stack may be grown.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_Obj **
+StackAllocWords(
+    Tcl_Interp *interp,
+    int numWords)
+{
+    /*
+     * Note that GrowEvaluationStack sets a marker in the stack. This marker
+     * is read when rewinding, e.g., by TclStackFree.
+     */
+
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
+
+    eePtr->execStackPtr->tosPtr += numWords;
+    return resPtr;
+}
+
+static Tcl_Obj **
+StackReallocWords(
+    Tcl_Interp *interp,
+    int numWords)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
+
+    eePtr->execStackPtr->tosPtr += numWords;
+    return resPtr;
+}
+
+void
+TclStackFree(
+    Tcl_Interp *interp,
+    void *freePtr)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr;
+    ExecStack *esPtr;
+    Tcl_Obj **markerPtr;
+
+    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+	ckfree((char *) freePtr);
+	return;
+    }
+
+    /*
+     * Rewind the stack to the previous marker position. The current marker,
+     * as set in the last call to GrowEvaluationStack, contains a pointer to
+     * the previous marker.
+     */
+
+    eePtr = iPtr->execEnvPtr;
+    esPtr = eePtr->execStackPtr;
+    markerPtr = esPtr->markerPtr;
+
+    if (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr) {
+	Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?");
+    }
+
+    esPtr->tosPtr = markerPtr-1;
+    esPtr->markerPtr = (Tcl_Obj **) *markerPtr;
+    if (*markerPtr) {
+ 	return;
+    }
+
+    /*
+     * Return to previous stack.
+     */
+
+    esPtr->tosPtr = &esPtr->stackWords[-1];
+    if (esPtr->prevPtr) {
+ 	eePtr->execStackPtr = esPtr->prevPtr;
+    }
+    if (esPtr->nextPtr) {
+ 	if (!esPtr->prevPtr) {
+ 	    eePtr->execStackPtr = esPtr->nextPtr;
+ 	}
+ 	DeleteExecStack(esPtr);
+    }
+}
+
+void *
+TclStackAlloc(
+    Tcl_Interp *interp,
+    int numBytes)
+{
+    Interp *iPtr = (Interp *) interp;
+    int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
+
+    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+	return (void *) ckalloc(numBytes);
+    }
+
+    return (void *) StackAllocWords(interp, numWords);
+}
+
+void *
+TclStackRealloc(
+    Tcl_Interp *interp,
+    void *ptr,
+    int numBytes)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr;
+    ExecStack *esPtr;
+    Tcl_Obj **markerPtr;
+    int numWords;
+
+    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
+	return (void *) ckrealloc((char *) ptr, numBytes);
+    }
+
+    eePtr = iPtr->execEnvPtr;
+    esPtr = eePtr->execStackPtr;
+    markerPtr = esPtr->markerPtr;
+
+    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
+	Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
+    }
+
+    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
+    return (void *) StackReallocWords(interp, numWords);
 }
 
 /*
@@ -692,167 +1154,97 @@ GrowEvaluationStack(eePtr)
  *	Evaluate an expression in a Tcl_Obj.
  *
  * Results:
- *	A standard Tcl object result. If the result is other than TCL_OK,
- *	then the interpreter's result contains an error message. If the
- *	result is TCL_OK, then a pointer to the expression's result value
- *	object is stored in resultPtrPtr. In that case, the object's ref
- *	count is incremented to reflect the reference returned to the
- *	caller; the caller is then responsible for the resulting object
- *	and must, for example, decrement the ref count when it is finished
- *	with the object.
+ *	A standard Tcl object result. If the result is other than TCL_OK, then
+ *	the interpreter's result contains an error message. If the result is
+ *	TCL_OK, then a pointer to the expression's result value object is
+ *	stored in resultPtrPtr. In that case, the object's ref count is
+ *	incremented to reflect the reference returned to the caller; the
+ *	caller is then responsible for the resulting object and must, for
+ *	example, decrement the ref count when it is finished with the object.
  *
  * Side effects:
- *	Any side effects caused by subcommands in the expression, if any.
- *	The interpreter result is not modified unless there is an error.
+ *	Any side effects caused by subcommands in the expression, if any. The
+ *	interpreter result is not modified unless there is an error.
  *
  *--------------------------------------------------------------
  */
 
 int
-Tcl_ExprObj(interp, objPtr, resultPtrPtr)
-    Tcl_Interp *interp;		/* Context in which to evaluate the
+Tcl_ExprObj(
+    Tcl_Interp *interp,		/* Context in which to evaluate the
 				 * expression. */
-    register Tcl_Obj *objPtr;	/* Points to Tcl object containing
-				 * expression to evaluate. */
-    Tcl_Obj **resultPtrPtr;	/* Where the Tcl_Obj* that is the expression
+    register Tcl_Obj *objPtr,	/* Points to Tcl object containing expression
+				 * to evaluate. */
+    Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
 				 * result is stored if no errors occur. */
 {
     Interp *iPtr = (Interp *) interp;
-    CompileEnv compEnv;		/* Compilation environment structure
-				 * allocated in frame. */
-    LiteralTable *localTablePtr = &(compEnv.localLitTable);
+    CompileEnv compEnv;		/* Compilation environment structure allocated
+				 * in frame. */
     register ByteCode *codePtr = NULL;
-    				/* Tcl Internal type of bytecode.
-				 * Initialized to avoid compiler warning. */
-    AuxData *auxDataPtr;
-    LiteralEntry *entryPtr;
-    Tcl_Obj *saveObjPtr;
-    char *string;
-    int length, i, result;
+    				/* Tcl Internal type of bytecode. Initialized
+				 * to avoid compiler warning. */
+    int result;
 
     /*
-     * First handle some common expressions specially.
+     * Execute the expression after first saving the interpreter's result.
      */
 
-    string = Tcl_GetStringFromObj(objPtr, &length);
-    if (length == 1) {
-	if (*string == '0') {
-	    *resultPtrPtr = Tcl_NewLongObj(0);
-	    Tcl_IncrRefCount(*resultPtrPtr);
-	    return TCL_OK;
-	} else if (*string == '1') {
-	    *resultPtrPtr = Tcl_NewLongObj(1);
-	    Tcl_IncrRefCount(*resultPtrPtr);
-	    return TCL_OK;
-	}
-    } else if ((length == 2) && (*string == '!')) {
-	if (*(string+1) == '0') {
-	    *resultPtrPtr = Tcl_NewLongObj(1);
-	    Tcl_IncrRefCount(*resultPtrPtr);
-	    return TCL_OK;
-	} else if (*(string+1) == '1') {
-	    *resultPtrPtr = Tcl_NewLongObj(0);
-	    Tcl_IncrRefCount(*resultPtrPtr);
-	    return TCL_OK;
-	}
-    }
-
-    /*
-     * Compile and execute the expression after saving the interp's result.
-     */
-    
-    saveObjPtr = Tcl_GetObjResult(interp);
+    Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
     Tcl_IncrRefCount(saveObjPtr);
 
     /*
      * Get the expression ByteCode from the object. If it exists, make sure it
      * is valid in the current context.
      */
-
     if (objPtr->typePtr == &exprCodeType) {
-	Namespace *namespacePtr = iPtr->varFramePtr ?
-		iPtr->varFramePtr->nsPtr : iPtr->globalNsPtr;
+	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
 
-	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
-	        || (codePtr->compileEpoch != iPtr->compileEpoch)
-	        || (codePtr->nsPtr != namespacePtr)
-	        || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
+		|| (codePtr->compileEpoch != iPtr->compileEpoch)
+		|| (codePtr->nsPtr != namespacePtr)
+		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
 	    objPtr->typePtr->freeIntRepProc(objPtr);
 	    objPtr->typePtr = (Tcl_ObjType *) NULL;
 	}
     }
     if (objPtr->typePtr != &exprCodeType) {
-#ifndef TCL_TIP280
-	TclInitCompileEnv(interp, &compEnv, string, length);
-#else
-	/* TIP #280 : No invoker (yet) - Expression compilation */
-	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
-#endif
-	result = TclCompileExpr(interp, string, length, &compEnv);
-
 	/*
-	 * Free the compilation environment's literal table bucket array if
-	 * it was dynamically allocated. 
+	 * TIP #280: No invoker (yet) - Expression compilation.
 	 */
 
-	if (localTablePtr->buckets != localTablePtr->staticBuckets) {
-	    ckfree((char *) localTablePtr->buckets);
-	}
-    
-	if (result != TCL_OK) {
-	    /*
-	     * Compilation errors. Free storage allocated for compilation.
-	     */
+	int length;
+	const char *string = TclGetStringFromObj(objPtr, &length);
 
-#ifdef TCL_COMPILE_DEBUG
-	    TclVerifyLocalLiteralTable(&compEnv);
-#endif /*TCL_COMPILE_DEBUG*/
-	    entryPtr = compEnv.literalArrayPtr;
-	    for (i = 0;  i < compEnv.literalArrayNext;  i++) {
-		TclReleaseLiteral(interp, entryPtr->objPtr);
-		entryPtr++;
-	    }
-#ifdef TCL_COMPILE_DEBUG
-	    TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-    
-	    auxDataPtr = compEnv.auxDataArrayPtr;
-	    for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
-		if (auxDataPtr->type->freeProc != NULL) {
-		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
-		}
-		auxDataPtr++;
-	    }
-	    TclFreeCompileEnv(&compEnv);
-	    goto done;
-	}
+	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+	TclCompileExpr(interp, string, length, &compEnv, 0);
 
 	/*
-	 * Successful compilation. If the expression yielded no
-	 * instructions, push an zero object as the expression's result.
+	 * Successful compilation. If the expression yielded no instructions,
+	 * push an zero object as the expression's result.
 	 */
-	    
+
 	if (compEnv.codeNext == compEnv.codeStart) {
-	    TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
-	            &compEnv);
+	    TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
+		    &compEnv);
 	}
-	    
+
 	/*
 	 * Add a "done" instruction as the last instruction and change the
-	 * object into a ByteCode object. Ownership of the literal objects
-	 * and aux data items is given to the ByteCode object.
+	 * object into a ByteCode object. Ownership of the literal objects and
+	 * aux data items is given to the ByteCode object.
 	 */
 
-	compEnv.numSrcBytes = iPtr->termOffset;
 	TclEmitOpcode(INST_DONE, &compEnv);
 	TclInitByteCodeObj(objPtr, &compEnv);
 	objPtr->typePtr = &exprCodeType;
 	TclFreeCompileEnv(&compEnv);
-	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile == 2) {
 	    TclPrintByteCodeObj(interp, objPtr);
+	    fflush(stdout);
 	}
 #endif /* TCL_COMPILE_DEBUG */
     }
@@ -863,30 +1255,29 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
      * Increment the code's ref count while it is being executed. If
      * afterwards no references to it remain, free the code.
      */
-    
+
     codePtr->refCount++;
     result = TclExecuteByteCode(interp, codePtr);
     codePtr->refCount--;
     if (codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
-    
+
     /*
-     * If the expression evaluated successfully, store a pointer to its
-     * value object in resultPtrPtr then restore the old interpreter result.
-     * We increment the object's ref count to reflect the reference that we
-     * are returning to the caller. We also decrement the ref count of the
-     * interpreter's result object after calling Tcl_SetResult since we
-     * next store into that field directly.
+     * If the expression evaluated successfully, store a pointer to its value
+     * object in resultPtrPtr then restore the old interpreter result. We
+     * increment the object's ref count to reflect the reference that we are
+     * returning to the caller. We also decrement the ref count of the
+     * interpreter's result object after calling Tcl_SetResult since we next
+     * store into that field directly.
      */
-    
+
     if (result == TCL_OK) {
 	*resultPtrPtr = iPtr->objResultPtr;
 	Tcl_IncrRefCount(iPtr->objResultPtr);
-	
+
 	Tcl_SetObjResult(interp, saveObjPtr);
     }
-done:
     TclDecrRefCount(saveObjPtr);
     return result;
 }
@@ -900,14 +1291,14 @@ done:
  *	bytecode.  We do not copy the bytecode intrep.  Instead, we
  *	return without setting copyPtr->typePtr, so the copy is a plain
  *	string copy of the expression value, and if it is to be used
- *	as a compiled expression, it will just need a recompile.
+ * 	as a compiled expression, it will just need a recompile.
  *
  *	This makes sense, because with Tcl's copy-on-write practices,
  *	the usual (only?) time Tcl_DuplicateObj() will be called is
  *	when the copy is about to be modified, which would invalidate
- *	any copied bytecode anyway.  The only reason it might make sense
- *	to copy the bytecode is if we had some modifying routines that
- *	operated directly on the intrep, like we do for lists and dicts.
+ * 	any copied bytecode anyway.  The only reason it might make sense
+ * 	to copy the bytecode is if we had some modifying routines that
+ * 	operated directly on the intrep, like we do for lists and dicts.
  *
  * Results:
  *	None.
@@ -932,7 +1323,7 @@ DupExprCodeInternalRep(
  * FreeExprCodeInternalRep --
  *
  *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode.  Frees the storage allocated to hold the internal rep,
+ * 	bytecode.  Frees the storage allocated to hold the internal rep,
  *	unless ref counts indicate bytecode execution is still in progress.
  *
  * Results:
@@ -947,14 +1338,13 @@ static void
 FreeExprCodeInternalRep(
     Tcl_Obj *objPtr)
 {
-    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
 
     codePtr->refCount--;
     if (codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
     objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
 }
 
 /*
@@ -962,14 +1352,13 @@ FreeExprCodeInternalRep(
  *
  * TclCompEvalObj --
  *
- *	This procedure evaluates the script contained in a Tcl_Obj by 
- *      first compiling it and then passing it to TclExecuteByteCode.
+ *	This procedure evaluates the script contained in a Tcl_Obj by first
+ *	compiling it and then passing it to TclExecuteByteCode.
  *
  * Results:
- *	The return value is one of the return codes defined in tcl.h
- *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
- *	that either contains the result of executing the code or an
- *	error message.
+ *	The return value is one of the return codes defined in tcl.h (such as
+ *	TCL_OK), and interp->objResultPtr refers to a Tcl object that either
+ *	contains the result of executing the code or an error message.
  *
  * Side effects:
  *	Almost certainly, depending on the ByteCode's instructions.
@@ -978,174 +1367,327 @@ FreeExprCodeInternalRep(
  */
 
 int
-#ifndef TCL_TIP280
-TclCompEvalObj(interp, objPtr)
-#else
-TclCompEvalObj(interp, objPtr, invoker, word)
-#endif
-    Tcl_Interp *interp;
-    Tcl_Obj *objPtr;
-#ifdef TCL_TIP280
-    CONST CmdFrame* invoker; /* Frame of the command doing the eval  */
-    int             word;    /* Index of the word which is in objPtr */
-#endif
+TclCompEvalObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    const CmdFrame *invoker,
+    int word)
 {
     register Interp *iPtr = (Interp *) interp;
-    register ByteCode* codePtr;		/* Tcl Internal type of bytecode. */
-    int oldCount = iPtr->cmdCount;	/* Used to tell whether any commands
-					 * at all were executed. */
-    char *script;
-    int numSrcBytes;
+    register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
     int result;
     Namespace *namespacePtr;
 
-
     /*
-     * Check that the interpreter is ready to execute scripts
+     * Check that the interpreter is ready to execute scripts. Note that we
+     * manage the interp's runlevel here: it is a small white lie (maybe), but
+     * saves a ++/-- pair at each invocation. Amazingly enough, the impact on
+     * performance is noticeable.
      */
 
     iPtr->numLevels++;
     if (TclInterpReady(interp) == TCL_ERROR) {
-	iPtr->numLevels--;
-	return TCL_ERROR;
+	result = TCL_ERROR;
+	goto done;
     }
 
-    if (iPtr->varFramePtr != NULL) {
-        namespacePtr = iPtr->varFramePtr->nsPtr;
-    } else {
-        namespacePtr = iPtr->globalNsPtr;
-    }
+    namespacePtr = iPtr->varFramePtr->nsPtr;
 
-    /* 
-     * If the object is not already of tclByteCodeType, compile it (and
-     * reset the compilation flags in the interpreter; this should be 
-     * done after any compilation).
-     * Otherwise, check that it is "fresh" enough.
+    /*
+     * If the object is not already of tclByteCodeType, compile it (and reset
+     * the compilation flags in the interpreter; this should be done after any
+     * compilation). Otherwise, check that it is "fresh" enough.
      */
 
-    if (objPtr->typePtr != &tclByteCodeType) {
-        recompileObj:
-	iPtr->errorLine = 1; 
-
-#ifdef TCL_TIP280
-	/* TIP #280. Remember the invoker for a moment in the interpreter
-	 * structures so that the byte code compiler can pick it up when
-	 * initializing the compilation environment, i.e. the extended
-	 * location information.
-	 */
-
-	iPtr->invokeCmdFramePtr = invoker;
-	iPtr->invokeWord        = word;
-#endif
-	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
-#ifdef TCL_TIP280
-	iPtr->invokeCmdFramePtr = NULL;
-#endif
-
-	if (result != TCL_OK) {
-	    iPtr->numLevels--;
-	    return result;
-	}
-	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-    } else {
+    if (objPtr->typePtr == &tclByteCodeType) {
 	/*
-	 * Make sure the Bytecode hasn't been invalidated by, e.g., someone 
-	 * redefining a command with a compile procedure (this might make the 
-	 * compiled code wrong). 
-	 * The object needs to be recompiled if it was compiled in/for a 
-	 * different interpreter, or for a different namespace, or for the 
-	 * same namespace but with different name resolution rules. 
-	 * Precompiled objects, however, are immutable and therefore
-	 * they are not recompiled, even if the epoch has changed.
+	 * Make sure the Bytecode hasn't been invalidated by, e.g., someone
+	 * redefining a command with a compile procedure (this might make the
+	 * compiled code wrong). The object needs to be recompiled if it was
+	 * compiled in/for a different interpreter, or for a different
+	 * namespace, or for the same namespace but with different name
+	 * resolution rules. Precompiled objects, however, are immutable and
+	 * therefore they are not recompiled, even if the epoch has changed.
 	 *
 	 * To be pedantically correct, we should also check that the
 	 * originating procPtr is the same as the current context procPtr
-	 * (assuming one exists at all - none for global level).  This
-	 * code is #def'ed out because [info body] was changed to never
-	 * return a bytecode type object, which should obviate us from
-	 * the extra checks here.
+	 * (assuming one exists at all - none for global level). This code is
+	 * #def'ed out because [info body] was changed to never return a
+	 * bytecode type object, which should obviate us from the extra checks
+	 * here.
 	 */
-	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
-	        || (codePtr->compileEpoch != iPtr->compileEpoch)
-#ifdef CHECK_PROC_ORIGINATION	/* [Bug: 3412 Pedantic] */
-		|| (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
-			iPtr->varFramePtr->procPtr == codePtr->procPtr))
-#endif
-	        || (codePtr->nsPtr != namespacePtr)
-	        || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
-            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-                if ((Interp *) *codePtr->interpHandle != iPtr) {
-                    panic("Tcl_EvalObj: compiled script jumped interps");
-                }
-	        codePtr->compileEpoch = iPtr->compileEpoch;
-            } else {
+		|| (codePtr->compileEpoch != iPtr->compileEpoch)
+		|| (codePtr->nsPtr != namespacePtr)
+		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
+	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+		if ((Interp *) *codePtr->interpHandle != iPtr) {
+		    Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
+		}
+		codePtr->compileEpoch = iPtr->compileEpoch;
+	    } else {
 		/*
-		 * This byteCode is invalid: free it and recompile
+		 * This byteCode is invalid: free it and recompile.
 		 */
-                tclByteCodeType.freeIntRepProc(objPtr);
+
+		objPtr->typePtr->freeIntRepProc(objPtr);
 		goto recompileObj;
 	    }
 	}
-    }
 
-    /*
-     * Execute the commands. If the code was compiled from an empty string,
-     * don't bother executing the code.
-     */
+	/*
+	 * #280.
+	 * Literal sharing fix. This part of the fix is not required by 8.4
+	 * because it eval-directs any literals, so just saving the argument
+	 * locations per command in bytecode is enough, embedded 'eval'
+	 * commands, etc. get the correct information.
+	 *
+	 * It had be backported for 8.5 because we can force the separate
+	 * compiling of a literal (in a proc body) by putting it into a control
+	 * command with dynamic pieces, and then such literal may be shared
+	 * and require their line-information to be reset, as for 8.6, as
+	 * described below.
+	 *
+	 * In 8.6 all the embedded script are compiled, and the resulting
+	 * bytecode stored in the literal. Now the shared literal has bytecode
+	 * with location data for _one_ particular location this literal is
+	 * found at. If we get executed from a different location the bytecode
+	 * has to be recompiled to get the correct locations. Not doing this
+	 * will execute the saved bytecode with data for a different location,
+	 * causing 'info frame' to point to the wrong place in the sources.
+	 *
+	 * Future optimizations ...
+	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
+	 *     case we recompile once per location of the literal, but not
+	 *     continously, because the moment we have all locations we do not
+	 *     need to recompile any longer.
+	 *
+	 * (2) Alternative: Do not recompile, tell the execution engine the
+	 *     offset between saved starting line and actual one. Then modify
+	 *     the users to adjust the locations they have by this offset.
+	 *
+	 * (3) Alternative 2: Do not fully recompile, adjust just the location
+	 *     information.
+	 */
+
+	if (invoker) {
+	    Tcl_HashEntry *hePtr =
+		    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+
+	    if (hePtr) {
+		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
+		int redo = 0;
+		CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
+
+		*ctxPtr = *invoker;
+
+		if (invoker->type == TCL_LOCATION_BC) {
+		    /*
+		     * Note: Type BC => ctx.data.eval.path    is not used.
+		     *		    ctx.data.tebc.codePtr used instead
+		     */
+		    
+		    TclGetSrcInfoForPc(ctxPtr);
+		    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+			/*
+			 * The reference made by 'TclGetSrcInfoForPc' is
+			 * dead.
+			 */
+			
+			Tcl_DecrRefCount(ctxPtr->data.eval.path);
+			ctxPtr->data.eval.path = NULL;
+		    }
+		}
+		
+		if (word < ctxPtr->nline) {
+		    /*
+		     * Note: We do not care if the line[word] is -1. This
+		     * is a difference and requires a recompile (location
+		     * changed from absolute to relative, literal is used
+		     * fixed and through variable)
+		     *
+		     * Example:
+		     * test info-32.0 using literal of info-24.8
+		     *     (dict with ... vs           set body ...).
+		     */
+		    
+		    redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+			    && (eclPtr->start != ctxPtr->line[word]))
+			|| ((eclPtr->type == TCL_LOCATION_BC)
+				&& (ctxPtr->type == TCL_LOCATION_SOURCE));
+		}
+		
+		TclStackFree(interp, ctxPtr);
+	    
+		if (redo) {
+		    goto recompileObj;
+		}
+	    }
+	}
 
-    numSrcBytes = codePtr->numSrcBytes;
-    if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
 	/*
 	 * Increment the code's ref count while it is being executed. If
 	 * afterwards no references to it remain, free the code.
 	 */
-	
+
+    runCompiledObj:
 	codePtr->refCount++;
 	result = TclExecuteByteCode(interp, codePtr);
 	codePtr->refCount--;
 	if (codePtr->refCount <= 0) {
 	    TclCleanupByteCode(codePtr);
 	}
-    } else {
-	result = TCL_OK;
+	goto done;
     }
-    iPtr->numLevels--;
 
+    recompileObj:
+    iPtr->errorLine = 1;
 
     /*
-     * If no commands at all were executed, check for asynchronous
-     * handlers so that they at least get one change to execute.
-     * This is needed to handle event loops written in Tcl with
-     * empty bodies.
+     * TIP #280. Remember the invoker for a moment in the interpreter
+     * structures so that the byte code compiler can pick it up when
+     * initializing the compilation environment, i.e. the extended location
+     * information.
      */
 
-    if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
-	result = Tcl_AsyncInvoke(interp, result);
-    
+    iPtr->invokeCmdFramePtr = invoker;
+    iPtr->invokeWord = word;
+    tclByteCodeType.setFromAnyProc(interp, objPtr);
+    iPtr->invokeCmdFramePtr = NULL;
+    codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
+    goto runCompiledObj;
 
+    done:
+    iPtr->numLevels--;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIncrObj --
+ *
+ *	Increment an integeral value in a Tcl_Obj by an integeral value held
+ *	in another Tcl_Obj. Caller is responsible for making sure we can
+ *	update the first object.
+ *
+ * Results:
+ *	TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
+ *	error, an error message is left in the interpreter (if it is not NULL,
+ *	of course).
+ *
+ * Side effects:
+ *	valuePtr gets the new incrmented value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIncrObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *valuePtr,
+    Tcl_Obj *incrPtr)
+{
+    ClientData ptr1, ptr2;
+    int type1, type2;
+    mp_int value, incr;
+
+    if (Tcl_IsShared(valuePtr)) {
+	Tcl_Panic("%s called with shared object", "TclIncrObj");
+    }
+
+    if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
 	/*
-	 * If an error occurred, record information about what was being
-	 * executed when the error occurred.
+	 * Produce error message (reparse?!)
 	 */
-	
-	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+
+	return TclGetIntFromObj(interp, valuePtr, &type1);
+    }
+    if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) {
+	/*
+	 * Produce error message (reparse?!)
+	 */
+
+	TclGetIntFromObj(interp, incrPtr, &type1);
+	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
+	return TCL_ERROR;
+    }
+
+    if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	long augend = *((const long *) ptr1);
+	long addend = *((const long *) ptr2);
+	long sum = augend + addend;
+
+	/*
+	 * Overflow when (augend and sum have different sign) and (augend and
+	 * addend have the same sign). This is encapsulated in the Overflowing
+	 * macro.
+	 */
+
+	if (!Overflowing(augend, addend, sum)) {
+	    TclSetLongObj(valuePtr, sum);
+	    return TCL_OK;
+	}
+#ifndef NO_WIDE_TYPE
+	{
+	    Tcl_WideInt w1 = (Tcl_WideInt) augend;
+	    Tcl_WideInt w2 = (Tcl_WideInt) addend;
+
+	    /*
+	     * We know the sum value is outside the long range, so we use the
+	     * macro form that doesn't range test again.
+	     */
+
+	    TclSetWideIntObj(valuePtr, w1 + w2);
+	    return TCL_OK;
 	}
+#endif
     }
 
-    /*
-     * Set the interpreter's termOffset member to the offset of the
-     * character just after the last one executed. We approximate the offset
-     * of the last character executed by using the number of characters
-     * compiled. 
-     */
+    if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
+	/*
+	 * Produce error message (reparse?!)
+	 */
 
-    iPtr->termOffset = numSrcBytes;
-    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+	return TclGetIntFromObj(interp, valuePtr, &type1);
+    }
+    if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
+	/*
+	 * Produce error message (reparse?!)
+	 */
 
-    return result;
+	TclGetIntFromObj(interp, incrPtr, &type1);
+	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
+	return TCL_ERROR;
+    }
+
+#ifndef NO_WIDE_TYPE
+    if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+	Tcl_WideInt w1, w2, sum;
+
+	TclGetWideIntFromObj(NULL, valuePtr, &w1);
+	TclGetWideIntFromObj(NULL, incrPtr, &w2);
+	sum = w1 + w2;
+
+	/*
+	 * Check for overflow.
+	 */
+
+	if (!Overflowing(w1, w2, sum)) {
+	    Tcl_SetWideIntObj(valuePtr, sum);
+	    return TCL_OK;
+	}
+    }
+#endif
+
+    Tcl_TakeBignumFromObj(interp, valuePtr, &value);
+    Tcl_GetBignumFromObj(interp, incrPtr, &incr);
+    mp_add(&value, &incr, &value);
+    mp_clear(&incr);
+    Tcl_SetBignumObj(valuePtr, &value);
+    return TCL_OK;
 }
 
 /*
@@ -1153,59 +1695,86 @@ TclCompEvalObj(interp, objPtr, invoker, word)
  *
  * TclExecuteByteCode --
  *
- *	This procedure executes the instructions of a ByteCode structure.
- *	It returns when a "done" instruction is executed or an error occurs.
+ *	This procedure executes the instructions of a ByteCode structure. It
+ *	returns when a "done" instruction is executed or an error occurs.
  *
  * Results:
- *	The return value is one of the return codes defined in tcl.h
- *	(such as TCL_OK), and interp->objResultPtr refers to a Tcl object
- *	that either contains the result of executing the code or an
- *	error message.
+ *	The return value is one of the return codes defined in tcl.h (such as
+ *	TCL_OK), and interp->objResultPtr refers to a Tcl object that either
+ *	contains the result of executing the code or an error message.
  *
  * Side effects:
  *	Almost certainly, depending on the ByteCode's instructions.
  *
  *----------------------------------------------------------------------
  */
- 
-static int
-TclExecuteByteCode(interp, codePtr)
-    Tcl_Interp *interp;		/* Token for command interpreter. */
-    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
+
+int
+TclExecuteByteCode(
+    Tcl_Interp *interp,		/* Token for command interpreter. */
+    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
 {
-    Interp *iPtr = (Interp *) interp;
-    ExecEnv *eePtr = iPtr->execEnvPtr;
-    				/* Points to the execution environment. */
-    register Tcl_Obj **stackPtr = eePtr->stackPtr;
-    				/* Cached evaluation stack base pointer. */
-    register int stackTop = eePtr->stackTop;
-    				/* Cached top index of evaluation stack. */
+    /*
+     * Compiler cast directive - not a real variable.
+     *	   Interp *iPtr = (Interp *) interp;
+     */
+#define iPtr ((Interp *) interp)
+
+    /*
+     * Check just the read-traced/write-traced bit of a variable.
+     */
+
+#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ)
+#define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE)
+
+    /*
+     * Constants: variables that do not change during the execution, used
+     * sporadically.
+     */
+
+    ExecStack *esPtr;
+    Tcl_Obj **initTosPtr;	/* Stack top at start of execution. */
+    ptrdiff_t *initCatchTop;	/* Catch stack top at start of execution. */
+    Var *compiledLocals;
+    Namespace *namespacePtr;
+    CmdFrame *bcFramePtr;	/* TIP #280: Structure for tracking lines. */
+    Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
+
+    /*
+     * Globals: variables that store state, must remain valid at all times.
+     */
+
+    ptrdiff_t *catchTop;
+    register Tcl_Obj **tosPtr;	/* Cached pointer to top of evaluation
+				 * stack. */
     register unsigned char *pc = codePtr->codeStart;
 				/* The current program counter. */
-    int opnd;			/* Current instruction's operand byte(s). */
-    int pcAdjustment;		/* Hold pc adjustment after instruction. */
-    int initStackTop = stackTop;/* Stack top at start of execution. */
-    ExceptionRange *rangePtr;	/* Points to closest loop or catch exception
-				 * range enclosing the pc. Used by various
-				 * instructions and processCatch to
-				 * process break, continue, and errors. */
-    int result = TCL_OK;	/* Return code returned after execution. */
-    int storeFlags;
-    Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
-    char *bytes;
-    int length;
-    long i = 0;			/* Init. avoids compiler warning. */
-    Tcl_WideInt w;
+    int instructionCount = 0;	/* Counter that is used to work out when to
+				 * call Tcl_AsyncReady() */
+    Tcl_Obj *expandNestList = NULL;
+    int checkInterp = 0;	/* Indicates when a check of interp readyness
+				 * is necessary. Set by CACHE_STACK_INFO() */
+
+    /*
+     * Transfer variables - needed only between opcodes, but not while
+     * executing an instruction.
+     */
+
     register int cleanup;
     Tcl_Obj *objResultPtr;
-    char *part1, *part2;
-    Var *varPtr, *arrayPtr;
-    CallFrame *varFramePtr = iPtr->varFramePtr;
 
-#ifdef TCL_TIP280
-    /* TIP #280 : Structures for tracking lines */
-    CmdFrame bcFrame;
-#endif
+    /*
+     * Result variable - needed only when going to checkForcatch or other
+     * error handlers; also used as local in some opcodes.
+     */
+
+    int result = TCL_OK;	/* Return code returned after execution. */
+
+    /*
+     * Locals - variables that are used within opcodes or bounded sections of
+     * the file (jumps between opcodes within a family).
+     * NOTE: These are now defined locally where needed.
+     */
 
 #ifdef TCL_COMPILE_DEBUG
     int traceInstructions = (tclTraceExec == 3);
@@ -1214,307 +1783,604 @@ TclExecuteByteCode(interp, codePtr)
     char *curInstName = NULL;
 
     /*
-     * This procedure uses a stack to hold information about catch commands.
-     * This information is the current operand stack top when starting to
-     * execute the code for each catch command. It starts out with stack-
-     * allocated space but uses dynamically-allocated storage if needed.
+     * The execution uses a unified stack: first the catch stack, immediately
+     * above it a CmdFrame, then the execution stack.
+     *
+     * Make sure the catch stack is large enough to hold the maximum number of
+     * catch commands that could ever be executing at the same time (this will
+     * be no more than the exception range array's depth). Make sure the
+     * execution stack is large enough to execute this ByteCode.
      */
 
-#define STATIC_CATCH_STACK_SIZE 4
-    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
-    int *catchStackPtr = catchStackStorage;
-    int catchTop = -1;
-
-#ifdef TCL_TIP280
-    /* TIP #280 : Initialize the frame. Do not push it yet. */
-
-    bcFrame.type      = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
-			 ? TCL_LOCATION_PREBC
-			 : TCL_LOCATION_BC);
-    bcFrame.level     = (iPtr->cmdFramePtr == NULL ?
-			 1 :
-			 iPtr->cmdFramePtr->level + 1);
-    bcFrame.framePtr  = iPtr->framePtr;
-    bcFrame.nextPtr   = iPtr->cmdFramePtr;
-    bcFrame.nline     = 0;
-    bcFrame.line      = NULL;
-
-    bcFrame.data.tebc.codePtr  = codePtr;
-    bcFrame.data.tebc.pc       = NULL;
-    bcFrame.cmd.str.cmd        = NULL;
-    bcFrame.cmd.str.len        = 0;
-#endif
+    catchTop = initCatchTop = (ptrdiff_t *) (
+	GrowEvaluationStack(iPtr->execEnvPtr,
+		(sizeof(CmdFrame) + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *) +
+		codePtr->maxExceptDepth + codePtr->maxStackDepth, 0) - 1);
+    bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1);
+    tosPtr = initTosPtr = ((Tcl_Obj **) (bcFramePtr + 1)) - 1;
+    esPtr = iPtr->execEnvPtr->execStackPtr;
+
+    /*
+     * TIP #280: Initialize the frame. Do not push it yet.
+     */
+
+    bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+	    ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
+    bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
+    bcFramePtr->framePtr = iPtr->framePtr;
+    bcFramePtr->nextPtr = iPtr->cmdFramePtr;
+    bcFramePtr->nline = 0;
+    bcFramePtr->line = NULL;
+
+    bcFramePtr->data.tebc.codePtr = codePtr;
+    bcFramePtr->data.tebc.pc = NULL;
+    bcFramePtr->cmd.str.cmd = NULL;
+    bcFramePtr->cmd.str.len = 0;
 
 #ifdef TCL_COMPILE_DEBUG
     if (tclTraceExec >= 2) {
 	PrintByteCodeInfo(codePtr);
-	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
+	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
 	fflush(stdout);
     }
-    opnd = 0;			/* Init. avoids compiler warning. */       
 #endif
-    
+
 #ifdef TCL_COMPILE_STATS
     iPtr->stats.numExecutions++;
 #endif
 
-    /*
-     * Make sure the catch stack is large enough to hold the maximum number
-     * of catch commands that could ever be executing at the same time. This
-     * will be no more than the exception range array's depth.
-     */
-
-    if (codePtr->maxExceptDepth > STATIC_CATCH_STACK_SIZE) {
-	catchStackPtr = (int *)
-	        ckalloc(codePtr->maxExceptDepth * sizeof(int));
-    }
+    namespacePtr = iPtr->varFramePtr->nsPtr;
+    compiledLocals = iPtr->varFramePtr->compiledLocals;
 
     /*
-     * Make sure the stack has enough room to execute this ByteCode.
-     */
-
-    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
-        GrowEvaluationStack(eePtr); 
-        stackPtr = eePtr->stackPtr;
-    }
-
-    /*
-     * Loop executing instructions until a "done" instruction, a 
-     * TCL_RETURN, or some error.
+     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
+     * or some error.
      */
 
     goto cleanup0;
 
-    
     /*
-     * Targets for standard instruction endings; unrolled
-     * for speed in the most frequent cases (instructions that 
-     * consume up to two stack elements).
+     * Targets for standard instruction endings; unrolled for speed in the
+     * most frequent cases (instructions that consume up to two stack
+     * elements).
      *
-     * This used to be a "for(;;)" loop, with each instruction doing
-     * its own cleanup.
+     * This used to be a "for(;;)" loop, with each instruction doing its own
+     * cleanup.
      */
-    
+
+    {
+	Tcl_Obj *valuePtr;
+
     cleanupV_pushObjResultPtr:
-    switch (cleanup) {
-        case 0:
-	    stackPtr[++stackTop] = (objResultPtr);
+	switch (cleanup) {
+	case 0:
+	    *(++tosPtr) = (objResultPtr);
 	    goto cleanup0;
-        default:
+	default:
 	    cleanup -= 2;
 	    while (cleanup--) {
 		valuePtr = POP_OBJECT();
 		TclDecrRefCount(valuePtr);
 	    }
-        case 2: 
-        cleanup2_pushObjResultPtr:
+	case 2:
+	cleanup2_pushObjResultPtr:
 	    valuePtr = POP_OBJECT();
 	    TclDecrRefCount(valuePtr);
-        case 1: 
-        cleanup1_pushObjResultPtr:
-	    valuePtr = stackPtr[stackTop];
+	case 1:
+	cleanup1_pushObjResultPtr:
+	    valuePtr = OBJ_AT_TOS;
 	    TclDecrRefCount(valuePtr);
-    }
-    stackPtr[stackTop] = objResultPtr;
-    goto cleanup0;
-    
+	}
+	OBJ_AT_TOS = objResultPtr;
+	goto cleanup0;
+
     cleanupV:
-    switch (cleanup) {
-        default:
+	switch (cleanup) {
+	default:
 	    cleanup -= 2;
 	    while (cleanup--) {
 		valuePtr = POP_OBJECT();
 		TclDecrRefCount(valuePtr);
 	    }
-        case 2: 
-        cleanup2:
+	case 2:
+	cleanup2:
 	    valuePtr = POP_OBJECT();
 	    TclDecrRefCount(valuePtr);
-        case 1: 
-        cleanup1:
+	case 1:
+	cleanup1:
 	    valuePtr = POP_OBJECT();
 	    TclDecrRefCount(valuePtr);
-        case 0:
+	case 0:
 	    /*
-	     * We really want to do nothing now, but this is needed
-	     * for some compilers (SunPro CC)
+	     * We really want to do nothing now, but this is needed for some
+	     * compilers (SunPro CC).
 	     */
+
 	    break;
+	}
     }
+ cleanup0:
 
-    cleanup0:
-    
 #ifdef TCL_COMPILE_DEBUG
-    ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop);
+    /*
+     * Skip the stack depth check if an expansion is in progress.
+     */
+
+    ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
+	    /*checkStack*/ expandNestList == NULL);
     if (traceInstructions) {
-	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
+	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
 	TclPrintInstruction(codePtr, pc);
 	fflush(stdout);
     }
 #endif /* TCL_COMPILE_DEBUG */
-    
-#ifdef TCL_COMPILE_STATS    
+
+#ifdef TCL_COMPILE_STATS
     iPtr->stats.instructionCount[*pc]++;
 #endif
 
+    /*
+     * Check for asynchronous handlers [Bug 746722]; we do the check every
+     * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+     */
+
+    if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+	/*
+	 * Check for asynchronous handlers [Bug 746722]; we do the check every
+	 * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
+	 */
+
+	if (TclAsyncReady(iPtr)) {
+	    int localResult;
+
+	    DECACHE_STACK_INFO();
+	    localResult = Tcl_AsyncInvoke(interp, result);
+	    CACHE_STACK_INFO();
+	    if (localResult == TCL_ERROR) {
+		result = localResult;
+		goto checkForCatch;
+	    }
+	}
+	if (TclLimitReady(iPtr->limit)) {
+	    int localResult;
+
+	    DECACHE_STACK_INFO();
+	    localResult = Tcl_LimitCheck(interp);
+	    CACHE_STACK_INFO();
+	    if (localResult == TCL_ERROR) {
+		result = localResult;
+		goto checkForCatch;
+	    }
+	}
+    }
+
      TCL_DTRACE_INST_NEXT();
 
+    /*
+     * These two instructions account for 26% of all instructions (according
+     * to measurements on tclbench by Ben Vitale
+     * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf]
+     * Resolving them before the switch reduces the cost of branch
+     * mispredictions, seems to improve runtime by 5% to 15%, and (amazingly!)
+     * reduces total obj size.
+     */
+
+    if (*pc == INST_LOAD_SCALAR1) {
+	goto instLoadScalar1;
+    } else if (*pc == INST_PUSH1) {
+	goto instPush1Peephole;
+    }
+
     switch (*pc) {
+    case INST_SYNTAX:
+    case INST_RETURN_IMM: {
+	int code = TclGetInt4AtPtr(pc+1);
+	int level = TclGetUInt4AtPtr(pc+5);
+
+	/*
+	 * OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr.
+	 */
+
+	TRACE(("%u %u => ", code, level));
+	result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
+	if (result == TCL_OK) {
+	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+		    O2S(objResultPtr)));
+	    NEXT_INST_F(9, 1, 0);
+	} else {
+	    Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
+	    if (*pc == INST_SYNTAX) {
+		iPtr->flags &= ~ERR_ALREADY_LOGGED;
+	    }
+	    cleanup = 2;
+	    goto processExceptionReturn;
+	}
+    }
+
+    case INST_RETURN_STK:
+	TRACE(("=> "));
+	objResultPtr = POP_OBJECT();
+	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+	Tcl_DecrRefCount(OBJ_AT_TOS);
+	OBJ_AT_TOS = objResultPtr;
+	if (result == TCL_OK) {
+	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+		    O2S(objResultPtr)));
+	    NEXT_INST_F(1, 0, 0);
+	} else {
+	    Tcl_SetObjResult(interp, objResultPtr);
+	    cleanup = 1;
+	    goto processExceptionReturn;
+	}
+
     case INST_DONE:
-	if (stackTop <= initStackTop) {
-	    stackTop--;
+	if (tosPtr > initTosPtr) {
+	    /*
+	     * Set the interpreter's object result to point to the topmost
+	     * object from the stack, and check for a possible [catch]. The
+	     * stackTop's level and refCount will be handled by "processCatch"
+	     * or "abnormalReturn".
+	     */
+
+	    Tcl_SetObjResult(interp, OBJ_AT_TOS);
+#ifdef TCL_COMPILE_DEBUG
+	    TRACE_WITH_OBJ(("=> return code=%d, result=", result),
+		    iPtr->objResultPtr);
+	    if (traceInstructions) {
+		fprintf(stdout, "\n");
+	    }
+#endif
+	    goto checkForCatch;
+	} else {
+	    (void) POP_OBJECT();
 	    goto abnormalReturn;
 	}
-	
+
+    case INST_PUSH1:
+    instPush1Peephole:
+	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+	TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
+	pc += 2;
+#if !TCL_COMPILE_DEBUG
 	/*
-	 * Set the interpreter's object result to point to the 
-	 * topmost object from the stack, and check for a possible
-	 * [catch]. The stackTop's level and refCount will be handled 
-	 * by "processCatch" or "abnormalReturn".
+	 * Runtime peephole optimisation: check if we are pushing again.
 	 */
 
-	valuePtr = stackPtr[stackTop];
-	Tcl_SetObjResult(interp, valuePtr);
-#ifdef TCL_COMPILE_DEBUG	    
-	TRACE_WITH_OBJ(("=> return code=%d, result=", result),
-	        iPtr->objResultPtr);
-	if (traceInstructions) {
-	    fprintf(stdout, "\n");
+	if (*pc == INST_PUSH1) {
+	    TCL_DTRACE_INST_NEXT();
+	    goto instPush1Peephole;
 	}
 #endif
-	goto checkForCatch;
-	
-    case INST_PUSH1:
-	objResultPtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
-	TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), objResultPtr);
-	NEXT_INST_F(2, 0, 1);
+	NEXT_INST_F(0, 0, 0);
 
     case INST_PUSH4:
 	objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
 	TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
 
-    case INST_POP:
-	TRACE_WITH_OBJ(("=> discarding "), stackPtr[stackTop]);
+    case INST_POP: {
+	Tcl_Obj *valuePtr;
+
+	TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
 	valuePtr = POP_OBJECT();
 	TclDecrRefCount(valuePtr);
-	NEXT_INST_F(1, 0, 0);
-	
+
+	/*
+	 * Runtime peephole optimisation: an INST_POP is scheduled at the end
+	 * of most commands. If the next instruction is an INST_START_CMD,
+	 * fall through to it.
+	 */
+
+	pc++;
+#if !TCL_COMPILE_DEBUG
+	if (*pc == INST_START_CMD) {
+	    TCL_DTRACE_INST_NEXT();
+	    goto instStartCmdPeephole;
+	}
+#endif
+	NEXT_INST_F(0, 0, 0);
+    }
+
+    case INST_START_CMD:
+#if !TCL_COMPILE_DEBUG
+    instStartCmdPeephole:
+#endif
+	/*
+	 * Remark that if the interpreter is marked for deletion its
+	 * compileEpoch is modified, so that the epoch check also verifies
+	 * that the interp is not deleted. If no outside call has been made
+	 * since the last check, it is safe to omit the check.
+	 */
+
+	iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
+	if (!checkInterp) {
+	instStartCmdOK:
+	    NEXT_INST_F(9, 0, 0);
+	} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
+		&& (codePtr->nsEpoch == namespacePtr->resolverEpoch))
+		|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+	    checkInterp = 0;
+	    goto instStartCmdOK;
+	} else {
+	    const char *bytes;
+	    int length, opnd;
+	    Tcl_Obj *newObjResultPtr;
+
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
+	    DECACHE_STACK_INFO();
+	    result = Tcl_EvalEx(interp, bytes, length, 0);
+	    CACHE_STACK_INFO();
+	    if (result != TCL_OK) {
+		cleanup = 0;
+		if (result == TCL_ERROR) {
+		    /*
+		     * Tcl_EvalEx already did the task of logging
+		     * the error to the stack trace for us, so set
+		     * a flag to prevent the TEBC exception handling
+		     * machinery from trying to do it again.
+		     * Tcl Bug 2037338.  See test execute-8.4.
+		     */
+		    iPtr->flags |= ERR_ALREADY_LOGGED;
+		}
+		goto processExceptionReturn;
+	    }
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    objResultPtr = Tcl_GetObjResult(interp);
+	    TclNewObj(newObjResultPtr);
+	    Tcl_IncrRefCount(newObjResultPtr);
+	    iPtr->objResultPtr = newObjResultPtr;
+	    NEXT_INST_V(opnd, 0, -1);
+	}
+
     case INST_DUP:
-	objResultPtr = stackPtr[stackTop];
+	objResultPtr = OBJ_AT_TOS;
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
-    case INST_OVER:
-	opnd = TclGetUInt4AtPtr( pc+1 );
-	objResultPtr = stackPtr[ stackTop - opnd ];
+    case INST_OVER: {
+	int opnd;
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	objResultPtr = OBJ_AT_DEPTH(opnd);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
+    }
+
+    case INST_REVERSE: {
+	int opnd;
+	Tcl_Obj **a, **b;
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	a = tosPtr-(opnd-1);
+	b = tosPtr;
+	while (a<b) {
+	    Tcl_Obj *temp = *a;
+	    *a = *b;
+	    *b = temp;
+	    a++; b--;
+	}
+	NEXT_INST_F(5, 0, 0);
+    }
+
+    case INST_CONCAT1: {
+	int opnd, length, appendLen = 0;
+	char *bytes, *p;
+	Tcl_Obj **currPtr;
 
-    case INST_CONCAT1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	{
-	    int totalLen = 0;
-	    
-	    /*
-	     * Peephole optimisation for appending an empty string.
-	     * This enables replacing 'K $x [set x{}]' by '$x[set x{}]'
-	     * for fastest execution. Avoid doing the optimisation for wide
-	     * ints - a case where equal strings may refer to different values
-	     * (see [Bug 1251791]).
-	     */
 
-	    if ((opnd == 2) && (stackPtr[stackTop-1]->typePtr != &tclWideIntType)) {
-		Tcl_GetStringFromObj(stackPtr[stackTop], &length);
-		if (length == 0) {
-		    /* Just drop the top item from the stack */
-		    NEXT_INST_F(2, 1, 0);
-		}
+	/*
+	 * Compute the length to be appended.
+	 */
+
+	for (currPtr=&OBJ_AT_DEPTH(opnd-2);
+		appendLen >= 0 && currPtr<=&OBJ_AT_TOS; currPtr++) {
+	    bytes = TclGetStringFromObj(*currPtr, &length);
+	    if (bytes != NULL) {
+		appendLen += length;
+	    }
+	}
+
+	if (appendLen < 0) {
+	    /* TODO: convert panic to error ? */
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
+
+	/*
+	 * If nothing is to be appended, just return the first object by
+	 * dropping all the others from the stack; this saves both the
+	 * computation and copy of the string rep of the first object,
+	 * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
+	 */
+
+	if (appendLen == 0) {
+	    TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+	    NEXT_INST_V(2, (opnd-1), 0);
+	}
+
+	/*
+	 * If the first object is shared, we need a new obj for the result;
+	 * otherwise, we can reuse the first object. In any case, make sure it
+	 * has enough room to accomodate all the concatenated bytes. Note that
+	 * if it is unshared its bytes are copied by ckrealloc, so that we set
+	 * the loop parameters to avoid copying them again: p points to the
+	 * end of the already copied bytes, currPtr to the second object.
+	 */
+
+	objResultPtr = OBJ_AT_DEPTH(opnd-1);
+	bytes = TclGetStringFromObj(objResultPtr, &length);
+	if (length + appendLen < 0) {
+	    /* TODO: convert panic to error ? */
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
+#if !TCL_COMPILE_DEBUG
+	if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
+	    TclFreeIntRep(objResultPtr);
+	    objResultPtr->typePtr = NULL;
+	    objResultPtr->bytes = ckrealloc(bytes, (length + appendLen + 1));
+	    objResultPtr->length = length + appendLen;
+	    p = TclGetString(objResultPtr) + length;
+	    currPtr = &OBJ_AT_DEPTH(opnd - 2);
+	} else {
+#endif
+	    p = (char *) ckalloc((unsigned) (length + appendLen + 1));
+	    TclNewObj(objResultPtr);
+	    objResultPtr->bytes = p;
+	    objResultPtr->length = length + appendLen;
+	    currPtr = &OBJ_AT_DEPTH(opnd - 1);
+#if !TCL_COMPILE_DEBUG
+	}
+#endif
+
+	/*
+	 * Append the remaining characters.
+	 */
+
+	for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
+	    bytes = TclGetStringFromObj(*currPtr, &length);
+	    if (bytes != NULL) {
+		memcpy(p, bytes, (size_t) length);
+		p += length;
 	    }
+	}
+	*p = '\0';
+
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+	NEXT_INST_V(2, opnd, 1);
+    }
+
+    case INST_EXPAND_START: {
+	/*
+	 * Push an element to the expandNestList. This records the current
+	 * stack depth - i.e., the point in the stack where the expanded
+	 * command starts.
+	 *
+	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
+	 * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
+	 * we do not define a special tclObjType for it. It is not dangerous
+	 * as the obj is never passed anywhere, so that all manipulations are
+	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
+	 * error, also in INST_EXPAND_STKTOP).
+	 */
+
+	Tcl_Obj *objPtr;
 
+	TclNewObj(objPtr);
+	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) CURR_DEPTH;
+	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
+	expandNestList = objPtr;
+	NEXT_INST_F(1, 0, 0);
+    }
+
+    case INST_EXPAND_STKTOP: {
+	int objc, length, i;
+	Tcl_Obj **objv, *valuePtr;
+	ptrdiff_t moved;
+
+	/*
+	 * Make sure that the element at stackTop is a list; if not, just
+	 * leave with an error. Note that the element from the expand list
+	 * will be removed at checkForCatch.
+	 */
+
+	valuePtr = OBJ_AT_TOS;
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK){
+	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+		    Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+	(void) POP_OBJECT();
+
+	/*
+	 * Make sure there is enough room in the stack to expand this list
+	 * *and* process the rest of the command (at least up to the next
+	 * argument expansion or command end). The operand is the current
+	 * stack depth, as seen by the compiler.
+	 */
+
+	length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
+	DECACHE_STACK_INFO();
+	moved = (GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - 1)
+		- (Tcl_Obj **) initCatchTop;
+
+	if (moved) {
 	    /*
-	     * Concatenate strings (with no separators) from the top
-	     * opnd items on the stack starting with the deepest item.
-	     * First, determine how many characters are needed.
+	     * Change the global data to point to the new stack.
 	     */
 
-	    for (i = (stackTop - (opnd-1));
-		    totalLen >= 0 && i <= stackTop; i++) {
-		bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
-		if (bytes != NULL) {
-		    totalLen += length;
-		}
-	    }
+	    initCatchTop += moved;
+	    catchTop += moved;
+	    initTosPtr += moved;
+	    tosPtr += moved;
+	    esPtr = iPtr->execEnvPtr->execStackPtr;
+	}
 
-	    if (totalLen < 0) {
-		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
-			INT_MAX);
-	    }
+	/*
+	 * Expand the list at stacktop onto the stack; free the list. Knowing
+	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
+	 */
+
+	for (i = 0; i < objc; i++) {
+	    PUSH_OBJECT(objv[i]);
+	}
 
+	Tcl_DecrRefCount(valuePtr);
+	NEXT_INST_F(5, 0, 0);
+    }
+
+    {
+	/*
+	 * INVOCATION BLOCK
+	 */
+
+	int objc, pcAdjustment;
+
+    case INST_INVOKE_EXPANDED:
+	{
+	    Tcl_Obj *objPtr = expandNestList;
+
+	    expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+	    objc = CURR_DEPTH
+		    - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
+	    TclDecrRefCount(objPtr);
+	}
+
+	if (objc) {
+	    pcAdjustment = 1;
+	    goto doInvocation;
+	} else {
 	    /*
-	     * Initialize the new append string object by appending the
-	     * strings of the opnd stack objects. Also pop the objects. 
+	     * Nothing was expanded, return {}.
 	     */
 
 	    TclNewObj(objResultPtr);
-	    if (totalLen > 0) {
-		char *p = (char *) ckalloc((unsigned) (totalLen + 1));
-		objResultPtr->bytes = p;
-		objResultPtr->length = totalLen;
-		for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
-		    valuePtr = stackPtr[i];
-		    bytes = Tcl_GetStringFromObj(valuePtr, &length);
-		    if (bytes != NULL) {
-			memcpy((VOID *) p, (VOID *) bytes,
-			       (size_t) length);
-			p += length;
-		    }
-		}
-		*p = '\0';
-	    }
-		
-	    TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
-	    NEXT_INST_V(2, opnd, 1);
+	    NEXT_INST_F(1, 0, 1);
 	}
-	    
+
     case INST_INVOKE_STK4:
-	opnd = TclGetUInt4AtPtr(pc+1);
+	objc = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
 	goto doInvocation;
 
     case INST_INVOKE_STK1:
-	opnd = TclGetUInt1AtPtr(pc+1);
+	objc = TclGetUInt1AtPtr(pc+1);
 	pcAdjustment = 2;
-	    
+
     doInvocation:
 	{
-	    int objc = opnd; /* The number of arguments. */
-	    Tcl_Obj **objv;	 /* The array of argument objects. */
-
-	    /*
-	     * We keep the stack reference count as a (char *), as that
-	     * works nicely as a portable pointer-sized counter.
-	     */
-
-	    char **preservedStackRefCountPtr;
-	    
-	    /* 
-	     * Reference to memory block containing
-	     * objv array (must be kept live throughout
-	     * trace and command invokations.) 
-	     */
-
-	    objv = &(stackPtr[stackTop - (objc-1)]);
+	    Tcl_Obj **objv = &OBJ_AT_DEPTH(objc-1);
 
 #ifdef TCL_COMPILE_DEBUG
 	    if (tclTraceExec >= 2) {
+		int i;
+
 		if (traceInstructions) {
 		    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
 		    TRACE(("%u => call ", objc));
 		} else {
-		    fprintf(stdout, "%d: (%u) invoking ",
-			    iPtr->numLevels,
-			    (unsigned int)(pc - codePtr->codeStart));
+		    fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
+			    (unsigned)(pc - codePtr->codeStart));
 		}
 		for (i = 0;  i < objc;  i++) {
 		    TclPrintObject(stdout, objv[i], 15);
@@ -1525,142 +2391,189 @@ TclExecuteByteCode(interp, codePtr)
 	    }
 #endif /*TCL_COMPILE_DEBUG*/
 
-	    /* 
-	     * If trace procedures will be called, we need a
-	     * command string to pass to TclEvalObjvInternal; note 
-	     * that a copy of the string will be made there to 
-	     * include the ending \0.
-	     */
-
-	    bytes = NULL;
-	    length = 0;
-	    if (iPtr->tracePtr != NULL) {
-		Trace *tracePtr, *nextTracePtr;
-		    
-		for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
-		     tracePtr = nextTracePtr) {
-		    nextTracePtr = tracePtr->nextPtr;
-		    if (tracePtr->level == 0 ||
-			iPtr->numLevels <= tracePtr->level) {
-			/*
-			 * Traces will be called: get command string
-			 */
-
-			bytes = GetSrcInfoForPc(pc, codePtr, &length);
-			break;
-		    }
-		}
-	    } else {		
-		Command *cmdPtr;
-		cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
-		if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
-		    bytes = GetSrcInfoForPc(pc, codePtr, &length);
-		}
-	    }		
-
 	    /*
-	     * A reference to part of the stack vector itself
-	     * escapes our control: increase its refCount
-	     * to stop it from being deallocated by a recursive
-	     * call to ourselves.  The extra variable is needed
-	     * because all others are liable to change due to the
-	     * trace procedures.
+	     * Reset the instructionCount variable, since we're about to check
+	     * for async stuff anyway while processing TclEvalObjvInternal.
 	     */
 
-	    preservedStackRefCountPtr = (char **) (stackPtr-1);
-	    ++*preservedStackRefCountPtr;
+	    instructionCount = 1;
 
 	    /*
 	     * Finally, let TclEvalObjvInternal handle the command.
 	     *
-	     * TIP #280 : Record the last piece of info needed by
+	     * TIP #280: Record the last piece of info needed by
 	     * 'TclGetSrcInfoForPc', and push the frame.
 	     */
 
-#ifdef TCL_TIP280
-	    bcFrame.data.tebc.pc = (char*) pc;
-	    iPtr->cmdFramePtr = &bcFrame;
-	    TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
-			       codePtr, &bcFrame,
-			       pc - codePtr->codeStart);
-#endif
+	    bcFramePtr->data.tebc.pc = (char *) pc;
+	    iPtr->cmdFramePtr = bcFramePtr;
+	    if (iPtr->flags & INTERP_DEBUG_FRAME) {
+		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    }
 	    DECACHE_STACK_INFO();
-	    Tcl_ResetResult(interp);
-	    result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+	    result = TclEvalObjvInternal(interp, objc, objv,
+		    /* call from TEBC */(char *) -1, -1, 0);
 	    CACHE_STACK_INFO();
-#ifdef TCL_TIP280
-	    TclArgumentBCRelease((Tcl_Interp*) iPtr,  objv, objc,
-				 codePtr,
-				 pc - codePtr->codeStart);
+	    if (iPtr->flags & INTERP_DEBUG_FRAME) {
+		TclArgumentBCRelease((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, pc - codePtr->codeStart);
+	    }
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-#endif
-
-	    /*
-	     * If the old stack is going to be released, it is
-	     * safe to do so now, since no references to objv are
-	     * going to be used from now on.
-	     */
-
-	    --*preservedStackRefCountPtr;
-	    if (*preservedStackRefCountPtr == (char *) 0) {
-		ckfree((VOID *) preservedStackRefCountPtr);
-	    }	    
 
 	    if (result == TCL_OK) {
+		Tcl_Obj *objPtr;
+
+#ifndef TCL_COMPILE_DEBUG
+		if (*(pc+pcAdjustment) == INST_POP) {
+		    NEXT_INST_V((pcAdjustment+1), objc, 0);
+		}
+#endif
 		/*
-		 * Push the call's object result and continue execution
-		 * with the next instruction.
+		 * Push the call's object result and continue execution with
+		 * the next instruction.
 		 */
 
 		TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
-		        objc, cmdNameBuf), Tcl_GetObjResult(interp));
+			objc, cmdNameBuf), Tcl_GetObjResult(interp));
 
 		objResultPtr = Tcl_GetObjResult(interp);
 
 		/*
-		 * Reset the interp's result to avoid possible duplications
-		 * of large objects [Bug 781585]. We do not call
-		 * Tcl_ResetResult() to avoid any side effects caused by
-		 * the resetting of errorInfo and errorCode [Bug 804681], 
-		 * which are not needed here. We chose instead to manipulate
-		 * the interp's object result directly.
+		 * Reset the interp's result to avoid possible duplications of
+		 * large objects [Bug 781585]. We do not call Tcl_ResetResult
+		 * to avoid any side effects caused by the resetting of
+		 * errorInfo and errorCode [Bug 804681], which are not needed
+		 * here. We chose instead to manipulate the interp's object
+		 * result directly.
 		 *
 		 * Note that the result object is now in objResultPtr, it
-		 * keeps the refCount it had in its role of iPtr->objResultPtr.
+		 * keeps the refCount it had in its role of
+		 * iPtr->objResultPtr.
 		 */
-		{
-		    Tcl_Obj *newObjResultPtr;
-		    TclNewObj(newObjResultPtr);
-		    Tcl_IncrRefCount(newObjResultPtr);
-		    iPtr->objResultPtr = newObjResultPtr;
-		}
 
-		NEXT_INST_V(pcAdjustment, opnd, -1);
+		TclNewObj(objPtr);
+		Tcl_IncrRefCount(objPtr);
+		iPtr->objResultPtr = objPtr;
+		NEXT_INST_V(pcAdjustment, objc, -1);
 	    } else {
-		cleanup = opnd;
+		cleanup = objc;
 		goto processExceptionReturn;
 	    }
 	}
 
-    case INST_EVAL_STK:
+#if TCL_SUPPORT_84_BYTECODE
+    case INST_CALL_BUILTIN_FUNC1: {
 	/*
-	 * Note to maintainers: it is important that INST_EVAL_STK
-	 * pop its argument from the stack before jumping to
-	 * checkForCatch! DO NOT OPTIMISE!
+	 * Call one of the built-in pre-8.5 Tcl math functions. This
+	 * translates to INST_INVOKE_STK1 with the first argument of
+	 * ::tcl::mathfunc::$objv[0]. We need to insert the named math
+	 * function into the stack.
 	 */
 
-	objPtr = stackPtr[stackTop];
-	DECACHE_STACK_INFO();
-#ifndef TCL_TIP280
-	result = TclCompEvalObj(interp, objPtr);
+	int opnd, numArgs;
+	Tcl_Obj *objPtr;
+
+	opnd = TclGetUInt1AtPtr(pc+1);
+	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
+	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
+	    Tcl_Panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+	}
+
+	objPtr = Tcl_NewStringObj("::tcl::mathfunc::", 17);
+	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
+
+	/*
+	 * Only 0, 1 or 2 args.
+	 */
+
+	numArgs = tclBuiltinFuncTable[opnd].numArgs;
+	if (numArgs == 0) {
+	    PUSH_OBJECT(objPtr);
+	} else if (numArgs == 1) {
+	    Tcl_Obj *tmpPtr1 = POP_OBJECT();
+	    PUSH_OBJECT(objPtr);
+	    PUSH_OBJECT(tmpPtr1);
+	    Tcl_DecrRefCount(tmpPtr1);
+	} else {
+	    Tcl_Obj *tmpPtr1, *tmpPtr2;
+	    tmpPtr2 = POP_OBJECT();
+	    tmpPtr1 = POP_OBJECT();
+	    PUSH_OBJECT(objPtr);
+	    PUSH_OBJECT(tmpPtr1);
+	    PUSH_OBJECT(tmpPtr2);
+	    Tcl_DecrRefCount(tmpPtr1);
+	    Tcl_DecrRefCount(tmpPtr2);
+	}
+
+	objc = numArgs + 1;
+	pcAdjustment = 2;
+	goto doInvocation;
+    }
+
+    case INST_CALL_FUNC1: {
+	/*
+	 * Call a non-builtin Tcl math function previously registered by a
+	 * call to Tcl_CreateMathFunc pre-8.5. This is essentially
+	 * INST_INVOKE_STK1 converting the first arg to
+	 * ::tcl::mathfunc::$objv[0].
+	 */
+
+	Tcl_Obj *tmpPtr, *objPtr;
+
+	/*
+	 * Number of arguments. The function name is the 0-th argument.
+	 */
+
+	objc = TclGetUInt1AtPtr(pc+1);
+
+	objPtr = OBJ_AT_DEPTH(objc-1);
+	tmpPtr = Tcl_NewStringObj("::tcl::mathfunc::", 17);
+	Tcl_AppendObjToObj(tmpPtr, objPtr);
+	Tcl_DecrRefCount(objPtr);
+
+	/*
+	 * Variation of PUSH_OBJECT.
+	 */
+
+	OBJ_AT_DEPTH(objc-1) = tmpPtr;
+	Tcl_IncrRefCount(tmpPtr);
+
+	pcAdjustment = 2;
+	goto doInvocation;
+    }
 #else
-	/* TIP #280: The invoking context is left NULL for a dynamically
+    /*
+     * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
+     * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
+     * remains for existing bytecode precompiled files.
+     */
+
+    case INST_CALL_BUILTIN_FUNC1:
+	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
+    case INST_CALL_FUNC1:
+	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+#endif
+    }
+
+    case INST_EVAL_STK: {
+	/*
+	 * Note to maintainers: it is important that INST_EVAL_STK pop its
+	 * argument from the stack before jumping to checkForCatch! DO NOT
+	 * OPTIMISE!
+	 */
+
+	Tcl_Obj *objPtr = OBJ_AT_TOS;
+
+	DECACHE_STACK_INFO();
+
+	/*
+	 * TIP #280: The invoking context is left NULL for a dynamically
 	 * constructed command. We cannot match its lines to the outer
 	 * context.
 	 */
 
-	result = TclCompEvalObj(interp, objPtr, NULL,0);
-#endif
+	result = TclCompEvalObj(interp, objPtr, NULL, 0);
 	CACHE_STACK_INFO();
 	if (result == TCL_OK) {
 	    /*
@@ -1669,69 +2582,75 @@ TclExecuteByteCode(interp, codePtr)
 
 	    objResultPtr = Tcl_GetObjResult(interp);
 	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
-			   Tcl_GetObjResult(interp));
+		    Tcl_GetObjResult(interp));
 
 	    /*
-	     * Reset the interp's result to avoid possible duplications
-	     * of large objects [Bug 781585]. We do not call
-	     * Tcl_ResetResult() to avoid any side effects caused by
-	     * the resetting of errorInfo and errorCode [Bug 804681], 
-	     * which are not needed here. We chose instead to manipulate
-	     * the interp's object result directly.
+	     * Reset the interp's result to avoid possible duplications of
+	     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
+	     * avoid any side effects caused by the resetting of errorInfo and
+	     * errorCode [Bug 804681], which are not needed here. We chose
+	     * instead to manipulate the interp's object result directly.
 	     *
-	     * Note that the result object is now in objResultPtr, it
-	     * keeps the refCount it had in its role of iPtr->objResultPtr.
+	     * Note that the result object is now in objResultPtr, it keeps
+	     * the refCount it had in its role of iPtr->objResultPtr.
 	     */
-	    {
-	        Tcl_Obj *newObjResultPtr;
-		TclNewObj(newObjResultPtr);
-		Tcl_IncrRefCount(newObjResultPtr);
-		iPtr->objResultPtr = newObjResultPtr;
-	    }
 
+	    TclNewObj(objPtr);
+	    Tcl_IncrRefCount(objPtr);
+	    iPtr->objResultPtr = objPtr;
 	    NEXT_INST_F(1, 1, -1);
 	} else {
 	    cleanup = 1;
 	    goto processExceptionReturn;
 	}
+    }
+
+    case INST_EXPR_STK: {
+	Tcl_Obj *objPtr, *valuePtr;
 
-    case INST_EXPR_STK:
-	objPtr = stackPtr[stackTop];
+	objPtr = OBJ_AT_TOS;
 	DECACHE_STACK_INFO();
-	Tcl_ResetResult(interp);
+	/*Tcl_ResetResult(interp);*/
 	result = Tcl_ExprObj(interp, objPtr, &valuePtr);
 	CACHE_STACK_INFO();
-	if (result != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", 
-	        O2S(objPtr)), Tcl_GetObjResult(interp));
+	if (result == TCL_OK) {
+	    objResultPtr = valuePtr;
+	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+	    NEXT_INST_F(1, 1, -1);	/* Already has right refct. */
+	} else {
+	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
+		    Tcl_GetObjResult(interp));
 	    goto checkForCatch;
 	}
-	objResultPtr = valuePtr;
-	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
-	NEXT_INST_F(1, 1, -1); /* already has right refct */
+    }
 
     /*
      * ---------------------------------------------------------
-     *     Start of INST_LOAD instructions.
+     *	   Start of INST_LOAD instructions.
      *
-     * WARNING: more 'goto' here than your doctor recommended!
-     * The different instructions set the value of some variables
-     * and then jump to somme common execution code.
+     * WARNING: more 'goto' here than your doctor recommended! The different
+     * instructions set the value of some variables and then jump to some
+     * common execution code.
      */
+    {
+	int opnd, pcAdjustment;
+	Tcl_Obj *part1Ptr, *part2Ptr;
+	Var *varPtr, *arrayPtr;
+	Tcl_Obj *objPtr;
 
     case INST_LOAD_SCALAR1:
+    instLoadScalar1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	varPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = varPtr->name;
+	varPtr = &(compiledLocals[opnd]);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	TRACE(("%u => ", opnd));
-	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
-	        && (varPtr->tracePtr == NULL)) {
+	if (TclIsVarDirectReadable(varPtr)) {
 	    /*
 	     * No errors, no traces: just get the value.
 	     */
+
 	    objResultPtr = varPtr->value.objPtr;
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(2, 0, 1);
@@ -1739,22 +2658,21 @@ TclExecuteByteCode(interp, codePtr)
 	pcAdjustment = 2;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 	goto doCallPtrGetVar;
 
     case INST_LOAD_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
-	varPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = varPtr->name;
+	varPtr = &(compiledLocals[opnd]);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	TRACE(("%u => ", opnd));
-	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
-	        && (varPtr->tracePtr == NULL)) {
+	if (TclIsVarDirectReadable(varPtr)) {
 	    /*
 	     * No errors, no traces: just get the value.
 	     */
+
 	    objResultPtr = varPtr->value.objPtr;
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(5, 0, 1);
@@ -1762,46 +2680,7 @@ TclExecuteByteCode(interp, codePtr)
 	pcAdjustment = 5;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part2 = NULL;
-	goto doCallPtrGetVar;
-
-    case INST_LOAD_ARRAY_STK:
-	cleanup = 2;
-	part2 = Tcl_GetString(stackPtr[stackTop]);  /* element name */
-	objPtr = stackPtr[stackTop-1]; /* array name */
-	TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
-	goto doLoadStk;
-
-    case INST_LOAD_STK:
-    case INST_LOAD_SCALAR_STK:
-	cleanup = 1;
-	part2 = NULL;
-	objPtr = stackPtr[stackTop]; /* variable name */
-	TRACE(("\"%.30s\" => ", O2S(objPtr)));
-
-    doLoadStk:
-	part1 = TclGetString(objPtr);
-	varPtr = TclObjLookupVar(interp, objPtr, part2, 
-	         TCL_LEAVE_ERR_MSG, "read",
-                 /*createPart1*/ 0,
-	         /*createPart2*/ 1, &arrayPtr);
-	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
-	}
-	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
-	        && (varPtr->tracePtr == NULL)
-	        && ((arrayPtr == NULL) 
-		        || (arrayPtr->tracePtr == NULL))) {
-	    /*
-	     * No errors, no traces: just get the value.
-	     */
-	    objResultPtr = varPtr->value.objPtr;
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_V(1, cleanup, 1);
-	}
-	pcAdjustment = 1;
+	part1Ptr = part2Ptr = NULL;
 	goto doCallPtrGetVar;
 
     case INST_LOAD_ARRAY4:
@@ -1812,143 +2691,267 @@ TclExecuteByteCode(interp, codePtr)
     case INST_LOAD_ARRAY1:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	pcAdjustment = 2;
-    
+
     doLoadArray:
-	part2 = TclGetString(stackPtr[stackTop]);
-	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = arrayPtr->name;
+	part1Ptr = NULL;
+	part2Ptr = OBJ_AT_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	TRACE(("%u \"%.30s\" => ", opnd, part2));
-	varPtr = TclLookupArrayElement(interp, part1, part2, 
-	        TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+	TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
+	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectReadable(varPtr)) {
+		/*
+		 * No errors, no traces: just get the value.
+		 */
+
+		objResultPtr = varPtr->value.objPtr;
+		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		NEXT_INST_F(pcAdjustment, 1, 1);
+	    }
+	}
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
 	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_APPEND(("ERROR: %.30s\n",
+				 O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
-	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
-	        && (varPtr->tracePtr == NULL)
-	        && ((arrayPtr == NULL) 
-		        || (arrayPtr->tracePtr == NULL))) {
-	    /*
-	     * No errors, no traces: just get the value.
-	     */
-	    objResultPtr = varPtr->value.objPtr;
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(pcAdjustment, 1, 1);
-	}
 	cleanup = 1;
 	goto doCallPtrGetVar;
 
+    case INST_LOAD_ARRAY_STK:
+	cleanup = 2;
+	part2Ptr = OBJ_AT_TOS;		/* element name */
+	objPtr = OBJ_UNDER_TOS;		/* array name */
+	TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), O2S(part2Ptr)));
+	goto doLoadStk;
+
+    case INST_LOAD_STK:
+    case INST_LOAD_SCALAR_STK:
+	cleanup = 1;
+	part2Ptr = NULL;
+	objPtr = OBJ_AT_TOS;		/* variable name */
+	TRACE(("\"%.30s\" => ", O2S(objPtr)));
+
+    doLoadStk:
+	part1Ptr = objPtr;
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
+		&arrayPtr);
+	if (varPtr) {
+	    if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
+		/*
+		 * No errors, no traces: just get the value.
+		 */
+
+		objResultPtr = varPtr->value.objPtr;
+		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		NEXT_INST_V(1, cleanup, 1);
+	    }
+	    pcAdjustment = 1;
+	    opnd = -1;
+	    goto doCallPtrGetVar;
+	} else {
+	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+
     doCallPtrGetVar:
 	/*
-	 * There are either errors or the variable is traced:
-	 * call TclPtrGetVar to process fully.
+	 * There are either errors or the variable is traced: call
+	 * TclPtrGetVar to process fully.
 	 */
 
 	DECACHE_STACK_INFO();
-	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, 
-	        part2, TCL_LEAVE_ERR_MSG);
+	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
 	CACHE_STACK_INFO();
-	if (objResultPtr == NULL) {
+	if (objResultPtr) {
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_V(pcAdjustment, cleanup, 1);
+	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(pcAdjustment, cleanup, 1);
+    }
 
     /*
-     *     End of INST_LOAD instructions.
+     *	   End of INST_LOAD instructions.
      * ---------------------------------------------------------
      */
 
     /*
      * ---------------------------------------------------------
-     *     Start of INST_STORE and related instructions.
+     *	   Start of INST_STORE and related instructions.
      *
-     * WARNING: more 'goto' here than your doctor recommended!
-     * The different instructions set the value of some variables
-     * and then jump to somme common execution code.
+     * WARNING: more 'goto' here than your doctor recommended! The different
+     * instructions set the value of some variables and then jump to somme
+     * common execution code.
      */
 
+    {
+	int opnd, pcAdjustment, storeFlags;
+	Tcl_Obj *part1Ptr, *part2Ptr;
+	Var *varPtr, *arrayPtr;
+	Tcl_Obj *objPtr, *valuePtr;
+
+    case INST_STORE_ARRAY4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doStoreArrayDirect;
+
+    case INST_STORE_ARRAY1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+
+    doStoreArrayDirect:
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
+		O2S(valuePtr)));
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectWritable(varPtr)) {
+		tosPtr--;
+		Tcl_DecrRefCount(OBJ_AT_TOS);
+		OBJ_AT_TOS = valuePtr;
+		goto doStoreVarDirect;
+	    }
+	}
+	cleanup = 2;
+	storeFlags = TCL_LEAVE_ERR_MSG;
+	part1Ptr = NULL;
+	goto doStoreArrayDirectFailed;
+
+    case INST_STORE_SCALAR4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doStoreScalarDirect;
+
+    case INST_STORE_SCALAR1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+
+    doStoreScalarDirect:
+	valuePtr = OBJ_AT_TOS;
+	varPtr = &(compiledLocals[opnd]);
+	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	if (TclIsVarDirectWritable(varPtr)) {
+    doStoreVarDirect:
+	    /*
+	     * No traces, no errors, plain 'set': we can safely inline. The
+	     * value *will* be set to what's requested, so that the stack top
+	     * remains pointing to the same Tcl_Obj.
+	     */
+
+	    valuePtr = varPtr->value.objPtr;
+	    if (valuePtr != NULL) {
+		TclDecrRefCount(valuePtr);
+	    }
+	    objResultPtr = OBJ_AT_TOS;
+	    varPtr->value.objPtr = objResultPtr;
+#ifndef TCL_COMPILE_DEBUG
+	    if (*(pc+pcAdjustment) == INST_POP) {
+		tosPtr--;
+		NEXT_INST_F((pcAdjustment+1), 0, 0);
+	    }
+#else
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
+	    Tcl_IncrRefCount(objResultPtr);
+	    NEXT_INST_F(pcAdjustment, 0, 0);
+	}
+	storeFlags = TCL_LEAVE_ERR_MSG;
+	part1Ptr = NULL;
+	goto doStoreScalar;
+
     case INST_LAPPEND_STK:
-	valuePtr = stackPtr[stackTop]; /* value to append */
-	part2 = NULL;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	valuePtr = OBJ_AT_TOS; /* value to append */
+	part2Ptr = NULL;
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreStk;
 
     case INST_LAPPEND_ARRAY_STK:
-	valuePtr = stackPtr[stackTop]; /* value to append */
-	part2 = TclGetString(stackPtr[stackTop - 1]);
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	valuePtr = OBJ_AT_TOS; /* value to append */
+	part2Ptr = OBJ_UNDER_TOS;
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreStk;
 
     case INST_APPEND_STK:
-	valuePtr = stackPtr[stackTop]; /* value to append */
-	part2 = NULL;
+	valuePtr = OBJ_AT_TOS; /* value to append */
+	part2Ptr = NULL;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_APPEND_ARRAY_STK:
-	valuePtr = stackPtr[stackTop]; /* value to append */
-	part2 = TclGetString(stackPtr[stackTop - 1]);
+	valuePtr = OBJ_AT_TOS; /* value to append */
+	part2Ptr = OBJ_UNDER_TOS;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_STORE_ARRAY_STK:
-	valuePtr = stackPtr[stackTop];
-	part2 = TclGetString(stackPtr[stackTop - 1]);
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;
 	storeFlags = TCL_LEAVE_ERR_MSG;
 	goto doStoreStk;
 
     case INST_STORE_STK:
     case INST_STORE_SCALAR_STK:
-	valuePtr = stackPtr[stackTop];
-	part2 = NULL;
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = NULL;
 	storeFlags = TCL_LEAVE_ERR_MSG;
 
     doStoreStk:
-	objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */
-	part1 = TclGetString(objPtr);
+	objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */
+	part1Ptr = objPtr;
 #ifdef TCL_COMPILE_DEBUG
-	if (part2 == NULL) {
-	    TRACE(("\"%.30s\" <- \"%.30s\" =>", 
-	            part1, O2S(valuePtr)));
+	if (part2Ptr == NULL) {
+	    TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr)));
 	} else {
 	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
-		    part1, part2, O2S(valuePtr)));
+		    O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
 	}
 #endif
-	varPtr = TclObjLookupVar(interp, objPtr, part2, 
-	         TCL_LEAVE_ERR_MSG, "set",
-                 /*createPart1*/ 1,
-	         /*createPart2*/ 1, &arrayPtr);
-	if (varPtr == NULL) {
+	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
+		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	if (varPtr) {
+	    cleanup = ((part2Ptr == NULL)? 2 : 3);
+	    pcAdjustment = 1;
+	    opnd = -1;
+	    goto doCallPtrSetVar;
+	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
-	cleanup = ((part2 == NULL)? 2 : 3);
-	pcAdjustment = 1;
-	goto doCallPtrSetVar;
 
     case INST_LAPPEND_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreArray;
 
     case INST_LAPPEND_ARRAY1:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	pcAdjustment = 2;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreArray;
 
     case INST_APPEND_ARRAY4:
@@ -1963,49 +2966,41 @@ TclExecuteByteCode(interp, codePtr)
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreArray;
 
-    case INST_STORE_ARRAY4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	goto doStoreArray;
-
-    case INST_STORE_ARRAY1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	    
     doStoreArray:
-	valuePtr = stackPtr[stackTop];
-	part2 = TclGetString(stackPtr[stackTop - 1]);
-	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = arrayPtr->name;
-	TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
-		    opnd, part2, O2S(valuePtr)));
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
+		O2S(valuePtr)));
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	varPtr = TclLookupArrayElement(interp, part1, part2, 
-	        TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
-	if (varPtr == NULL) {
+	cleanup = 2;
+	part1Ptr = NULL;
+
+    doStoreArrayDirectFailed:
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+	if (varPtr) {
+	    goto doCallPtrSetVar;
+	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
-	cleanup = 2;
-	goto doCallPtrSetVar;
 
     case INST_LAPPEND_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreScalar;
 
     case INST_LAPPEND_SCALAR1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;	    
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
-		      | TCL_LIST_ELEMENT);
+	pcAdjustment = 2;
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+		| TCL_LIST_ELEMENT);
 	goto doStoreScalar;
 
     case INST_APPEND_SCALAR4:
@@ -2016,248 +3011,317 @@ TclExecuteByteCode(interp, codePtr)
 
     case INST_APPEND_SCALAR1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;	    
+	pcAdjustment = 2;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreScalar;
 
-    case INST_STORE_SCALAR4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	goto doStoreScalar;
-
-    case INST_STORE_SCALAR1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-
     doStoreScalar:
-	valuePtr = stackPtr[stackTop];
-	varPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = varPtr->name;
+	valuePtr = OBJ_AT_TOS;
+	varPtr = &(compiledLocals[opnd]);
 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	cleanup = 1;
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 
     doCallPtrSetVar:
-	if ((storeFlags == TCL_LEAVE_ERR_MSG)
-	        && !((varPtr->flags & VAR_IN_HASHTABLE) 
-		        && (varPtr->hPtr == NULL))
-	        && (varPtr->tracePtr == NULL)
-	        && (TclIsVarScalar(varPtr) 
-		        || TclIsVarUndefined(varPtr))
-	        && ((arrayPtr == NULL) 
-		        || (arrayPtr->tracePtr == NULL))) {
-	    /*
-	     * No traces, no errors, plain 'set': we can safely inline.
-	     * The value *will* be set to what's requested, so that 
-	     * the stack top remains pointing to the same Tcl_Obj.
-	     */
-	    valuePtr = varPtr->value.objPtr;
-	    objResultPtr = stackPtr[stackTop];
-	    if (valuePtr != objResultPtr) {
-		if (valuePtr != NULL) {
-		    TclDecrRefCount(valuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
-		}
-		varPtr->value.objPtr = objResultPtr;
-		Tcl_IncrRefCount(objResultPtr);
-	    }
+	DECACHE_STACK_INFO();
+	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
+	CACHE_STACK_INFO();
+	if (objResultPtr) {
 #ifndef TCL_COMPILE_DEBUG
 	    if (*(pc+pcAdjustment) == INST_POP) {
 		NEXT_INST_V((pcAdjustment+1), cleanup, 0);
 	    }
-#else
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 #endif
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_V(pcAdjustment, cleanup, 1);
 	} else {
-	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, 
-	            part1, part2, valuePtr, storeFlags);
-	    CACHE_STACK_INFO();
-	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
-	    }
-	}
-#ifndef TCL_COMPILE_DEBUG
-	if (*(pc+pcAdjustment) == INST_POP) {
-	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-#endif
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(pcAdjustment, cleanup, 1);
-
+    }
 
     /*
-     *     End of INST_STORE and related instructions.
+     *	   End of INST_STORE and related instructions.
      * ---------------------------------------------------------
      */
 
     /*
      * ---------------------------------------------------------
-     *     Start of INST_INCR instructions.
+     *	   Start of INST_INCR instructions.
      *
-     * WARNING: more 'goto' here than your doctor recommended!
-     * The different instructions set the value of some variables
-     * and then jump to somme common execution code.
+     * WARNING: more 'goto' here than your doctor recommended! The different
+     * instructions set the value of some variables and then jump to somme
+     * common execution code.
      */
 
+/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
+
+    {
+	Tcl_Obj *objPtr, *incrPtr;
+	int opnd, pcAdjustment;
+#ifndef NO_WIDE_TYPE
+	Tcl_WideInt w;
+#endif
+	long i;
+	Tcl_Obj *part1Ptr, *part2Ptr;
+	Var *varPtr, *arrayPtr;
+
     case INST_INCR_SCALAR1:
     case INST_INCR_ARRAY1:
     case INST_INCR_ARRAY_STK:
     case INST_INCR_SCALAR_STK:
     case INST_INCR_STK:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	valuePtr = stackPtr[stackTop];
-	if (valuePtr->typePtr == &tclIntType) {
-	    i = valuePtr->internalRep.longValue;
-	} else if (valuePtr->typePtr == &tclWideIntType) {
-	    TclGetLongFromWide(i,valuePtr);
-	} else {
-	    REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
-	    if (result != TCL_OK) {
-		TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
-		        opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
-		DECACHE_STACK_INFO();
-		Tcl_AddErrorInfo(interp, "\n    (reading increment)");
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
-	    FORCE_LONG(valuePtr, i, w);
-	}
-	stackTop--;
-	TclDecrRefCount(valuePtr);
+	incrPtr = POP_OBJECT();
 	switch (*pc) {
-	    case INST_INCR_SCALAR1:
-		pcAdjustment = 2;
-		goto doIncrScalar;
-	    case INST_INCR_ARRAY1:
-		pcAdjustment = 2;
-		goto doIncrArray;
-	    default:
-		pcAdjustment = 1;
-		goto doIncrStk;
+	case INST_INCR_SCALAR1:
+	    pcAdjustment = 2;
+	    goto doIncrScalar;
+	case INST_INCR_ARRAY1:
+	    pcAdjustment = 2;
+	    goto doIncrArray;
+	default:
+	    pcAdjustment = 1;
+	    goto doIncrStk;
 	}
 
     case INST_INCR_ARRAY_STK_IMM:
     case INST_INCR_SCALAR_STK_IMM:
     case INST_INCR_STK_IMM:
 	i = TclGetInt1AtPtr(pc+1);
+	incrPtr = Tcl_NewIntObj(i);
+	Tcl_IncrRefCount(incrPtr);
 	pcAdjustment = 2;
-	    
+
     doIncrStk:
-	if ((*pc == INST_INCR_ARRAY_STK_IMM) 
-	        || (*pc == INST_INCR_ARRAY_STK)) {
-	    part2 = TclGetString(stackPtr[stackTop]);
-	    objPtr = stackPtr[stackTop - 1];
+	if ((*pc == INST_INCR_ARRAY_STK_IMM)
+		|| (*pc == INST_INCR_ARRAY_STK)) {
+	    part2Ptr = OBJ_AT_TOS;
+	    objPtr = OBJ_UNDER_TOS;
 	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
-		    O2S(objPtr), part2, i));
+		    O2S(objPtr), O2S(part2Ptr), i));
 	} else {
-	    part2 = NULL;
-	    objPtr = stackPtr[stackTop];
+	    part2Ptr = NULL;
+	    objPtr = OBJ_AT_TOS;
 	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
 	}
-	part1 = TclGetString(objPtr);
-
-	varPtr = TclObjLookupVar(interp, objPtr, part2, 
-	        TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
-	if (varPtr == NULL) {
-	    DECACHE_STACK_INFO();
+	part1Ptr = objPtr;
+	opnd = -1;
+	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
+	if (varPtr) {
+	    cleanup = ((part2Ptr == NULL)? 1 : 2);
+	    goto doIncrVar;
+	} else {
 	    Tcl_AddObjErrorInfo(interp,
-	            "\n    (reading value of variable to increment)", -1);
-	    CACHE_STACK_INFO();
+		    "\n    (reading value of variable to increment)", -1);
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
+	    Tcl_DecrRefCount(incrPtr);
 	    goto checkForCatch;
 	}
-	cleanup = ((part2 == NULL)? 1 : 2);
-	goto doIncrVar;
 
     case INST_INCR_ARRAY1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	i = TclGetInt1AtPtr(pc+2);
+	incrPtr = Tcl_NewIntObj(i);
+	Tcl_IncrRefCount(incrPtr);
 	pcAdjustment = 3;
 
     doIncrArray:
-	part2 = TclGetString(stackPtr[stackTop]);
-	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = arrayPtr->name;
+	part1Ptr = NULL;
+	part2Ptr = OBJ_AT_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	cleanup = 1;
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	TRACE(("%u \"%.30s\" (by %ld) => ",
-		    opnd, part2, i));
-	varPtr = TclLookupArrayElement(interp, part1, part2, 
-	        TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
-	if (varPtr == NULL) {
+	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), i));
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
+	if (varPtr) {
+	    goto doIncrVar;
+	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    result = TCL_ERROR;
+	    Tcl_DecrRefCount(incrPtr);
 	    goto checkForCatch;
 	}
-	cleanup = 1;
-	goto doIncrVar;
 
     case INST_INCR_SCALAR1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	i = TclGetInt1AtPtr(pc+2);
 	pcAdjustment = 3;
+	cleanup = 0;
+	varPtr = &(compiledLocals[opnd]);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+
+	if (TclIsVarDirectModifyable(varPtr)) {
+	    ClientData ptr;
+	    int type;
+
+	    objPtr = varPtr->value.objPtr;
+	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
+		if (type == TCL_NUMBER_LONG) {
+		    long augend = *((const long *)ptr);
+		    long sum = augend + i;
+
+		    /*
+		     * Overflow when (augend and sum have different sign) and
+		     * (augend and i have the same sign). This is encapsulated
+		     * in the Overflowing macro.
+		     */
+
+		    if (!Overflowing(augend, i, sum)) {
+			TRACE(("%u %ld => ", opnd, i));
+			if (Tcl_IsShared(objPtr)) {
+			    objPtr->refCount--;	/* We know it's shared. */
+			    TclNewLongObj(objResultPtr, sum);
+			    Tcl_IncrRefCount(objResultPtr);
+			    varPtr->value.objPtr = objResultPtr;
+			} else {
+			    objResultPtr = objPtr;
+			    TclSetLongObj(objPtr, sum);
+			}
+			goto doneIncr;
+		    }
+#ifndef NO_WIDE_TYPE
+		    {
+			w = (Tcl_WideInt)augend;
+
+			TRACE(("%u %ld => ", opnd, i));
+			if (Tcl_IsShared(objPtr)) {
+			    objPtr->refCount--;	/* We know it's shared. */
+			    objResultPtr = Tcl_NewWideIntObj(w+i);
+			    Tcl_IncrRefCount(objResultPtr);
+			    varPtr->value.objPtr = objResultPtr;
+			} else {
+			    objResultPtr = objPtr;
+
+			    /*
+			     * We know the sum value is outside the long
+			     * range; use macro form that doesn't range test
+			     * again.
+			     */
+
+			    TclSetWideIntObj(objPtr, w+i);
+			}
+			goto doneIncr;
+		    }
+#endif
+		}	/* end if (type == TCL_NUMBER_LONG) */
+#ifndef NO_WIDE_TYPE
+		if (type == TCL_NUMBER_WIDE) {
+		    Tcl_WideInt sum;
+		    w = *((const Tcl_WideInt *)ptr);
+		    sum = w + i;
+
+		    /*
+		     * Check for overflow.
+		     */
+
+		    if (!Overflowing(w, i, sum)) {
+			TRACE(("%u %ld => ", opnd, i));
+			if (Tcl_IsShared(objPtr)) {
+			    objPtr->refCount--;	/* We know it's shared. */
+			    objResultPtr = Tcl_NewWideIntObj(sum);
+			    Tcl_IncrRefCount(objResultPtr);
+			    varPtr->value.objPtr = objResultPtr;
+			} else {
+			    objResultPtr = objPtr;
+
+			    /*
+			     * We *do not* know the sum value is outside the
+			     * long range (wide + long can yield long); use
+			     * the function call that checks range.
+			     */
+
+			    Tcl_SetWideIntObj(objPtr, sum);
+			}
+			goto doneIncr;
+		    }
+		}
+#endif
+	    }
+	    if (Tcl_IsShared(objPtr)) {
+		objPtr->refCount--;	/* We know it's shared */
+		objResultPtr = Tcl_DuplicateObj(objPtr);
+		Tcl_IncrRefCount(objResultPtr);
+		varPtr->value.objPtr = objResultPtr;
+	    } else {
+		objResultPtr = objPtr;
+	    }
+	    TclNewLongObj(incrPtr, i);
+	    result = TclIncrObj(interp, objResultPtr, incrPtr);
+	    Tcl_DecrRefCount(incrPtr);
+	    if (result == TCL_OK) {
+		goto doneIncr;
+	    } else {
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		goto checkForCatch;
+	    }
+	}
+
+	/*
+	 * All other cases, flow through to generic handling.
+	 */
+
+	TclNewLongObj(incrPtr, i);
+	Tcl_IncrRefCount(incrPtr);
 
     doIncrScalar:
-	varPtr = &(varFramePtr->compiledLocals[opnd]);
-	part1 = varPtr->name;
+	varPtr = &(compiledLocals[opnd]);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 	cleanup = 0;
 	TRACE(("%u %ld => ", opnd, i));
 
-
     doIncrVar:
-	objPtr = varPtr->value.objPtr;
-	if (TclIsVarScalar(varPtr)
-	        && !TclIsVarUndefined(varPtr) 
-	        && (varPtr->tracePtr == NULL)
-	        && ((arrayPtr == NULL) 
-		        || (arrayPtr->tracePtr == NULL))
-	        && (objPtr->typePtr == &tclIntType)) {
-	    /*
-	     * No errors, no traces, the variable already has an
-	     * integer value: inline processing.
-	     */
-
-	    i += objPtr->internalRep.longValue;
+	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
+	    objPtr = varPtr->value.objPtr;
 	    if (Tcl_IsShared(objPtr)) {
-		objResultPtr = Tcl_NewLongObj(i);
-		TclDecrRefCount(objPtr);
+		objPtr->refCount--;	/* We know it's shared */
+		objResultPtr = Tcl_DuplicateObj(objPtr);
 		Tcl_IncrRefCount(objResultPtr);
 		varPtr->value.objPtr = objResultPtr;
 	    } else {
-		Tcl_SetLongObj(objPtr, i);
 		objResultPtr = objPtr;
 	    }
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    result = TclIncrObj(interp, objResultPtr, incrPtr);
+	    Tcl_DecrRefCount(incrPtr);
+	    if (result == TCL_OK) {
+		goto doneIncr;
+	    } else {
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		goto checkForCatch;
+	    }
 	} else {
 	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1, 
-                    part2, i, TCL_LEAVE_ERR_MSG);
+	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
+		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
+	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
 		result = TCL_ERROR;
 		goto checkForCatch;
 	    }
 	}
+    doneIncr:
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 #ifndef TCL_COMPILE_DEBUG
 	if (*(pc+pcAdjustment) == INST_POP) {
@@ -2265,250 +3329,532 @@ TclExecuteByteCode(interp, codePtr)
 	}
 #endif
 	NEXT_INST_V(pcAdjustment, cleanup, 1);
-	    	    
+    }
+
     /*
-     *     End of INST_INCR instructions.
+     *	   End of INST_INCR instructions.
      * ---------------------------------------------------------
      */
 
+    /*
+     * ---------------------------------------------------------
+     *	   Start of INST_EXIST instructions.
+     */
+    {
+	Tcl_Obj *part1Ptr, *part2Ptr;
+	Var *varPtr, *arrayPtr;
 
-    case INST_JUMP1:
-	opnd = TclGetInt1AtPtr(pc+1);
-	TRACE(("%d => new pc %u\n", opnd,
-	        (unsigned int)(pc + opnd - codePtr->codeStart)));
-	NEXT_INST_F(opnd, 0, 0);
+    case INST_EXIST_SCALAR: {
+	int opnd = TclGetUInt4AtPtr(pc+1);
 
-    case INST_JUMP4:
-	opnd = TclGetInt4AtPtr(pc+1);
-	TRACE(("%d => new pc %u\n", opnd,
-	        (unsigned int)(pc + opnd - codePtr->codeStart)));
-	NEXT_INST_F(opnd, 0, 0);
+	varPtr = &(compiledLocals[opnd]);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (ReadTraced(varPtr)) {
+	    DECACHE_STACK_INFO();
+	    TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
+		    TCL_TRACE_READS, 0, opnd);
+	    CACHE_STACK_INFO();
+	    if (TclIsVarUndefined(varPtr)) {
+		TclCleanupVar(varPtr, NULL);
+		varPtr = NULL;
+	    }
+	}
 
-    case INST_JUMP_FALSE4:
-	opnd = 5;                             /* TRUE */
-	pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
-	goto doJumpTrue;
+	/*
+	 * Tricky! Arrays always exist.
+	 */
 
-    case INST_JUMP_TRUE4:
-	opnd = TclGetInt4AtPtr(pc+1);         /* TRUE */
-	pcAdjustment = 5;                     /* FALSE */
-	goto doJumpTrue;
+	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(5, 0, 1);
+    }
 
-    case INST_JUMP_FALSE1:
-	opnd = 2;                             /* TRUE */
-	pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
-	goto doJumpTrue;
+    case INST_EXIST_ARRAY: {
+	int opnd = TclGetUInt4AtPtr(pc+1);
+
+	part2Ptr = OBJ_AT_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
+	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (!varPtr || !ReadTraced(varPtr)) {
+		goto doneExistArray;
+	    }
+	}
+	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
+		0, 1, arrayPtr, opnd);
+	if (varPtr) {
+	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
+		DECACHE_STACK_INFO();
+		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
+			TCL_TRACE_READS, 0, opnd);
+		CACHE_STACK_INFO();
+	    }
+	    if (TclIsVarUndefined(varPtr)) {
+		TclCleanupVar(varPtr, arrayPtr);
+		varPtr = NULL;
+	    }
+	}
+    doneExistArray:
+	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(5, 1, 1);
+    }
+
+    case INST_EXIST_ARRAY_STK:
+	cleanup = 2;
+	part2Ptr = OBJ_AT_TOS;		/* element name */
+	part1Ptr = OBJ_UNDER_TOS;	/* array name */
+	TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
+	goto doExistStk;
+
+    case INST_EXIST_STK:
+	cleanup = 1;
+	part2Ptr = NULL;
+	part1Ptr = OBJ_AT_TOS;		/* variable name */
+	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+
+    doExistStk:
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access",
+		/*createPart1*/0, /*createPart2*/1, &arrayPtr);
+	if (varPtr) {
+	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
+		DECACHE_STACK_INFO();
+		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
+			TCL_TRACE_READS, 0, -1);
+		CACHE_STACK_INFO();
+	    }
+	    if (TclIsVarUndefined(varPtr)) {
+		TclCleanupVar(varPtr, arrayPtr);
+		varPtr = NULL;
+	    }
+	}
+	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(1, cleanup, 1);
+    }
+
+    /*
+     *	   End of INST_EXIST instructions.
+     * ---------------------------------------------------------
+     */
+
+    case INST_UPVAR: {
+	int opnd;
+	Var *varPtr, *otherPtr;
+
+	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
 
-    case INST_JUMP_TRUE1:
-	opnd = TclGetInt1AtPtr(pc+1);          /* TRUE */
-	pcAdjustment = 2;                      /* FALSE */
-	    
-    doJumpTrue:
 	{
-	    int b;
-		
-	    valuePtr = stackPtr[stackTop];
-	    if (valuePtr->typePtr == &tclIntType) {
-		b = (valuePtr->internalRep.longValue != 0);
-	    } else if (valuePtr->typePtr == &tclDoubleType) {
-		b = (valuePtr->internalRep.doubleValue != 0.0);
-	    } else if (valuePtr->typePtr == &tclWideIntType) {
-		TclGetWide(w,valuePtr);
-		b = (w != W0);
-	    } else {
-		result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
-		if (result != TCL_OK) {
-		    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
-		    goto checkForCatch;
+	    CallFrame *framePtr, *savedFramePtr;
+
+	    result = TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr);
+	    if (result != -1) {
+		/*
+		 * Locate the other variable.
+		 */
+
+		savedFramePtr = iPtr->varFramePtr;
+		iPtr->varFramePtr = framePtr;
+		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+			(TCL_LEAVE_ERR_MSG), "access",
+			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+		iPtr->varFramePtr = savedFramePtr;
+		if (otherPtr) {
+		    result = TCL_OK;
+		    goto doLinkVars;
 		}
 	    }
-#ifndef TCL_COMPILE_DEBUG
-	    NEXT_INST_F((b? opnd : pcAdjustment), 1, 0);
-#else
-	    if (b) {
-		if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
-		    TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr),
-		            (unsigned int)(pc+opnd - codePtr->codeStart)));
-		} else {
-		    TRACE(("%d => %.20s true\n", pcAdjustment, O2S(valuePtr)));
-		}
-		NEXT_INST_F(opnd, 1, 0);
-	    } else {
-		if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
-		    TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
-		} else {
-		    opnd = pcAdjustment;
-		    TRACE(("%d => %.20s false, new pc %u\n", opnd, O2S(valuePtr),
-		            (unsigned int)(pc + opnd - codePtr->codeStart)));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+
+    case INST_VARIABLE:
+	TRACE(("variable "));
+	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	if (otherPtr) {
+	    /*
+	     * Do the [variable] magic.
+	     */
+
+	    TclSetVarNamespaceVar(otherPtr);
+	    result = TCL_OK;
+	    goto doLinkVars;
+	}
+	result = TCL_ERROR;
+	goto checkForCatch;
+
+    case INST_NSUPVAR:
+	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+
+	{
+	    Tcl_Namespace *nsPtr, *savedNsPtr;
+
+	    result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
+	    if (result == TCL_OK) {
+		/*
+		 * Locate the other variable.
+		 */
+
+		savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+		iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+			(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+		iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
+		if (otherPtr) {
+		    goto doLinkVars;
 		}
-		NEXT_INST_F(pcAdjustment, 1, 0);
 	    }
-#endif
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-	    	    
-    case INST_LOR:
-    case INST_LAND:
-    {
+
+    doLinkVars:
+
 	/*
-	 * Operands must be boolean or numeric. No int->double
-	 * conversions are performed.
+	 * If we are here, the local variable has already been created: do the
+	 * little work of TclPtrMakeUpvar that remains to be done right here
+	 * if there are no errors; otherwise, let it handle the case.
 	 */
-		
-	int i1, i2;
-	int iResult;
-	char *s;
-	Tcl_ObjType *t1Ptr, *t2Ptr;
-
-	value2Ptr = stackPtr[stackTop];
-	valuePtr  = stackPtr[stackTop - 1];;
-	t1Ptr = valuePtr->typePtr;
-	t2Ptr = value2Ptr->typePtr;
-
-	if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
-	    i1 = (valuePtr->internalRep.longValue != 0);
-	} else if (t1Ptr == &tclWideIntType) {
-	    TclGetWide(w,valuePtr);
-	    i1 = (w != W0);
-	} else if (t1Ptr == &tclDoubleType) {
-	    i1 = (valuePtr->internalRep.doubleValue != 0.0);
-	} else {
-	    s = Tcl_GetStringFromObj(valuePtr, &length);
-	    if (TclLooksLikeInt(s, length)) {
-		GET_WIDE_OR_INT(result, valuePtr, i, w);
-		if (valuePtr->typePtr == &tclIntType) {
-		    i1 = (i != 0);
-		} else {
-		    i1 = (w != W0);
+
+	opnd = TclGetInt4AtPtr(pc+1);;
+	varPtr = &(compiledLocals[opnd]);
+	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
+		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
+	    if (!TclIsVarUndefined(varPtr)) {
+		/*
+		 * Then it is a defined link.
+		 */
+
+		Var *linkPtr = varPtr->value.linkPtr;
+
+		if (linkPtr == otherPtr) {
+		    goto doLinkVarsDone;
+		}
+		if (TclIsVarInHash(linkPtr)) {
+		    VarHashRefCount(linkPtr)--;
+		    if (TclIsVarUndefined(linkPtr)) {
+			TclCleanupVar(linkPtr, NULL);
+		    }
 		}
-	    } else {
-		result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
-					       valuePtr, &i1);
-		i1 = (i1 != 0);
 	    }
+	    TclSetVarLink(varPtr);
+	    varPtr->value.linkPtr = otherPtr;
+	    if (TclIsVarInHash(otherPtr)) {
+		VarHashRefCount(otherPtr)++;
+	    }
+	} else {
+	    result = TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0, opnd);
 	    if (result != TCL_OK) {
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
-		        (t1Ptr? t1Ptr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
 		goto checkForCatch;
 	    }
 	}
-		
-	if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
-	    i2 = (value2Ptr->internalRep.longValue != 0);
-	} else if (t2Ptr == &tclWideIntType) {
-	    TclGetWide(w,value2Ptr);
-	    i2 = (w != W0);
-	} else if (t2Ptr == &tclDoubleType) {
-	    i2 = (value2Ptr->internalRep.doubleValue != 0.0);
-	} else {
-	    s = Tcl_GetStringFromObj(value2Ptr, &length);
-	    if (TclLooksLikeInt(s, length)) {
-		GET_WIDE_OR_INT(result, value2Ptr, i, w);
-		if (value2Ptr->typePtr == &tclIntType) {
-		    i2 = (i != 0);
-		} else {
-		    i2 = (w != W0);
-		}
+
+	/*
+	 * Do not pop the namespace or frame index, it may be needed for other
+	 * variables - and [variable] did not push it at all.
+	 */
+
+    doLinkVarsDone:
+	NEXT_INST_F(5, 1, 0);
+    }
+
+    case INST_JUMP1: {
+	int opnd = TclGetInt1AtPtr(pc+1);
+
+	TRACE(("%d => new pc %u\n", opnd,
+		(unsigned)(pc + opnd - codePtr->codeStart)));
+	NEXT_INST_F(opnd, 0, 0);
+    }
+
+    case INST_JUMP4: {
+	int opnd = TclGetInt4AtPtr(pc+1);
+
+	TRACE(("%d => new pc %u\n", opnd,
+		(unsigned)(pc + opnd - codePtr->codeStart)));
+	NEXT_INST_F(opnd, 0, 0);
+    }
+
+    {
+	int jmpOffset[2], b;
+	Tcl_Obj *valuePtr;
+
+	/* TODO: consider rewrite so we don't compute the offset we're not
+	 * going to take. */
+    case INST_JUMP_FALSE4:
+	jmpOffset[0] = TclGetInt4AtPtr(pc+1);	/* FALSE offset */
+	jmpOffset[1] = 5;			/* TRUE offset*/
+	goto doCondJump;
+
+    case INST_JUMP_TRUE4:
+	jmpOffset[0] = 5;
+	jmpOffset[1] = TclGetInt4AtPtr(pc+1);
+	goto doCondJump;
+
+    case INST_JUMP_FALSE1:
+	jmpOffset[0] = TclGetInt1AtPtr(pc+1);
+	jmpOffset[1] = 2;
+	goto doCondJump;
+
+    case INST_JUMP_TRUE1:
+	jmpOffset[0] = 2;
+	jmpOffset[1] = TclGetInt1AtPtr(pc+1);
+
+    doCondJump:
+	valuePtr = OBJ_AT_TOS;
+
+	/* TODO - check claim that taking address of b harms performance */
+	/* TODO - consider optimization search for constants */
+	result = TclGetBooleanFromObj(interp, valuePtr, &b);
+	if (result != TCL_OK) {
+	    TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
+		    ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
+		    ? 0 : 1]), Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	if (b) {
+	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+		TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1],
+			O2S(valuePtr),
+			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
 	    } else {
-		result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+		TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
 	    }
-	    if (result != TCL_OK) {
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
-		        (t2Ptr? t2Ptr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, value2Ptr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
+	} else {
+	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+		TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+	    } else {
+		TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
+			O2S(valuePtr),
+			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
 	    }
 	}
+#endif
+	NEXT_INST_F(jmpOffset[b], 1, 0);
+    }
+
+    case INST_JUMP_TABLE: {
+	Tcl_HashEntry *hPtr;
+	JumptableInfo *jtPtr;
+	int opnd;
+
+	/*
+	 * Jump to location looked up in a hashtable; fall through to next
+	 * instr if lookup fails.
+	 */
+
+	opnd = TclGetInt4AtPtr(pc+1);
+	jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS)));
+	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
+	if (hPtr != NULL) {
+	    int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
+
+	    TRACE_APPEND(("found in table, new pc %u\n",
+		    (unsigned)(pc - codePtr->codeStart + jumpOffset)));
+	    NEXT_INST_F(jumpOffset, 1, 0);
+	} else {
+	    TRACE_APPEND(("not found in table\n"));
+	    NEXT_INST_F(5, 1, 0);
+	}
+    }
+
+    /*
+     * These two instructions are now redundant: the complete logic of the LOR
+     * and LAND is now handled by the expression compiler.
+     */
 
+    case INST_LOR:
+    case INST_LAND: {
 	/*
-	 * Reuse the valuePtr object already on stack if possible.
+	 * Operands must be boolean or numeric. No int->double conversions are
+	 * performed.
 	 */
-	
+
+	int i1, i2, iResult;
+	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
+	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+
+	result = TclGetBooleanFromObj(NULL, valuePtr, &i1);
+	if (result != TCL_OK) {
+	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
+
+	result = TclGetBooleanFromObj(NULL, value2Ptr, &i2);
+	if (result != TCL_OK) {
+	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
+		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, value2Ptr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
+
 	if (*pc == INST_LOR) {
 	    iResult = (i1 || i2);
 	} else {
 	    iResult = (i1 && i2);
 	}
-	if (Tcl_IsShared(valuePtr)) {
-	    objResultPtr = Tcl_NewLongObj(iResult);
-	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
-	    NEXT_INST_F(1, 2, 1);
-	} else {	/* reuse the valuePtr object */
-	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
-	    Tcl_SetLongObj(valuePtr, iResult);
-	    NEXT_INST_F(1, 1, 0);
-	}
+	objResultPtr = constants[iResult];
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
+	NEXT_INST_F(1, 2, 1);
     }
 
     /*
      * ---------------------------------------------------------
-     *     Start of INST_LIST and related instructions.
+     *	   Start of INST_LIST and related instructions.
      */
 
-    case INST_LIST:
+    case INST_LIST: {
 	/*
-	 * Pop the opnd (objc) top stack elements into a new list obj
-	 * and then decrement their ref counts. 
+	 * Pop the opnd (objc) top stack elements into a new list obj and then
+	 * decrement their ref counts.
 	 */
 
+	int opnd;
+
 	opnd = TclGetUInt4AtPtr(pc+1);
-	objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)]));
+	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_V(5, opnd, 1);
+    }
+
+    case INST_LIST_LENGTH: {
+	Tcl_Obj *valuePtr;
+	int length;
 
-    case INST_LIST_LENGTH:
-	valuePtr = stackPtr[stackTop];
+	valuePtr = OBJ_AT_TOS;
 
-	result = Tcl_ListObjLength(interp, valuePtr, &length);
-	if (result != TCL_OK) {
+	result = TclListObjLength(interp, valuePtr, &length);
+	if (result == TCL_OK) {
+	    TclNewIntObj(objResultPtr, length);
+	    TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
 	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
-	            Tcl_GetObjResult(interp));
+		    Tcl_GetObjResult(interp));
 	    goto checkForCatch;
 	}
-	objResultPtr = Tcl_NewIntObj(length);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
-	NEXT_INST_F(1, 1, 1);
-	    
-    case INST_LIST_INDEX:
+    }
+
+    case INST_LIST_INDEX: {
 	/*** lindex with objc == 3 ***/
-		
+
+	/* Variables also for INST_LIST_INDEX_IMM */
+
+	int listc, idx, opnd, pcAdjustment;
+	Tcl_Obj **listv;
+	Tcl_Obj *valuePtr, *value2Ptr;
+
 	/*
-	 * Pop the two operands
+	 * Pop the two operands.
 	 */
-	value2Ptr = stackPtr[stackTop];
-	valuePtr  = stackPtr[stackTop- 1];
+
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
 	/*
-	 * Extract the desired list element
+	 * Extract the desired list element.
 	 */
+
+	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
+	if ((result == TCL_OK) && (value2Ptr->typePtr != &tclListType)
+		&& (TclGetIntForIndexM(NULL , value2Ptr, listc-1,
+			&idx) == TCL_OK)) {
+	    TclDecrRefCount(value2Ptr);
+	    tosPtr--;
+	    pcAdjustment = 1;
+	    goto lindexFastPath;
+	}
+
 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
-	if (objResultPtr == NULL) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
-	            Tcl_GetObjResult(interp));
+	if (objResultPtr) {
+	    /*
+	     * Stash the list element on the stack.
+	     */
+
+	    TRACE(("%.20s %.20s => %s\n",
+		    O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+	    NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */
+	} else {
+	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
+		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
 
+    case INST_LIST_INDEX_IMM:
+	/*** lindex with objc==3 and index in bytecode stream ***/
+
+	pcAdjustment = 5;
+
 	/*
-	 * Stash the list element on the stack
+	 * Pop the list and get the index.
 	 */
-	TRACE(("%.20s %.20s => %s\n",
-	        O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
 
-    case INST_LIST_INDEX_MULTI:
-    {
+	valuePtr = OBJ_AT_TOS;
+	opnd = TclGetInt4AtPtr(pc+1);
+
+	/*
+	 * Get the contents of the list, making sure that it really is a list
+	 * in the process.
+	 */
+
+	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
+
+	if (result == TCL_OK) {
+	    /*
+	     * Select the list item based on the index. Negative operand means
+	     * end-based indexing.
+	     */
+
+	    if (opnd < -1) {
+		idx = opnd+1 + listc;
+	    } else {
+		idx = opnd;
+	    }
+
+	lindexFastPath:
+	    if (idx >= 0 && idx < listc) {
+		objResultPtr = listv[idx];
+	    } else {
+		TclNewObj(objResultPtr);
+	    }
+
+	    TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
+		    objResultPtr);
+	    NEXT_INST_F(pcAdjustment, 1, 1);
+	} else {
+	    TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
+		    Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
+    }
+
+    case INST_LIST_INDEX_MULTI: {
 	/*
 	 * 'lindex' with multiple index args:
 	 *
 	 * Determine the count of index args.
 	 */
 
-	int numIdx;
+	int numIdx, opnd;
 
 	opnd = TclGetUInt4AtPtr(pc+1);
 	numIdx = opnd-1;
@@ -2516,143 +3862,318 @@ TclExecuteByteCode(interp, codePtr)
 	/*
 	 * Do the 'lindex' operation.
 	 */
-	objResultPtr = TclLindexFlat(interp, stackPtr[stackTop - numIdx],
-	        numIdx, stackPtr + stackTop - numIdx + 1);
+
+	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIdx),
+		numIdx, &OBJ_AT_DEPTH(numIdx - 1));
 
 	/*
-	 * Check for errors
+	 * Check for errors.
 	 */
-	if (objResultPtr == NULL) {
+
+	if (objResultPtr) {
+	    /*
+	     * Set result.
+	     */
+
+	    TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+	    NEXT_INST_V(5, opnd, -1);
+	} else {
 	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
-
-	/*
-	 * Set result
-	 */
-	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
-	NEXT_INST_V(5, opnd, -1);
     }
 
-    case INST_LSET_FLAT:
-    {
+    case INST_LSET_FLAT: {
 	/*
-	 * Lset with 3, 5, or more args.  Get the number
-	 * of index args.
+	 * Lset with 3, 5, or more args. Get the number of index args.
 	 */
-	int numIdx;
 
-	opnd = TclGetUInt4AtPtr( pc + 1 );
+	int numIdx,opnd;
+	Tcl_Obj *valuePtr, *value2Ptr;
+
+	opnd = TclGetUInt4AtPtr(pc + 1);
 	numIdx = opnd - 2;
 
 	/*
-	 * Get the old value of variable, and remove the stack ref.
-	 * This is safe because the variable still references the
-	 * object; the ref count will never go zero here.
+	 * Get the old value of variable, and remove the stack ref. This is
+	 * safe because the variable still references the object; the ref
+	 * count will never go zero here - we can use the smaller macro
+	 * Tcl_DecrRefCount.
 	 */
+
 	value2Ptr = POP_OBJECT();
-	TclDecrRefCount(value2Ptr); /* This one should be done here */
+	Tcl_DecrRefCount(value2Ptr); /* This one should be done here */
 
 	/*
 	 * Get the new element value.
 	 */
-	valuePtr = stackPtr[stackTop];
+
+	valuePtr = OBJ_AT_TOS;
 
 	/*
-	 * Compute the new variable value
+	 * Compute the new variable value.
 	 */
-	objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
-	        stackPtr + stackTop - numIdx, valuePtr);
 
+	objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
+		&OBJ_AT_DEPTH(numIdx), valuePtr);
 
 	/*
-	 * Check for errors
+	 * Check for errors.
 	 */
-	if (objResultPtr == NULL) {
+
+	if (objResultPtr) {
+	    /*
+	     * Set result.
+	     */
+
+	    TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+	    NEXT_INST_V(5, (numIdx+1), -1);
+	} else {
 	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
+    }
 
+    case INST_LSET_LIST: {
 	/*
-	 * Set result
+	 * 'lset' with 4 args.
 	 */
-	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
-	NEXT_INST_V(5, (numIdx+1), -1);
-    }
 
-    case INST_LSET_LIST:
+	Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
+
 	/*
-	 * 'lset' with 4 args.
-	 *
-	 * Get the old value of variable, and remove the stack ref.
-	 * This is safe because the variable still references the
-	 * object; the ref count will never go zero here.
+	 * Get the old value of variable, and remove the stack ref. This is
+	 * safe because the variable still references the object; the ref
+	 * count will never go zero here - we can use the smaller macro
+	 * Tcl_DecrRefCount.
 	 */
-	objPtr = POP_OBJECT(); 
-	TclDecrRefCount(objPtr); /* This one should be done here */
-	
+
+	objPtr = POP_OBJECT();
+	Tcl_DecrRefCount(objPtr);	/* This one should be done here. */
+
 	/*
-	 * Get the new element value, and the index list
+	 * Get the new element value, and the index list.
 	 */
-	valuePtr = stackPtr[stackTop];
-	value2Ptr = stackPtr[stackTop - 1];
-	
+
+	valuePtr = OBJ_AT_TOS;
+	value2Ptr = OBJ_UNDER_TOS;
+
 	/*
-	 * Compute the new variable value
+	 * Compute the new variable value.
 	 */
+
 	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
 
 	/*
-	 * Check for errors
+	 * Check for errors.
 	 */
-	if (objResultPtr == NULL) {
+
+	if (objResultPtr) {
+	    /*
+	     * Set result.
+	     */
+
+	    TRACE(("=> %s\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 2, -1);
+	} else {
 	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
-	            Tcl_GetObjResult(interp));
+		    Tcl_GetObjResult(interp));
 	    result = TCL_ERROR;
 	    goto checkForCatch;
 	}
+    }
+
+    case INST_LIST_RANGE_IMM: {
+	/*** lrange with objc==4 and both indices in bytecode stream ***/
+
+	int listc, fromIdx, toIdx;
+	Tcl_Obj **listv, *valuePtr;
+
+	/*
+	 * Pop the list and get the indices.
+	 */
+
+	valuePtr = OBJ_AT_TOS;
+	fromIdx = TclGetInt4AtPtr(pc+1);
+	toIdx = TclGetInt4AtPtr(pc+5);
+
+	/*
+	 * Get the contents of the list, making sure that it really is a list
+	 * in the process.
+	 */
+	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
+
+	/*
+	 * Skip a lot of work if we're about to throw the result away (common
+	 * with uses of [lassign]).
+	 */
+
+	if (result == TCL_OK) {
+#ifndef TCL_COMPILE_DEBUG
+	    if (*(pc+9) == INST_POP) {
+		NEXT_INST_F(10, 1, 0);
+	    }
+#endif
+	} else {
+	    TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
+		    fromIdx, toIdx), Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
 
 	/*
-	 * Set result
+	 * Adjust the indices for end-based handling.
 	 */
-	TRACE(("=> %s\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, -1);
+
+	if (fromIdx < -1) {
+	    fromIdx += 1+listc;
+	    if (fromIdx < -1) {
+		fromIdx = -1;
+	    }
+	} else if (fromIdx > listc) {
+	    fromIdx = listc;
+	}
+	if (toIdx < -1) {
+	    toIdx += 1+listc;
+	    if (toIdx < -1) {
+		toIdx = -1;
+	    }
+	} else if (toIdx > listc) {
+	    toIdx = listc;
+	}
+
+	/*
+	 * Check if we are referring to a valid, non-empty list range, and if
+	 * so, build the list of elements in that range.
+	 */
+
+	if (fromIdx<=toIdx && fromIdx<listc && toIdx>=0) {
+	    if (fromIdx<0) {
+		fromIdx = 0;
+	    }
+	    if (toIdx >= listc) {
+		toIdx = listc-1;
+	    }
+	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, listv+fromIdx);
+	} else {
+	    TclNewObj(objResultPtr);
+	}
+
+	TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
+		TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
+	NEXT_INST_F(9, 1, 1);
+    }
+
+    case INST_LIST_IN:
+    case INST_LIST_NOT_IN: {
+	/*
+	 * Basic list containment operators.
+	 */
+
+	int found, s1len, s2len, llen, i;
+	Tcl_Obj *valuePtr, *value2Ptr, *o;
+	char *s1;
+	const char *s2;
+
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
+
+	/* TODO: Consider more efficient tests than strcmp() */
+	s1 = TclGetStringFromObj(valuePtr, &s1len);
+	result = TclListObjLength(interp, value2Ptr, &llen);
+	if (result != TCL_OK) {
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
+		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
+	found = 0;
+	if (llen > 0) {
+	    /*
+	     * An empty list doesn't match anything.
+	     */
+
+	    i = 0;
+	    do {
+		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+		if (o != NULL) {
+		    s2 = TclGetStringFromObj(o, &s2len);
+		} else {
+		    s2 = "";
+		}
+		if (s1len == s2len) {
+		    found = (strcmp(s1, s2) == 0);
+		}
+		i++;
+	    } while (i < llen && found == 0);
+	}
+
+	if (*pc == INST_LIST_NOT_IN) {
+	    found = !found;
+	}
+
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), found));
+
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 * We're saving the effort of pushing a boolean value only to pop it
+	 * for branching.
+	 */
+
+	pc++;
+#ifndef TCL_COMPILE_DEBUG
+	switch (*pc) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((found ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((found ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((found ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	}
+#endif
+	objResultPtr = constants[found];
+	NEXT_INST_F(0, 2, 1);
+    }
 
     /*
-     *     End of INST_LIST and related instructions.
+     *	   End of INST_LIST and related instructions.
      * ---------------------------------------------------------
      */
 
     case INST_STR_EQ:
-    case INST_STR_NEQ:
-    {
+    case INST_STR_NEQ: {
 	/*
 	 * String (in)equality check
+	 * TODO: Consider merging into INST_STR_CMP
 	 */
+
 	int iResult;
+	Tcl_Obj *valuePtr, *value2Ptr;
 
-	value2Ptr = stackPtr[stackTop];
-	valuePtr = stackPtr[stackTop - 1];
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
 	if (valuePtr == value2Ptr) {
 	    /*
-	     * On the off-chance that the objects are the same,
-	     * we don't really have to think hard about equality.
+	     * On the off-chance that the objects are the same, we don't
+	     * really have to think hard about equality.
 	     */
+
 	    iResult = (*pc == INST_STR_EQ);
 	} else {
 	    char *s1, *s2;
 	    int s1len, s2len;
 
-	    s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
-	    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+	    s1 = TclGetStringFromObj(valuePtr, &s1len);
+	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
 	    if (s1len == s2len) {
 		/*
-		 * We only need to check (in)equality when
-		 * we have equal length strings.
+		 * We only need to check (in)equality when we have equal
+		 * length strings.
 		 */
+
 		if (*pc == INST_STR_NEQ) {
 		    iResult = (strcmp(s1, s2) != 0);
 		} else {
@@ -2664,63 +4185,66 @@ TclExecuteByteCode(interp, codePtr)
 	    }
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
 
 	/*
-	 * Peep-hole optimisation: if you're about to jump, do jump
-	 * from here.
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
 	 */
 
 	pc++;
 #ifndef TCL_COMPILE_DEBUG
 	switch (*pc) {
-	    case INST_JUMP_FALSE1:
-		NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	    case INST_JUMP_TRUE1:
-		NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	    case INST_JUMP_FALSE4:
-		NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	    case INST_JUMP_TRUE4:
-		NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
 	}
 #endif
-	objResultPtr = Tcl_NewIntObj(iResult);
+	objResultPtr = constants[iResult];
 	NEXT_INST_F(0, 2, 1);
     }
 
-    case INST_STR_CMP:
-    {
+    case INST_STR_CMP: {
 	/*
-	 * String compare
+	 * String compare.
 	 */
-	CONST char *s1, *s2;
+
+	const char *s1, *s2;
 	int s1len, s2len, iResult;
+	Tcl_Obj *valuePtr, *value2Ptr;
 
-	value2Ptr = stackPtr[stackTop];
-	valuePtr = stackPtr[stackTop - 1];
+    stringCompare:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
 	/*
-	 * The comparison function should compare up to the
-	 * minimum byte length only.
+	 * The comparison function should compare up to the minimum byte
+	 * length only.
 	 */
+
 	if (valuePtr == value2Ptr) {
 	    /*
-	     * In the pure equality case, set lengths too for
-	     * the checks below (or we could goto beyond it).
+	     * In the pure equality case, set lengths too for the checks below
+	     * (or we could goto beyond it).
 	     */
+
 	    iResult = s1len = s2len = 0;
 	} else if ((valuePtr->typePtr == &tclByteArrayType)
-	        && (value2Ptr->typePtr == &tclByteArrayType)) {
+		&& (value2Ptr->typePtr == &tclByteArrayType)) {
 	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
 	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
-	    iResult = memcmp(s1, s2, 
-	            (size_t) ((s1len < s2len) ? s1len : s2len));
+	    iResult = memcmp(s1, s2,
+		    (size_t) ((s1len < s2len) ? s1len : s2len));
 	} else if (((valuePtr->typePtr == &tclStringType)
-	        && (value2Ptr->typePtr == &tclStringType))) {
+		&& (value2Ptr->typePtr == &tclStringType))) {
 	    /*
 	     * Do a unicode-specific comparison if both of the args are of
-	     * String type.  If the char length == byte length, we can do a
-	     * memcmp.  In benchmark testing this proved the most efficient
+	     * String type. If the char length == byte length, we can do a
+	     * memcmp. In benchmark testing this proved the most efficient
 	     * check between the unicode and string comparison operations.
 	     */
 
@@ -2736,64 +4260,96 @@ TclExecuteByteCode(interp, codePtr)
 	    }
 	} else {
 	    /*
-	     * We can't do a simple memcmp in order to handle the
-	     * special Tcl \xC0\x80 null encoding for utf-8.
+	     * We can't do a simple memcmp in order to handle the special Tcl
+	     * \xC0\x80 null encoding for utf-8.
 	     */
-	    s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
-	    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+
+	    s1 = TclGetStringFromObj(valuePtr, &s1len);
+	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
 	    iResult = TclpUtfNcmp2(s1, s2,
-	            (size_t) ((s1len < s2len) ? s1len : s2len));
+		    (size_t) ((s1len < s2len) ? s1len : s2len));
 	}
 
 	/*
 	 * Make sure only -1,0,1 is returned
+	 * TODO: consider peephole opt.
 	 */
+
 	if (iResult == 0) {
 	    iResult = s1len - s2len;
 	}
+
+	if (*pc != INST_STR_CMP) {
+	    /*
+	     * Take care of the opcodes that goto'ed into here.
+	     */
+
+	    switch (*pc) {
+	    case INST_EQ:
+		iResult = (iResult == 0);
+		break;
+	    case INST_NEQ:
+		iResult = (iResult != 0);
+		break;
+	    case INST_LT:
+		iResult = (iResult < 0);
+		break;
+	    case INST_GT:
+		iResult = (iResult > 0);
+		break;
+	    case INST_LE:
+		iResult = (iResult <= 0);
+		break;
+	    case INST_GE:
+		iResult = (iResult >= 0);
+		break;
+	    }
+	}
 	if (iResult < 0) {
-	    iResult = -1;
-	} else if (iResult > 0) {
-	    iResult = 1;
+	    TclNewIntObj(objResultPtr, -1);
+	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), -1));
+	} else {
+	    objResultPtr = constants[(iResult>0)];
+	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
+		(iResult > 0)));
 	}
 
-	objResultPtr = Tcl_NewIntObj(iResult);
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
 	NEXT_INST_F(1, 2, 1);
     }
 
-    case INST_STR_LEN:
-    {
-	int length1;
-		 
-	valuePtr = stackPtr[stackTop];
+    case INST_STR_LEN: {
+	int length;
+	Tcl_Obj *valuePtr;
+
+	valuePtr = OBJ_AT_TOS;
 
 	if (valuePtr->typePtr == &tclByteArrayType) {
-	    (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+	    (void) Tcl_GetByteArrayFromObj(valuePtr, &length);
 	} else {
-	    length1 = Tcl_GetCharLength(valuePtr);
+	    length = Tcl_GetCharLength(valuePtr);
 	}
-	objResultPtr = Tcl_NewIntObj(length1);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+	TclNewIntObj(objResultPtr, length);
+	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);
     }
-	    
-    case INST_STR_INDEX:
-    {
+
+    case INST_STR_INDEX: {
 	/*
-	 * String compare
+	 * String compare.
 	 */
-	int index;
-	bytes = NULL; /* lint */
 
-	value2Ptr = stackPtr[stackTop];
-	valuePtr = stackPtr[stackTop - 1];
+	int index, length;
+	char *bytes;
+	Tcl_Obj *valuePtr, *value2Ptr;
+
+	bytes = NULL; /* lint */
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
 	/*
-	 * If we have a ByteArray object, avoid indexing in the
-	 * Utf string since the byte array contains one byte per
-	 * character.  Otherwise, use the Unicode string rep to
-	 * get the index'th char.
+	 * If we have a ByteArray object, avoid indexing in the Utf string
+	 * since the byte array contains one byte per character. Otherwise,
+	 * use the Unicode string rep to get the index'th char.
 	 */
 
 	if (valuePtr->typePtr == &tclByteArrayType) {
@@ -2802,10 +4358,11 @@ TclExecuteByteCode(interp, codePtr)
 	    /*
 	     * Get Unicode char length to calulate what 'end' means.
 	     */
+
 	    length = Tcl_GetCharLength(valuePtr);
 	}
 
-	result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index);
+	result = TclGetIntForIndexM(interp, value2Ptr, length - 1, &index);
 	if (result != TCL_OK) {
 	    goto checkForCatch;
 	}
@@ -2813,21 +4370,22 @@ TclExecuteByteCode(interp, codePtr)
 	if ((index >= 0) && (index < length)) {
 	    if (valuePtr->typePtr == &tclByteArrayType) {
 		objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
-		        (&bytes[index]), 1);
+			(&bytes[index]), 1);
 	    } else if (valuePtr->bytes && length == valuePtr->length) {
-		objResultPtr = Tcl_NewStringObj((CONST char *)
-		        (&valuePtr->bytes[index]), 1);
+		objResultPtr = Tcl_NewStringObj((const char *)
+			(&valuePtr->bytes[index]), 1);
 	    } else {
 		char buf[TCL_UTF_MAX];
 		Tcl_UniChar ch;
 
 		ch = Tcl_GetUniChar(valuePtr, index);
+
 		/*
-		 * This could be:
-		 * Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch, 1)
-		 * but creating the object as a string seems to be
-		 * faster in practical use.
+		 * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch,
+		 * 1) but creating the object as a string seems to be faster
+		 * in practical use.
 		 */
+
 		length = Tcl_UniCharToUtf(ch, buf);
 		objResultPtr = Tcl_NewStringObj(buf, length);
 	    }
@@ -2835,26 +4393,26 @@ TclExecuteByteCode(interp, codePtr)
 	    TclNewObj(objResultPtr);
 	}
 
-	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), 
-	        O2S(objResultPtr)));
+	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
+		O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
     }
 
-    case INST_STR_MATCH:
-    {
+    case INST_STR_MATCH: {
 	int nocase, match;
+	Tcl_Obj *valuePtr, *value2Ptr;
 
-	nocase    = TclGetInt1AtPtr(pc+1);
-	valuePtr  = stackPtr[stackTop];	        /* String */
-	value2Ptr = stackPtr[stackTop - 1];	/* Pattern */
+	nocase = TclGetInt1AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;		/* String */
+	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
 
 	/*
-	 * Check that at least one of the objects is Unicode before
-	 * promoting both.
+	 * Check that at least one of the objects is Unicode before promoting
+	 * both.
 	 */
 
 	if ((valuePtr->typePtr == &tclStringType)
-	        || (value2Ptr->typePtr == &tclStringType)) {
+		|| (value2Ptr->typePtr == &tclStringType)) {
 	    Tcl_UniChar *ustring1, *ustring2;
 	    int length1, length2;
 
@@ -2862,23 +4420,60 @@ TclExecuteByteCode(interp, codePtr)
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
+	} else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+	    unsigned char *string1, *string2;
+	    int length1, length2;
+
+	    string1 = Tcl_GetByteArrayFromObj(valuePtr, &length1);
+	    string2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
+	    match = TclByteArrayMatch(string1, length1, string2, length2, 0);
 	} else {
 	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
 		    TclGetString(value2Ptr), nocase);
 	}
 
 	/*
-	 * Reuse value2Ptr object already on stack if possible.
-	 * Adjustment is 2 due to the nocase byte
+	 * Reuse value2Ptr object already on stack if possible. Adjustment is
+	 * 2 due to the nocase byte
+	 * TODO: consider peephole opt.
 	 */
 
 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
-	if (Tcl_IsShared(value2Ptr)) {
-	    objResultPtr = Tcl_NewIntObj(match);
+	objResultPtr = constants[match];
+	NEXT_INST_F(2, 2, 1);
+    }
+
+    case INST_REGEXP: {
+	int cflags, match;
+	Tcl_Obj *valuePtr, *value2Ptr;
+	Tcl_RegExp regExpr;
+
+	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
+	valuePtr = OBJ_AT_TOS;		/* String */
+	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+
+	regExpr = Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
+	if (regExpr == NULL) {
+	    match = -1;
+	} else {
+	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
+	}
+
+	/*
+	 * Adjustment is 2 due to the nocase byte
+	 */
+
+	if (match < 0) {
+	    objResultPtr = Tcl_GetObjResult(interp);
+	    TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
+		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	} else {
+	    TRACE(("%.20s %.20s => %d\n",
+		    O2S(valuePtr), O2S(value2Ptr), match));
+	    objResultPtr = constants[match];
 	    NEXT_INST_F(2, 2, 1);
-	} else {	/* reuse the valuePtr object */
-	    Tcl_SetIntObj(value2Ptr, match);
-	    NEXT_INST_F(2, 1, 0);
 	}
     }
 
@@ -2887,1441 +4482,2277 @@ TclExecuteByteCode(interp, codePtr)
     case INST_LT:
     case INST_GT:
     case INST_LE:
-    case INST_GE:
-    {
-	/*
-	 * Any type is allowed but the two operands must have the
-	 * same type. We will compute value op value2.
-	 */
-
-	Tcl_ObjType *t1Ptr, *t2Ptr;
-	char *s1 = NULL;	/* Init. avoids compiler warning. */
-	char *s2 = NULL;	/* Init. avoids compiler warning. */
-	long i2 = 0;		/* Init. avoids compiler warning. */
-	double d1 = 0.0;	/* Init. avoids compiler warning. */
-	double d2 = 0.0;	/* Init. avoids compiler warning. */
-	long iResult = 0;	/* Init. avoids compiler warning. */
+    case INST_GE: {
+	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
+	ClientData ptr1, ptr2;
+	int iResult = 0, compare = 0, type1, type2;
+	double d1, d2, tmp;
+	long l1, l2;
+	mp_int big1, big2;
+#ifndef NO_WIDE_TYPE
+	Tcl_WideInt w1, w2;
+#endif
 
-	value2Ptr = stackPtr[stackTop];
-	valuePtr  = stackPtr[stackTop - 1];
+	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
+	    /*
+	     * At least one non-numeric argument - compare as strings.
+	     */
 
-	/*
-	 * Be careful in the equal-object case; 'NaN' isn't supposed
-	 * to be equal to even itself. [Bug 761471]
-	 */
+	    goto stringCompare;
+	}
+	if (type1 == TCL_NUMBER_NAN) {
+	    /*
+	     * NaN first arg: NaN != to everything, other compares are false.
+	     */
 
-	t1Ptr = valuePtr->typePtr;
+	    iResult = (*pc == INST_NEQ);
+	    goto foundResult;
+	}
 	if (valuePtr == value2Ptr) {
+	    compare = MP_EQ;
+	    goto convertComparison;
+	}
+	if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
 	    /*
-	     * If we are numeric already, we can proceed to the main
-	     * equality check right now.  Otherwise, we need to try to
-	     * coerce to a numeric type so we can see if we've got a
-	     * NaN but haven't parsed it as numeric.
+	     * At least one non-numeric argument - compare as strings.
 	     */
-	    if (!IS_NUMERIC_TYPE(t1Ptr)) {
-		if (t1Ptr == &tclListType) {
-		    int length;
-		    /*
-		     * Only a list of length 1 can be NaN or such
-		     * things.
-		     */
-		    (void) Tcl_ListObjLength(NULL, valuePtr, &length);
-		    if (length == 1) {
-			goto mustConvertForNaNCheck;
-		    }
-		} else {
-		    /*
-		     * Too bad, we'll have to compute the string and
-		     * try the conversion
-		     */
 
-		  mustConvertForNaNCheck:
-		    s1 = Tcl_GetStringFromObj(valuePtr, &length);
-		    if (TclLooksLikeInt(s1, length)) {
-			GET_WIDE_OR_INT(iResult, valuePtr, i, w);
-		    } else {
-			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-				valuePtr, &d1);
-		    }
-		    t1Ptr = valuePtr->typePtr;
-		}
-	    }
+	    goto stringCompare;
+	}
+	if (type2 == TCL_NUMBER_NAN) {
+	    /*
+	     * NaN 2nd arg: NaN != to everything, other compares are false.
+	     */
 
-	    switch (*pc) {
-	    case INST_EQ:
-	    case INST_LE:
-	    case INST_GE:
-		iResult = !((t1Ptr == &tclDoubleType)
-			&& IS_NAN(valuePtr->internalRep.doubleValue));
-		break;
-	    case INST_LT:
-	    case INST_GT:
-		iResult = 0;
-		break;
-	    case INST_NEQ:
-		iResult = ((t1Ptr == &tclDoubleType)
-			&& IS_NAN(valuePtr->internalRep.doubleValue));
-		break;
-	    }
+	    iResult = (*pc == INST_NEQ);
 	    goto foundResult;
 	}
+	switch (type1) {
+	case TCL_NUMBER_LONG:
+	    l1 = *((const long *)ptr1);
+	    switch (type2) {
+	    case TCL_NUMBER_LONG:
+		l2 = *((const long *)ptr2);
+	    longCompare:
+		compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+		break;
+#ifndef NO_WIDE_TYPE
+	    case TCL_NUMBER_WIDE:
+		w2 = *((const Tcl_WideInt *)ptr2);
+		w1 = (Tcl_WideInt)l1;
+		goto wideCompare;
+#endif
+	    case TCL_NUMBER_DOUBLE:
+		d2 = *((const double *)ptr2);
+		d1 = (double) l1;
 
-	t2Ptr = value2Ptr->typePtr;
+		/*
+		 * If the double has a fractional part, or if the long can be
+		 * converted to double without loss of precision, then compare
+		 * as doubles.
+		 */
 
-	/*
-	 * We only want to coerce numeric validation if neither type
-	 * is NULL.  A NULL type means the arg is essentially an empty
-	 * object ("", {} or [list]).
-	 */
-	if (!(     (!t1Ptr && !valuePtr->bytes)
-	        || (valuePtr->bytes && !valuePtr->length)
-		   || (!t2Ptr && !value2Ptr->bytes)
-		   || (value2Ptr->bytes && !value2Ptr->length))) {
-	    if (!IS_NUMERIC_TYPE(t1Ptr)) {
-		s1 = Tcl_GetStringFromObj(valuePtr, &length);
-		if (TclLooksLikeInt(s1, length)) {
-		    GET_WIDE_OR_INT(iResult, valuePtr, i, w);
-		} else {
-		    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, 
-		            valuePtr, &d1);
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+			|| l1 == (long) d1
+			|| modf(d2, &tmp) != 0.0) {
+		    goto doubleCompare;
 		}
-		t1Ptr = valuePtr->typePtr;
-	    }
-	    if (!IS_NUMERIC_TYPE(t2Ptr)) {
-		s2 = Tcl_GetStringFromObj(value2Ptr, &length);
-		if (TclLooksLikeInt(s2, length)) {
-		    GET_WIDE_OR_INT(iResult, value2Ptr, i2, w);
-		} else {
-		    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-		            value2Ptr, &d2);
-		}
-		t2Ptr = value2Ptr->typePtr;
-	    }
-	}
-	if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
-	    /*
-	     * One operand is not numeric. Compare as strings.  NOTE:
-	     * strcmp is not correct for \x00 < \x01, but that is
-	     * unlikely to occur here.  We could use the TclUtfNCmp2
-	     * to handle this.
-	     */
-	    int s1len, s2len;
-	    s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
-	    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
-	    switch (*pc) {
-	        case INST_EQ:
-		    if (s1len == s2len) {
-			iResult = (strcmp(s1, s2) == 0);
-		    } else {
-			iResult = 0;
-		    }
-		    break;
-	        case INST_NEQ:
-		    if (s1len == s2len) {
-			iResult = (strcmp(s1, s2) != 0);
-		    } else {
-			iResult = 1;
-		    }
-		    break;
-	        case INST_LT:
-		    iResult = (strcmp(s1, s2) < 0);
-		    break;
-	        case INST_GT:
-		    iResult = (strcmp(s1, s2) > 0);
-		    break;
-	        case INST_LE:
-		    iResult = (strcmp(s1, s2) <= 0);
+
+		/*
+		 * Otherwise, to make comparision based on full precision,
+		 * need to convert the double to a suitably sized integer.
+		 *
+		 * Need this to get comparsions like
+		 * 	expr 20000000000000003 < 20000000000000004.0
+		 * right. Converting the first argument to double will yield
+		 * two double values that are equivalent within double
+		 * precision. Converting the double to an integer gets done
+		 * exactly, then integer comparison can tell the difference.
+		 */
+
+		if (d2 < (double)LONG_MIN) {
+		    compare = MP_GT;
 		    break;
-	        case INST_GE:
-		    iResult = (strcmp(s1, s2) >= 0);
+		}
+		if (d2 > (double)LONG_MAX) {
+		    compare = MP_LT;
 		    break;
+		}
+		l2 = (long) d2;
+		goto longCompare;
+	    case TCL_NUMBER_BIG:
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+		if (mp_cmp_d(&big2, 0) == MP_LT) {
+		    compare = MP_GT;
+		} else {
+		    compare = MP_LT;
+		}
+		mp_clear(&big2);
 	    }
-	} else if ((t1Ptr == &tclDoubleType)
-		   || (t2Ptr == &tclDoubleType)) {
-	    /*
-	     * Compare as doubles.
-	     */
-	    if (t1Ptr == &tclDoubleType) {
-		d1 = valuePtr->internalRep.doubleValue;
-		GET_DOUBLE_VALUE(d2, value2Ptr, t2Ptr);
-	    } else {	/* t1Ptr is integer, t2Ptr is double */
-		GET_DOUBLE_VALUE(d1, valuePtr, t1Ptr);
-		d2 = value2Ptr->internalRep.doubleValue;
-	    }
-	    switch (*pc) {
-	        case INST_EQ:
-		    iResult = d1 == d2;
-		    break;
-	        case INST_NEQ:
-		    iResult = d1 != d2;
-		    break;
-	        case INST_LT:
-		    iResult = d1 < d2;
-		    break;
-	        case INST_GT:
-		    iResult = d1 > d2;
-		    break;
-	        case INST_LE:
-		    iResult = d1 <= d2;
+	    break;
+
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+	    w1 = *((const Tcl_WideInt *)ptr1);
+	    switch (type2) {
+	    case TCL_NUMBER_WIDE:
+		w2 = *((const Tcl_WideInt *)ptr2);
+	    wideCompare:
+		compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
+		break;
+	    case TCL_NUMBER_LONG:
+		l2 = *((const long *)ptr2);
+		w2 = (Tcl_WideInt)l2;
+		goto wideCompare;
+	    case TCL_NUMBER_DOUBLE:
+		d2 = *((const double *)ptr2);
+		d1 = (double) w1;
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+			|| w1 == (Tcl_WideInt) d1
+			|| modf(d2, &tmp) != 0.0) {
+		    goto doubleCompare;
+		}
+		if (d2 < (double)LLONG_MIN) {
+		    compare = MP_GT;
 		    break;
-	        case INST_GE:
-		    iResult = d1 >= d2;
+		}
+		if (d2 > (double)LLONG_MAX) {
+		    compare = MP_LT;
 		    break;
+		}
+		w2 = (Tcl_WideInt) d2;
+		goto wideCompare;
+	    case TCL_NUMBER_BIG:
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+		if (mp_cmp_d(&big2, 0) == MP_LT) {
+		    compare = MP_GT;
+		} else {
+		    compare = MP_LT;
+		}
+		mp_clear(&big2);
 	    }
-	} else if ((t1Ptr == &tclWideIntType)
-	        || (t2Ptr == &tclWideIntType)) {
-	    Tcl_WideInt w2;
-	    /*
-	     * Compare as wide ints (neither are doubles)
-	     */
-	    if (t1Ptr == &tclIntType) {
-		w  = Tcl_LongAsWide(valuePtr->internalRep.longValue);
-		TclGetWide(w2,value2Ptr);
-	    } else if (t2Ptr == &tclIntType) {
-		TclGetWide(w,valuePtr);
-		w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue);
-	    } else {
-		TclGetWide(w,valuePtr);
-		TclGetWide(w2,value2Ptr);
-	    }
-	    switch (*pc) {
-	        case INST_EQ:
-		    iResult = w == w2;
+	    break;
+#endif
+
+	case TCL_NUMBER_DOUBLE:
+	    d1 = *((const double *)ptr1);
+	    switch (type2) {
+	    case TCL_NUMBER_DOUBLE:
+		d2 = *((const double *)ptr2);
+	    doubleCompare:
+		compare = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
+		break;
+	    case TCL_NUMBER_LONG:
+		l2 = *((const long *)ptr2);
+		d2 = (double) l2;
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+			|| l2 == (long) d2
+			|| modf(d1, &tmp) != 0.0) {
+		    goto doubleCompare;
+		}
+		if (d1 < (double)LONG_MIN) {
+		    compare = MP_LT;
 		    break;
-	        case INST_NEQ:
-		    iResult = w != w2;
+		}
+		if (d1 > (double)LONG_MAX) {
+		    compare = MP_GT;
 		    break;
-	        case INST_LT:
-		    iResult = w < w2;
+		}
+		l1 = (long) d1;
+		goto longCompare;
+#ifndef NO_WIDE_TYPE
+	    case TCL_NUMBER_WIDE:
+		w2 = *((const Tcl_WideInt *)ptr2);
+		d2 = (double) w2;
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+			|| w2 == (Tcl_WideInt) d2
+			|| modf(d1, &tmp) != 0.0) {
+		    goto doubleCompare;
+		}
+		if (d1 < (double)LLONG_MIN) {
+		    compare = MP_LT;
 		    break;
-	        case INST_GT:
-		    iResult = w > w2;
+		}
+		if (d1 > (double)LLONG_MAX) {
+		    compare = MP_GT;
 		    break;
-	        case INST_LE:
-		    iResult = w <= w2;
+		}
+		w1 = (Tcl_WideInt) d1;
+		goto wideCompare;
+#endif
+	    case TCL_NUMBER_BIG:
+		if (TclIsInfinite(d1)) {
+		    compare = (d1 > 0.0) ? MP_GT : MP_LT;
 		    break;
-	        case INST_GE:
-		    iResult = w >= w2;
+		}
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+		if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
+		    if (mp_cmp_d(&big2, 0) == MP_LT) {
+			compare = MP_GT;
+		    } else {
+			compare = MP_LT;
+		    }
+		    mp_clear(&big2);
 		    break;
+		}
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+			&& modf(d1, &tmp) != 0.0) {
+		    d2 = TclBignumToDouble(&big2);
+		    mp_clear(&big2);
+		    goto doubleCompare;
+		}
+		Tcl_InitBignumFromDouble(NULL, d1, &big1);
+		goto bigCompare;
 	    }
-	} else {
-	    /*
-	     * Compare as ints.
-	     */
-	    i  = valuePtr->internalRep.longValue;
-	    i2 = value2Ptr->internalRep.longValue;
-	    switch (*pc) {
-	        case INST_EQ:
-		    iResult = i == i2;
-		    break;
-	        case INST_NEQ:
-		    iResult = i != i2;
-		    break;
-	        case INST_LT:
-		    iResult = i < i2;
-		    break;
-	        case INST_GT:
-		    iResult = i > i2;
-		    break;
-	        case INST_LE:
-		    iResult = i <= i2;
+	    break;
+
+	case TCL_NUMBER_BIG:
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	    switch (type2) {
+#ifndef NO_WIDE_TYPE
+	    case TCL_NUMBER_WIDE:
+#endif
+	    case TCL_NUMBER_LONG:
+		compare = mp_cmp_d(&big1, 0);
+		mp_clear(&big1);
+		break;
+	    case TCL_NUMBER_DOUBLE:
+		d2 = *((const double *)ptr2);
+		if (TclIsInfinite(d2)) {
+		    compare = (d2 > 0.0) ? MP_LT : MP_GT;
+		    mp_clear(&big1);
 		    break;
-	        case INST_GE:
-		    iResult = i >= i2;
+		}
+		if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
+		    compare = mp_cmp_d(&big1, 0);
+		    mp_clear(&big1);
 		    break;
+		}
+		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+			&& modf(d2, &tmp) != 0.0) {
+		    d1 = TclBignumToDouble(&big1);
+		    mp_clear(&big1);
+		    goto doubleCompare;
+		}
+		Tcl_InitBignumFromDouble(NULL, d2, &big2);
+		goto bigCompare;
+	    case TCL_NUMBER_BIG:
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	    bigCompare:
+		compare = mp_cmp(&big1, &big2);
+		mp_clear(&big1);
+		mp_clear(&big2);
 	    }
 	}
 
-    foundResult:
-	TRACE(("%.20s %.20s => %ld\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+	/*
+	 * Turn comparison outcome into appropriate result for opcode.
+	 */
+
+    convertComparison:
+	switch (*pc) {
+	case INST_EQ:
+	    iResult = (compare == MP_EQ);
+	    break;
+	case INST_NEQ:
+	    iResult = (compare != MP_EQ);
+	    break;
+	case INST_LT:
+	    iResult = (compare == MP_LT);
+	    break;
+	case INST_GT:
+	    iResult = (compare == MP_GT);
+	    break;
+	case INST_LE:
+	    iResult = (compare != MP_GT);
+	    break;
+	case INST_GE:
+	    iResult = (compare != MP_LT);
+	    break;
+	}
 
 	/*
-	 * Peep-hole optimisation: if you're about to jump, do jump
-	 * from here.
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
 	 */
 
+    foundResult:
 	pc++;
 #ifndef TCL_COMPILE_DEBUG
 	switch (*pc) {
-	    case INST_JUMP_FALSE1:
-		NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	    case INST_JUMP_TRUE1:
-		NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	    case INST_JUMP_FALSE4:
-		NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	    case INST_JUMP_TRUE4:
-		NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
 	}
 #endif
-	objResultPtr = Tcl_NewIntObj(iResult);
+	objResultPtr = constants[iResult];
 	NEXT_INST_F(0, 2, 1);
     }
 
     case INST_MOD:
     case INST_LSHIFT:
-    case INST_RSHIFT:
-    case INST_BITOR:
-    case INST_BITXOR:
-    case INST_BITAND:
-    {
-	/*
-	 * Only integers are allowed. We compute value op value2.
-	 */
-
-	long i2 = 0, rem, negative;
-	long iResult = 0; /* Init. avoids compiler warning. */
-	Tcl_WideInt w2, wResult = W0;
-	int doWide = 0;
-
-	value2Ptr = stackPtr[stackTop];
-	valuePtr  = stackPtr[stackTop - 1]; 
-	if (valuePtr->typePtr == &tclIntType) {
-	    i = valuePtr->internalRep.longValue;
-	} else if (valuePtr->typePtr == &tclWideIntType) {
-	    TclGetWide(w,valuePtr);
-	} else {	/* try to convert to int */
-	    REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
-	    if (result != TCL_OK) {
-		TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
-		        O2S(valuePtr), O2S(value2Ptr), 
-		        (valuePtr->typePtr? 
-			     valuePtr->typePtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
+    case INST_RSHIFT: {
+	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
+	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+	ClientData ptr1, ptr2;
+	int invalid, shift, type1, type2;
+	long l1 = 0;
+
+	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
+	if ((result != TCL_OK) || (type1 == TCL_NUMBER_DOUBLE)
+		|| (type1 == TCL_NUMBER_NAN)) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
+		    O2S(value2Ptr), (valuePtr->typePtr?
+		    valuePtr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
 	}
-	if (value2Ptr->typePtr == &tclIntType) {
-	    i2 = value2Ptr->internalRep.longValue;
-	} else if (value2Ptr->typePtr == &tclWideIntType) {
-	    TclGetWide(w2,value2Ptr);
-	} else {
-	    REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2);
-	    if (result != TCL_OK) {
-		TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
-		        O2S(valuePtr), O2S(value2Ptr),
-		        (value2Ptr->typePtr?
-			    value2Ptr->typePtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, value2Ptr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
+
+	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
+	if ((result != TCL_OK) || (type2 == TCL_NUMBER_DOUBLE)
+		|| (type2 == TCL_NUMBER_NAN)) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
+		    O2S(value2Ptr), (value2Ptr->typePtr?
+		    value2Ptr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, value2Ptr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
 	}
 
-	switch (*pc) {
-	case INST_MOD:
-	    /*
-	     * This code is tricky: C doesn't guarantee much about
-	     * the quotient or remainder, but Tcl does. The
-	     * remainder always has the same sign as the divisor and
-	     * a smaller absolute value.
-	     */
-	    if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) {
-		if (valuePtr->typePtr == &tclIntType) {
-		    TRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2));
-		} else {
-		    TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
+	if (*pc == INST_MOD) {
+	    /* TODO: Attempts to re-use unshared operands on stack */
+
+	    long l2 = 0;	/* silence gcc warning */
+
+	    if (type2 == TCL_NUMBER_LONG) {
+		l2 = *((const long *)ptr2);
+		if (l2 == 0) {
+		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
+			    O2S(value2Ptr)));
+		    goto divideByZero;
 		}
-		goto divideByZero;
-	    }
-	    if (value2Ptr->typePtr == &tclIntType && i2 == 0) {
-		if (valuePtr->typePtr == &tclIntType) {
-		    TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
-		} else {
-		    TRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2));
+		if ((l2 == 1) || (l2 == -1)) {
+		    /*
+		     * Div. by |1| always yields remainder of 0.
+		     */
+
+		    objResultPtr = constants[0];
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
 		}
-		goto divideByZero;
 	    }
-	    negative = 0;
-	    if (valuePtr->typePtr == &tclWideIntType
-		|| value2Ptr->typePtr == &tclWideIntType) {
-		Tcl_WideInt wRemainder;
+	    if (type1 == TCL_NUMBER_LONG) {
+		l1 = *((const long *)ptr1);
+		if (l1 == 0) {
+		    /*
+		     * 0 % (non-zero) always yields remainder of 0.
+		     */
+
+		    objResultPtr = constants[0];
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
+		}
+		if (type2 == TCL_NUMBER_LONG) {
+		    /*
+		     * Both operands are long; do native calculation.
+		     */
+
+		    long lRemainder, lQuotient = l1 / l2;
+
+		    /*
+		     * Force Tcl's integer division rules.
+		     * TODO: examine for logic simplification
+		     */
+
+		    if ((lQuotient < 0 || (lQuotient == 0 &&
+			    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
+			    (lQuotient * l2 != l1)) {
+			lQuotient -= 1;
+		    }
+		    lRemainder = l1 - l2*lQuotient;
+		    TclNewLongObj(objResultPtr, lRemainder);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
+		}
+
 		/*
-		 * Promote to wide
+		 * First operand fits in long; second does not, so the second
+		 * has greater magnitude than first. No need to divide to
+		 * determine the remainder.
 		 */
-		if (valuePtr->typePtr == &tclIntType) {
-		    w = Tcl_LongAsWide(i);
-		} else if (value2Ptr->typePtr == &tclIntType) {
-		    w2 = Tcl_LongAsWide(i2);
+
+#ifndef NO_WIDE_TYPE
+		if (type2 == TCL_NUMBER_WIDE) {
+		    Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
+
+		    if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) {
+			/*
+			 * Arguments are opposite sign; remainder is sum.
+			 */
+
+			objResultPtr = Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+
+		    /*
+		     * Arguments are same sign; remainder is first operand.
+		     */
+
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
 		}
-		if (w2 < 0) {
-		    w2 = -w2;
-		    w = -w;
-		    negative = 1;
+#endif
+		{
+		    mp_int big2;
+
+		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
+		    /* TODO: internals intrusion */
+		    if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
+			/*
+			 * Arguments are opposite sign; remainder is sum.
+			 */
+
+			mp_int big1;
+
+			TclBNInitBignumFromLong(&big1, l1);
+			mp_add(&big2, &big1, &big2);
+			mp_clear(&big1);
+			objResultPtr = Tcl_NewBignumObj(&big2);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+
+		    /*
+		     * Arguments are same sign; remainder is first operand.
+		     */
+
+		    mp_clear(&big2);
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
 		}
-		wRemainder  = w % w2;
-		if (wRemainder < 0) {
-		    wRemainder += w2;
+	    }
+#ifndef NO_WIDE_TYPE
+	    if (type1 == TCL_NUMBER_WIDE) {
+		Tcl_WideInt w1 = *((const Tcl_WideInt *)ptr1);
+
+		if (type2 != TCL_NUMBER_BIG) {
+		    Tcl_WideInt w2, wQuotient, wRemainder;
+
+		    Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+		    wQuotient = w1 / w2;
+
+		    /*
+		     * Force Tcl's integer division rules.
+		     * TODO: examine for logic simplification
+		     */
+
+		    if (((wQuotient < (Tcl_WideInt) 0)
+			    || ((wQuotient == (Tcl_WideInt) 0)
+			    && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
+			    || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
+			    && (wQuotient * w2 != w1)) {
+			wQuotient -= (Tcl_WideInt) 1;
+		    }
+		    wRemainder = w1 - w2*wQuotient;
+		    objResultPtr = Tcl_NewWideIntObj(wRemainder);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
 		}
-		if (negative) {
-		    wRemainder = -wRemainder;
+		{
+		    mp_int big2;
+		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
+		    /* TODO: internals intrusion */
+		    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
+			/*
+			 * Arguments are opposite sign; remainder is sum.
+			 */
+
+			mp_int big1;
+
+			TclBNInitBignumFromWideInt(&big1, w1);
+			mp_add(&big2, &big1, &big2);
+			mp_clear(&big1);
+			objResultPtr = Tcl_NewBignumObj(&big2);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+
+		    /*
+		     * Arguments are same sign; remainder is first operand.
+		     */
+
+		    mp_clear(&big2);
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
 		}
-		wResult = wRemainder;
-		doWide = 1;
-		break;
-	    }
-	    if (i2 < 0) {
-		i2 = -i2;
-		i = -i;
-		negative = 1;
-	    }
-	    rem  = i % i2;
-	    if (rem < 0) {
-		rem += i2;
 	    }
-	    if (negative) {
-		rem = -rem;
+#endif
+	    {
+		mp_int big1, big2, bigResult, bigRemainder;
+
+		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
+		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
+		mp_init(&bigResult);
+		mp_init(&bigRemainder);
+		mp_div(&big1, &big2, &bigResult, &bigRemainder);
+		if (!mp_iszero(&bigRemainder)
+			&& (bigRemainder.sign != big2.sign)) {
+		    /*
+		     * Convert to Tcl's integer division rules.
+		     */
+
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    mp_add(&bigRemainder, &big2, &bigRemainder);
+		}
+		mp_copy(&bigRemainder, &bigResult);
+		mp_clear(&bigRemainder);
+		mp_clear(&big1);
+		mp_clear(&big2);
+		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		if (Tcl_IsShared(valuePtr)) {
+		    objResultPtr = Tcl_NewBignumObj(&bigResult);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
+		}
+		Tcl_SetBignumObj(valuePtr, &bigResult);
+		TRACE(("%s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 1, 0);
 	    }
-	    iResult = rem;
+	}
+
+	/*
+	 * Reject negative shift argument.
+	 */
+
+	switch (type2) {
+	case TCL_NUMBER_LONG:
+	    invalid = (*((const long *)ptr2) < (long)0);
+	    break;
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
+	    break;
+#endif
+	case TCL_NUMBER_BIG: {
+	    mp_int big2;
+
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	    invalid = (mp_cmp_d(&big2, 0) == MP_LT);
+	    mp_clear(&big2);
 	    break;
-	case INST_LSHIFT:
+	}
+	default:
+	    /* Unused, here to silence compiler warning */
+	    invalid = 0;
+	}
+	if (invalid) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("negative shift argument", -1));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+
+	/*
+	 * Zero shifted any number of bits is still zero.
+	 */
+
+	if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    objResultPtr = constants[0];
+	    TRACE(("%s\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 2, 1);
+	}
+
+	if (*pc == INST_LSHIFT) {
 	    /*
-	     * Shifts are never usefully 64-bits wide!
+	     * Large left shifts create integer overflow.
+	     *
+	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
+	     * converts values in the (unsigned) range to their signed int
+	     * counterparts, leading to incorrect results.
 	     */
-	    FORCE_LONG(value2Ptr, i2, w2);
-	    if (valuePtr->typePtr == &tclWideIntType) {
-#ifdef TCL_COMPILE_DEBUG
-		w2 = Tcl_LongAsWide(i2);
-#endif /* TCL_COMPILE_DEBUG */
-		wResult = w;
+
+	    if ((type2 != TCL_NUMBER_LONG)
+		    || (*((const long *)ptr2) > (long) INT_MAX)) {
 		/*
-		 * Shift in steps when the shift gets large to prevent
-		 * annoying compiler/processor bugs. [Bug 868467]
+		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
+		 * an mp_int, but since we're using mp_mul_2d() to do the
+		 * work, and it takes only an int argument, that's a good
+		 * place to draw the line.
 		 */
-		if (i2 >= 64) {
-		    wResult = Tcl_LongAsWide(0);
-		} else if (i2 > 60) {
-		    wResult = w << 30;
-		    wResult <<= 30;
-		    wResult <<= i2-60;
-		} else if (i2 > 30) {
-		    wResult = w << 30;
-		    wResult <<= i2-30;
-		} else {
-		    wResult = w << i2;
-		}
-		doWide = 1;
-		break;
+
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"integer value too large to represent", -1));
+		result = TCL_ERROR;
+		goto checkForCatch;
 	    }
+	    shift = (int)(*((const long *)ptr2));
+
 	    /*
-	     * Shift in steps when the shift gets large to prevent
-	     * annoying compiler/processor bugs. [Bug 868467]
+	     * Handle shifts within the native long range.
 	     */
-	    if (i2 >= 64) {
-		iResult = 0;
-	    } else if (i2 > 60) {
-		iResult = i << 30;
-		iResult <<= 30;
-		iResult <<= i2-60;
-	    } else if (i2 > 30) {
-		iResult = i << 30;
-		iResult <<= i2-30;
-	    } else {
-		iResult = i << i2;
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if ((type1 == TCL_NUMBER_LONG)
+		    && (size_t) shift < CHAR_BIT*sizeof(long)
+		    && ((l1 = *(const long *)ptr1) != 0)
+		    && !((l1>0 ? l1 : ~l1)
+			    & -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
+		TclNewLongObj(objResultPtr, (l1<<shift));
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
-	    break;
-	case INST_RSHIFT:
+
 	    /*
-	     * 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.
+	     * Handle shifts within the native wide range.
 	     */
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if ((type1 != TCL_NUMBER_BIG)
+		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
+		Tcl_WideInt w;
+
+		TclGetWideIntFromObj(NULL, valuePtr, &w);
+		if (!((w>0 ? w : ~w)
+			& -(((Tcl_WideInt)1)
+			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
+		    objResultPtr = Tcl_NewWideIntObj(w<<shift);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
+		}
+	    }
+	} else {
 	    /*
-	     * Shifts are never usefully 64-bits wide!
+	     * Quickly force large right shifts to 0 or -1.
 	     */
-	    FORCE_LONG(value2Ptr, i2, w2);
-	    if (valuePtr->typePtr == &tclWideIntType) {
-#ifdef TCL_COMPILE_DEBUG
-		w2 = Tcl_LongAsWide(i2);
-#endif /* TCL_COMPILE_DEBUG */
-		if (w < 0) {
-		    wResult = ~w;
-		} else {
-		    wResult = w;
-		}
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if ((type2 != TCL_NUMBER_LONG)
+		    || (*(const long *)ptr2 > INT_MAX)) {
 		/*
-		 * Shift in steps when the shift gets large to prevent
-		 * annoying compiler/processor bugs. [Bug 868467]
+		 * Again, technically, the value to be shifted could be an
+		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
+		 * not take us to the result of 0 or -1, but since we're using
+		 * mp_div_2d to do the work, and it takes only an int
+		 * argument, we draw the line there.
 		 */
-		if (i2 >= 64) {
-		    wResult = Tcl_LongAsWide(0);
-		} else if (i2 > 60) {
-		    wResult >>= 30;
-		    wResult >>= 30;
-		    wResult >>= i2-60;
-		} else if (i2 > 30) {
-		    wResult >>= 30;
-		    wResult >>= i2-30;
+
+		int zero;
+
+		switch (type1) {
+		case TCL_NUMBER_LONG:
+		    zero = (*(const long *)ptr1 > 0L);
+		    break;
+#ifndef NO_WIDE_TYPE
+		case TCL_NUMBER_WIDE:
+		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
+		    break;
+#endif
+		case TCL_NUMBER_BIG: {
+		    mp_int big1;
+		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+		    zero = (mp_cmp_d(&big1, 0) == MP_GT);
+		    mp_clear(&big1);
+		    break;
+		}
+		default:
+		    /* Unused, here to silence compiler warning. */
+		    zero = 0;
+		}
+		if (zero) {
+		    objResultPtr = constants[0];
+		} else {
+		    TclNewIntObj(objResultPtr, -1);
+		}
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+	    shift = (int)(*(const long *)ptr2);
+
+	    /*
+	     * Handle shifts within the native long range.
+	     */
+
+	    if (type1 == TCL_NUMBER_LONG) {
+		l1 = *((const long *)ptr1);
+		if ((size_t)shift >= CHAR_BIT*sizeof(long)) {
+		    if (l1 >= (long)0) {
+			objResultPtr = constants[0];
+		    } else {
+			TclNewIntObj(objResultPtr, -1);
+		    }
 		} else {
-		    wResult >>= i2;
+		    TclNewLongObj(objResultPtr, (l1 >> shift));
 		}
-		if (w < 0) {
-		    wResult = ~wResult;
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+
+#ifndef NO_WIDE_TYPE
+	    /*
+	     * Handle shifts within the native wide range.
+	     */
+
+	    if (type1 == TCL_NUMBER_WIDE) {
+		Tcl_WideInt w = *(const Tcl_WideInt *)ptr1;
+
+		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
+		    if (w >= (Tcl_WideInt)0) {
+			objResultPtr = constants[0];
+		    } else {
+			TclNewIntObj(objResultPtr, -1);
+		    }
+		} else {
+		    objResultPtr = Tcl_NewWideIntObj(w >> shift);
 		}
-		doWide = 1;
-		break;
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
-	    if (i < 0) {
-		iResult = ~i;
+#endif
+	}
+
+	{
+	    mp_int big, bigResult, bigRemainder;
+
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
+
+	    mp_init(&bigResult);
+	    if (*pc == INST_LSHIFT) {
+		mp_mul_2d(&big, shift, &bigResult);
 	    } else {
-		iResult = i;
+		mp_init(&bigRemainder);
+		mp_div_2d(&big, shift, &bigResult, &bigRemainder);
+		if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
+		    /*
+		     * Convert to Tcl's integer division rules.
+		     */
+
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		}
+		mp_clear(&bigRemainder);
+	    }
+	    mp_clear(&big);
+
+	    if (!Tcl_IsShared(valuePtr)) {
+		Tcl_SetBignumObj(valuePtr, &bigResult);
+		TRACE(("%s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 1, 0);
 	    }
+	    objResultPtr = Tcl_NewBignumObj(&bigResult);
+	}
+	TRACE(("%s\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, 1);
+    }
+
+    case INST_BITOR:
+    case INST_BITXOR:
+    case INST_BITAND: {
+	ClientData ptr1, ptr2;
+	int type1, type2;
+	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
+	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+
+	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
+	if ((result != TCL_OK)
+		|| (type1 == TCL_NUMBER_NAN)
+		|| (type1 == TCL_NUMBER_DOUBLE)) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
+		    O2S(value2Ptr), (valuePtr->typePtr?
+		    valuePtr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
+	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
+	if ((result != TCL_OK) || (type2 == TCL_NUMBER_NAN)
+		|| (type2 == TCL_NUMBER_DOUBLE)) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
+		    O2S(value2Ptr), (value2Ptr->typePtr?
+		    value2Ptr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, value2Ptr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
+
+	if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
+	    mp_int big1, big2, bigResult, *First, *Second;
+	    int numPos;
+
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
 	    /*
-	     * Shift in steps when the shift gets large to prevent
-	     * annoying compiler/processor bugs. [Bug 868467]
+	     * Count how many positive arguments we have. If only one of the
+	     * arguments is negative, store it in 'Second'.
 	     */
-	    if (i2 >= 64) {
-		iResult = 0;
-	    } else if (i2 > 60) {
-		iResult >>= 30;
-		iResult >>= 30;
-		iResult >>= i2-60;
-	    } else if (i2 > 30) {
-		iResult >>= 30;
-		iResult >>= i2-30;
+
+	    if (mp_cmp_d(&big1, 0) != MP_LT) {
+		numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
+		First = &big1;
+		Second = &big2;
 	    } else {
-		iResult >>= i2;
+		First = &big2;
+		Second = &big1;
+		numPos = (mp_cmp_d(First, 0) != MP_LT);
 	    }
-	    if (i < 0) {
-		iResult = ~iResult;
-	    }
-	    break;
-	case INST_BITOR:
-	    if (valuePtr->typePtr == &tclWideIntType
-		|| value2Ptr->typePtr == &tclWideIntType) {
-		/*
-		 * Promote to wide
-		 */
-		if (valuePtr->typePtr == &tclIntType) {
-		    w = Tcl_LongAsWide(i);
-		} else if (value2Ptr->typePtr == &tclIntType) {
-		    w2 = Tcl_LongAsWide(i2);
+	    mp_init(&bigResult);
+
+	    switch (*pc) {
+	    case INST_BITAND:
+		switch (numPos) {
+		case 2:
+		    /*
+		     * Both arguments positive, base case.
+		     */
+
+		    mp_and(First, Second, &bigResult);
+		    break;
+		case 1:
+		    /*
+		     * First is positive; second negative:
+		     * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
+		     */
+
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_xor(First, Second, &bigResult);
+		    mp_and(First, &bigResult, &bigResult);
+		    break;
+		case 0:
+		    /*
+		     * Both arguments negative:
+		     * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
+		     */
+
+		    mp_neg(First, First);
+		    mp_sub_d(First, 1, First);
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_or(First, Second, &bigResult);
+		    mp_neg(&bigResult, &bigResult);
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    break;
 		}
-		wResult = w | w2;
-		doWide = 1;
 		break;
-	    }
-	    iResult = i | i2;
-	    break;
-	case INST_BITXOR:
-	    if (valuePtr->typePtr == &tclWideIntType
-		|| value2Ptr->typePtr == &tclWideIntType) {
-		/*
-		 * Promote to wide
-		 */
-		if (valuePtr->typePtr == &tclIntType) {
-		    w = Tcl_LongAsWide(i);
-		} else if (value2Ptr->typePtr == &tclIntType) {
-		    w2 = Tcl_LongAsWide(i2);
+
+	    case INST_BITOR:
+		switch (numPos) {
+		case 2:
+		    /*
+		     * Both arguments positive, base case.
+		     */
+
+		    mp_or(First, Second, &bigResult);
+		    break;
+		case 1:
+		    /*
+		     * First is positive; second negative:
+		     * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
+		     */
+
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_xor(First, Second, &bigResult);
+		    mp_and(Second, &bigResult, &bigResult);
+		    mp_neg(&bigResult, &bigResult);
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    break;
+		case 0:
+		    /*
+		     * Both arguments negative:
+		     * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
+		     */
+
+		    mp_neg(First, First);
+		    mp_sub_d(First, 1, First);
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_and(First, Second, &bigResult);
+		    mp_neg(&bigResult, &bigResult);
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    break;
 		}
-		wResult = w ^ w2;
-		doWide = 1;
 		break;
-	    }
-	    iResult = i ^ i2;
-	    break;
-	case INST_BITAND:
-	    if (valuePtr->typePtr == &tclWideIntType
-		|| value2Ptr->typePtr == &tclWideIntType) {
-		/*
-		 * Promote to wide
-		 */
-		if (valuePtr->typePtr == &tclIntType) {
-		    w = Tcl_LongAsWide(i);
-		} else if (value2Ptr->typePtr == &tclIntType) {
-		    w2 = Tcl_LongAsWide(i2);
+
+	    case INST_BITXOR:
+		switch (numPos) {
+		case 2:
+		    /*
+		     * Both arguments positive, base case.
+		     */
+
+		    mp_xor(First, Second, &bigResult);
+		    break;
+		case 1:
+		    /*
+		     * First is positive; second negative:
+		     * P^N = ~(P^~N) = -(P^(-N-1))-1
+		     */
+
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_xor(First, Second, &bigResult);
+		    mp_neg(&bigResult, &bigResult);
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    break;
+		case 0:
+		    /*
+		     * Both arguments negative:
+		     * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
+		     */
+
+		    mp_neg(First, First);
+		    mp_sub_d(First, 1, First);
+		    mp_neg(Second, Second);
+		    mp_sub_d(Second, 1, Second);
+		    mp_xor(First, Second, &bigResult);
+		    break;
 		}
-		wResult = w & w2;
-		doWide = 1;
 		break;
 	    }
-	    iResult = i & i2;
-	    break;
+
+	    mp_clear(&big1);
+	    mp_clear(&big2);
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewBignumObj(&bigResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+	    Tcl_SetBignumObj(valuePtr, &bigResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
 	}
 
-	/*
-	 * Reuse the valuePtr object already on stack if possible.
-	 */
-		
-	if (Tcl_IsShared(valuePtr)) {
-	    if (doWide) {
+#ifndef NO_WIDE_TYPE
+	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
+	    Tcl_WideInt wResult, w1, w2;
+
+	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
+	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	    switch (*pc) {
+	    case INST_BITAND:
+		wResult = w1 & w2;
+		break;
+	    case INST_BITOR:
+		wResult = w1 | w2;
+		break;
+	    case INST_BITXOR:
+		wResult = w1 ^ w2;
+		break;
+	    default:
+		/* Unused, here to silence compiler warning. */
+		wResult = 0;
+	    }
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
 		objResultPtr = Tcl_NewWideIntObj(wResult);
-		TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
-	    } else {
-		objResultPtr = Tcl_NewLongObj(iResult);
-		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
-	    NEXT_INST_F(1, 2, 1);
-	} else {	/* reuse the valuePtr object */
-	    if (doWide) {
-		TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
-		Tcl_SetWideIntObj(valuePtr, wResult);
-	    } else {
-		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
-		Tcl_SetLongObj(valuePtr, iResult);
+	    Tcl_SetWideIntObj(valuePtr, wResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
+	}
+#endif
+	{
+	    long lResult, l1 = *((const long *)ptr1);
+	    long l2 = *((const long *)ptr2);
+
+	    switch (*pc) {
+	    case INST_BITAND:
+		lResult = l1 & l2;
+		break;
+	    case INST_BITOR:
+		lResult = l1 | l2;
+		break;
+	    case INST_BITXOR:
+		lResult = l1 ^ l2;
+		break;
+	    default:
+		/* Unused, here to silence compiler warning. */
+		lResult = 0;
+	    }
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
+		TclNewLongObj(objResultPtr, lResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
+	    TclSetLongObj(valuePtr, lResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 1, 0);
 	}
     }
 
+    case INST_EXPON:
     case INST_ADD:
     case INST_SUB:
-    case INST_MULT:
     case INST_DIV:
-    {
-	/*
-	 * Operands must be numeric and ints get converted to floats
-	 * if necessary. We compute value op value2.
-	 */
+    case INST_MULT: {
+	ClientData ptr1, ptr2;
+	int type1, type2;
+	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
+	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+
+	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
+	if ((result != TCL_OK)
+#ifndef ACCEPT_NAN
+		|| (type1 == TCL_NUMBER_NAN)
+#endif
+		) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
+		    O2S(value2Ptr), O2S(valuePtr),
+		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
 
-	Tcl_ObjType *t1Ptr, *t2Ptr;
-	long i2 = 0, quot, rem;	/* Init. avoids compiler warning. */
-	double d1, d2;
-	long iResult = 0;	/* Init. avoids compiler warning. */
-	double dResult = 0.0;	/* Init. avoids compiler warning. */
-	int doDouble = 0;	/* 1 if doing floating arithmetic */
-	Tcl_WideInt w2, wquot, wrem;
-	Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
-	int doWide = 0;		/* 1 if doing wide arithmetic. */
-
-	value2Ptr = stackPtr[stackTop];
-	valuePtr  = stackPtr[stackTop - 1];
-	t1Ptr = valuePtr->typePtr;
-	t2Ptr = value2Ptr->typePtr;
-		
-	if (t1Ptr == &tclIntType) {
-	    i = valuePtr->internalRep.longValue;
-	} else if (t1Ptr == &tclWideIntType) {
-	    TclGetWide(w,valuePtr);
-	} else if ((t1Ptr == &tclDoubleType)
-		   && (valuePtr->bytes == NULL)) {
+#ifdef ACCEPT_NAN
+	if (type1 == TCL_NUMBER_NAN) {
 	    /*
-	     * We can only use the internal rep directly if there is
-	     * no string rep.  Otherwise the string rep might actually
-	     * look like an integer, which is preferred.
+	     * NaN first argument -> result is also NaN.
 	     */
 
-	    d1 = valuePtr->internalRep.doubleValue;
-	} else {
-	    char *s = Tcl_GetStringFromObj(valuePtr, &length);
-	    if (TclLooksLikeInt(s, length)) {
-		GET_WIDE_OR_INT(result, valuePtr, i, w);
-	    } else {
-		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-					      valuePtr, &d1);
-	    }
-	    if (result != TCL_OK) {
-		TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
-		        s, O2S(valuePtr),
-		        (valuePtr->typePtr?
-			    valuePtr->typePtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
-	    t1Ptr = valuePtr->typePtr;
+	    NEXT_INST_F(1, 1, 0);
+	}
+#endif
+
+	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
+	if ((result != TCL_OK)
+#ifndef ACCEPT_NAN
+		|| (type2 == TCL_NUMBER_NAN)
+#endif
+		) {
+	    result = TCL_ERROR;
+	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+		    O2S(value2Ptr), O2S(valuePtr),
+		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, value2Ptr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
 	}
 
-	if (t2Ptr == &tclIntType) {
-	    i2 = value2Ptr->internalRep.longValue;
-	} else if (t2Ptr == &tclWideIntType) {
-	    TclGetWide(w2,value2Ptr);
-	} else if ((t2Ptr == &tclDoubleType)
-		   && (value2Ptr->bytes == NULL)) {
+#ifdef ACCEPT_NAN
+	if (type2 == TCL_NUMBER_NAN) {
 	    /*
-	     * We can only use the internal rep directly if there is
-	     * no string rep.  Otherwise the string rep might actually
-	     * look like an integer, which is preferred.
+	     * NaN second argument -> result is also NaN.
 	     */
 
-	    d2 = value2Ptr->internalRep.doubleValue;
-	} else {
-	    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
-	    if (TclLooksLikeInt(s, length)) {
-		GET_WIDE_OR_INT(result, value2Ptr, i2, w2);
-	    } else {
-		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-		        value2Ptr, &d2);
-	    }
-	    if (result != TCL_OK) {
-		TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
-		        O2S(value2Ptr), s,
-		        (value2Ptr->typePtr?
-			    value2Ptr->typePtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, value2Ptr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
-	    t2Ptr = value2Ptr->typePtr;
+	    objResultPtr = value2Ptr;
+	    NEXT_INST_F(1, 2, 1);
 	}
+#endif
 
-	if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
+	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
 	    /*
-	     * Do double arithmetic.
+	     * At least one of the values is floating-point, so perform
+	     * floating point calculations.
 	     */
-	    doDouble = 1;
-	    if (t1Ptr == &tclIntType) {
-		d1 = i;       /* promote value 1 to double */
-	    } else if (t2Ptr == &tclIntType) {
-		d2 = i2;      /* promote value 2 to double */
-	    } else if (t1Ptr == &tclWideIntType) {
-		d1 = Tcl_WideAsDouble(w);
-	    } else if (t2Ptr == &tclWideIntType) {
-		d2 = Tcl_WideAsDouble(w2);
-	    }
+
+	    double d1, d2, dResult;
+
+	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
+	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
+
 	    switch (*pc) {
-	        case INST_ADD:
-		    dResult = d1 + d2;
-		    break;
-	        case INST_SUB:
-		    dResult = d1 - d2;
-		    break;
-	        case INST_MULT:
-		    dResult = d1 * d2;
-		    break;
-	        case INST_DIV:
-		    if (d2 == 0.0) {
-			TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
-			goto divideByZero;
-		    }
-		    dResult = d1 / d2;
-		    break;
+	    case INST_ADD:
+		dResult = d1 + d2;
+		break;
+	    case INST_SUB:
+		dResult = d1 - d2;
+		break;
+	    case INST_MULT:
+		dResult = d1 * d2;
+		break;
+	    case INST_DIV:
+#ifndef IEEE_FLOATING_POINT
+		if (d2 == 0.0) {
+		    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
+		    goto divideByZero;
+		}
+#endif
+		/*
+		 * We presume that we are running with zero-divide unmasked if
+		 * we're on an IEEE box. Otherwise, this statement might cause
+		 * demons to fly out our noses.
+		 */
+
+		dResult = d1 / d2;
+		break;
+	    case INST_EXPON:
+		if (d1==0.0 && d2<0.0) {
+		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
+		    goto exponOfZero;
+		}
+		dResult = pow(d1, d2);
+		break;
+	    default:
+		/* Unused, here to silence compiler warning. */
+		dResult = 0;
 	    }
-		    
+
+#ifndef ACCEPT_NAN
 	    /*
 	     * Check now for IEEE floating-point error.
 	     */
-		    
-	    if (IS_NAN(dResult) || IS_INF(dResult)) {
+
+	    if (TclIsNaN(dResult)) {
 		TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
-		        O2S(valuePtr), O2S(value2Ptr)));
+			O2S(valuePtr), O2S(value2Ptr)));
 		DECACHE_STACK_INFO();
 		TclExprFloatError(interp, dResult);
 		CACHE_STACK_INFO();
 		result = TCL_ERROR;
 		goto checkForCatch;
 	    }
-	} else if ((t1Ptr == &tclWideIntType) 
-		   || (t2Ptr == &tclWideIntType)) {
-	    /*
-	     * Do wide integer arithmetic.
-	     */
-	    doWide = 1;
-	    if (t1Ptr == &tclIntType) {
-		w = Tcl_LongAsWide(i);
-	    } else if (t2Ptr == &tclIntType) {
-		w2 = Tcl_LongAsWide(i2);
+#endif
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
+		TclNewDoubleObj(objResultPtr, dResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
-	    switch (*pc) {
-	        case INST_ADD:
-		    wResult = w + w2;
-		    break;
-	        case INST_SUB:
-		    wResult = w - w2;
-		    break;
-	        case INST_MULT:
-		    wResult = w * w2;
-		    break;
-	        case INST_DIV:
+	    TclSetDoubleObj(valuePtr, dResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
+	}
+
+	if ((sizeof(long) >= 2*sizeof(int)) && (*pc == INST_MULT)
+		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	    long l1 = *((const long *)ptr1);
+	    long l2 = *((const long *)ptr2);
+
+	    if ((l1 <= INT_MAX) && (l1 >= INT_MIN)
+		    && (l2 <= INT_MAX) && (l2 >= INT_MIN)) {
+		long lResult = l1 * l2;
+
+		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		if (Tcl_IsShared(valuePtr)) {
+		    TclNewLongObj(objResultPtr,lResult);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
+		}
+		TclSetLongObj(valuePtr, lResult);
+		TRACE(("%s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 1, 0);
+	    }
+	}
+
+	if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (*pc == INST_MULT)
+		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	    Tcl_WideInt w1, w2, wResult;
+	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
+	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	    wResult = w1 * w2;
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewWideIntObj(wResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+	    Tcl_SetWideIntObj(valuePtr, wResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
+	}
+
+	/* TODO: Attempts to re-use unshared operands on stack. */
+	if (*pc == INST_EXPON) {
+	    long l1 = 0, l2 = 0;
+	    int oddExponent = 0, negativeExponent = 0;
+#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
+	    Tcl_WideInt w1;
+#endif
+
+	    if (type2 == TCL_NUMBER_LONG) {
+		l2 = *((const long *) ptr2);
+		if (l2 == 0) {
 		    /*
-		     * This code is tricky: C doesn't guarantee much
-		     * about the quotient or remainder, but Tcl does.
-		     * The remainder always has the same sign as the
-		     * divisor and a smaller absolute value.
+		     * Anything to the zero power is 1.
 		     */
-		    if (w2 == W0) {
-			TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
-			goto divideByZero;
-		    }
-		    if (w2 < 0) {
-			w2 = -w2;
-			w = -w;
+
+		    objResultPtr = constants[1];
+		    NEXT_INST_F(1, 2, 1);
+		} else if (l2 == 1) {
+		    /*
+		     * Anything to the first power is itself
+		     */
+		    NEXT_INST_F(1, 1, 0);
+		}
+	    }
+
+	    switch (type2) {
+	    case TCL_NUMBER_LONG: {
+		negativeExponent = (l2 < 0);
+		oddExponent = (int) (l2 & 1);
+		break;
+	    }
+#ifndef NO_WIDE_TYPE
+	    case TCL_NUMBER_WIDE: {
+		Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
+
+		negativeExponent = (w2 < 0);
+		oddExponent = (int) (w2 & (Tcl_WideInt)1);
+		break;
+	    }
+#endif
+	    case TCL_NUMBER_BIG: {
+		mp_int big2;
+
+		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+		negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+		mp_mod_2d(&big2, 1, &big2);
+		oddExponent = !mp_iszero(&big2);
+		mp_clear(&big2);
+		break;
+	    }
+	    }
+
+	    if (type1 == TCL_NUMBER_LONG) {
+		l1 = *((const long *)ptr1);
+	    }
+	    if (negativeExponent) {
+		if (type1 == TCL_NUMBER_LONG) {
+		    switch (l1) {
+		    case 0:
+			/*
+			 * Zero to a negative power is div by zero error.
+			 */
+
+			TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr),
+				O2S(value2Ptr)));
+			goto exponOfZero;
+		    case -1:
+			if (oddExponent) {
+			    TclNewIntObj(objResultPtr, -1);
+			} else {
+			    objResultPtr = constants[1];
+			}
+			NEXT_INST_F(1, 2, 1);
+		    case 1:
+			/*
+			 * 1 to any power is 1.
+			 */
+
+			objResultPtr = constants[1];
+			NEXT_INST_F(1, 2, 1);
 		    }
-		    wquot = w / w2;
-		    wrem  = w % w2;
-		    if (wrem < W0) {
-			wquot -= 1;
+		}
+
+		/*
+		 * Integers with magnitude greater than 1 raise to a negative
+		 * power yield the answer zero (see TIP 123).
+		 */
+
+		objResultPtr = constants[0];
+		NEXT_INST_F(1, 2, 1);
+	    }
+
+	    if (type1 == TCL_NUMBER_LONG) {
+		switch (l1) {
+		case 0:
+		    /*
+		     * Zero to a positive power is zero.
+		     */
+
+		    objResultPtr = constants[0];
+		    NEXT_INST_F(1, 2, 1);
+		case 1:
+		    /*
+		     * 1 to any power is 1.
+		     */
+
+		    objResultPtr = constants[1];
+		    NEXT_INST_F(1, 2, 1);
+		case -1:
+		    if (oddExponent) {
+			TclNewIntObj(objResultPtr, -1);
+		    } else {
+			objResultPtr = constants[1];
 		    }
-		    wResult = wquot;
-		    break;
+		    NEXT_INST_F(1, 2, 1);
+		}
 	    }
-	} else {
 	    /*
-		     * Do integer arithmetic.
+	     * We refuse to accept exponent arguments that exceed
+	     * one mp_digit which means the max exponent value is
+	     * 2**28-1 = 0x0fffffff = 268435455, which fits into 
+	     * a signed 32 bit int which is within the range of the
+	     * long int type.  This means any numeric Tcl_Obj value 
+	     * not using TCL_NUMBER_LONG type must hold a value larger
+	     * than we accept.
+	     */
+	    if (type2 != TCL_NUMBER_LONG) {
+		Tcl_SetObjResult(interp,
+			Tcl_NewStringObj("exponent too large", -1));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+
+	    if (type1 == TCL_NUMBER_LONG) {
+		if (l1 == 2) {
+		    /*
+		     * Reduce small powers of 2 to shifts.
 		     */
-	    switch (*pc) {
-	        case INST_ADD:
-		    iResult = i + i2;
-		    break;
-	        case INST_SUB:
-		    iResult = i - i2;
-		    break;
-	        case INST_MULT:
-		    iResult = i * i2;
-		    break;
-	        case INST_DIV:
+
+		    if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			TclNewLongObj(objResultPtr, (1L << l2));
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+#if !defined(TCL_WIDE_INT_IS_LONG)
+		    if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			objResultPtr =
+				Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+#endif
+		    goto overflow;
+		}
+		if (l1 == -2) {
+		    int signum = oddExponent ? -1 : 1;
+
 		    /*
-		     * This code is tricky: C doesn't guarantee much
-		     * about the quotient or remainder, but Tcl does.
-		     * The remainder always has the same sign as the
-		     * divisor and a smaller absolute value.
+		     * Reduce small powers of 2 to shifts.
 		     */
-		    if (i2 == 0) {
-			TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
-			goto divideByZero;
+
+		    if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			TclNewLongObj(objResultPtr, signum * (1L << l2));
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
 		    }
-		    if (i2 < 0) {
-			i2 = -i2;
-			i = -i;
+#if !defined(TCL_WIDE_INT_IS_LONG)
+		    if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			objResultPtr = Tcl_NewWideIntObj(
+				signum * (((Tcl_WideInt) 1) << l2));
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
 		    }
-		    quot = i / i2;
-		    rem  = i % i2;
-		    if (rem < 0) {
-			quot -= 1;
+#endif
+		    goto overflow;
+		}
+#if (LONG_MAX == 0x7fffffff)
+		if (l2 - 2 < (long)MaxBase32Size
+			&& l1 <=  MaxBase32[l2 - 2]
+			&& l1 >= -MaxBase32[l2 - 2]) {
+		    /*
+		     * Small powers of 32-bit integers.
+		     */
+
+		    long lResult = l1 * l1;	/* b**2 */
+		    switch (l2) {
+		    case 2:
+			break;
+		    case 3:
+			lResult *= l1;		/* b**3 */
+			break;
+		    case 4:
+			lResult *= lResult;	/* b**4 */
+			break;
+		    case 5:
+			lResult *= lResult;	/* b**4 */
+			lResult *= l1;		/* b**5 */
+			break;
+		    case 6:
+			lResult *= l1;		/* b**3 */
+			lResult *= lResult;	/* b**6 */
+			break;
+		    case 7:
+			lResult *= l1;		/* b**3 */
+			lResult *= lResult;	/* b**6 */
+			lResult *= l1;		/* b**7 */
+			break;
+		    case 8:
+			lResult *= lResult;	/* b**4 */
+			lResult *= lResult;	/* b**8 */
+			break;
 		    }
-		    iResult = quot;
-		    break;
-	    }
-	}
+		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		    if (Tcl_IsShared(valuePtr)) {
+			TclNewLongObj(objResultPtr, lResult);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+		    Tcl_SetLongObj(valuePtr, lResult);
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
+		}
+		if (l1 - 3 >= 0 && l1 - 2 < (long)Exp32IndexSize
+			&& l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
 
-	/*
-	 * Reuse the valuePtr object already on stack if possible.
-	 */
-		
-	if (Tcl_IsShared(valuePtr)) {
-	    if (doDouble) {
-		objResultPtr = Tcl_NewDoubleObj(dResult);
-		TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
-	    } else if (doWide) {
-		objResultPtr = Tcl_NewWideIntObj(wResult);
-		TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
-	    } else {
-		objResultPtr = Tcl_NewLongObj(iResult);
-		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
-	    } 
-	    NEXT_INST_F(1, 2, 1);
-	} else {	    /* reuse the valuePtr object */
-	    if (doDouble) { /* NB: stack top is off by 1 */
-		TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
-		Tcl_SetDoubleObj(valuePtr, dResult);
-	    } else if (doWide) {
-		TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
-		Tcl_SetWideIntObj(valuePtr, wResult);
-	    } else {
-		TRACE(("%ld %ld => %ld\n", i, i2, iResult));
-		Tcl_SetLongObj(valuePtr, iResult);
-	    }
-	    NEXT_INST_F(1, 1, 0);
-	}
-    }
+		    unsigned short base = Exp32Index[l1 - 3]
+			    + (unsigned short) (l2 - 2 - MaxBase32Size);
+		    if (base < Exp32Index[l1 - 2]) {
+			/*
+			 * 32-bit number raised to intermediate power, done by
+			 * table lookup.
+			 */
 
-    case INST_UPLUS:
-    {
-	/*
-	 * Operand must be numeric.
-	 */
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			if (Tcl_IsShared(valuePtr)) {
+			    TclNewLongObj(objResultPtr, Exp32Value[base]);
+			    TRACE(("%s\n", O2S(objResultPtr)));
+			    NEXT_INST_F(1, 2, 1);
+			}
+			Tcl_SetLongObj(valuePtr, Exp32Value[base]);
+			TRACE(("%s\n", O2S(valuePtr)));
+			NEXT_INST_F(1, 1, 0);
+		    }
+		}
+		if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
+			&& l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
+		    unsigned short base = Exp32Index[-l1 - 3]
+			    + (unsigned short) (l2 - 2 - MaxBase32Size);
+		    if (base < Exp32Index[-l1 - 2]) {
+			long lResult = (oddExponent) ?
+			    -Exp32Value[base] : Exp32Value[base];
 
-	double d;
-	Tcl_ObjType *tPtr;
-		
-	valuePtr = stackPtr[stackTop];
-	tPtr = valuePtr->typePtr;
-	if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType) 
-                || (valuePtr->bytes != NULL))) {
-	    char *s = Tcl_GetStringFromObj(valuePtr, &length);
-	    if (TclLooksLikeInt(s, length)) {
-		GET_WIDE_OR_INT(result, valuePtr, i, w);
-	    } else {
-		result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
+			/*
+			 * 32-bit number raised to intermediate power, done by
+			 * table lookup.
+			 */
+
+			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+			if (Tcl_IsShared(valuePtr)) {
+			    TclNewLongObj(objResultPtr, lResult);
+			    TRACE(("%s\n", O2S(objResultPtr)));
+			    NEXT_INST_F(1, 2, 1);
+			}
+			Tcl_SetLongObj(valuePtr, lResult);
+			TRACE(("%s\n", O2S(valuePtr)));
+			NEXT_INST_F(1, 1, 0);
+		    }
+		}
+#endif
 	    }
-	    if (result != TCL_OK) { 
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
-		        s, (tPtr? tPtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
+#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
+	    if (type1 == TCL_NUMBER_LONG) {
+		w1 = l1;
+#ifndef NO_WIDE_TYPE
+	    } else if (type1 == TCL_NUMBER_WIDE) {
+		w1 = *((const Tcl_WideInt*) ptr1);
+#endif
+	    } else {
+		goto overflow;
 	    }
-	    tPtr = valuePtr->typePtr;
-	}
+	    if (l2 - 2 < (long)MaxBase64Size
+		    && w1 <=  MaxBase64[l2 - 2]
+		    && w1 >= -MaxBase64[l2 - 2]) {
+		/*
+		 * Small powers of integers whose result is wide.
+		 */
 
-	/*
-	 * Ensure that the operand's string rep is the same as the
-	 * formatted version of its internal rep. This makes sure
-	 * that "expr +000123" yields "83", not "000123". We
-	 * implement this by _discarding_ the string rep since we
-	 * know it will be regenerated, if needed later, by
-	 * formatting the internal rep's value.
-	 */
+		Tcl_WideInt wResult = w1 * w1; /* b**2 */
 
-	if (Tcl_IsShared(valuePtr)) {
-	    if (tPtr == &tclIntType) {
-		i = valuePtr->internalRep.longValue;
-		objResultPtr = Tcl_NewLongObj(i);
-	    } else if (tPtr == &tclWideIntType) {
-		TclGetWide(w,valuePtr);
-		objResultPtr = Tcl_NewWideIntObj(w);
-	    } else {
-		d = valuePtr->internalRep.doubleValue;
-		objResultPtr = Tcl_NewDoubleObj(d);
+		switch (l2) {
+		case 2:
+		    break;
+		case 3:
+		    wResult *= l1;	/* b**3 */
+		    break;
+		case 4:
+		    wResult *= wResult;	/* b**4 */
+		    break;
+		case 5:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= w1;	/* b**5 */
+		    break;
+		case 6:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    break;
+		case 7:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    wResult *= w1;	/* b**7 */
+		    break;
+		case 8:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= wResult;	/* b**8 */
+		    break;
+		case 9:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= wResult;	/* b**8 */
+		    wResult *= w1;	/* b**9 */
+		    break;
+		case 10:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= w1;	/* b**5 */
+		    wResult *= wResult;	/* b**10 */
+		    break;
+		case 11:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= w1;	/* b**5 */
+		    wResult *= wResult;	/* b**10 */
+		    wResult *= w1;	/* b**11 */
+		    break;
+		case 12:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    wResult *= wResult;	/* b**12 */
+		    break;
+		case 13:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    wResult *= wResult;	/* b**12 */
+		    wResult *= w1;	/* b**13 */
+		    break;
+		case 14:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    wResult *= w1;	/* b**7 */
+		    wResult *= wResult;	/* b**14 */
+		    break;
+		case 15:
+		    wResult *= w1;	/* b**3 */
+		    wResult *= wResult;	/* b**6 */
+		    wResult *= w1;	/* b**7 */
+		    wResult *= wResult;	/* b**14 */
+		    wResult *= w1;	/* b**15 */
+		    break;
+		case 16:
+		    wResult *= wResult;	/* b**4 */
+		    wResult *= wResult;	/* b**8 */
+		    wResult *= wResult;	/* b**16 */
+		    break;
+
+		}
+		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		objResultPtr = Tcl_NewWideIntObj(wResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
 	    }
-	    TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
-	    NEXT_INST_F(1, 1, 1);
-	} else {
-	    Tcl_InvalidateStringRep(valuePtr);
-	    TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
-	    NEXT_INST_F(1, 0, 0);
-	}
-    }
-	    
-    case INST_UMINUS:
-    case INST_LNOT:
-    {
-	/*
-	 * The operand must be numeric or a boolean string as
-	 * accepted by Tcl_GetBooleanFromObj(). If the operand
-	 * object is unshared modify it directly, otherwise
-	 * create a copy to modify: this is "copy on write".
-	 * Free any old string representation since it is now
-	 * invalid.
-	 */
 
-	double d;
-	int boolvar;
-	Tcl_ObjType *tPtr;
+	    /*
+	     * Handle cases of powers > 16 that still fit in a 64-bit word by
+	     * doing table lookup.
+	     */
+	    if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
+		    && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+		unsigned short base = Exp64Index[w1 - 3]
+			+ (unsigned short) (l2 - 2 - MaxBase64Size);
 
-	valuePtr = stackPtr[stackTop];
-	tPtr = valuePtr->typePtr;
-	if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
-	        || (valuePtr->bytes != NULL))) {
-	    if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
-		valuePtr->typePtr = &tclIntType;
-	    } else {
-		char *s = Tcl_GetStringFromObj(valuePtr, &length);
-		if (TclLooksLikeInt(s, length)) {
-		    GET_WIDE_OR_INT(result, valuePtr, i, w);
-		} else {
-		    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-		            valuePtr, &d);
-		}
-		if (result == TCL_ERROR && *pc == INST_LNOT) {
-		    result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
-		            valuePtr, &boolvar);
-		    i = (long)boolvar; /* i is long, not int! */
+		if (base < Exp64Index[w1 - 2]) {
+		    /*
+		     * 64-bit number raised to intermediate power, done by
+		     * table lookup.
+		     */
+
+		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		    if (Tcl_IsShared(valuePtr)) {
+			objResultPtr = Tcl_NewWideIntObj(Exp64Value[base]);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+		    Tcl_SetWideIntObj(valuePtr, Exp64Value[base]);
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
 		}
-		if (result != TCL_OK) {
-		    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
-		            s, (tPtr? tPtr->name : "null")));
-		    DECACHE_STACK_INFO();
-		    IllegalExprOperandType(interp, pc, valuePtr);
-		    CACHE_STACK_INFO();
-		    goto checkForCatch;
+	    }
+
+	    if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
+		    && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+		unsigned short base = Exp64Index[-w1 - 3]
+			+ (unsigned short) (l2 - 2 - MaxBase64Size);
+
+		if (base < Exp64Index[-w1 - 2]) {
+		    Tcl_WideInt wResult = (oddExponent) ?
+			    -Exp64Value[base] : Exp64Value[base];
+		    /*
+		     * 64-bit number raised to intermediate power, done by
+		     * table lookup.
+		     */
+
+		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		    if (Tcl_IsShared(valuePtr)) {
+			objResultPtr = Tcl_NewWideIntObj(wResult);
+			TRACE(("%s\n", O2S(objResultPtr)));
+			NEXT_INST_F(1, 2, 1);
+		    }
+		    Tcl_SetWideIntObj(valuePtr, wResult);
+		    TRACE(("%s\n", O2S(valuePtr)));
+		    NEXT_INST_F(1, 1, 0);
 		}
 	    }
-	    tPtr = valuePtr->typePtr;
+#endif
+
+	    goto overflow;
 	}
 
-	if (Tcl_IsShared(valuePtr)) {
-	    /*
-	     * Create a new object.
-	     */
-	    if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
-		i = valuePtr->internalRep.longValue;
-		objResultPtr = Tcl_NewLongObj(
-		    (*pc == INST_UMINUS)? -i : !i);
-		TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
-	    } else if (tPtr == &tclWideIntType) {
-		TclGetWide(w,valuePtr);
-		if (*pc == INST_UMINUS) {
-		    objResultPtr = Tcl_NewWideIntObj(-w);
-		} else {
-		    objResultPtr = Tcl_NewLongObj(w == W0);
+	if ((*pc != INST_MULT)
+		&& (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+	    Tcl_WideInt w1, w2, wResult;
+
+	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
+	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	    switch (*pc) {
+	    case INST_ADD:
+		wResult = w1 + w2;
+#ifndef NO_WIDE_TYPE
+		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+		{
+		    /*
+		     * Check for overflow.
+		     */
+
+		    if (Overflowing(w1, w2, wResult)) {
+			goto overflow;
+		    }
 		}
-		TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
-	    } else {
-		d = valuePtr->internalRep.doubleValue;
-		if (*pc == INST_UMINUS) {
-		    objResultPtr = Tcl_NewDoubleObj(-d);
-		} else {
+		break;
+
+	    case INST_SUB:
+		wResult = w1 - w2;
+#ifndef NO_WIDE_TYPE
+		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+		{
 		    /*
-		     * Should be able to use "!d", but apparently
-		     * some compilers can't handle it.
+		     * Must check for overflow. The macro tests for overflows
+		     * in sums by looking at the sign bits. As we have a
+		     * subtraction here, we are adding -w2. As -w2 could in
+		     * turn overflow, we test with ~w2 instead: it has the
+		     * opposite sign bit to w2 so it does the job. Note that
+		     * the only "bad" case (w2==0) is irrelevant for this
+		     * macro, as in that case w1 and wResult have the same
+		     * sign and there is no overflow anyway.
 		     */
-		    objResultPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
+
+		    if (Overflowing(w1, ~w2, wResult)) {
+			goto overflow;
+		    }
+		}
+		break;
+
+	    case INST_DIV:
+		if (w2 == 0) {
+		    TRACE(("%s %s => DIVIDE BY ZERO\n",
+			    O2S(valuePtr), O2S(value2Ptr)));
+		    goto divideByZero;
+		}
+
+		/*
+		 * Need a bignum to represent (LLONG_MIN / -1)
+		 */
+
+		if ((w1 == LLONG_MIN) && (w2 == -1)) {
+		    goto overflow;
+		}
+		wResult = w1 / w2;
+
+		/*
+		 * Force Tcl's integer division rules.
+		 * TODO: examine for logic simplification
+		 */
+
+		if (((wResult < 0) || ((wResult == 0) &&
+			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+			((wResult * w2) != w1)) {
+		    wResult -= 1;
 		}
-		TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
+		break;
+	    default:
+		/*
+		 * Unused, here to silence compiler warning.
+		 */
+
+		wResult = 0;
 	    }
-	    NEXT_INST_F(1, 1, 1);
-	} else {
-	    /*
-	     * valuePtr is unshared. Modify it directly.
-	     */
-	    if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
-		i = valuePtr->internalRep.longValue;
-		Tcl_SetLongObj(valuePtr,
-	                (*pc == INST_UMINUS)? -i : !i);
-		TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
-	    } else if (tPtr == &tclWideIntType) {
-		TclGetWide(w,valuePtr);
-		if (*pc == INST_UMINUS) {
-		    Tcl_SetWideIntObj(valuePtr, -w);
-		} else {
-		    Tcl_SetLongObj(valuePtr, w == W0);
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewWideIntObj(wResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+	    Tcl_SetWideIntObj(valuePtr, wResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
+	}
+
+    overflow:
+	{
+	    mp_int big1, big2, bigResult, bigRemainder;
+
+	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	    mp_init(&bigResult);
+	    switch (*pc) {
+	    case INST_ADD:
+		mp_add(&big1, &big2, &bigResult);
+		break;
+	    case INST_SUB:
+		mp_sub(&big1, &big2, &bigResult);
+		break;
+	    case INST_MULT:
+		mp_mul(&big1, &big2, &bigResult);
+		break;
+	    case INST_DIV:
+		if (mp_iszero(&big2)) {
+		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
+			    O2S(value2Ptr)));
+		    mp_clear(&big1);
+		    mp_clear(&big2);
+		    mp_clear(&bigResult);
+		    goto divideByZero;
 		}
-		TRACE_WITH_OBJ((LLD" => ", w), valuePtr);
-	    } else {
-		d = valuePtr->internalRep.doubleValue;
-		if (*pc == INST_UMINUS) {
-		    Tcl_SetDoubleObj(valuePtr, -d);
-		} else {
+		mp_init(&bigRemainder);
+		mp_div(&big1, &big2, &bigResult, &bigRemainder);
+		/* TODO: internals intrusion */
+		if (!mp_iszero(&bigRemainder)
+			&& (bigRemainder.sign != big2.sign)) {
 		    /*
-		     * Should be able to use "!d", but apparently
-		     * some compilers can't handle it.
+		     * Convert to Tcl's integer division rules.
 		     */
-		    Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
+
+		    mp_sub_d(&bigResult, 1, &bigResult);
+		    mp_add(&bigRemainder, &big2, &bigRemainder);
 		}
-		TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
+		mp_clear(&bigRemainder);
+		break;
+	    case INST_EXPON:
+		if (big2.used > 1) {
+		    Tcl_SetObjResult(interp,
+			    Tcl_NewStringObj("exponent too large", -1));
+		    mp_clear(&big1);
+		    mp_clear(&big2);
+		    mp_clear(&bigResult);
+		    result = TCL_ERROR;
+		    goto checkForCatch;
+		}
+		mp_expt_d(&big1, big2.dp[0], &bigResult);
+		break;
 	    }
-	    NEXT_INST_F(1, 0, 0);
+	    mp_clear(&big1);
+	    mp_clear(&big2);
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewBignumObj(&bigResult);
+		TRACE(("%s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 2, 1);
+	    }
+	    Tcl_SetBignumObj(valuePtr, &bigResult);
+	    TRACE(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
 	}
     }
 
-    case INST_BITNOT:
-    {
-	/*
-	 * The operand must be an integer. If the operand object is
-	 * unshared modify it directly, otherwise modify a copy. 
-	 * Free any old string representation since it is now
-	 * invalid.
-	 */
-		
-	Tcl_ObjType *tPtr;
-		
-	valuePtr = stackPtr[stackTop];
-	tPtr = valuePtr->typePtr;
-	if (!IS_INTEGER_TYPE(tPtr)) {
-	    REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
-	    if (result != TCL_OK) {   /* try to convert to double */
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
-		        O2S(valuePtr), (tPtr? tPtr->name : "null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    }
+    case INST_LNOT: {
+	int b;
+	Tcl_Obj *valuePtr = OBJ_AT_TOS;
+
+	/* TODO - check claim that taking address of b harms performance */
+	/* TODO - consider optimization search for constants */
+	result = TclGetBooleanFromObj(NULL, valuePtr, &b);
+	if (result != TCL_OK) {
+	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
 	}
-		
-	if (valuePtr->typePtr == &tclWideIntType) {
-	    TclGetWide(w,valuePtr);
+	/* TODO: Consider peephole opt. */
+	objResultPtr = constants[!b];
+	NEXT_INST_F(1, 1, 1);
+    }
+
+    case INST_BITNOT: {
+	mp_int big;
+	ClientData ptr;
+	int type;
+	Tcl_Obj *valuePtr = OBJ_AT_TOS;
+
+	result = GetNumberFromObj(NULL, valuePtr, &ptr, &type);
+	if ((result != TCL_OK)
+		|| (type == TCL_NUMBER_NAN) || (type == TCL_NUMBER_DOUBLE)) {
+	    /*
+	     * ... ~$NonInteger => raise an error.
+	     */
+
+	    result = TCL_ERROR;
+	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
+	    DECACHE_STACK_INFO();
+	    IllegalExprOperandType(interp, pc, valuePtr);
+	    CACHE_STACK_INFO();
+	    goto checkForCatch;
+	}
+	if (type == TCL_NUMBER_LONG) {
+	    long l = *((const long *)ptr);
+
 	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewWideIntObj(~w);
-		TRACE(("0x%" TCL_LL_MODIFIER "x => (%" TCL_LL_MODIFIER "u)\n",
-			w, ~w));
+		TclNewLongObj(objResultPtr, ~l);
 		NEXT_INST_F(1, 1, 1);
-	    } else {
-		/*
-		 * valuePtr is unshared. Modify it directly.
-		 */
-		Tcl_SetWideIntObj(valuePtr, ~w);
-		TRACE(("0x%" TCL_LL_MODIFIER "x => (%" TCL_LL_MODIFIER "u)\n",
-			w, ~w));
-		NEXT_INST_F(1, 0, 0);
 	    }
-	} else {
-	    i = valuePtr->internalRep.longValue;
+	    TclSetLongObj(valuePtr, ~l);
+	    NEXT_INST_F(1, 0, 0);
+	}
+#ifndef NO_WIDE_TYPE
+	if (type == TCL_NUMBER_WIDE) {
+	    Tcl_WideInt w = *((const Tcl_WideInt *)ptr);
+
 	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewLongObj(~i);
-		TRACE(("0x%lx => (%lu)\n", i, ~i));
+		objResultPtr = Tcl_NewWideIntObj(~w);
 		NEXT_INST_F(1, 1, 1);
-	    } else {
-		/*
-		 * valuePtr is unshared. Modify it directly.
-		 */
-		Tcl_SetLongObj(valuePtr, ~i);
-		TRACE(("0x%lx => (%lu)\n", i, ~i));
-		NEXT_INST_F(1, 0, 0);
 	    }
+	    Tcl_SetWideIntObj(valuePtr, ~w);
+	    NEXT_INST_F(1, 0, 0);
 	}
+#endif
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
+	/* ~a = - a - 1 */
+	mp_neg(&big, &big);
+	mp_sub_d(&big, 1, &big);
+	if (Tcl_IsShared(valuePtr)) {
+	    objResultPtr = Tcl_NewBignumObj(&big);
+	    NEXT_INST_F(1, 1, 1);
+	}
+	Tcl_SetBignumObj(valuePtr, &big);
+	NEXT_INST_F(1, 0, 0);
     }
 
-    case INST_CALL_BUILTIN_FUNC1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	{
-	    /*
-	     * Call one of the built-in Tcl math functions.
-	     */
-
-	    BuiltinFunc *mathFuncPtr;
+    case INST_UMINUS: {
+	ClientData ptr;
+	int type;
+	Tcl_Obj *valuePtr = OBJ_AT_TOS;
 
-	    if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
-		TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
-		panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
-	    }
-	    mathFuncPtr = &(tclBuiltinFuncTable[opnd]);
+	result = GetNumberFromObj(NULL, valuePtr, &ptr, &type);
+	if ((result != TCL_OK)
+#ifndef ACCEPT_NAN
+		|| (type == TCL_NUMBER_NAN)
+#endif
+		) {
+	    result = TCL_ERROR;
+	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
-	    result = (*mathFuncPtr->proc)(interp, eePtr,
-	            mathFuncPtr->clientData);
+	    IllegalExprOperandType(interp, pc, valuePtr);
 	    CACHE_STACK_INFO();
-	    if (result != TCL_OK) {
-		goto checkForCatch;
+	    goto checkForCatch;
+	}
+	switch (type) {
+	case TCL_NUMBER_DOUBLE: {
+	    double d;
+
+	    if (Tcl_IsShared(valuePtr)) {
+		TclNewDoubleObj(objResultPtr, -(*((const double *)ptr)));
+		NEXT_INST_F(1, 1, 1);
 	    }
-	    TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
+	    d = *((const double *)ptr);
+	    TclSetDoubleObj(valuePtr, -d);
+	    NEXT_INST_F(1, 0, 0);
 	}
-	NEXT_INST_F(2, 0, 0);
-		    
-    case INST_CALL_FUNC1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	{
-	    /*
-	     * Call a non-builtin Tcl math function previously
-	     * registered by a call to Tcl_CreateMathFunc.
-	     */
-		
-	    int objc = opnd;   /* Number of arguments. The function name
-				* is the 0-th argument. */
-	    Tcl_Obj **objv;    /* The array of arguments. The function
-				* name is objv[0]. */
+	case TCL_NUMBER_LONG: {
+	    long l = *((const long *)ptr);
 
-	    objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
-	    DECACHE_STACK_INFO();
-	    result = ExprCallMathFunc(interp, eePtr, objc, objv);
-	    CACHE_STACK_INFO();
-	    if (result != TCL_OK) {
-		goto checkForCatch;
+	    if (l != LONG_MIN) {
+		if (Tcl_IsShared(valuePtr)) {
+		    TclNewLongObj(objResultPtr, -l);
+		    NEXT_INST_F(1, 1, 1);
+		}
+		TclSetLongObj(valuePtr, -l);
+		NEXT_INST_F(1, 0, 0);
 	    }
-	    TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
+	    /* FALLTHROUGH */
 	}
-	NEXT_INST_F(2, 0, 0);
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE: {
+	    Tcl_WideInt w;
 
-    case INST_TRY_CVT_TO_NUMERIC:
-    {
-	/*
-	 * Try to convert the topmost stack object to an int or
-	 * double object. This is done in order to support Tcl's
-	 * policy of interpreting operands if at all possible as
-	 * first integers, else floating-point numbers.
-	 */
-		
-	double d;
-	char *s;
-	Tcl_ObjType *tPtr;
-	int converted, needNew;
-
-	valuePtr = stackPtr[stackTop];
-	tPtr = valuePtr->typePtr;
-	converted = 0;
-	if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
-	        || (valuePtr->bytes != NULL))) {
-	    if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
-		valuePtr->typePtr = &tclIntType;
-		converted = 1;
+	    if (type == TCL_NUMBER_LONG) {
+		w = (Tcl_WideInt)(*((const long *)ptr));
 	    } else {
-		s = Tcl_GetStringFromObj(valuePtr, &length);
-		if (TclLooksLikeInt(s, length)) {
-		    GET_WIDE_OR_INT(result, valuePtr, i, w);
-		} else {
-		    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
-		            valuePtr, &d);
-		}
-		if (result == TCL_OK) {
-		    converted = 1;
+		w = *((const Tcl_WideInt *)ptr);
+	    }
+	    if (w != LLONG_MIN) {
+		if (Tcl_IsShared(valuePtr)) {
+		    objResultPtr = Tcl_NewWideIntObj(-w);
+		    NEXT_INST_F(1, 1, 1);
 		}
-		result = TCL_OK; /* reset the result variable */
+		Tcl_SetWideIntObj(valuePtr, -w);
+		NEXT_INST_F(1, 0, 0);
+	    }
+	    /* FALLTHROUGH */
+	}
+#endif
+	case TCL_NUMBER_BIG: {
+	    mp_int big;
+
+	    switch (type) {
+#ifdef NO_WIDE_TYPE
+	    case TCL_NUMBER_LONG:
+		TclBNInitBignumFromLong(&big, *(const long *) ptr);
+		break;
+#else
+	    case TCL_NUMBER_WIDE:
+		TclBNInitBignumFromWideInt(&big, *(const Tcl_WideInt *) ptr);
+		break;
+#endif
+	    case TCL_NUMBER_BIG:
+		Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
 	    }
-	    tPtr = valuePtr->typePtr;
+	    mp_neg(&big, &big);
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewBignumObj(&big);
+		NEXT_INST_F(1, 1, 1);
+	    }
+	    Tcl_SetBignumObj(valuePtr, &big);
+	    NEXT_INST_F(1, 0, 0);
 	}
+	case TCL_NUMBER_NAN:
+	    /* -NaN => NaN */
+	    NEXT_INST_F(1, 0, 0);
+	}
+    }
 
+    case INST_UPLUS:
+    case INST_TRY_CVT_TO_NUMERIC: {
 	/*
-	 * Ensure that the topmost stack object, if numeric, has a
-	 * string rep the same as the formatted version of its
-	 * internal rep. This is used, e.g., to make sure that "expr
-	 * {0001}" yields "1", not "0001". We implement this by
-	 * _discarding_ the string rep since we know it will be
-	 * regenerated, if needed later, by formatting the internal
-	 * rep's value. Also check if there has been an IEEE
-	 * floating point error.
+	 * Try to convert the topmost stack object to numeric object. This is
+	 * done in order to support [expr]'s policy of interpreting operands
+	 * if at all possible as numbers first, then strings.
 	 */
-	
-	objResultPtr = valuePtr;
-	needNew = 0;
-	if (IS_NUMERIC_TYPE(tPtr)) {
-	    if (Tcl_IsShared(valuePtr)) {
-		if (valuePtr->bytes != NULL) {
-		    /*
-		     * We only need to make a copy of the object
-		     * when it already had a string rep
-		     */
-		    needNew = 1;
-		    if (tPtr == &tclIntType) {
-			i = valuePtr->internalRep.longValue;
-			objResultPtr = Tcl_NewLongObj(i);
-		    } else if (tPtr == &tclWideIntType) {
-			TclGetWide(w,valuePtr);
-			objResultPtr = Tcl_NewWideIntObj(w);
-		    } else {
-			d = valuePtr->internalRep.doubleValue;
-			objResultPtr = Tcl_NewDoubleObj(d);
-		    }
-		    tPtr = objResultPtr->typePtr;
-		}
+
+	ClientData ptr;
+	int type;
+	Tcl_Obj *valuePtr = OBJ_AT_TOS;
+
+	if (GetNumberFromObj(NULL, valuePtr, &ptr, &type) != TCL_OK) {
+	    if (*pc == INST_UPLUS) {
+		/*
+		 * ... +$NonNumeric => raise an error.
+		 */
+
+		result = TCL_ERROR;
+		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
+		DECACHE_STACK_INFO();
+		IllegalExprOperandType(interp, pc, valuePtr);
+		CACHE_STACK_INFO();
+		goto checkForCatch;
 	    } else {
-		Tcl_InvalidateStringRep(valuePtr);
+		/* ... TryConvertToNumeric($NonNumeric) is acceptable */
+		TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 0, 0);
 	    }
-		
-	    if (tPtr == &tclDoubleType) {
-		d = objResultPtr->internalRep.doubleValue;
-		if (IS_NAN(d) || IS_INF(d)) {
-		    TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
-		            O2S(objResultPtr)));
-		    DECACHE_STACK_INFO();
-		    TclExprFloatError(interp, d);
-		    CACHE_STACK_INFO();
-		    result = TCL_ERROR;
-		    goto checkForCatch;
-		}
+	}
+#ifndef ACCEPT_NAN
+	if (type == TCL_NUMBER_NAN) {
+	    result = TCL_ERROR;
+	    if (*pc == INST_UPLUS) {
+		/*
+		 * ... +$NonNumeric => raise an error.
+		 */
+
+		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
+		DECACHE_STACK_INFO();
+		IllegalExprOperandType(interp, pc, valuePtr);
+		CACHE_STACK_INFO();
+	    } else {
+		/*
+		 * Numeric conversion of NaN -> error.
+		 */
+
+		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
+			O2S(objResultPtr)));
+		DECACHE_STACK_INFO();
+		TclExprFloatError(interp, *((const double *)ptr));
+		CACHE_STACK_INFO();
 	    }
-	    converted = converted;  /* lint, converted not used. */
-	    TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
-	            (converted? "converted" : "not converted"),
-		    (needNew? "new Tcl_Obj" : "same Tcl_Obj")));
-	} else {
-	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+	    goto checkForCatch;
 	}
-	if (needNew) {
-	    NEXT_INST_F(1, 1, 1);
-	} else {
+#endif
+
+	/*
+	 * Ensure that the numeric value has a string rep the same as the
+	 * formatted version of its internal rep. This is used, e.g., to make
+	 * sure that "expr {0001}" yields "1", not "0001". We implement this
+	 * by _discarding_ the string rep since we know it will be
+	 * regenerated, if needed later, by formatting the internal rep's
+	 * value.
+	 */
+
+	if (valuePtr->bytes == NULL) {
+	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
+	if (Tcl_IsShared(valuePtr)) {
+	    /*
+	     * Here we do some surgery within the Tcl_Obj internals. We want
+	     * to copy the intrep, but not the string, so we temporarily hide
+	     * the string so we do not copy it.
+	     */
+
+	    char *savedString = valuePtr->bytes;
+
+	    valuePtr->bytes = NULL;
+	    objResultPtr = Tcl_DuplicateObj(valuePtr);
+	    valuePtr->bytes = savedString;
+	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 1);
+	}
+	TclInvalidateStringRep(valuePtr);
+	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+	NEXT_INST_F(1, 0, 0);
     }
-	
+
     case INST_BREAK:
+	/*
 	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
 	CACHE_STACK_INFO();
+	*/
 	result = TCL_BREAK;
 	cleanup = 0;
 	goto processExceptionReturn;
 
     case INST_CONTINUE:
+	/*
 	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
 	CACHE_STACK_INFO();
+	*/
 	result = TCL_CONTINUE;
 	cleanup = 0;
 	goto processExceptionReturn;
 
-    case INST_FOREACH_START4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	{
-	    /*
-	     * Initialize the temporary local var that holds the count
-	     * of the number of iterations of the loop body to -1.
-	     */
+    case INST_FOREACH_START4: {
+	/*
+	 * Initialize the temporary local var that holds the count of the
+	 * number of iterations of the loop body to -1.
+	 */
 
-	    ForeachInfo *infoPtr = (ForeachInfo *)
-	            codePtr->auxDataArrayPtr[opnd].clientData;
-	    int iterTmpIndex = infoPtr->loopCtTemp;
-	    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
-	    Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
-	    Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
+	int opnd, iterTmpIndex;
+	ForeachInfo *infoPtr;
+	Var *iterVarPtr;
+	Tcl_Obj *oldValuePtr;
 
-	    if (oldValuePtr == NULL) {
-		iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
-		Tcl_IncrRefCount(iterVarPtr->value.objPtr);
-	    } else {
-		Tcl_SetLongObj(oldValuePtr, -1);
-	    }
-	    TclSetVarScalar(iterVarPtr);
-	    TclClearVarUndefined(iterVarPtr);
-	    TRACE(("%u => loop iter count temp %d\n", 
-		   opnd, iterTmpIndex));
+	opnd = TclGetUInt4AtPtr(pc+1);
+	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	iterTmpIndex = infoPtr->loopCtTemp;
+	iterVarPtr = &(compiledLocals[iterTmpIndex]);
+	oldValuePtr = iterVarPtr->value.objPtr;
+
+	if (oldValuePtr == NULL) {
+	    TclNewLongObj(iterVarPtr->value.objPtr, -1);
+	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+	} else {
+	    TclSetLongObj(oldValuePtr, -1);
 	}
-	    
+	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
+
 #ifndef TCL_COMPILE_DEBUG
-	/* 
-	 * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4
-	 * immediately after INST_FOREACH_START4 - let us just fall
-	 * through instead of jumping back to the top.
+	/*
+	 * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
+	 * after INST_FOREACH_START4 - let us just fall through instead of
+	 * jumping back to the top.
 	 */
 
 	pc += 5;
 	TCL_DTRACE_INST_NEXT();
 #else
 	NEXT_INST_F(5, 0, 0);
-#endif	
-    case INST_FOREACH_STEP4:
+#endif
+    }
+
+    case INST_FOREACH_STEP4: {
+	/*
+	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+	 * the next value list element to each loop var.
+	 */
+
+	ForeachInfo *infoPtr;
+	ForeachVarList *varListPtr;
+	Tcl_Obj *listPtr,*valuePtr, *value2Ptr, **elements;
+	Var *iterVarPtr, *listVarPtr, *varPtr;
+	int opnd, numLists, iterNum, listTmpIndex, listLen, numVars;
+	int varIndex, valIndex, continueLoop, j;
+	long i;
+
 	opnd = TclGetUInt4AtPtr(pc+1);
-	{
-	    /*
-	     * "Step" a foreach loop (i.e., begin its next iteration) by
-	     * assigning the next value list element to each loop var.
-	     */
+	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	numLists = infoPtr->numLists;
 
-	    ForeachInfo *infoPtr = (ForeachInfo *)
-	            codePtr->auxDataArrayPtr[opnd].clientData;
-	    ForeachVarList *varListPtr;
-	    int numLists = infoPtr->numLists;
-	    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
-	    Tcl_Obj *listPtr;
-	    Var *iterVarPtr, *listVarPtr;
-	    int iterNum, listTmpIndex, listLen, numVars;
-	    int varIndex, valIndex, continueLoop, j;
+	/*
+	 * Increment the temp holding the loop iteration number.
+	 */
 
-	    /*
-	     * Increment the temp holding the loop iteration number.
-	     */
+	iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+	valuePtr = iterVarPtr->value.objPtr;
+	iterNum = (valuePtr->internalRep.longValue + 1);
+	TclSetLongObj(valuePtr, iterNum);
 
-	    iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
-	    valuePtr = iterVarPtr->value.objPtr;
-	    iterNum = (valuePtr->internalRep.longValue + 1);
-	    Tcl_SetLongObj(valuePtr, iterNum);
-		
-	    /*
-	     * Check whether all value lists are exhausted and we should
-	     * stop the loop.
-	     */
+	/*
+	 * Check whether all value lists are exhausted and we should stop the
+	 * loop.
+	 */
 
-	    continueLoop = 0;
-	    listTmpIndex = infoPtr->firstValueTemp;
-	    for (i = 0;  i < numLists;  i++) {
-		varListPtr = infoPtr->varLists[i];
-		numVars = varListPtr->numVars;
-		    
-		listVarPtr = &(compiledLocals[listTmpIndex]);
-		listPtr = listVarPtr->value.objPtr;
-		result = Tcl_ListObjLength(interp, listPtr, &listLen);
-		if (result != TCL_OK) {
-		    TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
-		            opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
-		    goto checkForCatch;
-		}
+	continueLoop = 0;
+	listTmpIndex = infoPtr->firstValueTemp;
+	for (i = 0;  i < numLists;  i++) {
+	    varListPtr = infoPtr->varLists[i];
+	    numVars = varListPtr->numVars;
+
+	    listVarPtr = &(compiledLocals[listTmpIndex]);
+	    listPtr = listVarPtr->value.objPtr;
+	    result = TclListObjLength(interp, listPtr, &listLen);
+	    if (result == TCL_OK) {
 		if (listLen > (iterNum * numVars)) {
 		    continueLoop = 1;
 		}
 		listTmpIndex++;
+	    } else {
+		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
+			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+		goto checkForCatch;
 	    }
+	}
 
-	    /*
-	     * If some var in some var list still has a remaining list
-	     * element iterate one more time. Assign to var the next
-	     * element from its value list. We already checked above
-	     * that each list temp holds a valid list object.
-	     */
-		
-	    if (continueLoop) {
-		listTmpIndex = infoPtr->firstValueTemp;
-		for (i = 0;  i < numLists;  i++) {
-		    varListPtr = infoPtr->varLists[i];
-		    numVars = varListPtr->numVars;
+	/*
+	 * If some var in some var list still has a remaining list element
+	 * iterate one more time. Assign to var the next element from its
+	 * value list. We already checked above that each list temp holds a
+	 * valid list object (by calling Tcl_ListObjLength), but cannot rely
+	 * on that check remaining valid: one list could have been shimmered
+	 * as a side effect of setting a traced variable.
+	 */
 
-		    listVarPtr = &(compiledLocals[listTmpIndex]);
-		    listPtr = listVarPtr->value.objPtr;
+	if (continueLoop) {
+	    listTmpIndex = infoPtr->firstValueTemp;
+	    for (i = 0;  i < numLists;  i++) {
+		varListPtr = infoPtr->varLists[i];
+		numVars = varListPtr->numVars;
 
-		    valIndex = (iterNum * numVars);
-		    for (j = 0;  j < numVars;  j++) {
-			Tcl_Obj **elements;
+		listVarPtr = &(compiledLocals[listTmpIndex]);
+		listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
+		TclListObjGetElements(interp, listPtr, &listLen, &elements);
 
-			/*
-			 * The call to TclPtrSetVar might shimmer listPtr,
-			 * so re-fetch pointers every iteration for safety.
-			 * See test foreach-10.1.
-			 */
+		valIndex = (iterNum * numVars);
+		for (j = 0;  j < numVars;  j++) {
+		    if (valIndex >= listLen) {
+			TclNewObj(valuePtr);
+		    } else {
+			valuePtr = elements[valIndex];
+		    }
 
-			Tcl_ListObjGetElements(NULL, listPtr,
-				&listLen, &elements);
-			if (valIndex >= listLen) {
-			    TclNewObj(valuePtr);
-			} else {
-			    valuePtr = elements[valIndex];
-			}
-			    
-			varIndex = varListPtr->varIndexes[j];
-			varPtr = &(varFramePtr->compiledLocals[varIndex]);
-			part1 = varPtr->name;
-			while (TclIsVarLink(varPtr)) {
-			    varPtr = varPtr->value.linkPtr;
-			}
-			if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL))
-			        && (varPtr->tracePtr == NULL)
-			        && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) {
-			    value2Ptr = varPtr->value.objPtr;
-			    if (valuePtr != value2Ptr) {
-				if (value2Ptr != NULL) {
-				    TclDecrRefCount(value2Ptr);
-				} else {
-				    TclSetVarScalar(varPtr);
-				    TclClearVarUndefined(varPtr);
-				}
-				varPtr->value.objPtr = valuePtr;
-				Tcl_IncrRefCount(valuePtr);
+		    varIndex = varListPtr->varIndexes[j];
+		    varPtr = &(compiledLocals[varIndex]);
+		    while (TclIsVarLink(varPtr)) {
+			varPtr = varPtr->value.linkPtr;
+		    }
+		    if (TclIsVarDirectWritable(varPtr)) {
+			value2Ptr = varPtr->value.objPtr;
+			if (valuePtr != value2Ptr) {
+			    if (value2Ptr != NULL) {
+				TclDecrRefCount(value2Ptr);
 			    }
-			} else {
-			    DECACHE_STACK_INFO();
+			    varPtr->value.objPtr = valuePtr;
 			    Tcl_IncrRefCount(valuePtr);
-			    value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, 
-						     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
-			    TclDecrRefCount(valuePtr);
-			    CACHE_STACK_INFO();
-			    if (value2Ptr == NULL) {
-				TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
-						opnd, varIndex),
-					       Tcl_GetObjResult(interp));
-				result = TCL_ERROR;
-				goto checkForCatch;
-			    }
 			}
-			valIndex++;
+		    } else {
+			DECACHE_STACK_INFO();
+			value2Ptr = TclPtrSetVar(interp, varPtr, NULL, NULL,
+				NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex);
+			CACHE_STACK_INFO();
+			if (value2Ptr == NULL) {
+			    TRACE_WITH_OBJ((
+				    "%u => ERROR init. index temp %d: ",
+				    opnd,varIndex), Tcl_GetObjResult(interp));
+			    result = TCL_ERROR;
+			    TclDecrRefCount(listPtr);
+			    goto checkForCatch;
+			}
 		    }
-		    listTmpIndex++;
+		    valIndex++;
 		}
+		TclDecrRefCount(listPtr);
+		listTmpIndex++;
 	    }
-	    TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists, 
-	            iterNum, (continueLoop? "continue" : "exit")));
+	}
+	TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
+		iterNum, (continueLoop? "continue" : "exit")));
 
-	    /* 
-	     * Run-time peep-hole optimisation: the compiler ALWAYS follows
-	     * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
-	     * instruction and jump direct from here.
-	     */
+	/*
+	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
+	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
+	 * instruction and jump direct from here.
+	 */
 
-	    pc += 5;
-	    if (*pc == INST_JUMP_FALSE1) {
-		NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
-	    } else {
-		NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
-	    }
+	pc += 5;
+	if (*pc == INST_JUMP_FALSE1) {
+	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
+	} else {
+	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
 	}
+    }
 
     case INST_BEGIN_CATCH4:
 	/*
-	 * Record start of the catch command with exception range index
-	 * equal to the operand. Push the current stack depth onto the
-	 * special catch stack.
+	 * Record start of the catch command with exception range index equal
+	 * to the operand. Push the current stack depth onto the special catch
+	 * stack.
 	 */
-	catchStackPtr[++catchTop] = stackTop;
+
+	*(++catchTop) = CURR_DEPTH;
 	TRACE(("%u => catchTop=%d, stackTop=%d\n",
-	       TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
+		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
+		(int) CURR_DEPTH));
 	NEXT_INST_F(5, 0, 0);
 
     case INST_END_CATCH:
 	catchTop--;
+	DECACHE_STACK_INFO();
+	Tcl_ResetResult(interp);
+	CACHE_STACK_INFO();
 	result = TCL_OK;
-	TRACE(("=> catchTop=%d\n", catchTop));
+	TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
 	NEXT_INST_F(1, 0, 0);
-	    
+
     case INST_PUSH_RESULT:
 	objResultPtr = Tcl_GetObjResult(interp);
-	TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
 
 	/*
 	 * See the comments at INST_INVOKE_STK
 	 */
 	{
 	    Tcl_Obj *newObjResultPtr;
+
 	    TclNewObj(newObjResultPtr);
 	    Tcl_IncrRefCount(newObjResultPtr);
 	    iPtr->objResultPtr = newObjResultPtr;
@@ -4330,205 +6761,784 @@ TclExecuteByteCode(interp, codePtr)
 	NEXT_INST_F(1, 0, -1);
 
     case INST_PUSH_RETURN_CODE:
-	objResultPtr = Tcl_NewLongObj(result);
+	TclNewIntObj(objResultPtr, result);
 	TRACE(("=> %u\n", result));
 	NEXT_INST_F(1, 0, 1);
 
+    case INST_PUSH_RETURN_OPTIONS:
+	objResultPtr = Tcl_GetReturnOptions(interp, result);
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+
+/* TODO: normalize "valPtr" to "valuePtr" */
+    {
+	int opnd, opnd2, allocateDict;
+	Tcl_Obj *dictPtr, *valPtr;
+	Var *varPtr;
+
+    case INST_DICT_GET:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	dictPtr = OBJ_AT_DEPTH(opnd);
+	if (opnd > 1) {
+	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
+		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
+	    if (dictPtr == NULL) {
+		TRACE_WITH_OBJ((
+			"%u => ERROR tracing dictionary path into \"%s\": ",
+			opnd, O2S(OBJ_AT_DEPTH(opnd))),
+			Tcl_GetObjResult(interp));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+	result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &objResultPtr);
+	if ((result == TCL_OK) && objResultPtr) {
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_V(5, opnd+1, 1);
+	}
+	if (result != TCL_OK) {
+	    TRACE_WITH_OBJ((
+		    "%u => ERROR reading leaf dictionary key \"%s\": ",
+		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+	} else {
+	    DECACHE_STACK_INFO();
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
+		    "\" not known in dictionary", NULL);
+	    CACHE_STACK_INFO();
+	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	}
+	goto checkForCatch;
+
+    case INST_DICT_SET:
+    case INST_DICT_UNSET:
+    case INST_DICT_INCR_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
+
+	varPtr = &(compiledLocals[opnd2]);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u %u => ", opnd, opnd2));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);
+	    CACHE_STACK_INFO();
+	}
+	if (dictPtr == NULL) {
+	    TclNewObj(dictPtr);
+	    allocateDict = 1;
+	} else {
+	    allocateDict = Tcl_IsShared(dictPtr);
+	    if (allocateDict) {
+		dictPtr = Tcl_DuplicateObj(dictPtr);
+	    }
+	}
+
+	switch (*pc) {
+	case INST_DICT_SET:
+	    cleanup = opnd + 1;
+	    result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd,
+		    &OBJ_AT_DEPTH(opnd), OBJ_AT_TOS);
+	    break;
+	case INST_DICT_INCR_IMM:
+	    cleanup = 1;
+	    opnd = TclGetInt4AtPtr(pc+1);
+	    result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valPtr);
+	    if (result != TCL_OK) {
+		break;
+	    }
+	    if (valPtr == NULL) {
+		Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
+	    } else {
+		Tcl_Obj *incrPtr = Tcl_NewIntObj(opnd);
+
+		Tcl_IncrRefCount(incrPtr);
+		if (Tcl_IsShared(valPtr)) {
+		    valPtr = Tcl_DuplicateObj(valPtr);
+		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valPtr);
+		}
+		result = TclIncrObj(interp, valPtr, incrPtr);
+		if (result == TCL_OK) {
+		    TclInvalidateStringRep(dictPtr);
+		}
+		TclDecrRefCount(incrPtr);
+	    }
+	    break;
+	case INST_DICT_UNSET:
+	    cleanup = opnd;
+	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
+		    &OBJ_AT_DEPTH(opnd-1));
+	    break;
+	default:
+	    cleanup = 0; /* stop compiler warning */
+	    Tcl_Panic("Should not happen!");
+	}
+
+	if (result != TCL_OK) {
+	    if (allocateDict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
+		    opnd, opnd2), Tcl_GetObjResult(interp));
+	    goto checkForCatch;
+	}
+
+	if (TclIsVarDirectWritable(varPtr)) {
+	    if (allocateDict) {
+		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
+
+		Tcl_IncrRefCount(dictPtr);
+		if (oldValuePtr != NULL) {
+		    TclDecrRefCount(oldValuePtr);
+		}
+		varPtr->value.objPtr = dictPtr;
+	    }
+	    objResultPtr = dictPtr;
+	} else {
+	    Tcl_IncrRefCount(dictPtr);
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
+	    CACHE_STACK_INFO();
+	    TclDecrRefCount(dictPtr);
+	    if (objResultPtr == NULL) {
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+#ifndef TCL_COMPILE_DEBUG
+	if (*(pc+9) == INST_POP) {
+	    NEXT_INST_V(10, cleanup, 0);
+	}
+#endif
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(9, cleanup, 1);
+
+    case INST_DICT_APPEND:
+    case INST_DICT_LAPPEND:
+	opnd = TclGetUInt4AtPtr(pc+1);
+
+	varPtr = &(compiledLocals[opnd]);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
+	    CACHE_STACK_INFO();
+	}
+	if (dictPtr == NULL) {
+	    TclNewObj(dictPtr);
+	    allocateDict = 1;
+	} else {
+	    allocateDict = Tcl_IsShared(dictPtr);
+	    if (allocateDict) {
+		dictPtr = Tcl_DuplicateObj(dictPtr);
+	    }
+	}
+
+	result = Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS, &valPtr);
+	if (result != TCL_OK) {
+	    if (allocateDict) {
+		TclDecrRefCount(dictPtr);
+	    }
+	    goto checkForCatch;
+	}
+
+	/*
+	 * Note that a non-existent key results in a NULL valPtr, which is a
+	 * case handled separately below. What we *can* say at this point is
+	 * that the write-back will always succeed.
+	 */
+
+	switch (*pc) {
+	case INST_DICT_APPEND:
+	    if (valPtr == NULL) {
+		valPtr = OBJ_AT_TOS;
+	    } else {
+		if (Tcl_IsShared(valPtr)) {
+		    valPtr = Tcl_DuplicateObj(valPtr);
+		}
+		Tcl_AppendObjToObj(valPtr, OBJ_AT_TOS);
+	    }
+	    break;
+	case INST_DICT_LAPPEND:
+	    /*
+	     * More complex because list-append can fail.
+	     */
+
+	    if (valPtr == NULL) {
+		valPtr = Tcl_NewListObj(1, &OBJ_AT_TOS);
+	    } else if (Tcl_IsShared(valPtr)) {
+		valPtr = Tcl_DuplicateObj(valPtr);
+		result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS);
+		if (result != TCL_OK) {
+		    TclDecrRefCount(valPtr);
+		    if (allocateDict) {
+			TclDecrRefCount(dictPtr);
+		    }
+		    goto checkForCatch;
+		}
+	    } else {
+		result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS);
+		if (result != TCL_OK) {
+		    if (allocateDict) {
+			TclDecrRefCount(dictPtr);
+		    }
+		    goto checkForCatch;
+		}
+	    }
+	    break;
+	default:
+	    Tcl_Panic("Should not happen!");
+	}
+
+	Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valPtr);
+
+	if (TclIsVarDirectWritable(varPtr)) {
+	    if (allocateDict) {
+		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
+
+		Tcl_IncrRefCount(dictPtr);
+		if (oldValuePtr != NULL) {
+		    TclDecrRefCount(oldValuePtr);
+		}
+		varPtr->value.objPtr = dictPtr;
+	    }
+	    objResultPtr = dictPtr;
+	} else {
+	    Tcl_IncrRefCount(dictPtr);
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
+	    CACHE_STACK_INFO();
+	    TclDecrRefCount(dictPtr);
+	    if (objResultPtr == NULL) {
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+#ifndef TCL_COMPILE_DEBUG
+	if (*(pc+5) == INST_POP) {
+	    NEXT_INST_F(6, 2, 0);
+	}
+#endif
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(5, 2, 1);
+    }
+
+    {
+	int opnd, done;
+	Tcl_Obj *statePtr, *dictPtr, *keyPtr, *valuePtr, *emptyPtr;
+	Var *varPtr;
+	Tcl_DictSearch *searchPtr;
+
+    case INST_DICT_FIRST:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	dictPtr = POP_OBJECT();
+	searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
+	result = Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
+		&valuePtr, &done);
+	if (result != TCL_OK) {
+	    ckfree((char *) searchPtr);
+	    goto checkForCatch;
+	}
+	TclNewObj(statePtr);
+	statePtr->typePtr = &dictIteratorType;
+	statePtr->internalRep.twoPtrValue.ptr1 = (void *) searchPtr;
+	statePtr->internalRep.twoPtrValue.ptr2 = (void *) dictPtr;
+	varPtr = (compiledLocals + opnd);
+	if (varPtr->value.objPtr) {
+	    if (varPtr->value.objPtr->typePtr != &dictIteratorType) {
+		TclDecrRefCount(varPtr->value.objPtr);
+	    } else {
+		Tcl_Panic("mis-issued dictFirst!");
+	    }
+	}
+	varPtr->value.objPtr = statePtr;
+	Tcl_IncrRefCount(statePtr);
+	goto pushDictIteratorResult;
+
+    case INST_DICT_NEXT:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	statePtr = compiledLocals[opnd].value.objPtr;
+	if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
+	    Tcl_Panic("mis-issued dictNext!");
+	}
+	searchPtr = (Tcl_DictSearch *) statePtr->internalRep.twoPtrValue.ptr1;
+	Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+    pushDictIteratorResult:
+	if (done) {
+	    TclNewObj(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	    PUSH_OBJECT(emptyPtr);
+	} else {
+	    PUSH_OBJECT(valuePtr);
+	    PUSH_OBJECT(keyPtr);
+	}
+	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
+	objResultPtr = constants[done];
+	/* TODO: consider opt like INST_FOREACH_STEP4 */
+	NEXT_INST_F(5, 0, 1);
+
+    case INST_DICT_DONE:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
+	statePtr = compiledLocals[opnd].value.objPtr;
+	if (statePtr == NULL) {
+	    Tcl_Panic("mis-issued dictDone!");
+	}
+
+	if (statePtr->typePtr == &dictIteratorType) {
+	    /*
+	     * First kill the search, and then release the reference to the
+	     * dictionary that we were holding.
+	     */
+
+	    searchPtr = (Tcl_DictSearch *)
+		    statePtr->internalRep.twoPtrValue.ptr1;
+	    Tcl_DictObjDone(searchPtr);
+	    ckfree((char *) searchPtr);
+
+	    dictPtr = (Tcl_Obj *) statePtr->internalRep.twoPtrValue.ptr2;
+	    TclDecrRefCount(dictPtr);
+
+	    /*
+	     * Set the internal variable to an empty object to signify that we
+	     * don't hold an iterator.
+	     */
+
+	    TclDecrRefCount(statePtr);
+	    TclNewObj(emptyPtr);
+	    compiledLocals[opnd].value.objPtr = emptyPtr;
+	    Tcl_IncrRefCount(emptyPtr);
+	}
+	NEXT_INST_F(5, 0, 0);
+    }
+
+    {
+	int opnd, opnd2, i, length, allocdict;
+	Tcl_Obj **keyPtrPtr, *dictPtr;
+	DictUpdateInfo *duiPtr;
+	Var *varPtr;
+
+    case INST_DICT_UPDATE_START:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
+	varPtr = &(compiledLocals[opnd]);
+	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
+		    TCL_LEAVE_ERR_MSG, opnd);
+	    CACHE_STACK_INFO();
+	    if (dictPtr == NULL) {
+		goto dictUpdateStartFailed;
+	    }
+	}
+	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+		&keyPtrPtr) != TCL_OK) {
+	    goto dictUpdateStartFailed;
+	}
+	if (length != duiPtr->length) {
+	    Tcl_Panic("dictUpdateStart argument length mismatch");
+	}
+	for (i=0 ; i<length ; i++) {
+	    Tcl_Obj *valPtr;
+
+	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
+		    &valPtr) != TCL_OK) {
+		goto dictUpdateStartFailed;
+	    }
+	    varPtr = &(compiledLocals[duiPtr->varIndices[i]]);
+	    while (TclIsVarLink(varPtr)) {
+		varPtr = varPtr->value.linkPtr;
+	    }
+	    DECACHE_STACK_INFO();
+	    if (valPtr == NULL) {
+		TclObjUnsetVar2(interp,
+			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
+			NULL, 0);
+	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    valPtr, TCL_LEAVE_ERR_MSG,
+		    duiPtr->varIndices[i]) == NULL) {
+		CACHE_STACK_INFO();
+	    dictUpdateStartFailed:
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    CACHE_STACK_INFO();
+	}
+	NEXT_INST_F(9, 0, 0);
+
+    case INST_DICT_UPDATE_END:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd2 = TclGetUInt4AtPtr(pc+5);
+	varPtr = &(compiledLocals[opnd]);
+	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u => ", opnd));
+	if (TclIsVarDirectReadable(varPtr)) {
+	    dictPtr = varPtr->value.objPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
+	    CACHE_STACK_INFO();
+	}
+	if (dictPtr == NULL) {
+	    NEXT_INST_F(9, 1, 0);
+	}
+	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
+		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+			&keyPtrPtr) != TCL_OK) {
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+	allocdict = Tcl_IsShared(dictPtr);
+	if (allocdict) {
+	    dictPtr = Tcl_DuplicateObj(dictPtr);
+	}
+	for (i=0 ; i<length ; i++) {
+	    Tcl_Obj *valPtr;
+	    Var *var2Ptr;
+
+	    var2Ptr = &(compiledLocals[duiPtr->varIndices[i]]);
+	    while (TclIsVarLink(var2Ptr)) {
+		var2Ptr = var2Ptr->value.linkPtr;
+	    }
+	    if (TclIsVarDirectReadable(var2Ptr)) {
+		valPtr = var2Ptr->value.objPtr;
+	    } else {
+		DECACHE_STACK_INFO();
+		valPtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
+			duiPtr->varIndices[i]);
+		CACHE_STACK_INFO();
+	    }
+	    if (valPtr == NULL) {
+		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
+	    } else if (dictPtr == valPtr) {
+		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
+			Tcl_DuplicateObj(valPtr));
+	    } else {
+		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valPtr);
+	    }
+	}
+	if (TclIsVarDirectWritable(varPtr)) {
+	    Tcl_IncrRefCount(dictPtr);
+	    TclDecrRefCount(varPtr->value.objPtr);
+	    varPtr->value.objPtr = dictPtr;
+	} else {
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
+	    CACHE_STACK_INFO();
+	    if (objResultPtr == NULL) {
+		if (allocdict) {
+		    TclDecrRefCount(dictPtr);
+		}
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+	NEXT_INST_F(9, 1, 0);
+    }
+
     default:
-	panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
+	Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
     } /* end of switch on opCode */
 
     /*
-     * Division by zero in an expression. Control only reaches this
-     * point by "goto divideByZero".
+     * Division by zero in an expression. Control only reaches this point by
+     * "goto divideByZero".
      */
-	
+
  divideByZero:
     DECACHE_STACK_INFO();
-    Tcl_ResetResult(interp);
-    Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
-    Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
-            (char *) NULL);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+    Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
     CACHE_STACK_INFO();
 
     result = TCL_ERROR;
     goto checkForCatch;
-	
+
     /*
-     * An external evaluation (INST_INVOKE or INST_EVAL) returned 
-     * something different from TCL_OK, or else INST_BREAK or 
-     * INST_CONTINUE were called.
+     * Exponentiation of zero by negative number in an expression. Control
+     * only reaches this point by "goto exponOfZero".
      */
 
- processExceptionReturn:
-#if TCL_COMPILE_DEBUG    
-    switch (*pc) {
-        case INST_INVOKE_STK1:
-        case INST_INVOKE_STK4:
+ exponOfZero:
+    DECACHE_STACK_INFO();
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "exponentiation of zero by negative power", -1));
+    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+	    "exponentiation of zero by negative power", NULL);
+    CACHE_STACK_INFO();
+    result = TCL_ERROR;
+    goto checkForCatch;
+
+    /*
+     * Block for variables needed to process exception returns.
+     */
+
+    {
+	ExceptionRange *rangePtr;
+				/* Points to closest loop or catch exception
+				 * range enclosing the pc. Used by various
+				 * instructions and processCatch to process
+				 * break, continue, and errors. */
+	Tcl_Obj *valuePtr;
+	const char *bytes;
+	int length;
+#if TCL_COMPILE_DEBUG
+	int opnd;
+#endif
+
+	/*
+	 * An external evaluation (INST_INVOKE or INST_EVAL) returned
+	 * something different from TCL_OK, or else INST_BREAK or
+	 * INST_CONTINUE were called.
+	 */
+
+    processExceptionReturn:
+#if TCL_COMPILE_DEBUG
+	switch (*pc) {
+	case INST_INVOKE_STK1:
+	    opnd = TclGetUInt1AtPtr(pc+1);
 	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
 	    break;
-        case INST_EVAL_STK:
+	case INST_INVOKE_STK4:
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
+	    break;
+	case INST_EVAL_STK:
 	    /*
-	     * Note that the object at stacktop has to be used
-	     * before doing the cleanup.
+	     * Note that the object at stacktop has to be used before doing
+	     * the cleanup.
 	     */
 
-	    TRACE(("\"%.30s\" => ", O2S(stackPtr[stackTop])));
+	    TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
 	    break;
-        default:
+	default:
 	    TRACE(("=> "));
-    }		    
-#endif	   
-    if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
-	rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
-	if (rangePtr == NULL) {
-	    TRACE_APPEND(("no encl. loop or catch, returning %s\n",
-	            StringForResultCode(result)));
-	    goto abnormalReturn;
-	} 
-	if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
-	    TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
-	    goto processCatch;
 	}
-	while (cleanup--) {
-	    valuePtr = POP_OBJECT();
-	    TclDecrRefCount(valuePtr);
+#endif
+	if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
+	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+	    if (rangePtr == NULL) {
+		TRACE_APPEND(("no encl. loop or catch, returning %s\n",
+			StringForResultCode(result)));
+		goto abnormalReturn;
+	    }
+	    if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+		TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
+		goto processCatch;
+	    }
+	    while (cleanup--) {
+		valuePtr = POP_OBJECT();
+		TclDecrRefCount(valuePtr);
+	    }
+	    if (result == TCL_BREAK) {
+		result = TCL_OK;
+		pc = (codePtr->codeStart + rangePtr->breakOffset);
+		TRACE_APPEND(("%s, range at %d, new pc %d\n",
+			StringForResultCode(result),
+			rangePtr->codeOffset, rangePtr->breakOffset));
+		NEXT_INST_F(0, 0, 0);
+	    } else {
+		if (rangePtr->continueOffset == -1) {
+		    TRACE_APPEND((
+			    "%s, loop w/o continue, checking for catch\n",
+			    StringForResultCode(result)));
+		    goto checkForCatch;
+		}
+		result = TCL_OK;
+		pc = (codePtr->codeStart + rangePtr->continueOffset);
+		TRACE_APPEND(("%s, range at %d, new pc %d\n",
+			StringForResultCode(result),
+			rangePtr->codeOffset, rangePtr->continueOffset));
+		NEXT_INST_F(0, 0, 0);
+	    }
+#if TCL_COMPILE_DEBUG
+	} else if (traceInstructions) {
+	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
+		Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+			result, O2S(objPtr)));
+	    } else {
+		Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+		TRACE_APPEND(("%s, result= \"%s\"\n",
+			StringForResultCode(result), O2S(objPtr)));
+	    }
+#endif
 	}
-	if (result == TCL_BREAK) {
-	    result = TCL_OK;
-	    pc = (codePtr->codeStart + rangePtr->breakOffset);
-	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
-		   StringForResultCode(result),
-		   rangePtr->codeOffset, rangePtr->breakOffset));
-	    NEXT_INST_F(0, 0, 0);
-	} else {
-	    if (rangePtr->continueOffset == -1) {
-		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
-		        StringForResultCode(result)));
-		goto checkForCatch;
-	    } 
-	    result = TCL_OK;
-	    pc = (codePtr->codeStart + rangePtr->continueOffset);
-	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
-		   StringForResultCode(result),
-		   rangePtr->codeOffset, rangePtr->continueOffset));
-	    NEXT_INST_F(0, 0, 0);
-	}
-#if TCL_COMPILE_DEBUG    
-    } else if (traceInstructions) {
-	if ((result != TCL_ERROR) && (result != TCL_RETURN))  {
-	    objPtr = Tcl_GetObjResult(interp);
-	    TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ", 
-		    result, O2S(objPtr)));
-	} else {
-	    objPtr = Tcl_GetObjResult(interp);
-	    TRACE_APPEND(("%s, result= \"%s\"\n", 
-	            StringForResultCode(result), O2S(objPtr)));
+
+	/*
+	 * Execution has generated an "exception" such as TCL_ERROR. If the
+	 * exception is an error, record information about what was being
+	 * executed when the error occurred. Find the closest enclosing catch
+	 * range, if any. If no enclosing catch range is found, stop execution
+	 * and return the "exception" code.
+	 */
+
+	checkForCatch:
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
+	    if (bytes != NULL) {
+		DECACHE_STACK_INFO();
+		Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+		CACHE_STACK_INFO();
+	    }
 	}
+	iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+	/*
+	 * Clear all expansions that may have started after the last
+	 * INST_BEGIN_CATCH.
+	 */
+
+	while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
+		(*catchTop <=
+		(ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
+	    Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
+
+	    TclDecrRefCount(expandNestList);
+	    expandNestList = objPtr;
+	}
+
+	/*
+	 * We must not catch an exceeded limit. Instead, it blows outwards
+	 * until we either hit another interpreter (presumably where the limit
+	 * is not exceeded) or we get to the top-level.
+	 */
+
+	if (TclLimitExceeded(iPtr->limit)) {
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		fprintf(stdout, "   ... limit exceeded, returning %s\n",
+			StringForResultCode(result));
+	    }
 #endif
-    }
-	    	
-    /*
-     * Execution has generated an "exception" such as TCL_ERROR. If the
-     * exception is an error, record information about what was being
-     * executed when the error occurred. Find the closest enclosing
-     * catch range, if any. If no enclosing catch range is found, stop
-     * execution and return the "exception" code.
-     */
-	
- checkForCatch:
-    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	bytes = GetSrcInfoForPc(pc, codePtr, &length);
-	if (bytes != NULL) {
-	    DECACHE_STACK_INFO();
-	    Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
-            CACHE_STACK_INFO();
-	    iPtr->flags |= ERR_ALREADY_LOGGED;
+	    goto abnormalReturn;
 	}
-    }
-    if (catchTop == -1) {
+	if (catchTop == initCatchTop) {
 #ifdef TCL_COMPILE_DEBUG
-	if (traceInstructions) {
-	    fprintf(stdout, "   ... no enclosing catch, returning %s\n",
-	            StringForResultCode(result));
+	    if (traceInstructions) {
+		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
+			StringForResultCode(result));
+	    }
+#endif
+	    goto abnormalReturn;
 	}
+	rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+	if (rangePtr == NULL) {
+	    /*
+	     * This is only possible when compiling a [catch] that sends its
+	     * script to INST_EVAL. Cannot correct the compiler without
+	     * breakingcompat with previous .tbc compiled scripts.
+	     */
+
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
+			StringForResultCode(result));
+	    }
 #endif
-	goto abnormalReturn;
-    }
-    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
-    if (rangePtr == NULL) {
+	    goto abnormalReturn;
+	}
+
 	/*
-	 * This is only possible when compiling a [catch] that sends its
-	 * script to INST_EVAL. Cannot correct the compiler without 
-	 * breakingcompat with previous .tbc compiled scripts.
+	 * A catch exception range (rangePtr) was found to handle an
+	 * "exception". It was found either by checkForCatch just above or by
+	 * an instruction during break, continue, or error processing. Jump to
+	 * its catchOffset after unwinding the operand stack to the depth it
+	 * had when starting to execute the range's catch command.
 	 */
+
+    processCatch:
+	while (CURR_DEPTH > *catchTop) {
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+	}
 #ifdef TCL_COMPILE_DEBUG
 	if (traceInstructions) {
-	    fprintf(stdout, "   ... no enclosing catch, returning %s\n",
-	            StringForResultCode(result));
+	    fprintf(stdout, "  ... found catch at %d, catchTop=%d, "
+		    "unwound to %ld, new pc %u\n",
+		    rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
+		    (long) *catchTop, (unsigned) rangePtr->catchOffset);
 	}
 #endif
-	goto abnormalReturn;
-    }
+	pc = (codePtr->codeStart + rangePtr->catchOffset);
+	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */
 
-    /*
-     * A catch exception range (rangePtr) was found to handle an
-     * "exception". It was found either by checkForCatch just above or
-     * by an instruction during break, continue, or error processing.
-     * Jump to its catchOffset after unwinding the operand stack to
-     * the depth it had when starting to execute the range's catch
-     * command.
-     */
+	/*
+	 * end of infinite loop dispatching on instructions.
+	 */
 
- processCatch:
-    while (stackTop > catchStackPtr[catchTop]) {
-	valuePtr = POP_OBJECT();
-	TclDecrRefCount(valuePtr);
-    }
-#ifdef TCL_COMPILE_DEBUG
-    if (traceInstructions) {
-	fprintf(stdout, "  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
-	        rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
-	        (unsigned int)(rangePtr->catchOffset));
-    }
-#endif	
-    pc = (codePtr->codeStart + rangePtr->catchOffset);
-    NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
+	/*
+	 * Abnormal return code. Restore the stack to state it had when
+	 * starting to execute the ByteCode. Panic if the stack is below the
+	 * initial level.
+	 */
 
-    /* 
-     * end of infinite loop dispatching on instructions.
-     */
+    abnormalReturn:
+	TCL_DTRACE_INST_LAST();
+	while (tosPtr > initTosPtr) {
+	    Tcl_Obj *objPtr = POP_OBJECT();
 
-    /*
-     * Abnormal return code. Restore the stack to state it had when starting
-     * to execute the ByteCode. Panic if the stack is below the initial level.
-     */
+	    Tcl_DecrRefCount(objPtr);
+	}
 
- abnormalReturn:
-    TCL_DTRACE_INST_LAST();
-    while (stackTop > initStackTop) {
-	valuePtr = POP_OBJECT();
-	TclDecrRefCount(valuePtr);
-    }
-    if (stackTop < initStackTop) {
-	fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n",
-	        (unsigned int)(pc - codePtr->codeStart),
-		(unsigned int) stackTop,
-		(unsigned int) initStackTop);
-	panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+	/*
+	 * Clear all expansions.
+	 */
+
+	while (expandNestList) {
+	    Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
+
+	    TclDecrRefCount(expandNestList);
+	    expandNestList = objPtr;
+	}
+	if (tosPtr < initTosPtr) {
+	    fprintf(stderr,
+		    "\nTclExecuteByteCode: abnormal return at pc %u: "
+		    "stack top %d < entry stack top %d\n",
+		    (unsigned)(pc - codePtr->codeStart),
+		    (unsigned) CURR_DEPTH, (unsigned) 0);
+	    Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+	}
     }
-	
+
     /*
-     * Free the catch stack array if malloc'ed storage was used.
+     * Restore the stack to the state it had previous to this bytecode.
      */
 
-    if (catchStackPtr != catchStackStorage) {
-	ckfree((char *) catchStackPtr);
-    }
-    eePtr->stackTop = initStackTop;
-
+    TclStackFree(interp, initCatchTop+1);
     return result;
-#undef STATIC_CATCH_STACK_SIZE
+#undef iPtr
 }
 
 #ifdef TCL_COMPILE_DEBUG
@@ -4537,9 +7547,9 @@ TclExecuteByteCode(interp, codePtr)
  *
  * PrintByteCodeInfo --
  *
- *	This procedure prints a summary about a bytecode object to stdout.
- *	It is called by TclExecuteByteCode when starting to execute the
- *	bytecode object if tclTraceExec has the value 2 or more.
+ *	This procedure prints a summary about a bytecode object to stdout. It
+ *	is called by TclExecuteByteCode when starting to execute the bytecode
+ *	object if tclTraceExec has the value 2 or more.
  *
  * Results:
  *	None.
@@ -4551,46 +7561,45 @@ TclExecuteByteCode(interp, codePtr)
  */
 
 static void
-PrintByteCodeInfo(codePtr)
-    register ByteCode *codePtr;	/* The bytecode whose summary is printed
-				 * to stdout. */
+PrintByteCodeInfo(
+    register ByteCode *codePtr)	/* The bytecode whose summary is printed to
+				 * stdout. */
 {
     Proc *procPtr = codePtr->procPtr;
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
 
-    fprintf(stdout, "\nExecuting ByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
-	    (unsigned int) codePtr, codePtr->refCount,
-	    codePtr->compileEpoch, (unsigned int) iPtr,
+    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
+	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
 	    iPtr->compileEpoch);
-    
+
     fprintf(stdout, "  Source: ");
     TclPrintSource(stdout, codePtr->source, 60);
 
     fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
-            codePtr->numCommands, codePtr->numSrcBytes,
+	    codePtr->numCommands, codePtr->numSrcBytes,
 	    codePtr->numCodeBytes, codePtr->numLitObjects,
 	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
 #ifdef TCL_COMPILE_STATS
-	    (codePtr->numSrcBytes?
-	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
-#else
-	    0.0);
+	    codePtr->numSrcBytes?
+		    ((float)codePtr->structureSize)/codePtr->numSrcBytes :
 #endif
+	    0.0);
+
 #ifdef TCL_COMPILE_STATS
-    fprintf(stdout, "  Code %u = header %u+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
-	    (unsigned int)codePtr->structureSize,
-	    (unsigned int)(sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+    fprintf(stdout, "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+	    (unsigned long) codePtr->structureSize,
+	    (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)),
 	    codePtr->numCodeBytes,
-	    (unsigned long)(codePtr->numLitObjects * sizeof(Tcl_Obj *)),
-	    (unsigned long)(codePtr->numExceptRanges * sizeof(ExceptionRange)),
-	    (unsigned long)(codePtr->numAuxDataItems * sizeof(AuxData)),
+	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
 	    codePtr->numCmdLocBytes);
 #endif /* TCL_COMPILE_STATS */
     if (procPtr != NULL) {
 	fprintf(stdout,
-		"  Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
-		(unsigned int) procPtr, procPtr->refCount,
-		procPtr->numArgs, procPtr->numCompiledLocals);
+		"  Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
+		procPtr, procPtr->refCount, procPtr->numArgs,
+		procPtr->numCompiledLocals);
     }
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -4608,60 +7617,63 @@ PrintByteCodeInfo(codePtr)
  *	None.
  *
  * Side effects:
- *	Prints a message to stderr and panics if either the pc or stack
- *	top are invalid.
+ *	Prints a message to stderr and panics if either the pc or stack top
+ *	are invalid.
  *
  *----------------------------------------------------------------------
  */
 
 #ifdef TCL_COMPILE_DEBUG
 static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
-    register ByteCode *codePtr; /* The bytecode whose summary is printed
-				 * to stdout. */
-    unsigned char *pc;		/* Points to first byte of a bytecode
+ValidatePcAndStackTop(
+    register ByteCode *codePtr,	/* The bytecode whose summary is printed to
+				 * stdout. */
+    unsigned char *pc,		/* Points to first byte of a bytecode
 				 * instruction. The program counter. */
-    int stackTop;		/* Current stack top. Must be between
+    int stackTop,		/* Current stack top. Must be between
 				 * stackLowerBound and stackUpperBound
 				 * (inclusive). */
-    int stackLowerBound;	/* Smallest legal value for stackTop. */
+    int stackLowerBound,	/* Smallest legal value for stackTop. */
+    int checkStack)		/* 0 if the stack depth check should be
+				 * skipped. */
 {
-    int stackUpperBound = stackLowerBound +  codePtr->maxStackDepth;	
-                                /* Greatest legal value for stackTop. */
-    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
-    unsigned int codeStart = (unsigned int) codePtr->codeStart;
-    unsigned int codeEnd = (unsigned int)
+    int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+				/* Greatest legal value for stackTop. */
+    unsigned relativePc = (unsigned) (pc - codePtr->codeStart);
+    unsigned long codeStart = (unsigned long) codePtr->codeStart;
+    unsigned long codeEnd = (unsigned long)
 	    (codePtr->codeStart + codePtr->numCodeBytes);
     unsigned char opCode = *pc;
 
-    if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
-	fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
-		(unsigned int) pc);
-	panic("TclExecuteByteCode execution failure: bad pc");
+    if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) {
+	fprintf(stderr, "\nBad instruction pc 0x%p in TclExecuteByteCode\n",
+		pc);
+	Tcl_Panic("TclExecuteByteCode execution failure: bad pc");
     }
-    if ((unsigned int) opCode > LAST_INST_OPCODE) {
+    if ((unsigned) opCode > LAST_INST_OPCODE) {
 	fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
-		(unsigned int) opCode, relativePc);
-        panic("TclExecuteByteCode execution failure: bad opcode");
+		(unsigned) opCode, relativePc);
+	Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
     }
-    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
+    if (checkStack &&
+	    ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
 	int numChars;
-	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
-	char *ellipsis = "";
-	
+	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+
 	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
 		stackTop, relativePc, stackLowerBound, stackUpperBound);
 	if (cmd != NULL) {
-	    if (numChars > 100) {
-		numChars = 100;
-		ellipsis = "...";
-	    }
-	    fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
-		    ellipsis);
+	    Tcl_Obj *message;
+
+	    TclNewLiteralStringObj(message, "\n executing ");
+	    Tcl_IncrRefCount(message);
+	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
+	    fprintf(stderr,"%s\n", Tcl_GetString(message));
+	    Tcl_DecrRefCount(message);
 	} else {
 	    fprintf(stderr, "\n");
 	}
-	panic("TclExecuteByteCode execution failure: bad stack top");
+	Tcl_Panic("TclExecuteByteCode execution failure: bad stack top");
     }
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -4671,142 +7683,66 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
  *
  * IllegalExprOperandType --
  *
- *	Used by TclExecuteByteCode to add an error message to errorInfo
- *	when an illegal operand type is detected by an expression
+ *	Used by TclExecuteByteCode to append an error message to the interp
+ *	result when an illegal operand type is detected by an expression
  *	instruction. The argument opndPtr holds the operand object in error.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	An error message is appended to errorInfo.
+ *	An error message is appended to the interp result.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-IllegalExprOperandType(interp, pc, opndPtr)
-    Tcl_Interp *interp;		/* Interpreter to which error information
+IllegalExprOperandType(
+    Tcl_Interp *interp,		/* Interpreter to which error information
 				 * pertains. */
-    unsigned char *pc;		/* Points to the instruction being executed
+    unsigned char *pc,		/* Points to the instruction being executed
 				 * when the illegal type was found. */
-    Tcl_Obj *opndPtr;		/* Points to the operand holding the value
+    Tcl_Obj *opndPtr)		/* Points to the operand holding the value
 				 * with the illegal type. */
 {
-    unsigned char opCode = *pc;
-    
-    Tcl_ResetResult(interp);
-    if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"can't use empty string as operand of \"",
-		operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
-    } else {
-	char *msg = "non-numeric string";
-	char *s, *p;
-	int length;
-	int looksLikeInt = 0;
+    ClientData ptr;
+    int type;
+    unsigned char opcode = *pc;
+    const char *description, *operator = operatorStrings[opcode - INST_LOR];
 
-	s = Tcl_GetStringFromObj(opndPtr, &length);
-	p = s;
-	/*
-	 * strtod() isn't at all consistent about detecting Inf and
-	 * NaN between platforms.
-	 */
-	if (length == 3) {
-	    if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') &&
-		    (s[2]=='n' || s[2]=='N')) {
-		msg = "non-numeric floating-point value";
-		goto makeErrorMessage;
-	    }
-	    if ((s[0]=='i' || s[0]=='I') && (s[1]=='n' || s[1]=='N') &&
-		    (s[2]=='f' || s[2]=='F')) {
-		msg = "infinite floating-point value";
-		goto makeErrorMessage;
-	    }
-	}
+    if (opcode == INST_EXPON) {
+	operator = "**";
+    }
 
-	/*
-	 * We cannot use TclLooksLikeInt here because it passes strings
-	 * like "10;" [Bug 587140]. We'll accept as "looking like ints"
-	 * for the present purposes any string that looks formally like
-	 * a (decimal|octal|hex) integer.
-	 */
+    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
+	int numBytes;
+	const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
 
-	while (length && isspace(UCHAR(*p))) {
-	    length--;
-	    p++;
-	}
-	if (length && ((*p == '+') || (*p == '-'))) {
-	    length--;
-	    p++;
-	}
-	if (length) {
-	    if ((*p == '0') && ((*(p+1) == 'x') || (*(p+1) == 'X'))) {
-		p += 2;
-		length -= 2;
-		looksLikeInt = ((length > 0) && isxdigit(UCHAR(*p)));
-		if (looksLikeInt) {
-		    length--;
-		    p++;
-		    while (length && isxdigit(UCHAR(*p))) {
-			length--;
-			p++;
-		    }
-		}
-	    } else {
-		looksLikeInt = (length && isdigit(UCHAR(*p)));
-		if (looksLikeInt) {
-		    length--;
-		    p++;
-		    while (length && isdigit(UCHAR(*p))) {
-			length--;
-			p++;
-		    }
-		}
-	    }
-	    while (length && isspace(UCHAR(*p))) {
-		length--;
-		p++;
-	    }
-	    looksLikeInt = !length;
-	}
-	if (looksLikeInt) {
-	    /*
-	     * If something that looks like an integer could not be
-	     * converted, then it *must* be a bad octal or too large
-	     * to represent [Bug 542588].
-	     */
-
-	    if (TclCheckBadOctal(NULL, s)) {
-		msg = "invalid octal number";
-	    } else {
-		msg = "integer value too large to represent";
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-		    "integer value too large to represent", (char *) NULL);
-	    }
+	if (numBytes == 0) {
+	    description = "empty string";
+	} else if (TclCheckBadOctal(NULL, bytes)) {
+	    description = "invalid octal number";
 	} else {
-	    /*
-	     * See if the operand can be interpreted as a double in
-	     * order to improve the error message.
-	     */
-
-	    double d;
-
-	    if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
-		msg = "floating-point value";
-	    }
+	    description = "non-numeric string";
 	}
-      makeErrorMessage:
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
-		msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
-		"\"", (char *) NULL);
+    } else if (type == TCL_NUMBER_NAN) {
+	description = "non-numeric floating-point value";
+    } else if (type == TCL_NUMBER_DOUBLE) {
+	description = "floating-point value";
+    } else {
+	/* TODO: No caller needs this. Eliminate? */
+	description = "(big) integer";
     }
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "can't use %s as operand of \"%s\"", description, operator));
+    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -4816,85 +7752,98 @@ IllegalExprOperandType(interp, pc, opndPtr)
  * Results:
  *	If a command is found that encloses the program counter value, a
  *	pointer to the command's source is returned and the length of the
- *	source is stored at *lengthPtr. If multiple commands resulted in
- *	code at pc, information about the closest enclosing command is
- *	returned. If no matching command is found, NULL is returned and
- *	*lengthPtr is unchanged.
+ *	source is stored at *lengthPtr. If multiple commands resulted in code
+ *	at pc, information about the closest enclosing command is returned. If
+ *	no matching command is found, NULL is returned and *lengthPtr is
+ *	unchanged.
  *
  * Side effects:
- *	None.
+ *	The CmdFrame at *cfPtr is updated.
  *
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_TIP280
+const char *
+TclGetSrcInfoForCmd(
+    Interp *iPtr,
+    int *lenPtr)
+{
+    CmdFrame *cfPtr = iPtr->cmdFramePtr;
+    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+	    codePtr, lenPtr);
+}
+
 void
-TclGetSrcInfoForPc (cfPtr)
-     CmdFrame* cfPtr;
+TclGetSrcInfoForPc(
+    CmdFrame *cfPtr)
 {
-    ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr;
+    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
     if (cfPtr->cmd.str.cmd == NULL) {
-        cfPtr->cmd.str.cmd = GetSrcInfoForPc((unsigned char*) cfPtr->data.tebc.pc,
-					     codePtr,
-					     &cfPtr->cmd.str.len);
+	cfPtr->cmd.str.cmd = GetSrcInfoForPc(
+		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
+		&cfPtr->cmd.str.len);
     }
 
     if (cfPtr->cmd.str.cmd != NULL) {
-        /* We now have the command. We can get the srcOffset back and
-	 * from there find the list of word locations for this command
+	/*
+	 * We now have the command. We can get the srcOffset back and from
+	 * there find the list of word locations for this command.
 	 */
 
-	ExtCmdLoc*     eclPtr;
-	ECL*           locPtr = NULL;
-	int            srcOffset;
-
-        Interp*        iPtr  = (Interp*) *codePtr->interpHandle;
-	Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+	ExtCmdLoc *eclPtr;
+	ECL *locPtr = NULL;
+	int srcOffset, i;
+	Interp *iPtr = (Interp *) *codePtr->interpHandle;
+	Tcl_HashEntry *hePtr =
+		Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
 
-	if (!hePtr) return;
+	if (!hePtr) {
+	    return;
+	}
 
 	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
-	eclPtr    = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	eclPtr = (ExtCmdLoc *) Tcl_GetHashValue (hePtr);
 
-	{
-	    int i;
-	    for (i=0; i < eclPtr->nuloc; i++) {
-		if (eclPtr->loc [i].srcOffset == srcOffset) {
-		    locPtr = &(eclPtr->loc [i]);
-		    break;
-		}
+	for (i=0; i < eclPtr->nuloc; i++) {
+	    if (eclPtr->loc[i].srcOffset == srcOffset) {
+		locPtr = eclPtr->loc+i;
+		break;
 	    }
 	}
+	if (locPtr == NULL) {
+	    Tcl_Panic("LocSearch failure");
+	}
 
-	if (locPtr == NULL) {Tcl_Panic ("LocSearch failure");}
-
-	cfPtr->line           = locPtr->line;
-	cfPtr->nline          = locPtr->nline;
-	cfPtr->type           = eclPtr->type;
+	cfPtr->line = locPtr->line;
+	cfPtr->nline = locPtr->nline;
+	cfPtr->type = eclPtr->type;
 
 	if (eclPtr->type == TCL_LOCATION_SOURCE) {
 	    cfPtr->data.eval.path = eclPtr->path;
-	    Tcl_IncrRefCount (cfPtr->data.eval.path);
+	    Tcl_IncrRefCount(cfPtr->data.eval.path);
 	}
-	/* Do not set cfPtr->data.eval.path NULL for non-SOURCE
-	 * Needed for cfPtr->data.tebc.codePtr.
+
+	/*
+	 * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for
+	 * cfPtr->data.tebc.codePtr.
 	 */
     }
 }
-#endif
 
-static char *
-GetSrcInfoForPc(pc, codePtr, lengthPtr)
-    unsigned char *pc;		/* The program counter value for which to
+static const char *
+GetSrcInfoForPc(
+    unsigned char *pc,		/* The program counter value for which to
 				 * return the closest command's source info.
-				 * This points to a bytecode instruction
-				 * in codePtr's code. */
-    ByteCode *codePtr;		/* The bytecode sequence in which to look
-				 * up the command source for the pc. */
-    int *lengthPtr;		/* If non-NULL, the location where the
-				 * length of the command's source should be
-				 * stored. If NULL, no length is stored. */
+				 * This points to a bytecode instruction in
+				 * codePtr's code. */
+    ByteCode *codePtr,		/* The bytecode sequence in which to look up
+				 * the command source for the pc. */
+    int *lengthPtr)		/* If non-NULL, the location where the length
+				 * of the command's source should be stored.
+				 * If NULL, no length is stored. */
 {
     register int pcOffset = (pc - codePtr->codeStart);
     int numCmds = codePtr->numCommands;
@@ -4917,11 +7866,11 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 
     codeDeltaNext = codePtr->codeDeltaStart;
     codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
     srcLengthNext = codePtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -4931,7 +7880,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 	}
 	codeOffset += delta;
 
-	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
 	    codeLengthNext++;
 	    codeLen = TclGetInt4AtPtr(codeLengthNext);
 	    codeLengthNext += 4;
@@ -4941,7 +7890,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 	}
 	codeEnd = (codeOffset + codeLen - 1);
 
-	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -4951,7 +7900,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 	}
 	srcOffset += delta;
 
-	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -4959,11 +7908,13 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 	    srcLen = TclGetInt1AtPtr(srcLengthNext);
 	    srcLengthNext++;
 	}
-	
-	if (codeOffset > pcOffset) {      /* best cmd already found */
+
+	if (codeOffset > pcOffset) {	/* Best cmd already found */
 	    break;
-	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
+	}
+	if (pcOffset <= codeEnd) {	/* This cmd's code encloses pc */
 	    int dist = (pcOffset - codeOffset);
+
 	    if (dist <= bestDist) {
 		bestDist = dist;
 		bestSrcOffset = srcOffset;
@@ -4975,7 +7926,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
     if (bestDist == INT_MAX) {
 	return NULL;
     }
-    
+
     if (lengthPtr != NULL) {
 	*lengthPtr = bestSrcLength;
     }
@@ -4991,15 +7942,14 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
  *	ExceptionRange.
  *
  * Results:
- *	In the normal case, catchOnly is 0 (false) and this procedure
- *	returns a pointer to the most closely enclosing ExceptionRange
- *	structure regardless of whether it is a loop or catch exception
- *	range. This is appropriate when processing a TCL_BREAK or
- *	TCL_CONTINUE, which will be "handled" either by a loop exception
- *	range or a closer catch range. If catchOnly is nonzero, this
- *	procedure ignores loop exception ranges and returns a pointer to the
- *	closest catch range. If no matching ExceptionRange is found that
- *	encloses pc, a NULL is returned.
+ *	In the normal case, catchOnly is 0 (false) and this procedure returns
+ *	a pointer to the most closely enclosing ExceptionRange structure
+ *	regardless of whether it is a loop or catch exception range. This is
+ *	appropriate when processing a TCL_BREAK or TCL_CONTINUE, which will be
+ *	"handled" either by a loop exception range or a closer catch range. If
+ *	catchOnly is nonzero, this procedure ignores loop exception ranges and
+ *	returns a pointer to the closest catch range. If no matching
+ *	ExceptionRange is found that encloses pc, a NULL is returned.
  *
  * Side effects:
  *	None.
@@ -5008,33 +7958,32 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
  */
 
 static ExceptionRange *
-GetExceptRangeForPc(pc, catchOnly, codePtr)
-    unsigned char *pc;		/* The program counter value for which to
+GetExceptRangeForPc(
+    unsigned char *pc,		/* The program counter value for which to
 				 * search for a closest enclosing exception
 				 * range. This points to a bytecode
 				 * instruction in codePtr's code. */
-    int catchOnly;		/* If 0, consider either loop or catch
+    int catchOnly,		/* If 0, consider either loop or catch
 				 * ExceptionRanges in search. If nonzero
-				 * consider only catch ranges (and ignore
-				 * any closer loop ranges). */
-    ByteCode* codePtr;		/* Points to the ByteCode in which to search
+				 * consider only catch ranges (and ignore any
+				 * closer loop ranges). */
+    ByteCode *codePtr)		/* Points to the ByteCode in which to search
 				 * for the enclosing ExceptionRange. */
 {
     ExceptionRange *rangeArrayPtr;
     int numRanges = codePtr->numExceptRanges;
     register ExceptionRange *rangePtr;
-    int pcOffset = (pc - codePtr->codeStart);
+    int pcOffset = pc - codePtr->codeStart;
     register int start;
 
     if (numRanges == 0) {
 	return NULL;
     }
 
-    /* 
-     * This exploits peculiarities of our compiler: nested ranges
-     * are always *after* their containing ranges, so that by scanning
-     * backwards we are sure that the first matching range is indeed
-     * the deepest.
+    /*
+     * This exploits peculiarities of our compiler: nested ranges are always
+     * *after* their containing ranges, so that by scanning backwards we are
+     * sure that the first matching range is indeed the deepest.
      */
 
     rangeArrayPtr = codePtr->exceptArrayPtr;
@@ -5042,7 +7991,7 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
     while (--rangePtr >= rangeArrayPtr) {
 	start = rangePtr->codeOffset;
 	if ((start <= pcOffset) &&
-	        (pcOffset < (start + rangePtr->numCodeBytes))) {
+		(pcOffset < (start + rangePtr->numCodeBytes))) {
 	    if ((!catchOnly)
 		    || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
 		return rangePtr;
@@ -5057,9 +8006,9 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
  *
  * GetOpcodeName --
  *
- *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros
- *	used in TclExecuteByteCode when debugging. It returns the name of
- *	the bytecode instruction at a specified instruction pc.
+ *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
+ *	in TclExecuteByteCode when debugging. It returns the name of the
+ *	bytecode instruction at a specified instruction pc.
  *
  * Results:
  *	A character string for the instruction.
@@ -5072,12 +8021,12 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
 
 #ifdef TCL_COMPILE_DEBUG
 static char *
-GetOpcodeName(pc)
-    unsigned char *pc;		/* Points to the instruction whose name
-				 * should be returned. */
+GetOpcodeName(
+    unsigned char *pc)		/* Points to the instruction whose name should
+				 * be returned. */
 {
     unsigned char opCode = *pc;
-    
+
     return tclInstructionTable[opCode].name;
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -5085,991 +8034,10 @@ GetOpcodeName(pc)
 /*
  *----------------------------------------------------------------------
  *
- * VerifyExprObjType --
- *
- *	This procedure is called by the math functions to verify that
- *	the object is either an int or double, coercing it if necessary.
- *	If an error occurs during conversion, an error message is left
- *	in the interpreter's result unless "interp" is NULL.
- *
- * Results:
- *	TCL_OK if it was int or double, TCL_ERROR otherwise
- *
- * Side effects:
- *	objPtr is ensured to be of tclIntType, tclWideIntType or
- *	tclDoubleType.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-VerifyExprObjType(interp, objPtr)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    Tcl_Obj *objPtr;		/* Points to the object to type check. */
-{
-    if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
-	return TCL_OK;
-    } else {
-	int length, result = TCL_OK;
-	char *s = Tcl_GetStringFromObj(objPtr, &length);
-	
-	if (TclLooksLikeInt(s, length)) {
-	    long i;
-	    Tcl_WideInt w;
-	    GET_WIDE_OR_INT(result, objPtr, i, w);
-	    /* Quiet cranky old compilers that complain about
-	     * setting i, but not using it. */
-	   (void)i;
-	} else {
-	    double d;
-	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
-	}
-	if ((result != TCL_OK) && (interp != NULL)) {
-	    Tcl_ResetResult(interp);
-	    if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-			"argument to math function was an invalid octal number",
-			-1);
-	    } else {
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-			"argument to math function didn't have numeric value",
-			-1);
-	    }
-	}
-	return result;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 pushes an
- *	Tcl object holding the result. If it fails it returns TCL_ERROR
- *	and leaves an error message in the interpreter's result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprUnaryFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Contains the address of a procedure that
-				 * takes one double argument and returns a
-				 * double result. */
-{
-    Tcl_Obj **stackPtr;		/* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr;
-    double d, dResult;
-    int result;
-    
-    double (*func) _ANSI_ARGS_((double)) =
-	(double (*)_ANSI_ARGS_((double))) clientData;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the function's argument from the evaluation stack. Convert it
-     * to a double if necessary.
-     */
-
-    valuePtr = POP_OBJECT();
-
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);
-
-    errno = 0;
-    dResult = (*func)(d);
-    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
-	TclExprFloatError(interp, dResult);
-	result = TCL_ERROR;
-	goto done;
-    }
-    
-    /*
-     * Push a Tcl object holding the result.
-     */
-
-    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-    
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprBinaryFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Contains the address of a procedure that
-				 * takes two double arguments and
-				 * returns a double result. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr, *value2Ptr;
-    double d1, d2, dResult;
-    int result;
-    
-    double (*func) _ANSI_ARGS_((double, double))
-	= (double (*)_ANSI_ARGS_((double, double))) clientData;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the function's two arguments from the evaluation stack. Convert
-     * them to doubles if necessary.
-     */
-
-    value2Ptr = POP_OBJECT();
-    valuePtr  = POP_OBJECT();
-
-    if ((VerifyExprObjType(interp, valuePtr) != TCL_OK) ||
-	    (VerifyExprObjType(interp, value2Ptr) != TCL_OK)) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    GET_DOUBLE_VALUE(d1, valuePtr, valuePtr->typePtr);
-    GET_DOUBLE_VALUE(d2, value2Ptr, value2Ptr->typePtr);
-
-    errno = 0;
-    dResult = (*func)(d1, d2);
-    if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
-	TclExprFloatError(interp, dResult);
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Push a Tcl object holding the result.
-     */
-
-    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-    
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    TclDecrRefCount(value2Ptr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprAbsFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr;
-    long i, iResult;
-    double d, dResult;
-    int result;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.
-     */
-
-    valuePtr = POP_OBJECT();
-
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Push a Tcl object with the result.
-     */
-    if (valuePtr->typePtr == &tclIntType) {
-	i = valuePtr->internalRep.longValue;
-	if (i < 0) {
-	    if (i == LONG_MIN) {
-#ifdef TCL_WIDE_INT_IS_LONG
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"integer value too large to represent", -1));
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			"integer value too large to represent", (char *) NULL);
-		result = TCL_ERROR;
-		goto done;
-#else 
-		/*
-		 * Special case: abs(MIN_INT) must promote to wide.
-		 */
-
-		PUSH_OBJECT( Tcl_NewWideIntObj(-(Tcl_WideInt) i) );
-		result = TCL_OK;
-		goto done;
-#endif
-
-	    }
-	    iResult = -i;
-	} else {
-	    iResult = i;
-	}	    
-	PUSH_OBJECT(Tcl_NewLongObj(iResult));
-    } else if (valuePtr->typePtr == &tclWideIntType) {
-	Tcl_WideInt wResult, w;
-	TclGetWide(w,valuePtr);
-	if (w < W0) {
-	    wResult = -w;
-	    if (wResult < 0) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		        "integer value too large to represent", -1);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			"integer value too large to represent", (char *) NULL);
-		result = TCL_ERROR;
-		goto done;
-	    }
-	} else {
-	    wResult = w;
-	}	    
-	PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
-    } else {
-	d = valuePtr->internalRep.doubleValue;
-	if (d < 0.0) {
-	    dResult = -d;
-        } else if (d == -0.0) {
-            /* We need to distinguish here between positive 0.0 and
-             * negative -0.0, see Bug ID #2954959.
-             */
-            static const double poszero = 0.0;
-            if (memcmp(&d, &poszero, sizeof(double))) {
-                dResult = -d;
-            } else {
-                dResult = d;
-            }
-	} else {
-	    dResult = d;
-	}
-	if (IS_NAN(dResult) || IS_INF(dResult)) {
-	    TclExprFloatError(interp, dResult);
-	    result = TCL_ERROR;
-	    goto done;
-	}
-	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-    }
-
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprDoubleFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr;
-    double dResult;
-    int result;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.
-     */
-
-    valuePtr = POP_OBJECT();
-
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr);
-
-    /*
-     * Push a Tcl object with the result.
-     */
-
-    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprIntFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr;
-    long iResult;
-    double d;
-    int result;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.
-     */
-
-    valuePtr = POP_OBJECT();
-    
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-    
-    if (valuePtr->typePtr == &tclIntType) {
-	iResult = valuePtr->internalRep.longValue;
-    } else if (valuePtr->typePtr == &tclWideIntType) {
-	TclGetLongFromWide(iResult,valuePtr);
-    } else {
-	d = valuePtr->internalRep.doubleValue;
-	if (d < 0.0) {
-	    if (d < (double) (long) LONG_MIN) {
-		tooLarge:
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		        "integer value too large to represent", -1);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			"integer value too large to represent", (char *) NULL);
-		result = TCL_ERROR;
-		goto done;
-	    }
-	} else {
-	    if (d > (double) LONG_MAX) {
-		goto tooLarge;
-	    }
-	}
-	if (IS_NAN(d) || IS_INF(d)) {
-	    TclExprFloatError(interp, d);
-	    result = TCL_ERROR;
-	    goto done;
-	}
-	iResult = (long) d;
-    }
-
-    /*
-     * Push a Tcl object with the result.
-     */
-    
-    PUSH_OBJECT(Tcl_NewLongObj(iResult));
-
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprWideFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    register Tcl_Obj *valuePtr;
-    Tcl_WideInt wResult;
-    double d;
-    int result;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.
-     */
-
-    valuePtr = POP_OBJECT();
-    
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-    
-    if (valuePtr->typePtr == &tclWideIntType) {
-	TclGetWide(wResult,valuePtr);
-    } else if (valuePtr->typePtr == &tclIntType) {
-	wResult = Tcl_LongAsWide(valuePtr->internalRep.longValue);
-    } else {
-	d = valuePtr->internalRep.doubleValue;
-	if (d < 0.0) {
-	    if (d < Tcl_WideAsDouble(LLONG_MIN)) {
-		tooLarge:
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		        "integer value too large to represent", -1);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			"integer value too large to represent", (char *) NULL);
-		result = TCL_ERROR;
-		goto done;
-	    }
-	} else {
-	    if (d > Tcl_WideAsDouble(LLONG_MAX)) {
-		goto tooLarge;
-	    }
-	}
-	if (IS_NAN(d) || IS_INF(d)) {
-	    TclExprFloatError(interp, d);
-	    result = TCL_ERROR;
-	    goto done;
-	}
-	wResult = Tcl_DoubleAsWide(d);
-    }
-
-    /*
-     * Push a Tcl object with the result.
-     */
-    
-    PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
-
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-static int
-ExprRandFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    Interp *iPtr = (Interp *) interp;
-    double dResult;
-    long tmp;			/* Algorithm assumes at least 32 bits.
-				 * Only long guarantees that.  See below. */
-
-    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
-	iPtr->flags |= RAND_SEED_INITIALIZED;
-        
-        /* 
-	 * Take into consideration the thread this interp is running in order
-	 * to insure different seeds in different threads (bug #416643)
-	 */
-
-	iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);
-
-	/*
-	 * Make sure 1 <= randSeed <= (2^31) - 2.  See below.
-	 */
-
-        iPtr->randSeed &= (unsigned long) 0x7fffffff;
-	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
-	    iPtr->randSeed ^= 123459876;
-	}
-    }
-    
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-    
-    CACHE_STACK_INFO();
-
-    /*
-     * Generate the random number using the linear congruential
-     * generator defined by the following recurrence:
-     *		seed = ( IA * seed ) mod IM
-     * where IA is 16807 and IM is (2^31) - 1.  The recurrence maps
-     * a seed in the range [1, IM - 1] to a new seed in that same range.
-     * The recurrence maps IM to 0, and maps 0 back to 0, so those two
-     * values must not be allowed as initial values of seed.
-     *
-     * In order to avoid potential problems with integer overflow, the
-     * recurrence is implemented in terms of additional constants
-     * IQ and IR such that
-     *		IM = IA*IQ + IR
-     * None of the operations in the implementation overflows a 32-bit
-     * signed integer, and the C type long is guaranteed to be at least
-     * 32 bits wide.
-     *
-     * For more details on how this algorithm works, refer to the following
-     * papers: 
-     *
-     *	S.K. Park & K.W. Miller, "Random number generators: good ones
-     *	are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
-     *
-     *	W.H. Press & S.A. Teukolsky, "Portable random number
-     *	generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
-     */
-
-#define RAND_IA		16807
-#define RAND_IM		2147483647
-#define RAND_IQ		127773
-#define RAND_IR		2836
-#define RAND_MASK	123459876
-
-    tmp = iPtr->randSeed/RAND_IQ;
-    iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
-    if (iPtr->randSeed < 0) {
-	iPtr->randSeed += RAND_IM;
-    }
-
-    /*
-     * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
-     * dividing by RAND_IM yields a double in the range (0, 1).
-     */
-
-    dResult = iPtr->randSeed * (1.0/RAND_IM);
-
-    /*
-     * Push a Tcl object with the result.
-     */
-
-    PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-    
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    DECACHE_STACK_INFO();
-    return TCL_OK;
-}
-
-static int
-ExprRoundFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    Tcl_Obj *valuePtr, *resPtr;
-    double d, f, i;
-    int result;
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-
-    result = TCL_OK;
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.
-     */
-
-    valuePtr = POP_OBJECT();
-
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    if ((valuePtr->typePtr == &tclIntType) ||
-	    (valuePtr->typePtr == &tclWideIntType)) {
-	result = TCL_OK;
-	resPtr = valuePtr;
-    } else {
-
-	/* 
-	 * Round the number to the nearest integer.  I'd like to use round(),
-	 * but it's C99 (or BSD), and not yet universal.
-	 */
-	
-	d = valuePtr->internalRep.doubleValue;
-	f = modf(d, &i);
-	if (d < 0.0) {
-	    if (f <= -0.5) {
-		i += -1.0;
-	    }
-	    if (i <= Tcl_WideAsDouble(LLONG_MIN)) {
-		goto tooLarge;
-	    } else if (i <= (double) LONG_MIN) {
-		resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
-	    } else {
-		resPtr = Tcl_NewLongObj((long) i);
-	    }			    
-	} else {
-	    if (f >= 0.5) {
-		i += 1.0;
-	    }
-	    if (i >= Tcl_WideAsDouble(LLONG_MAX)) {
-		goto tooLarge;
-	    } else if (i >= (double) LONG_MAX) {
-		resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
-	    } else {
-		resPtr = Tcl_NewLongObj((long) i);
-	    }
-	}
-    }
-
-    /*
-     * Push the result object and free the argument Tcl_Obj.
-     */
-
-    PUSH_OBJECT(resPtr);
-    
-    done:
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-    return result;
-
-    /*
-     * Error return: result cannot be represented as an integer.
-     */
-    
-    tooLarge:
-    Tcl_ResetResult(interp);
-    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	    "integer value too large to represent", -1);
-    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-	    "integer value too large to represent",
-	    (char *) NULL);
-    result = TCL_ERROR;
-    goto done;
-}
-
-static int
-ExprSrandFunc(interp, eePtr, clientData)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    ClientData clientData;	/* Ignored. */
-{
-    Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *valuePtr;
-    long i = 0;			/* Initialized to avoid compiler warning. */
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-    
-    CACHE_STACK_INFO();
-
-    /*
-     * Pop the argument from the evaluation stack.  Use the value
-     * to reset the random number seed.
-     */
-
-    valuePtr = POP_OBJECT();
-
-    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	goto badValue;
-    }
-
-    if (Tcl_GetLongFromObj(NULL, valuePtr, &i) != TCL_OK) {
-	Tcl_WideInt w;
-
-	if (Tcl_GetWideIntFromObj(interp, valuePtr, &w) != TCL_OK) {
-	badValue:
-	    Tcl_AddErrorInfo(interp, "\n    (argument to \"srand()\")");
-	    TclDecrRefCount(valuePtr);
-	    DECACHE_STACK_INFO();
-	    return TCL_ERROR;
-	}
-
-	i = Tcl_WideAsLong(w);
-    }
-    
-    /*
-     * Reset the seed.  Make sure 1 <= randSeed <= 2^31 - 2.
-     * See comments in ExprRandFunc() for more details.
-     */
-
-    iPtr->flags |= RAND_SEED_INITIALIZED;
-    iPtr->randSeed = i;
-    iPtr->randSeed &= (unsigned long) 0x7fffffff;
-    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
-	iPtr->randSeed ^= 123459876;
-    }
-
-    /*
-     * To avoid duplicating the random number generation code we simply
-     * clean up our state and call the real random number function. That
-     * function will always succeed.
-     */
-    
-    TclDecrRefCount(valuePtr);
-    DECACHE_STACK_INFO();
-
-    ExprRandFunc(interp, eePtr, clientData);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExprCallMathFunc --
- *
- *	This procedure is invoked to call a non-builtin math function
- *	during the execution of an expression. 
- *
- * 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 the interpreter's
- *	result.	After a successful return this procedure pushes a Tcl object
- *	holding the result. 
- *
- * Side effects:
- *	None, unless the called math function has side effects.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprCallMathFunc(interp, eePtr, objc, objv)
-    Tcl_Interp *interp;		/* The interpreter in which to execute the
-				 * function. */
-    ExecEnv *eePtr;		/* Points to the environment for executing
-				 * the function. */
-    int objc;			/* Number of arguments. The function name is
-				 * the 0-th argument. */
-    Tcl_Obj **objv;		/* The array of arguments. The function name
-				 * is objv[0]. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj **stackPtr;		/* Cached evaluation stack base pointer. */
-    register int stackTop;	/* Cached top index of evaluation stack. */
-    char *funcName;
-    Tcl_HashEntry *hPtr;
-    MathFunc *mathFuncPtr;	/* Information about math function. */
-    Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
-    Tcl_Value funcResult;	/* Result of function call as Tcl_Value. */
-    register Tcl_Obj *valuePtr;
-    long i;
-    double d;
-    int j, k, result;
-
-    Tcl_ResetResult(interp);
-
-    /*
-     * Set stackPtr and stackTop from eePtr.
-     */
-    
-    CACHE_STACK_INFO();
-
-    /*
-     * Look up the MathFunc record for the function.
-     */
-
-    funcName = TclGetString(objv[0]);
-    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
-    if (hPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"unknown math function \"", funcName, "\"", (char *) NULL);
-	result = TCL_ERROR;
-	goto done;
-    }
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
-    if (mathFuncPtr->numArgs != (objc-1)) {
-	panic("ExprCallMathFunc: expected number of args %d != actual number %d",
-	        mathFuncPtr->numArgs, objc);
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Collect the arguments for the function, if there are any, into the
-     * array "args". Note that args[0] will have the Tcl_Value that
-     * corresponds to objv[1].
-     */
-
-    for (j = 1, k = 0;  j < objc;  j++, k++) {
-	valuePtr = objv[j];
-
-	if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
-	    result = TCL_ERROR;
-	    goto done;
-	}
-
-	/*
-	 * Copy the object's numeric value to the argument record,
-	 * converting it if necessary. 
-	 */
-
-	if (valuePtr->typePtr == &tclIntType) {
-	    i = valuePtr->internalRep.longValue;
-	    if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
-		args[k].type = TCL_DOUBLE;
-		args[k].doubleValue = i;
-	    } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
-		args[k].type = TCL_WIDE_INT;
-		args[k].wideValue = Tcl_LongAsWide(i);
-	    } else {
-		args[k].type = TCL_INT;
-		args[k].intValue = i;
-	    }
-	} else if (valuePtr->typePtr == &tclWideIntType) {
-	    Tcl_WideInt w;
-	    TclGetWide(w,valuePtr);
-	    if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
-		args[k].type = TCL_DOUBLE;
-		args[k].doubleValue = Tcl_WideAsDouble(w);
-	    } else if (mathFuncPtr->argTypes[k] == TCL_INT) {
-		args[k].type = TCL_INT;
-		args[k].intValue = Tcl_WideAsLong(w);
-	    } else {
-		args[k].type = TCL_WIDE_INT;
-		args[k].wideValue = w;
-	    }
-	} else {
-	    d = valuePtr->internalRep.doubleValue;
-	    if (mathFuncPtr->argTypes[k] == TCL_INT) {
-		args[k].type = TCL_INT;
-		args[k].intValue = (long) d;
-	    } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
-		args[k].type = TCL_WIDE_INT;
-		args[k].wideValue = Tcl_DoubleAsWide(d);
-	    } else {
-		args[k].type = TCL_DOUBLE;
-		args[k].doubleValue = d;
-	    }
-	}
-    }
-
-    /*
-     * Invoke the function and copy its result back into valuePtr.
-     */
-
-    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
-	    &funcResult);
-    if (result != TCL_OK) {
-	goto done;
-    }
-
-    /*
-     * Pop the objc top stack elements and decrement their ref counts.
-     */
-
-    k = (stackTop - (objc-1));
-    while (stackTop >= k) {
-	valuePtr = POP_OBJECT();
-	TclDecrRefCount(valuePtr);
-    }
-    
-    /*
-     * Push the call's object result.
-     */
-    
-    if (funcResult.type == TCL_INT) {
-	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
-    } else if (funcResult.type == TCL_WIDE_INT) {
-	PUSH_OBJECT(Tcl_NewWideIntObj(funcResult.wideValue));
-    } else {
-	d = funcResult.doubleValue;
-	if (IS_NAN(d) || IS_INF(d)) {
-	    TclExprFloatError(interp, d);
-	    result = TCL_ERROR;
-	    goto done;
-	}
-	PUSH_OBJECT(Tcl_NewDoubleObj(d));
-    }
-
-    /*
-     * Reflect the change to stackTop back in eePtr.
-     */
-
-    done:
-    DECACHE_STACK_INFO();
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclExprFloatError --
  *
- *	This procedure is called when an error occurs during a
- *	floating-point operation. It reads errno and sets
- *	interp->objResultPtr accordingly.
+ *	This procedure is called when an error occurs during a floating-point
+ *	operation. It reads errno and sets interp->objResultPtr accordingly.
  *
  * Results:
  *	interp->objResultPtr is set to hold an error message.
@@ -6081,34 +8049,34 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
  */
 
 void
-TclExprFloatError(interp, value)
-    Tcl_Interp *interp;		/* Where to store error message. */
-    double value;		/* Value returned after error;  used to
+TclExprFloatError(
+    Tcl_Interp *interp,		/* Where to store error message. */
+    double value)		/* Value returned after error; used to
 				 * distinguish underflows from overflows. */
 {
-    char *s;
+    const char *s;
 
-    Tcl_ResetResult(interp);
-    if ((errno == EDOM) || IS_NAN(value)) {
+    if ((errno == EDOM) || TclIsNaN(value)) {
 	s = "domain error: argument not in valid range";
-	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
-    } else if ((errno == ERANGE) || IS_INF(value)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
+    } else if ((errno == ERANGE) || TclIsInfinite(value)) {
 	if (value == 0.0) {
 	    s = "floating-point value too small to represent";
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
 	} else {
 	    s = "floating-point value too large to represent";
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
 	}
     } else {
-	char msg[64 + TCL_INTEGER_SPACE];
-	
-	sprintf(msg, "unknown floating-point error, errno = %d", errno);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
-	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
+	Tcl_Obj *objPtr = Tcl_ObjPrintf(
+		"unknown floating-point error, errno = %d", errno);
+
+	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
+		Tcl_GetString(objPtr), NULL);
+	Tcl_SetObjResult(interp, objPtr);
     }
 }
 
@@ -6122,8 +8090,8 @@ TclExprFloatError(interp, value)
  *	the log base 2 of an integer.
  *
  * Results:
- *	Returns the log base 2 of the operand. If the argument is less
- *	than or equal to zero, a zero is returned.
+ *	Returns the log base 2 of the operand. If the argument is less than or
+ *	equal to zero, a zero is returned.
  *
  * Side effects:
  *	None.
@@ -6132,9 +8100,9 @@ TclExprFloatError(interp, value)
  */
 
 int
-TclLog2(value)
-    register int value;		/* The integer for which to compute the
-				 * log base 2. */
+TclLog2(
+    register int value)		/* The integer for which to compute the log
+				 * base 2. */
 {
     register int n = value;
     register int result = 0;
@@ -6164,15 +8132,15 @@ TclLog2(value)
  */
 
 static int
-EvalStatsCmd(unused, interp, objc, objv)
-    ClientData unused;		/* Unused. */
-    Tcl_Interp *interp;		/* The current interpreter. */
-    int objc;			/* The number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument strings. */
+EvalStatsCmd(
+    ClientData unused,		/* Unused. */
+    Tcl_Interp *interp,		/* The current interpreter. */
+    int objc,			/* The number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument strings. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralTable *globalTablePtr = &(iPtr->literalTable);
-    ByteCodeStats *statsPtr = &(iPtr->stats);
+    LiteralTable *globalTablePtr = &iPtr->literalTable;
+    ByteCodeStats *statsPtr = &iPtr->stats;
     double totalCodeBytes, currentCodeBytes;
     double totalLiteralBytes, currentLiteralBytes;
     double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
@@ -6184,12 +8152,18 @@ EvalStatsCmd(unused, interp, objc, objv)
     int decadeHigh, minSizeDecade, maxSizeDecade, length, i;
     char *litTableStats;
     LiteralEntry *entryPtr;
+    Tcl_Obj *objPtr;
+
+#define Percent(a,b) ((a) * 100.0 / (b))
+
+    objPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(objPtr);
 
     numInstructions = 0.0;
     for (i = 0;  i < 256;  i++) {
-        if (statsPtr->instructionCount[i] != 0) {
-            numInstructions += statsPtr->instructionCount[i];
-        }
+	if (statsPtr->instructionCount[i] != 0) {
+	    numInstructions += statsPtr->instructionCount[i];
+	}
     }
 
     totalLiteralBytes = sizeof(LiteralTable)
@@ -6202,7 +8176,7 @@ EvalStatsCmd(unused, interp, objc, objv)
     numCurrentByteCodes =
 	    statsPtr->numCompilations - statsPtr->numByteCodesFreed;
     currentHeaderBytes = numCurrentByteCodes
-	    * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time)));
+	    * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time));
     literalMgmtBytes = sizeof(LiteralTable)
 	    + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
 	    + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
@@ -6210,94 +8184,93 @@ EvalStatsCmd(unused, interp, objc, objv)
 	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
 	    + statsPtr->currentLitStringBytes;
     currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
-    
+
     /*
      * Summary statistics, total and current source and ByteCode sizes.
      */
 
-    fprintf(stdout, "\n----------------------------------------------------------------\n");
-    fprintf(stdout,
-	    "Compilation and execution statistics for interpreter 0x%x\n",
-	    (unsigned int) iPtr);
+    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+    Tcl_AppendPrintfToObj(objPtr,
+	    "Compilation and execution statistics for interpreter %#lx\n",
+	    iPtr);
 
-    fprintf(stdout, "\nNumber ByteCodes executed	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed	%ld\n",
 	    statsPtr->numExecutions);
-    fprintf(stdout, "Number ByteCodes compiled	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled	%ld\n",
 	    statsPtr->numCompilations);
-    fprintf(stdout, "  Mean executions/compile	%.1f\n",
-	    ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
-    
-    fprintf(stdout, "\nInstructions executed		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile	%.1f\n",
+	    statsPtr->numExecutions / (float)statsPtr->numCompilations);
+
+    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed		%.0f\n",
 	    numInstructions);
-    fprintf(stdout, "  Mean inst/compile		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile		%.0f\n",
 	    numInstructions / statsPtr->numCompilations);
-    fprintf(stdout, "  Mean inst/execution		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution		%.0f\n",
 	    numInstructions / statsPtr->numExecutions);
 
-    fprintf(stdout, "\nTotal ByteCodes			%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes			%ld\n",
 	    statsPtr->numCompilations);
-    fprintf(stdout, "  Source bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Source bytes			%.6g\n",
 	    statsPtr->totalSrcBytes);
-    fprintf(stdout, "  Code bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code bytes			%.6g\n",
 	    totalCodeBytes);
-    fprintf(stdout, "    ByteCode bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes		%.6g\n",
 	    statsPtr->totalByteCodeBytes);
-    fprintf(stdout, "    Literal bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes		%.6g\n",
 	    totalLiteralBytes);
-    fprintf(stdout, "      table %u + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
-	    (unsigned int)sizeof(LiteralTable),
-	    (unsigned long)iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
-	    (unsigned long)statsPtr->numLiteralsCreated * sizeof(LiteralEntry),
-	    (unsigned long)statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
+    Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+	    (unsigned long) sizeof(LiteralTable),
+	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
+	    (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)),
+	    (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)),
 	    statsPtr->totalLitStringBytes);
-    fprintf(stdout, "  Mean code/compile		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile		%.1f\n",
 	    totalCodeBytes / statsPtr->numCompilations);
-    fprintf(stdout, "  Mean code/source		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source		%.1f\n",
 	    totalCodeBytes / statsPtr->totalSrcBytes);
 
-    fprintf(stdout, "\nCurrent (active) ByteCodes	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes	%ld\n",
 	    numCurrentByteCodes);
-    fprintf(stdout, "  Source bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Source bytes			%.6g\n",
 	    statsPtr->currentSrcBytes);
-    fprintf(stdout, "  Code bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code bytes			%.6g\n",
 	    currentCodeBytes);
-    fprintf(stdout, "    ByteCode bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes		%.6g\n",
 	    statsPtr->currentByteCodeBytes);
-    fprintf(stdout, "    Literal bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes		%.6g\n",
 	    currentLiteralBytes);
-    fprintf(stdout, "      table %u + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
-	    (unsigned int)sizeof(LiteralTable),
-	    (unsigned long)iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
-	    (unsigned long)iPtr->literalTable.numEntries * sizeof(LiteralEntry),
-	    (unsigned long)iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+    Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+	    (unsigned long) sizeof(LiteralTable),
+	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
+	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
+	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
 	    statsPtr->currentLitStringBytes);
-    fprintf(stdout, "  Mean code/source		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source		%.1f\n",
 	    currentCodeBytes / statsPtr->currentSrcBytes);
-    fprintf(stdout, "  Code + source bytes		%.6g (%0.1f mean code/src)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes		%.6g (%0.1f mean code/src)\n",
 	    (currentCodeBytes + statsPtr->currentSrcBytes),
 	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
 
     /*
      * Tcl_IsShared statistics check
      *
-     * This gives the refcount of each obj as Tcl_IsShared was called
-     * for it.  Shared objects must be duplicated before they can be
-     * modified.
+     * This gives the refcount of each obj as Tcl_IsShared was called for it.
+     * Shared objects must be duplicated before they can be modified.
      */
 
     numSharedMultX = 0;
-    fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
-    fprintf(stdout, "  Object had refcount <=1 (not shared)	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
+    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)	%ld\n",
 	    tclObjsShared[1]);
     for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
-	fprintf(stdout, "  refcount ==%d		%ld\n",
+	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%d		%ld\n",
 		i, tclObjsShared[i]);
 	numSharedMultX += tclObjsShared[i];
     }
-    fprintf(stdout, "  refcount >=%d		%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%d		%ld\n",
 	    i, tclObjsShared[0]);
     numSharedMultX += tclObjsShared[0];
-    fprintf(stdout, "  Total shared objects			%d\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects			%d\n",
 	    numSharedMultX);
 
     /*
@@ -6307,14 +8280,14 @@ EvalStatsCmd(unused, interp, objc, objv)
     numByteCodeLits = 0;
     refCountSum = 0;
     numSharedMultX = 0;
-    numSharedOnce  = 0;
-    objBytesIfUnshared  = 0.0;
-    strBytesIfUnshared  = 0.0;
+    numSharedOnce = 0;
+    objBytesIfUnshared = 0.0;
+    strBytesIfUnshared = 0.0;
     strBytesSharedMultX = 0.0;
-    strBytesSharedOnce  = 0.0;
+    strBytesSharedOnce = 0.0;
     for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
 	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
-	        entryPtr = entryPtr->nextPtr) {
+		entryPtr = entryPtr->nextPtr) {
 	    if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
 		numByteCodeLits++;
 	    }
@@ -6334,213 +8307,230 @@ EvalStatsCmd(unused, interp, objc, objv)
     sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
 	    - currentLiteralBytes;
 
-    fprintf(stdout, "\nTotal objects (all interps)	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)	%ld\n",
 	    tclObjsAlloced);
-    fprintf(stdout, "Current objects			%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Current objects			%ld\n",
 	    (tclObjsAlloced - tclObjsFreed));
-    fprintf(stdout, "Total literal objects		%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Total literal objects		%ld\n",
 	    statsPtr->numLiteralsCreated);
 
-    fprintf(stdout, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
 	    globalTablePtr->numEntries,
-	    (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
-    fprintf(stdout, "  ByteCode literals	 	%ld (%0.1f%% of current literals)\n",
+	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
+    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals	 	%ld (%0.1f%% of current literals)\n",
 	    numByteCodeLits,
-	    (numByteCodeLits * 100.0) / globalTablePtr->numEntries);
-    fprintf(stdout, "  Literals reused > 1x	 	%d\n",
+	    Percent(numByteCodeLits, globalTablePtr->numEntries));
+    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x	 	%d\n",
 	    numSharedMultX);
-    fprintf(stdout, "  Mean reference count	 	%.2f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count	 	%.2f\n",
 	    ((double) refCountSum) / globalTablePtr->numEntries);
-    fprintf(stdout, "  Mean len, str reused >1x 	%.2f\n",
-	    (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0));
-    fprintf(stdout, "  Mean len, str used 1x	 	%.2f\n",
-	    (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0));
-    fprintf(stdout, "  Total sharing savings	 	%.6g (%0.1f%% of bytes if no sharing)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x 	%.2f\n",
+	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
+    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x	 	%.2f\n",
+	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
+    Tcl_AppendPrintfToObj(objPtr, "  Total sharing savings	 	%.6g (%0.1f%% of bytes if no sharing)\n",
 	    sharingBytesSaved,
-	    (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared));
-    fprintf(stdout, "    Bytes with sharing		%.6g\n",
+	    Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
+    Tcl_AppendPrintfToObj(objPtr, "    Bytes with sharing		%.6g\n",
 	    currentLiteralBytes);
-    fprintf(stdout, "      table %u + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
-	    (unsigned int)sizeof(LiteralTable),
-	    (unsigned long)iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
-	    (unsigned long)iPtr->literalTable.numEntries * sizeof(LiteralEntry),
-	    (unsigned long)iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+    Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+	    (unsigned long) sizeof(LiteralTable),
+	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
+	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
+	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
 	    statsPtr->currentLitStringBytes);
-    fprintf(stdout, "    Bytes if no sharing		%.6g = objects %.6g + strings %.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing		%.6g = objects %.6g + strings %.6g\n",
 	    (objBytesIfUnshared + strBytesIfUnshared),
 	    objBytesIfUnshared, strBytesIfUnshared);
-    fprintf(stdout, "  String sharing savings 	%.6g = unshared %.6g - shared %.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings 	%.6g = unshared %.6g - shared %.6g\n",
 	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
 	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
-    fprintf(stdout, "  Literal mgmt overhead	 	%ld (%0.1f%% of bytes with sharing)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead	 	%ld (%0.1f%% of bytes with sharing)\n",
 	    literalMgmtBytes,
-	    (literalMgmtBytes * 100.0) / currentLiteralBytes);
-    fprintf(stdout, "    table %u + buckets %lu + entries %lu\n",
-	    (unsigned int)sizeof(LiteralTable),
-	    (unsigned long)iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
-	    (unsigned long)iPtr->literalTable.numEntries * sizeof(LiteralEntry));
+	    Percent(literalMgmtBytes, currentLiteralBytes));
+    Tcl_AppendPrintfToObj(objPtr, "    table %lu + buckets %lu + entries %lu\n",
+	    (unsigned long) sizeof(LiteralTable),
+	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
+	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));
 
     /*
      * Breakdown of current ByteCode space requirements.
      */
-    
-    fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
-    fprintf(stdout, "                         Bytes      Pct of    Avg per\n");
-    fprintf(stdout, "                                     total    ByteCode\n");
-    fprintf(stdout, "Total             %12.6g     100.00%%   %8.1f\n",
+
+    Tcl_AppendPrintfToObj(objPtr, "\nBreakdown of current ByteCode requirements:\n");
+    Tcl_AppendPrintfToObj(objPtr, "                         Bytes      Pct of    Avg per\n");
+    Tcl_AppendPrintfToObj(objPtr, "                                     total    ByteCode\n");
+    Tcl_AppendPrintfToObj(objPtr, "Total             %12.6g     100.00%%   %8.1f\n",
 	    statsPtr->currentByteCodeBytes,
 	    statsPtr->currentByteCodeBytes / numCurrentByteCodes);
-    fprintf(stdout, "Header            %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Header            %12.6g   %8.1f%%   %8.1f\n",
 	    currentHeaderBytes,
-	    ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes),
 	    currentHeaderBytes / numCurrentByteCodes);
-    fprintf(stdout, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentInstBytes,
-	    ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes),
 	    statsPtr->currentInstBytes / numCurrentByteCodes);
-    fprintf(stdout, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentLitBytes,
-	    ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes),
 	    statsPtr->currentLitBytes / numCurrentByteCodes);
-    fprintf(stdout, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentExceptBytes,
-	    ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes),
 	    statsPtr->currentExceptBytes / numCurrentByteCodes);
-    fprintf(stdout, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentAuxBytes,
-	    ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes),
 	    statsPtr->currentAuxBytes / numCurrentByteCodes);
-    fprintf(stdout, "Command map       %12.6g   %8.1f%%   %8.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "Command map       %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentCmdMapBytes,
-	    ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
+	    Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
 	    statsPtr->currentCmdMapBytes / numCurrentByteCodes);
 
     /*
      * Detailed literal statistics.
      */
-    
-    fprintf(stdout, "\nLiteral string sizes:\n");
-    fprintf(stdout, "	 Up to length		Percentage\n");
+
+    Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
+    Tcl_AppendPrintfToObj(objPtr, "	 Up to length		Percentage\n");
     maxSizeDecade = 0;
     for (i = 31;  i >= 0;  i--) {
-        if (statsPtr->literalCount[i] > 0) {
-            maxSizeDecade = i;
+	if (statsPtr->literalCount[i] > 0) {
+	    maxSizeDecade = i;
 	    break;
-        }
+	}
     }
     sum = 0;
     for (i = 0;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->literalCount[i];
-        fprintf(stdout,	"	%10d		%8.0f%%\n",
-		decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
+	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
     }
 
     litTableStats = TclLiteralStats(globalTablePtr);
-    fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
-            litTableStats);
+    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
+	    litTableStats);
     ckfree((char *) litTableStats);
 
     /*
      * Source and ByteCode size distributions.
      */
 
-    fprintf(stdout, "\nSource sizes:\n");
-    fprintf(stdout, "	 Up to size		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
+    Tcl_AppendPrintfToObj(objPtr, "	 Up to size		Percentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
-        if (statsPtr->srcCount[i] > 0) {
+	if (statsPtr->srcCount[i] > 0) {
 	    minSizeDecade = i;
 	    break;
-        }
+	}
     }
     for (i = 31;  i >= 0;  i--) {
-        if (statsPtr->srcCount[i] > 0) {
-            maxSizeDecade = i;
+	if (statsPtr->srcCount[i] > 0) {
+	    maxSizeDecade = i;
 	    break;
-        }
+	}
     }
     sum = 0;
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->srcCount[i];
-        fprintf(stdout,	"	%10d		%8.0f%%\n",
-		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
+	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
 
-    fprintf(stdout, "\nByteCode sizes:\n");
-    fprintf(stdout, "	 Up to size		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
+    Tcl_AppendPrintfToObj(objPtr, "	 Up to size		Percentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
-        if (statsPtr->byteCodeCount[i] > 0) {
+	if (statsPtr->byteCodeCount[i] > 0) {
 	    minSizeDecade = i;
 	    break;
-        }
+	}
     }
     for (i = 31;  i >= 0;  i--) {
-        if (statsPtr->byteCodeCount[i] > 0) {
-            maxSizeDecade = i;
+	if (statsPtr->byteCodeCount[i] > 0) {
+	    maxSizeDecade = i;
 	    break;
-        }
+	}
     }
     sum = 0;
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->byteCodeCount[i];
-        fprintf(stdout,	"	%10d		%8.0f%%\n",
-		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
+	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
 
-    fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
-    fprintf(stdout, "	       Up to ms		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
+    Tcl_AppendPrintfToObj(objPtr, "	       Up to ms		Percentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
-        if (statsPtr->lifetimeCount[i] > 0) {
+	if (statsPtr->lifetimeCount[i] > 0) {
 	    minSizeDecade = i;
 	    break;
-        }
+	}
     }
     for (i = 31;  i >= 0;  i--) {
-        if (statsPtr->lifetimeCount[i] > 0) {
-            maxSizeDecade = i;
+	if (statsPtr->lifetimeCount[i] > 0) {
+	    maxSizeDecade = i;
 	    break;
-        }
+	}
     }
     sum = 0;
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->lifetimeCount[i];
-        fprintf(stdout,	"	%12.3f		%8.0f%%\n",
-		decadeHigh / 1000.0,
-		(sum * 100.0) / statsPtr->numByteCodesFreed);
+	Tcl_AppendPrintfToObj(objPtr, "	%12.3f		%8.0f%%\n",
+		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
     }
 
     /*
      * Instruction counts.
      */
 
-    fprintf(stdout, "\nInstruction counts:\n");
-    for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
-        if (statsPtr->instructionCount[i]) {
-            fprintf(stdout, "%20s %8ld %6.1f%%\n",
-		    tclInstructionTable[i].name,
-		    statsPtr->instructionCount[i],
-		    (statsPtr->instructionCount[i]*100.0) / numInstructions);
-        }
-    }
-
-    fprintf(stdout, "\nInstructions NEVER executed:\n");
+    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
     for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
-        if (statsPtr->instructionCount[i] == 0) {
-            fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
-        }
+	Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
+		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
+	if (statsPtr->instructionCount[i]) {
+	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
+		    Percent(statsPtr->instructionCount[i], numInstructions));
+	} else {
+	    Tcl_AppendPrintfToObj(objPtr, "0\n");
+	}
     }
 
 #ifdef TCL_MEM_DEBUG
-    fprintf(stdout, "\nHeap Statistics:\n");
-    TclDumpMemoryInfo(stdout);
+    Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
+    TclDumpMemoryInfo((ClientData) objPtr, 1);
 #endif
-    fprintf(stdout, "\n----------------------------------------------------------------\n");
+    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+
+    if (objc == 1) {
+	Tcl_SetObjResult(interp, objPtr);
+    } else {
+	Tcl_Channel outChan;
+	char *str = Tcl_GetStringFromObj(objv[1], &length);
+
+	if (length) {
+	    if (strcmp(str, "stdout") == 0) {
+		outChan = Tcl_GetStdChannel(TCL_STDOUT);
+	    } else if (strcmp(str, "stderr") == 0) {
+		outChan = Tcl_GetStdChannel(TCL_STDERR);
+	    } else {
+		outChan = Tcl_OpenFileChannel(NULL, str, "w", 0664);
+	    }
+	} else {
+	    outChan = Tcl_GetStdChannel(TCL_STDOUT);
+	}
+	if (outChan != NULL) {
+	    Tcl_WriteObj(outChan, objPtr);
+	}
+    }
+    Tcl_DecrRefCount(objPtr);
     return TCL_OK;
 }
 #endif /* TCL_COMPILE_STATS */
@@ -6551,15 +8541,15 @@ EvalStatsCmd(unused, interp, objc, objv)
  *
  * StringForResultCode --
  *
- *	Procedure that returns a human-readable string representing a
- *	Tcl result code such as TCL_ERROR. 
+ *	Procedure that returns a human-readable string representing a Tcl
+ *	result code such as TCL_ERROR.
  *
  * Results:
- *	If the result code is one of the standard Tcl return codes, the
- *	result is a string representing that code such as "TCL_ERROR".
- *	Otherwise, the result string is that code formatted as a
- *	sequence of decimal digit characters. Note that the resulting
- *	string must not be modified by the caller.
+ *	If the result code is one of the standard Tcl return codes, the result
+ *	is a string representing that code such as "TCL_ERROR". Otherwise, the
+ *	result string is that code formatted as a sequence of decimal digit
+ *	characters. Note that the resulting string must not be modified by the
+ *	caller.
  *
  * Side effects:
  *	None.
@@ -6567,13 +8557,13 @@ EvalStatsCmd(unused, interp, objc, objv)
  *----------------------------------------------------------------------
  */
 
-static CONST char *
-StringForResultCode(result)
-    int result;			/* The Tcl result code for which to
-				 * generate a string. */
+static const char *
+StringForResultCode(
+    int result)			/* The Tcl result code for which to generate a
+				 * string. */
 {
     static char buf[TCL_INTEGER_SPACE];
-    
+
     if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
 	return resultStrings[result];
     }
@@ -6589,4 +8579,3 @@ StringForResultCode(result)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 5ad7063..c59fb54 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1,47 +1,39 @@
 /*
  * tclFCmd.c
  *
- *      This file implements the generic portion of file manipulation 
- *      subcommands of the "file" command. 
+ *	This file implements the generic portion of file manipulation
+ *	subcommands of the "file" command.
  *
  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#ifndef _WIN64
-/* See [Bug 3354324]: file mtime sets wrong time */
-#   define _USE_32BIT_TIME_T
-#endif
-
-#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
  */
 
-static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, 
-			    int copyFlag, int force));
-static Tcl_Obj *	FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr));
-static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[], int copyFlag));
-static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[], int *forcePtr));
+static int		CopyRenameOneFile(Tcl_Interp *interp,
+			    Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
+			    int copyFlag, int force);
+static Tcl_Obj *	FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static int		FileCopyRename(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[], int copyFlag);
+static int		FileForceOption(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[], int *forcePtr);
 
 /*
  *---------------------------------------------------------------------------
  *
  * TclFileRenameCmd
  *
- *	This procedure implements the "rename" subcommand of the "file"
- *      command.  Filename arguments need to be translated to native
- *	format before being passed to platform-specific code that
- *	implements rename functionality.
+ *	This function implements the "rename" subcommand of the "file"
+ *	command. Filename arguments need to be translated to native format
+ *	before being passed to platform-specific code that implements rename
+ *	functionality.
  *
  * Results:
  *	A standard Tcl result.
@@ -53,10 +45,11 @@ static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
  */
 
 int
-TclFileRenameCmd(interp, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error reporting. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
+TclFileRenameCmd(
+    Tcl_Interp *interp,		/* Interp for error reporting or recursive
+				 * calls in the case of a tricky rename. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     return FileCopyRename(interp, objc, objv, 0);
 }
@@ -66,10 +59,9 @@ TclFileRenameCmd(interp, objc, objv)
  *
  * TclFileCopyCmd
  *
- *	This procedure implements the "copy" subcommand of the "file"
- *	command.  Filename arguments need to be translated to native
- *	format before being passed to platform-specific code that
- *	implements copy functionality.
+ *	This function implements the "copy" subcommand of the "file" command.
+ *	Filename arguments need to be translated to native format before being
+ *	passed to platform-specific code that implements copy functionality.
  *
  * Results:
  *	A standard Tcl result.
@@ -81,10 +73,11 @@ TclFileRenameCmd(interp, objc, objv)
  */
 
 int
-TclFileCopyCmd(interp, objc, objv)
-    Tcl_Interp *interp;		/* Used for error reporting */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
+TclFileCopyCmd(
+    Tcl_Interp *interp,		/* Used for error reporting or recursive calls
+				 * in the case of a tricky copy. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     return FileCopyRename(interp, objc, objv, 1);
 }
@@ -94,8 +87,8 @@ TclFileCopyCmd(interp, objc, objv)
  *
  * FileCopyRename --
  *
- *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
- *	See comments for those procedures.
+ *	Performs the work of TclFileRenameCmd and TclFileCopyCmd. See
+ *	comments for those functions.
  *
  * Results:
  *	See above.
@@ -107,15 +100,15 @@ TclFileCopyCmd(interp, objc, objv)
  */
 
 static int
-FileCopyRename(interp, objc, objv, copyFlag)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
-    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,
+FileCopyRename(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[],	/* Argument strings passed to Tcl_FileCmd. */
+    int copyFlag)		/* If non-zero, copy source(s). Otherwise,
 				 * rename them. */
 {
     int i, result, force;
-    Tcl_StatBuf statBuf; 
+    Tcl_StatBuf statBuf;
     Tcl_Obj *target;
 
     i = FileForceOption(interp, objc - 2, objv + 2, &force);
@@ -124,10 +117,9 @@ FileCopyRename(interp, objc, objv, copyFlag)
     }
     i += 2;
     if ((objc - i) < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", 
-		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
-		" ?options? source ?source ...? target\"", 
-		(char *) NULL);
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		TclGetString(objv[0]), " ", TclGetString(objv[1]),
+		" ?options? source ?source ...? target\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -155,15 +147,14 @@ FileCopyRename(interp, objc, objv, copyFlag)
 	    errno = ENOTDIR;
 	    Tcl_PosixError(interp);
 	    Tcl_AppendResult(interp, "error ",
-		    ((copyFlag) ? "copying" : "renaming"), ": target \"",
-		    Tcl_GetString(target), "\" is not a directory", 
-		    (char *) NULL);
+		    (copyFlag ? "copying" : "renaming"), ": target \"",
+		    TclGetString(target), "\" is not a directory", NULL);
 	    result = TCL_ERROR;
 	} else {
 	    /*
-	     * Even though already have target == translated(objv[i+1]),
-	     * pass the original argument down, so if there's an error, the
-	     * error message will reflect the original arguments.
+	     * Even though already have target == translated(objv[i+1]), pass
+	     * the original argument down, so if there's an error, the error
+	     * message will reflect the original arguments.
 	     */
 
 	    result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,
@@ -171,17 +162,17 @@ FileCopyRename(interp, objc, objv, copyFlag)
 	}
 	return result;
     }
-    
+
     /*
-     * Move each source file into target directory.  Extract the basename
-     * from each source, and append it to the end of the target path.
+     * Move each source file into target directory. Extract the basename from
+     * each source, and append it to the end of the target path.
      */
 
-    for ( ; i < objc - 1; i++) {
+    for ( ; i<objc-1 ; i++) {
 	Tcl_Obj *jargv[2];
 	Tcl_Obj *source, *newFileName;
 	Tcl_Obj *temp;
-	
+
 	source = FileBasename(interp, objv[i]);
 	if (source == NULL) {
 	    result = TCL_ERROR;
@@ -210,10 +201,9 @@ FileCopyRename(interp, objc, objv, copyFlag)
  *
  * TclFileMakeDirsCmd
  *
- *	This procedure implements the "mkdir" subcommand of the "file"
- *      command.  Filename arguments need to be translated to native
- *	format before being passed to platform-specific code that
- *	implements mkdir functionality.
+ *	This function implements the "mkdir" subcommand of the "file" command.
+ *	Filename arguments need to be translated to native format before being
+ *	passed to platform-specific code that implements mkdir functionality.
  *
  * Results:
  *	A standard Tcl result.
@@ -223,11 +213,12 @@ FileCopyRename(interp, objc, objv, copyFlag)
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclFileMakeDirsCmd(interp, objc, objv)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    int objc;			/* Number of arguments */
-    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
+TclFileMakeDirsCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    int objc,			/* Number of arguments */
+    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     Tcl_Obj *errfile;
     int result, i, j, pobjc;
@@ -245,6 +236,7 @@ TclFileMakeDirsCmd(interp, objc, objv)
 	}
 
 	split = Tcl_FSSplitPath(objv[i],&pobjc);
+	Tcl_IncrRefCount(split);
 	if (pobjc == 0) {
 	    errno = ENOENT;
 	    errfile = objv[i];
@@ -253,10 +245,10 @@ TclFileMakeDirsCmd(interp, objc, objv)
 	for (j = 0; j < pobjc; j++) {
 	    target = Tcl_FSJoinPath(split, j + 1);
 	    Tcl_IncrRefCount(target);
+
 	    /*
-	     * Call Tcl_FSStat() so that if target is a symlink that
-	     * points to a directory we will create subdirectories in
-	     * that directory.
+	     * Call Tcl_FSStat() so that if target is a symlink that points to
+	     * a directory we will create subdirectories in that directory.
 	     */
 
 	    if (Tcl_FSStat(target, &statBuf) == 0) {
@@ -267,25 +259,27 @@ TclFileMakeDirsCmd(interp, objc, objv)
 		}
 	    } else if (errno != ENOENT) {
 		/*
-		 * If Tcl_FSStat() failed and the error is anything
-		 * other than non-existence of the target, throw the
-		 * error.
+		 * If Tcl_FSStat() failed and the error is anything other than
+		 * non-existence of the target, throw the error.
 		 */
+
 		errfile = target;
 		goto done;
 	    } else if (Tcl_FSCreateDirectory(target) != TCL_OK) {
 		/*
 		 * Create might have failed because of being in a race
-		 * condition with another process trying to create the
-		 * same subdirectory.
+		 * condition with another process trying to create the same
+		 * subdirectory.
 		 */
+
 		if (errno == EEXIST) {
 		    if ((Tcl_FSStat(target, &statBuf) == 0)
 			    && S_ISDIR(statBuf.st_mode)) {
 			/*
-			 * It is a directory that wasn't there before,
-			 * so keep going without error.
+			 * It is a directory that wasn't there before, so keep
+			 * going without error.
 			 */
+
 			Tcl_ResetResult(interp);
 		    } else {
 			errfile = target;
@@ -296,7 +290,11 @@ TclFileMakeDirsCmd(interp, objc, objv)
 		    goto done;
 		}
 	    }
- 	    /* Forget about this sub-path */
+
+	    /*
+	     * Forget about this sub-path.
+	     */
+
 	    Tcl_DecrRefCount(target);
 	    target = NULL;
 	}
@@ -304,11 +302,10 @@ TclFileMakeDirsCmd(interp, objc, objv)
 	split = NULL;
     }
 
-    done:
+  done:
     if (errfile != NULL) {
 	Tcl_AppendResult(interp, "can't create directory \"",
-		Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), 
-		(char *) NULL);
+		TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
 	result = TCL_ERROR;
     }
     if (split != NULL) {
@@ -325,8 +322,8 @@ TclFileMakeDirsCmd(interp, objc, objv)
  *
  * TclFileDeleteCmd
  *
- *	This procedure implements the "delete" subcommand of the "file"
- *      command.
+ *	This function implements the "delete" subcommand of the "file"
+ *	command.
  *
  * Results:
  *	A standard Tcl result.
@@ -338,24 +335,24 @@ TclFileMakeDirsCmd(interp, objc, objv)
  */
 
 int
-TclFileDeleteCmd(interp, objc, objv)
-    Tcl_Interp *interp;		/* Used for error reporting */
-    int objc;			/* Number of arguments */
-    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */
+TclFileDeleteCmd(
+    Tcl_Interp *interp,		/* Used for error reporting */
+    int objc,			/* Number of arguments */
+    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     int i, force, result;
     Tcl_Obj *errfile;
     Tcl_Obj *errorBuffer = NULL;
-    
+
     i = FileForceOption(interp, objc - 2, objv + 2, &force);
     if (i < 0) {
 	return TCL_ERROR;
     }
     i += 2;
     if ((objc - i) < 1) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", 
-		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
-		" ?options? file ?file ...?\"", (char *) NULL);
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		TclGetString(objv[0]), " ", TclGetString(objv[1]),
+		" ?options? file ?file ...?\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -377,34 +374,39 @@ TclFileDeleteCmd(interp, objc, objv)
 
 	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
 	    /*
-	     * Trying to delete a file that does not exist is not
-	     * considered an error, just a no-op
+	     * Trying to delete a file that does not exist is not considered
+	     * an error, just a no-op
 	     */
 
 	    if (errno != ENOENT) {
 		result = TCL_ERROR;
 	    }
 	} else if (S_ISDIR(statBuf.st_mode)) {
-	    /* 
-	     * We own a reference count on errorBuffer, if it was set
-	     * as a result of this call. 
+	    /*
+	     * We own a reference count on errorBuffer, if it was set as a
+	     * result of this call.
 	     */
+
 	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
 	    if (result != TCL_OK) {
 		if ((force == 0) && (errno == EEXIST)) {
-		    Tcl_AppendResult(interp, "error deleting \"", 
-			    Tcl_GetString(objv[i]),
-			    "\": directory not empty", (char *) NULL);
+		    Tcl_AppendResult(interp, "error deleting \"",
+			    TclGetString(objv[i]), "\": directory not empty",
+			    NULL);
 		    Tcl_PosixError(interp);
 		    goto done;
 		}
 
-		/* 
+		/*
 		 * If possible, use the untranslated name for the file.
 		 */
-		 
+
 		errfile = errorBuffer;
-		/* FS supposed to check between translated objv and errfile */
+
+		/*
+		 * FS supposed to check between translated objv and errfile.
+		 */
+
 		if (Tcl_FSEqualPaths(objv[i], errfile)) {
 		    errfile = objv[i];
 		}
@@ -412,32 +414,34 @@ TclFileDeleteCmd(interp, objc, objv)
 	} else {
 	    result = Tcl_FSDeleteFile(objv[i]);
 	}
-	
+
 	if (result != TCL_OK) {
 	    result = TCL_ERROR;
-	    /* 
-	     * It is important that we break on error, otherwise we
-	     * might end up owning reference counts on numerous
-	     * errorBuffers.
+
+	    /*
+	     * It is important that we break on error, otherwise we might end
+	     * up owning reference counts on numerous errorBuffers.
 	     */
+
 	    break;
 	}
     }
     if (result != TCL_OK) {
 	if (errfile == NULL) {
-	    /* 
-	     * We try to accomodate poor error results from our 
-	     * Tcl_FS calls 
+	    /*
+	     * We try to accomodate poor error results from our Tcl_FS calls.
 	     */
-	    Tcl_AppendResult(interp, "error deleting unknown file: ", 
-		    Tcl_PosixError(interp), (char *) NULL);
+
+	    Tcl_AppendResult(interp, "error deleting unknown file: ",
+		    Tcl_PosixError(interp), NULL);
 	} else {
-	    Tcl_AppendResult(interp, "error deleting \"", 
-		    Tcl_GetString(errfile), "\": ", 
-		    Tcl_PosixError(interp), (char *) NULL);
+	    Tcl_AppendResult(interp, "error deleting \"",
+		    TclGetString(errfile), "\": ", Tcl_PosixError(interp),
+		    NULL);
 	}
-    } 
-    done:
+    }
+
+  done:
     if (errorBuffer != NULL) {
 	Tcl_DecrRefCount(errorBuffer);
     }
@@ -449,37 +453,37 @@ TclFileDeleteCmd(interp, objc, objv)
  *
  * CopyRenameOneFile
  *
- *	Copies or renames specified source file or directory hierarchy
- *	to the specified target.  
+ *	Copies or renames specified source file or directory hierarchy to the
+ *	specified target.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Target is overwritten if the force flag is set.  Attempting to
- *	copy/rename a file onto a directory or a directory onto a file
- *	will always result in an error.  
+ *	Target is overwritten if the force flag is set. Attempting to
+ *	copy/rename a file onto a directory or a directory onto a file will
+ *	always result in an error.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CopyRenameOneFile(interp, source, target, copyFlag, force) 
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Obj *source;		/* Pathname of file to copy.  May need to
-				 * be translated. */
-    Tcl_Obj *target;		/* Pathname of file to create/overwrite.
-				 * May need to be translated. */
-    int copyFlag;		/* If non-zero, copy files.  Otherwise,
-				 * rename them. */
-    int force;			/* If non-zero, overwrite target file if it
-				 * exists.  Otherwise, error if target already
+CopyRenameOneFile(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Obj *source,		/* Pathname of file to copy. May need to be
+				 * translated. */
+    Tcl_Obj *target,		/* Pathname of file to create/overwrite. May
+				 * need to be translated. */
+    int copyFlag,		/* If non-zero, copy files. Otherwise, rename
+				 * them. */
+    int force)			/* If non-zero, overwrite target file if it
+				 * exists. Otherwise, error if target already
 				 * exists. */
 {
     int result;
     Tcl_Obj *errfile, *errorBuffer;
-    /* If source is a link, then this is the real file/directory */
-    Tcl_Obj *actualSource = NULL;
+    Tcl_Obj *actualSource=NULL;	/* If source is a link, then this is the real
+				 * file/directory. */
     Tcl_StatBuf sourceStatBuf, targetStatBuf;
 
     if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
@@ -488,16 +492,15 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
     if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
 	return TCL_ERROR;
     }
-    
+
     errfile = NULL;
     errorBuffer = NULL;
     result = TCL_ERROR;
-    
+
     /*
-     * We want to copy/rename links and not the files they point to, so we
-     * use lstat(). If target is a link, we also want to replace the 
-     * link and not the file it points to, so we also use lstat() on the
-     * target.
+     * We want to copy/rename links and not the files they point to, so we use
+     * lstat(). If target is a link, we also want to replace the link and not
+     * the file it points to, so we also use lstat() on the target.
      */
 
     if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
@@ -533,30 +536,48 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	}
 #endif
 
-
 	/*
-	 * Prevent copying/renaming a file onto a directory and
-	 * vice-versa.  This is a policy decision based on the fact that
-	 * existing implementations of copy and rename on all platforms
-	 * also prevent this.
+	 * Prevent copying/renaming a file onto a directory and vice-versa.
+	 * This is a policy decision based on the fact that existing
+	 * implementations of copy and rename on all platforms also prevent
+	 * this.
 	 */
 
 	if (S_ISDIR(sourceStatBuf.st_mode)
-                && !S_ISDIR(targetStatBuf.st_mode)) {
+		&& !S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite file \"", 
-		    Tcl_GetString(target), "\" with directory \"", 
-		    Tcl_GetString(source), "\"", (char *) NULL);
+	    Tcl_AppendResult(interp, "can't overwrite file \"",
+		    TclGetString(target), "\" with directory \"",
+		    TclGetString(source), "\"", NULL);
 	    goto done;
 	}
 	if (!S_ISDIR(sourceStatBuf.st_mode)
-	        && S_ISDIR(targetStatBuf.st_mode)) {
+		&& S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite directory \"", 
-		    Tcl_GetString(target), "\" with file \"", 
-		    Tcl_GetString(source), "\"", (char *) NULL);
+	    Tcl_AppendResult(interp, "can't overwrite directory \"",
+		    TclGetString(target), "\" with file \"",
+		    TclGetString(source), "\"", NULL);
 	    goto done;
 	}
+
+	/*
+	 * The destination exists, but appears to be ok to over-write, and
+	 * -force is given. We now try to adjust permissions to ensure the
+	 * operation succeeds. If we can't adjust permissions, we'll let the
+	 * actual copy/rename return an error later.
+	 */
+
+	{
+	    Tcl_Obj *perm;
+	    int index;
+
+	    TclNewLiteralStringObj(perm, "u+w");
+	    Tcl_IncrRefCount(perm);
+	    if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
+		Tcl_FSFileAttrsSet(NULL, index, target, perm);
+	    }
+	    Tcl_DecrRefCount(perm);
+	}
     }
 
     if (copyFlag == 0) {
@@ -564,62 +585,95 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	if (result == TCL_OK) {
 	    goto done;
 	}
-	    
+
 	if (errno == EINVAL) {
-	    Tcl_AppendResult(interp, "error renaming \"", 
-		    Tcl_GetString(source), "\" to \"",
-		    Tcl_GetString(target), "\": trying to rename a volume or ",
-		    "move a directory into itself", (char *) NULL);
+	    Tcl_AppendResult(interp, "error renaming \"",
+		    TclGetString(source), "\" to \"", TclGetString(target),
+		    "\": trying to rename a volume or "
+		    "move a directory into itself", NULL);
 	    goto done;
 	} else if (errno != EXDEV) {
 	    errfile = target;
 	    goto done;
 	}
-	
+
 	/*
-	 * The rename failed because the move was across file systems.
-	 * Fall through to copy file and then remove original.  Note that
-	 * the low-level Tcl_FSRenameFileProc in the filesystem is allowed 
-	 * to implement cross-filesystem moves itself, if it desires.
+	 * The rename failed because the move was across file systems. Fall
+	 * through to copy file and then remove original. Note that the
+	 * low-level Tcl_FSRenameFileProc in the filesystem is allowed to
+	 * implement cross-filesystem moves itself, if it desires.
 	 */
     }
 
     actualSource = source;
     Tcl_IncrRefCount(actualSource);
+
+    /*
+     * Activate the following block to copy files instead of links. However
+     * Tcl's semantics currently say we should copy links, so any such change
+     * should be the subject of careful study on the consequences.
+     *
+     * Perhaps there could be an optional flag to 'file copy' to dictate which
+     * approach to use, with the default being _not_ to have this block
+     * active.
+     */
+
 #if 0
 #ifdef S_ISLNK
-    /* 
-     * To add a flag to make 'copy' copy links instead of files, we could
-     * add a condition to ignore this 'if' here.
-     */
     if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
-	/* 
-	 * We want to copy files not links.  Therefore we must follow the
-	 * link.  There are two purposes to this 'stat' call here.  First
-	 * we want to know if the linked-file/dir actually exists, and
-	 * second, in the block of code which follows, some 20 lines
-	 * down, we want to check if the thing is a file or directory.
+	/*
+	 * We want to copy files not links. Therefore we must follow the link.
+	 * There are two purposes to this 'stat' call here. First we want to
+	 * know if the linked-file/dir actually exists, and second, in the
+	 * block of code which follows, some 20 lines down, we want to check
+	 * if the thing is a file or directory.
 	 */
+
 	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
-	    /* Actual file doesn't exist */
-	    Tcl_AppendResult(interp, 
-		    "error copying \"", Tcl_GetString(source), 
-		    "\": the target of this link doesn't exist",
-		    (char *) NULL);
+	    /*
+	     * Actual file doesn't exist.
+	     */
+
+	    Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
+		    "\": the target of this link doesn't exist", NULL);
 	    goto done;
 	} else {
 	    int counter = 0;
+
 	    while (1) {
 		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
 		if (path == NULL) {
 		    break;
 		}
+
+		/*
+		 * Now we want to check if this is a relative path, and if so,
+		 * to make it absolute.
+		 */
+
+		if (Tcl_FSGetPathType(path) == TCL_PATH_RELATIVE) {
+		    Tcl_Obj *abs = Tcl_FSJoinToPath(actualSource, 1, &path);
+
+		    if (abs == NULL) {
+			break;
+		    }
+		    Tcl_IncrRefCount(abs);
+		    Tcl_DecrRefCount(path);
+		    path = abs;
+		}
 		Tcl_DecrRefCount(actualSource);
 		actualSource = path;
 		counter++;
-		/* Arbitrary limit of 20 links to follow */
+
+		/*
+		 * Arbitrary limit of 20 links to follow.
+		 */
+
 		if (counter > 20) {
-		    /* Too many links */
+		    /*
+		     * Too many links.
+		     */
+
 		    Tcl_SetErrno(EMLINK);
 		    errfile = source;
 		    goto done;
@@ -628,47 +682,43 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	    /* Now 'actualSource' is the correct file */
 	}
     }
-#endif
+#endif /* S_ISLNK */
 #endif
 
     if (S_ISDIR(sourceStatBuf.st_mode)) {
 	result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer);
 	if (result != TCL_OK) {
 	    if (errno == EXDEV) {
-		/* 
+		/*
 		 * The copy failed because we're trying to do a
-		 * cross-filesystem copy.  We do this through our Tcl
-		 * library.
+		 * cross-filesystem copy. We do this through our Tcl library.
 		 */
-		Tcl_SavedResult savedResult;
-		Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
-		Tcl_IncrRefCount(copyCommand);
-		Tcl_ListObjAppendElement(interp, copyCommand, 
-			Tcl_NewStringObj("::tcl::CopyDirectory",-1));
+
+		Tcl_Obj *copyCommand, *cmdObj, *opObj;
+
+		TclNewObj(copyCommand);
+		TclNewLiteralStringObj(cmdObj, "::tcl::CopyDirectory");
+		Tcl_ListObjAppendElement(interp, copyCommand, cmdObj);
 		if (copyFlag) {
-		    Tcl_ListObjAppendElement(interp, copyCommand, 
-					     Tcl_NewStringObj("copying",-1));
+		    TclNewLiteralStringObj(opObj, "copying");
 		} else {
-		    Tcl_ListObjAppendElement(interp, copyCommand, 
-					     Tcl_NewStringObj("renaming",-1));
+		    TclNewLiteralStringObj(opObj, "renaming");
 		}
+		Tcl_ListObjAppendElement(interp, copyCommand, opObj);
 		Tcl_ListObjAppendElement(interp, copyCommand, source);
 		Tcl_ListObjAppendElement(interp, copyCommand, target);
-		Tcl_SaveResult(interp, &savedResult);
-		result = Tcl_EvalObjEx(interp, copyCommand, 
-				       TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+		Tcl_IncrRefCount(copyCommand);
+		result = Tcl_EvalObjEx(interp, copyCommand,
+			TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
 		Tcl_DecrRefCount(copyCommand);
 		if (result != TCL_OK) {
-		    /* 
-		     * There was an error in the Tcl-level copy.
-		     * We will pass on the Tcl error message and
-		     * can ensure this by setting errfile to NULL
+		    /*
+		     * There was an error in the Tcl-level copy. We will pass
+		     * on the Tcl error message and can ensure this by setting
+		     * errfile to NULL
 		     */
-		    Tcl_DiscardResult(&savedResult);
+
 		    errfile = NULL;
-		} else {
-		    /* The copy was successful */
-		    Tcl_RestoreResult(interp, &savedResult);
 		}
 	    } else {
 		errfile = errorBuffer;
@@ -685,19 +735,22 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	    result = TclCrossFilesystemCopy(interp, source, target);
 	}
 	if (result != TCL_OK) {
-	    /* 
-	     * We could examine 'errno' to double-check if the problem
-	     * was with the target, but we checked the source above,
-	     * so it should be quite clear 
+	    /*
+	     * We could examine 'errno' to double-check if the problem was
+	     * with the target, but we checked the source above, so it should
+	     * be quite clear
 	     */
+
 	    errfile = target;
-	    /* 
-	     * We now need to reset the result, because the above call,
-	     * if it failed, may have put an error message in place.
-	     * (Ideally we would prefer not to pass an interpreter in
-	     * above, but the channel IO code used by
-	     * TclCrossFilesystemCopy currently requires one)
+
+	    /*
+	     * We now need to reset the result, because the above call, if it
+	     * failed, may have put an error message in place. (Ideally we
+	     * would prefer not to pass an interpreter in above, but the
+	     * channel IO code used by TclCrossFilesystemCopy currently
+	     * requires one).
 	     */
+
 	    Tcl_ResetResult(interp);
 	}
     }
@@ -716,31 +769,26 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	    }
 	}
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "can't unlink \"", 
-		Tcl_GetString(errfile), "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
+	    Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
+		    "\": ", Tcl_PosixError(interp), NULL);
 	    errfile = NULL;
 	}
     }
-    
-    done:
+
+  done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, 
-		((copyFlag) ? "error copying \"" : "error renaming \""),
-		 Tcl_GetString(source), (char *) NULL);
+	Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
+		 " \"", TclGetString(source), NULL);
 	if (errfile != source) {
-	    Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target), 
-			     (char *) NULL);
+	    Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
 	    if (errfile != target) {
-		Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile), 
-				 (char *) NULL);
+		Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
 	    }
 	}
-	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
-		(char *) NULL);
+	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
     }
     if (errorBuffer != NULL) {
-        Tcl_DecrRefCount(errorBuffer);
+	Tcl_DecrRefCount(errorBuffer);
     }
     if (actualSource != NULL) {
 	Tcl_DecrRefCount(actualSource);
@@ -753,14 +801,13 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
  *
  * FileForceOption --
  *
- *	Helps parse command line options for file commands that take
- *	the "-force" and "--" options.
+ *	Helps parse command line options for file commands that take the
+ *	"-force" and "--" options.
  *
  * Results:
- *	The return value is how many arguments from argv were consumed
- *	by this function, or -1 if there was an error parsing the
- *	options.  If an error occurred, an error message is left in the
- *	interp's result.
+ *	The return value is how many arguments from argv were consumed by this
+ *	function, or -1 if there was an error parsing the options. If an error
+ *	occurred, an error message is left in the interp's result.
  *
  * Side effects:
  *	None.
@@ -769,29 +816,29 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
  */
 
 static int
-FileForceOption(interp, objc, objv, forcePtr)
-    Tcl_Interp *interp;		/* Interp, for error return. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings.  First command line
+FileForceOption(
+    Tcl_Interp *interp,		/* Interp, for error return. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[],	/* Argument strings.  First command line
 				 * option, if it exists, begins at 0. */
-    int *forcePtr;		/* If the "-force" was specified, *forcePtr
-				 * is filled with 1, otherwise with 0. */
+    int *forcePtr)		/* If the "-force" was specified, *forcePtr is
+				 * filled with 1, otherwise with 0. */
 {
     int force, i;
-    
+
     force = 0;
     for (i = 0; i < objc; i++) {
-	if (Tcl_GetString(objv[i])[0] != '-') {
+	if (TclGetString(objv[i])[0] != '-') {
 	    break;
 	}
-	if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
+	if (strcmp(TclGetString(objv[i]), "-force") == 0) {
 	    force = 1;
-	} else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
+	} else if (strcmp(TclGetString(objv[i]), "--") == 0) {
 	    i++;
 	    break;
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]), 
-		    "\": should be -force or --", (char *)NULL);
+	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
+		    "\": should be -force or --", NULL);
 	    return -1;
 	}
     }
@@ -805,13 +852,12 @@ FileForceOption(interp, objc, objv, forcePtr)
  *
  *	Given a path in either tcl format (with / separators), or in the
  *	platform-specific format for the current platform, return all the
- *	characters in the path after the last directory separator.  But,
- *	if path is the root directory, returns no characters.
+ *	characters in the path after the last directory separator. But, if
+ *	path is the root directory, returns no characters.
  *
  * Results:
- *	Returns the string object that represents the basename.  If there 
- *	is an error, an error message is left in interp, and NULL is 
- *	returned.
+ *	Returns the string object that represents the basename. If there is an
+ *	error, an error message is left in interp, and NULL is returned.
  *
  * Side effects:
  *	None.
@@ -820,23 +866,25 @@ FileForceOption(interp, objc, objv, forcePtr)
  */
 
 static Tcl_Obj *
-FileBasename(interp, pathPtr)
-    Tcl_Interp *interp;		/* Interp, for error return. */
-    Tcl_Obj *pathPtr;		/* Path whose basename to extract. */
+FileBasename(
+    Tcl_Interp *interp,		/* Interp, for error return. */
+    Tcl_Obj *pathPtr)		/* Path whose basename to extract. */
 {
     int objc;
     Tcl_Obj *splitPtr;
     Tcl_Obj *resultPtr = NULL;
-    
+
     splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
+    Tcl_IncrRefCount(splitPtr);
 
     if (objc != 0) {
-	if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
+	if ((objc == 1) && (*TclGetString(pathPtr) == '~')) {
 	    Tcl_DecrRefCount(splitPtr);
 	    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
 		return NULL;
 	    }
 	    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
+	    Tcl_IncrRefCount(splitPtr);
 	}
 
 	/*
@@ -847,7 +895,7 @@ FileBasename(interp, pathPtr)
 	if (objc > 0) {
 	    Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
 	    if ((objc == 1) &&
-	      (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
+		    (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
 		resultPtr = NULL;
 	    }
 	}
@@ -865,48 +913,46 @@ FileBasename(interp, pathPtr)
  *
  * TclFileAttrsCmd --
  *
- *      Sets or gets the platform-specific attributes of a file.  The
- *      objc-objv points to the file name with the rest of the command
- *      line following.  This routine uses platform-specific tables of
- *      option strings and callbacks.  The callback to get the
- *      attributes take three parameters:
- *	    Tcl_Interp *interp;	    The interp to report errors with.
- *				    Since this is an object-based API,
- *				    the object form of the result should 
- *				    be used.
+ *	Sets or gets the platform-specific attributes of a file. The objc-objv
+ *	points to the file name with the rest of the command line following.
+ *	This routine uses platform-specific tables of option strings and
+ *	callbacks. The callback to get the attributes take three parameters:
+ *	    Tcl_Interp *interp;	    The interp to report errors with. Since
+ *				    this is an object-based API, the object
+ *				    form of the result should be used.
  *	    CONST char *fileName;   This is extracted using
  *				    Tcl_TranslateFileName.
- *	    TclObj **attrObjPtrPtr; A new object to hold the attribute
- *				    is allocated and put here.
+ *	    TclObj **attrObjPtrPtr; A new object to hold the attribute is
+ *				    allocated and put here.
  *	The first two parameters of the callback used to write out the
  *	attributes are the same. The third parameter is:
- *	    CONST *attrObjPtr;	    A pointer to the object that has
- *				    the new attribute.
- *	They both return standard TCL errors; if the routine to get
- *	an attribute fails, no object is allocated and *attrObjPtrPtr
- *	is unchanged.
+ *	    CONST *attrObjPtr;	    A pointer to the object that has the new
+ *				    attribute.
+ *	They both return standard TCL errors; if the routine to get an
+ *	attribute fails, no object is allocated and *attrObjPtrPtr is
+ *	unchanged.
  *
  * Results:
- *      Standard TCL error.
+ *	Standard TCL error.
  *
  * Side effects:
- *      May set file attributes for the file name.
- *      
+ *	May set file attributes for the file name.
+ *
  *----------------------------------------------------------------------
  */
 
 int
-TclFileAttrsCmd(interp, objc, objv)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int objc;			/* Number of command line arguments. */
-    Tcl_Obj *CONST objv[];	/* The command line objects. */
+TclFileAttrsCmd(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int objc,			/* Number of command line arguments. */
+    Tcl_Obj *CONST objv[])	/* The command line objects. */
 {
     int result;
     CONST char ** attributeStrings;
     Tcl_Obj* objStrings = NULL;
-    int numObjStrings = -1;
+    int numObjStrings = -1, didAlloc = 0;
     Tcl_Obj *filePtr;
-    
+
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 2, objv,
 		"name ?option? ?value? ?option value ...?");
@@ -917,64 +963,95 @@ TclFileAttrsCmd(interp, objc, objv)
     if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
     	return TCL_ERROR;
     }
-    
+
     objc -= 3;
     objv += 3;
     result = TCL_ERROR;
     Tcl_SetErrno(0);
+
     attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
     if (attributeStrings == NULL) {
 	int index;
 	Tcl_Obj *objPtr;
+
 	if (objStrings == NULL) {
 	    if (Tcl_GetErrno() != 0) {
-		/* 
-		 * There was an error, probably that the filePtr is
-		 * not accepted by any filesystem
+		/*
+		 * There was an error, probably that the filePtr is not
+		 * accepted by any filesystem
 		 */
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
-			"could not read \"", Tcl_GetString(filePtr), 
-			"\": ", Tcl_PosixError(interp), 
-			(char *) NULL);
-		return TCL_ERROR;
+		Tcl_AppendResult(interp, "could not read \"",
+			TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
+			NULL);
 	    }
-	    goto end;
+	    return TCL_ERROR;
 	}
-	/* We own the object now */
+
+	/*
+	 * We own the object now.
+	 */
+
 	Tcl_IncrRefCount(objStrings);
-        /* Use objStrings as a list object */
+
+	/*
+	 * Use objStrings as a list object.
+	 */
+
 	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
 	    goto end;
 	}
-	attributeStrings = (CONST char **)
-		ckalloc ((1+numObjStrings) * sizeof(char*));
+	attributeStrings = (CONST char **) TclStackAlloc(interp,
+		(1+numObjStrings) * sizeof(char*));
+	didAlloc = 1;
 	for (index = 0; index < numObjStrings; index++) {
 	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
-	    attributeStrings[index] = Tcl_GetString(objPtr);
+	    attributeStrings[index] = TclGetString(objPtr);
 	}
 	attributeStrings[index] = NULL;
+    } else if (objStrings != NULL) {
+	Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
     }
+
     if (objc == 0) {
 	/*
 	 * Get all attributes.
 	 */
 
-	int index;
+	int index, res = TCL_OK, nbAtts = 0;
 	Tcl_Obj *listPtr;
-	 
+
 	listPtr = Tcl_NewListObj(0, NULL);
 	for (index = 0; attributeStrings[index] != NULL; index++) {
-	    Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
-	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-	    /* We now forget about objPtr, it is in the list */
-	    objPtr = NULL;
-	    if (Tcl_FSFileAttrsGet(interp, index, filePtr,
-		    &objPtr) != TCL_OK) {
-		Tcl_DecrRefCount(listPtr);
-		goto end;
+	    Tcl_Obj *objPtrAttr;
+
+	    if (res != TCL_OK) {
+		/*
+		 * Clear the error from the last iteration.
+		 */
+
+		Tcl_ResetResult(interp);
+	    }
+
+	    res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr);
+	    if (res == TCL_OK) {
+		Tcl_Obj *objPtr =
+			Tcl_NewStringObj(attributeStrings[index], -1);
+
+		Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+		Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr);
+		nbAtts++;
 	    }
-	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
 	}
+
+	if (index > 0 && nbAtts == 0) {
+	    /*
+	     * Error: no valid attributes found.
+	     */
+
+	    Tcl_DecrRefCount(listPtr);
+	    goto end;
+	}
+
     	Tcl_SetObjResult(interp, listPtr);
     } else if (objc == 1) {
 	/*
@@ -985,9 +1062,9 @@ TclFileAttrsCmd(interp, objc, objv)
 	Tcl_Obj *objPtr = NULL;
 
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"",
-		    Tcl_GetString(objv[0]), "\", there are no file attributes"
-			     " in this filesystem.", (char *) NULL);
+	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
+		    "\", there are no file attributes in this filesystem.",
+		    NULL);
 	    goto end;
 	}
 
@@ -995,9 +1072,8 @@ TclFileAttrsCmd(interp, objc, objv)
 		"option", 0, &index) != TCL_OK) {
 	    goto end;
 	}
-	if (numObjStrings != -1 && objv[0]->typePtr != NULL
-		&& objv[0]->typePtr->freeIntRepProc != NULL) {
-	    objv[0]->typePtr->freeIntRepProc(objv[0]);
+	if (didAlloc) {
+	    TclFreeIntRep(objv[0]);
 	    objv[0]->typePtr = NULL;
 	}
 	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
@@ -1011,11 +1087,11 @@ TclFileAttrsCmd(interp, objc, objv)
 	 */
 
 	int i, index;
-        
+
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"",
-		    Tcl_GetString(objv[0]), "\", there are no file attributes"
-			     " in this filesystem.", (char *) NULL);
+	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
+		    "\", there are no file attributes in this filesystem.",
+		    NULL);
 	    goto end;
 	}
 
@@ -1024,15 +1100,13 @@ TclFileAttrsCmd(interp, objc, objv)
 		    "option", 0, &index) != TCL_OK) {
 		goto end;
     	    }
-	    if (numObjStrings != -1 && objv[i]->typePtr != NULL
-		    && objv[i]->typePtr->freeIntRepProc != NULL) {
-		objv[i]->typePtr->freeIntRepProc(objv[i]);
+	    if (didAlloc) {
+		TclFreeIntRep(objv[i]);
 		objv[i]->typePtr = NULL;
 	    }
 	    if (i + 1 == objc) {
 		Tcl_AppendResult(interp, "value for \"",
-			Tcl_GetString(objv[i]), "\" missing",
-			(char *) NULL);
+			TclGetString(objv[i]), "\" missing", NULL);
 		goto end;
 	    }
     	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
@@ -1043,17 +1117,29 @@ TclFileAttrsCmd(interp, objc, objv)
     }
     result = TCL_OK;
 
-    end:
-    if (numObjStrings != -1) {
-	/* Free up the array we allocated */
-	ckfree((char*)attributeStrings);
-	/* 
-	 * We don't need this object that was passed to us
-	 * any more.
+  end:
+    if (didAlloc) {
+	/*
+	 * Free up the array we allocated.
 	 */
-	if (objStrings != NULL) {
-	    Tcl_DecrRefCount(objStrings);
-	}
+
+	TclStackFree(interp, (void *)attributeStrings);
+    }
+
+    if (objStrings != NULL) {
+	/*
+	 * We don't need this object that was passed to us any more.
+	 */
+
+	Tcl_DecrRefCount(objStrings);
     }
     return result;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index bcaadd4..07757d9 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1,24 +1,23 @@
-/* 
+/*
  * tclFileName.c --
  *
- *	This file contains routines for converting file names betwen
- *	native and network form.
+ *	This file contains routines for converting file names betwen native
+ *	and network form.
  *
  * Copyright (c) 1995-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclRegexp.h"
+#include "tclFileSystem.h" /* For TclGetPathType() */
 
 /*
- * The following variable is set in the TclPlatformInit call to one
- * of: TCL_PLATFORM_UNIX, or TCL_PLATFORM_WINDOWS.
+ * The following variable is set in the TclPlatformInit call to one of:
+ * TCL_PLATFORM_UNIX or TCL_PLATFORM_WINDOWS.
  */
 
 TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
@@ -27,29 +26,60 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
  * Prototypes for local procedures defined in this file:
  */
 
-static CONST char *	DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *user, Tcl_DString *resultPtr));
-static CONST char *	ExtractWinRoot _ANSI_ARGS_((CONST char *path,
-			    Tcl_DString *resultPtr, int offset, 
-			    Tcl_PathType *typePtr));
-static int		SkipToChar _ANSI_ARGS_((char **stringPtr,
-			    char *match));
-static Tcl_Obj*		SplitWinPath _ANSI_ARGS_((CONST char *path));
-static Tcl_Obj*		SplitUnixPath _ANSI_ARGS_((CONST char *path));
+static const char *	DoTildeSubst(Tcl_Interp *interp,
+			    const char *user, Tcl_DString *resultPtr);
+static const char *	ExtractWinRoot(const char *path,
+			    Tcl_DString *resultPtr, int offset,
+			    Tcl_PathType *typePtr);
+static int		SkipToChar(char **stringPtr, int match);
+static Tcl_Obj *	SplitWinPath(const char *path);
+static Tcl_Obj *	SplitUnixPath(const char *path);
+static int		DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
+			    const char *separators, Tcl_Obj *pathPtr, int flags,
+			    char *pattern, Tcl_GlobTypeData *types);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetResultLength --
+ *
+ *	Resets the result DString for ExtractWinRoot to accommodate
+ *	any NT extended path prefixes.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May modify the Tcl_DString.
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetResultLength(
+    Tcl_DString *resultPtr,
+    int offset,
+    int extended)
+{
+    Tcl_DStringSetLength(resultPtr, offset);
+    if (extended == 2) {
+	Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
+    } else if (extended == 1) {
+	Tcl_DStringAppend(resultPtr, "//?/", 4);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * ExtractWinRoot --
  *
- *	Matches the root portion of a Windows path and appends it
- *	to the specified Tcl_DString.
- *	
+ *	Matches the root portion of a Windows path and appends it to the
+ *	specified Tcl_DString.
+ *
  * Results:
- *	Returns the position in the path immediately after the root
- *	including any trailing slashes.
- *	Appends a cleaned up version of the root to the Tcl_DString
- *	at the specified offest.
+ *	Returns the position in the path immediately after the root including
+ *	any trailing slashes. Appends a cleaned up version of the root to the
+ *	Tcl_DString at the specified offest.
  *
  * Side effects:
  *	Modifies the specified Tcl_DString.
@@ -57,59 +87,88 @@ static Tcl_Obj*		SplitUnixPath _ANSI_ARGS_((CONST char *path));
  *----------------------------------------------------------------------
  */
 
-static CONST char *
-ExtractWinRoot(path, resultPtr, offset, typePtr)
-    CONST char *path;		/* Path to parse. */
-    Tcl_DString *resultPtr;	/* Buffer to hold result. */
-    int offset;			/* Offset in buffer where result should be
+static const char *
+ExtractWinRoot(
+    const char *path,		/* Path to parse. */
+    Tcl_DString *resultPtr,	/* Buffer to hold result. */
+    int offset,			/* Offset in buffer where result should be
 				 * stored. */
-    Tcl_PathType *typePtr;	/* Where to store pathType result */
+    Tcl_PathType *typePtr)	/* Where to store pathType result */
 {
+    int extended = 0;
+
+    if (   (path[0] == '/' || path[0] == '\\')
+	&& (path[1] == '/' || path[1] == '\\')
+	&& (path[2] == '?')
+	&& (path[3] == '/' || path[3] == '\\')) {
+	extended = 1;
+	path = path + 4;
+	if (path[0] == 'U' && path[1] == 'N' && path[2] == 'C'
+	    && (path[3] == '/' || path[3] == '\\')) {
+	    extended = 2;
+	    path = path + 4;
+	}
+    }
+
     if (path[0] == '/' || path[0] == '\\') {
-	/* Might be a UNC or Vol-Relative path */
-	CONST char *host, *share, *tail;
+	/*
+	 * Might be a UNC or Vol-Relative path.
+	 */
+
+	const char *host, *share, *tail;
 	int hlen, slen;
+
 	if (path[1] != '/' && path[1] != '\\') {
-	    Tcl_DStringSetLength(resultPtr, offset);
+	    SetResultLength(resultPtr, offset, extended);
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
 	    Tcl_DStringAppend(resultPtr, "/", 1);
 	    return &path[1];
 	}
 	host = &path[2];
 
-	/* Skip separators */
-	while (host[0] == '/' || host[0] == '\\') host++;
+	/*
+	 * Skip separators.
+	 */
+
+	while (host[0] == '/' || host[0] == '\\') {
+	    host++;
+	}
 
 	for (hlen = 0; host[hlen];hlen++) {
-	    if (host[hlen] == '/' || host[hlen] == '\\')
+	    if (host[hlen] == '/' || host[hlen] == '\\') {
 		break;
+	    }
 	}
 	if (host[hlen] == 0 || host[hlen+1] == 0) {
-	    /* 
-	     * The path given is simply of the form 
-	     * '/foo', '//foo', '/////foo' or the same
-	     * with backslashes.  If there is exactly
-	     * one leading '/' the path is volume relative
-	     * (see filename man page).  If there are more
-	     * than one, we are simply assuming they
-	     * are superfluous and we trim them away.
-	     * (An alternative interpretation would
-	     * be that it is a host name, but we have
+	    /*
+	     * The path given is simply of the form '/foo', '//foo',
+	     * '/////foo' or the same with backslashes. If there is exactly
+	     * one leading '/' the path is volume relative (see filename man
+	     * page). If there are more than one, we are simply assuming they
+	     * are superfluous and we trim them away. (An alternative
+	     * interpretation would be that it is a host name, but we have
 	     * been documented that that is not the case).
 	     */
+
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
 	    Tcl_DStringAppend(resultPtr, "/", 1);
 	    return &path[2];
 	}
-	Tcl_DStringSetLength(resultPtr, offset);
+	SetResultLength(resultPtr, offset, extended);
 	share = &host[hlen];
 
-	/* Skip separators */
-	while (share[0] == '/' || share[0] == '\\') share++;
+	/*
+	 * Skip separators.
+	 */
+
+	while (share[0] == '/' || share[0] == '\\') {
+	    share++;
+	}
 
-	for (slen = 0; share[slen];slen++) {
-	    if (share[slen] == '/' || share[slen] == '\\')
+	for (slen=0; share[slen]; slen++) {
+	    if (share[slen] == '/' || share[slen] == '\\') {
 		break;
+	    }
 	}
 	Tcl_DStringAppend(resultPtr, "//", 2);
 	Tcl_DStringAppend(resultPtr, host, hlen);
@@ -118,24 +177,37 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
 
 	tail = &share[slen];
 
-	/* Skip separators */
-	while (tail[0] == '/' || tail[0] == '\\') tail++;
+	/*
+	 * Skip separators.
+	 */
+
+	while (tail[0] == '/' || tail[0] == '\\') {
+	    tail++;
+	}
 
 	*typePtr = TCL_PATH_ABSOLUTE;
 	return tail;
     } else if (*path && path[1] == ':') {
-	/* Might be a drive sep */
-	Tcl_DStringSetLength(resultPtr, offset);
+	/*
+	 * Might be a drive separator.
+	 */
+
+	SetResultLength(resultPtr, offset, extended);
 
 	if (path[2] != '/' && path[2] != '\\') {
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
 	    Tcl_DStringAppend(resultPtr, path, 2);
 	    return &path[2];
 	} else {
-	    char *tail = (char*)&path[3];
+	    const char *tail = &path[3];
 
-	    /* Skip separators */
-	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) tail++;
+	    /*
+	     * Skip separators.
+	     */
+
+	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) {
+		tail++;
+	    }
 
 	    *typePtr = TCL_PATH_ABSOLUTE;
 	    Tcl_DStringAppend(resultPtr, path, 2);
@@ -145,58 +217,90 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
 	}
     } else {
 	int abs = 0;
-	if ((path[0] == 'c' || path[0] == 'C') 
-	    && (path[1] == 'o' || path[1] == 'O')) {
+
+	/*
+	 * Check for Windows devices.
+	 */
+
+	if ((path[0] == 'c' || path[0] == 'C')
+		&& (path[1] == 'o' || path[1] == 'O')) {
 	    if ((path[2] == 'm' || path[2] == 'M')
-		&& path[3] >= '1' && path[3] <= '4') {
-		/* May have match for 'com[1-4]:?', which is a serial port */
+		    && path[3] >= '1' && path[3] <= '4') {
+		/*
+		 * May have match for 'com[1-4]:?', which is a serial port.
+		 */
+
 		if (path[4] == '\0') {
 		    abs = 4;
 		} else if (path [4] == ':' && path[5] == '\0') {
 		    abs = 5;
 		}
+
 	    } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
-		/* Have match for 'con' */
+		/*
+		 * Have match for 'con'.
+		 */
+
 		abs = 3;
 	    }
+
 	} else if ((path[0] == 'l' || path[0] == 'L')
-		   && (path[1] == 'p' || path[1] == 'P')
-		   && (path[2] == 't' || path[2] == 'T')) {
+		&& (path[1] == 'p' || path[1] == 'P')
+		&& (path[2] == 't' || path[2] == 'T')) {
 	    if (path[3] >= '1' && path[3] <= '3') {
-		/* May have match for 'lpt[1-3]:?' */
+		/*
+		 * May have match for 'lpt[1-3]:?'
+		 */
+
 		if (path[4] == '\0') {
 		    abs = 4;
 		} else if (path [4] == ':' && path[5] == '\0') {
 		    abs = 5;
 		}
 	    }
+
 	} else if ((path[0] == 'p' || path[0] == 'P')
-		   && (path[1] == 'r' || path[1] == 'R')
-		   && (path[2] == 'n' || path[2] == 'N')
-		   && path[3] == '\0') {
-	    /* Have match for 'prn' */
+		&& (path[1] == 'r' || path[1] == 'R')
+		&& (path[2] == 'n' || path[2] == 'N')
+		&& path[3] == '\0') {
+	    /*
+	     * Have match for 'prn'.
+	     */
 	    abs = 3;
+
 	} else if ((path[0] == 'n' || path[0] == 'N')
-		   && (path[1] == 'u' || path[1] == 'U')
-		   && (path[2] == 'l' || path[2] == 'L')
-		   && path[3] == '\0') {
-	    /* Have match for 'nul' */
+		&& (path[1] == 'u' || path[1] == 'U')
+		&& (path[2] == 'l' || path[2] == 'L')
+		&& path[3] == '\0') {
+	    /*
+	     * Have match for 'nul'.
+	     */
+
 	    abs = 3;
+
 	} else if ((path[0] == 'a' || path[0] == 'A')
-		   && (path[1] == 'u' || path[1] == 'U')
-		   && (path[2] == 'x' || path[2] == 'X')
-		   && path[3] == '\0') {
-	    /* Have match for 'aux' */
+		&& (path[1] == 'u' || path[1] == 'U')
+		&& (path[2] == 'x' || path[2] == 'X')
+		&& path[3] == '\0') {
+	    /*
+	     * Have match for 'aux'.
+	     */
+
 	    abs = 3;
 	}
+
 	if (abs != 0) {
 	    *typePtr = TCL_PATH_ABSOLUTE;
-	    Tcl_DStringSetLength(resultPtr, offset);
+	    SetResultLength(resultPtr, offset, extended);
 	    Tcl_DStringAppend(resultPtr, path, abs);
 	    return path + abs;
 	}
     }
-    /* Anything else is treated as relative */
+
+    /*
+     * Anything else is treated as relative.
+     */
+
     *typePtr = TCL_PATH_RELATIVE;
     return path;
 }
@@ -206,12 +310,12 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
  *
  * Tcl_GetPathType --
  *
- *	Determines whether a given path is relative to the current
- *	directory, relative to the current volume, or absolute.
- *	
- *	The objectified Tcl_FSGetPathType should be used in
- *	preference to this function (as you can see below, this
- *	is just a wrapper around that other function).
+ *	Determines whether a given path is relative to the current directory,
+ *	relative to the current volume, or absolute.
+ *
+ *	The objectified Tcl_FSGetPathType should be used in preference to this
+ *	function (as you can see below, this is just a wrapper around that
+ *	other function).
  *
  * Results:
  *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
@@ -224,11 +328,12 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
  */
 
 Tcl_PathType
-Tcl_GetPathType(path)
-    CONST char *path;
+Tcl_GetPathType(
+    const char *path)
 {
     Tcl_PathType type;
     Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
+
     Tcl_IncrRefCount(tempObj);
     type = Tcl_FSGetPathType(tempObj);
     Tcl_DecrRefCount(tempObj);
@@ -240,12 +345,18 @@ Tcl_GetPathType(path)
  *
  * TclpGetNativePathType --
  *
- *	Determines whether a given path is relative to the current
- *	directory, relative to the current volume, or absolute, but
- *	ONLY FOR THE NATIVE FILESYSTEM. This function is called from
- *	tclIOUtil.c (but needs to be here due to its dependence on
- *	static variables/functions in this file).  The exported
- *	function Tcl_FSGetPathType should be used by extensions.
+ *	Determines whether a given path is relative to the current directory,
+ *	relative to the current volume, or absolute, but ONLY FOR THE NATIVE
+ *	FILESYSTEM. This function is called from tclIOUtil.c (but needs to be
+ *	here due to its dependence on static variables/functions in this
+ *	file). The exported function Tcl_FSGetPathType should be used by
+ *	extensions.
+ *
+ *	Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even
+ *	though expanding the '~' could lead to any possible path type. This
+ *	function should therefore be considered a low-level, string
+ *	manipulation function only -- it doesn't actually do any expansion in
+ *	making its determination.
  *
  * Results:
  *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
@@ -258,22 +369,24 @@ Tcl_GetPathType(path)
  */
 
 Tcl_PathType
-TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
-    Tcl_Obj *pathObjPtr;
-    int *driveNameLengthPtr;
-    Tcl_Obj **driveNameRef;
+TclpGetNativePathType(
+    Tcl_Obj *pathPtr,		/* Native path of interest */
+    int *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
+				 * path was absolute */
+    Tcl_Obj **driveNameRef)
 {
     Tcl_PathType type = TCL_PATH_ABSOLUTE;
     int pathLen;
-    char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
-    
+    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+
     if (path[0] == '~') {
-	/* 
-	 * This case is common to all platforms.
-	 * Paths that begin with ~ are absolute.
+	/*
+	 * This case is common to all platforms. Paths that begin with ~ are
+	 * absolute.
 	 */
+
 	if (driveNameLengthPtr != NULL) {
-	    char *end = path + 1;
+	    const char *end = path + 1;
 	    while ((*end != '\0') && (*end != '/')) {
 		end++;
 	    }
@@ -281,56 +394,66 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
 	}
     } else {
 	switch (tclPlatform) {
-	    case TCL_PLATFORM_UNIX: {
-		char *origPath = path;
-	        
-		/*
-		 * Paths that begin with / are absolute.
-		 */
+	case TCL_PLATFORM_UNIX: {
+	    const char *origPath = path;
 
-#ifdef __QNX__
+	    /*
+	     * Paths that begin with / are absolute.
+	     */
+
+	    if (path[0] == '/') {
+		++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
 		/*
-		 * Check for QNX //<node id> prefix
+		 * Check for "//" network path prefix
 		 */
-		if (*path && (pathLen > 3) && (path[0] == '/') 
-		  && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
-		    path += 3;
-		    while (isdigit(UCHAR(*path))) {
+		if ((*path == '/') && path[1] && (path[1] != '/')) {
+		    path += 2;
+		    while (*path && *path != '/') {
 			++path;
 		    }
+#if defined(__CYGWIN__)
+		    /* UNC paths need to be followed by a share name */
+		    if (*path++ && (*path && *path != '/')) {
+			++path;
+			while (*path && *path != '/') {
+			    ++path;
+			}
+		    } else {
+			path = origPath + 1;
+		    }
+#endif
 		}
 #endif
-		if (path[0] == '/') {
-		    if (driveNameLengthPtr != NULL) {
-			/* 
-			 * We need this addition in case the QNX code 
-			 * was used 
-			 */
-			*driveNameLengthPtr = (1 + path - origPath);
-		    }
-		} else {
-		    type = TCL_PATH_RELATIVE;
+		if (driveNameLengthPtr != NULL) {
+		    /*
+		     * We need this addition in case the QNX or Cygwin code was used.
+		     */
+
+		    *driveNameLengthPtr = (path - origPath);
 		}
-		break;
+	    } else {
+		type = TCL_PATH_RELATIVE;
 	    }
-	    
-	    case TCL_PLATFORM_WINDOWS: {
-		Tcl_DString ds;
-		CONST char *rootEnd;
-		
-		Tcl_DStringInit(&ds);
-		rootEnd = ExtractWinRoot(path, &ds, 0, &type);
-		if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
-		    *driveNameLengthPtr = rootEnd - path;
-		    if (driveNameRef != NULL) {
-			*driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
-				Tcl_DStringLength(&ds));
-			Tcl_IncrRefCount(*driveNameRef);
-		    }
+	    break;
+	}
+	case TCL_PLATFORM_WINDOWS: {
+	    Tcl_DString ds;
+	    const char *rootEnd;
+
+	    Tcl_DStringInit(&ds);
+	    rootEnd = ExtractWinRoot(path, &ds, 0, &type);
+	    if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
+		*driveNameLengthPtr = rootEnd - path;
+		if (driveNameRef != NULL) {
+		    *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+			    Tcl_DStringLength(&ds));
+		    Tcl_IncrRefCount(*driveNameRef);
 		}
-		Tcl_DStringFree(&ds);
-		break;
 	    }
+	    Tcl_DStringFree(&ds);
+	    break;
+	}
 	}
     }
     return type;
@@ -341,18 +464,17 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
  *
  * TclpNativeSplitPath --
  *
- *      This function takes the given Tcl_Obj, which should be a valid
- *      path, and returns a Tcl List object containing each segment
- *      of that path as an element.
+ *	This function takes the given Tcl_Obj, which should be a valid path,
+ *	and returns a Tcl List object containing each segment of that path as
+ *	an element.
+ *
+ *	Note this function currently calls the older Split(Plat)Path
+ *	functions, which require more memory allocation than is desirable.
  *
- *      Note this function currently calls the older Split(Plat)Path
- *      functions, which require more memory allocation than is
- *      desirable.
- *      
  * Results:
- *      Returns list object with refCount of zero.  If the passed in
- *      lenPtr is non-NULL, we use it to return the number of elements
- *      in the returned list.
+ *	Returns list object with refCount of zero. If the passed in lenPtr is
+ *	non-NULL, we use it to return the number of elements in the returned
+ *	list.
  *
  * Side effects:
  *	None.
@@ -360,26 +482,25 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj* 
-TclpNativeSplitPath(pathPtr, lenPtr)
-    Tcl_Obj *pathPtr;		/* Path to split. */
-    int *lenPtr;		/* int to store number of path elements. */
+Tcl_Obj *
+TclpNativeSplitPath(
+    Tcl_Obj *pathPtr,		/* Path to split. */
+    int *lenPtr)		/* int to store number of path elements. */
 {
-    Tcl_Obj *resultPtr = NULL;  /* Needed only to prevent gcc warnings. */
+    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
 
     /*
-     * Perform platform specific splitting. 
+     * Perform platform specific splitting.
      */
 
     switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
-	    break;
+    case TCL_PLATFORM_UNIX:
+	resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
+	break;
 
-	case TCL_PLATFORM_WINDOWS:
-	    resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
-	    break;
-	    
+    case TCL_PLATFORM_WINDOWS:
+	resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
+	break;
     }
 
     /*
@@ -397,20 +518,19 @@ TclpNativeSplitPath(pathPtr, lenPtr)
  *
  * Tcl_SplitPath --
  *
- *	Split a path into a list of path components.  The first element
- *	of the list will have the same path type as the original path.
+ *	Split a path into a list of path components. The first element of the
+ *	list will have the same path type as the original path.
  *
  * Results:
- *	Returns a standard Tcl result.  The interpreter result contains
- *	a list of path components.
- *	*argvPtr will be filled in with the address of an array
- *	whose elements point to the elements of path, in order.
- *	*argcPtr will get filled in with the number of valid elements
- *	in the array.  A single block of memory is dynamically allocated
- *	to hold both the argv array and a copy of the path elements.
- *	The caller must eventually free this memory by calling ckfree()
- *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
- *	if the procedure returns normally.
+ *	Returns a standard Tcl result. The interpreter result contains a list
+ *	of path components. *argvPtr will be filled in with the address of an
+ *	array whose elements point to the elements of path, in order.
+ *	*argcPtr will get filled in with the number of valid elements in the
+ *	array. A single block of memory is dynamically allocated to hold both
+ *	the argv array and a copy of the path elements. The caller must
+ *	eventually free this memory by calling ckfree() on *argvPtr. Note:
+ *	*argvPtr and *argcPtr are only modified if the procedure returns
+ *	normally.
  *
  * Side effects:
  *	Allocates memory.
@@ -419,17 +539,18 @@ TclpNativeSplitPath(pathPtr, lenPtr)
  */
 
 void
-Tcl_SplitPath(path, argcPtr, argvPtr)
-    CONST char *path;		/* Pointer to string containing a path. */
-    int *argcPtr;		/* Pointer to location to fill in with
-				 * the number of elements in the path. */
-    CONST char ***argvPtr;	/* Pointer to place to store pointer to array
+Tcl_SplitPath(
+    const char *path,		/* Pointer to string containing a path. */
+    int *argcPtr,		/* Pointer to location to fill in with the
+				 * number of elements in the path. */
+    const char ***argvPtr)	/* Pointer to place to store pointer to array
 				 * of pointers to path elements. */
 {
-    Tcl_Obj *resultPtr = NULL;  /* Needed only to prevent gcc warnings. */
+    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
     Tcl_Obj *tmpPtr, *eltPtr;
     int i, size, len;
-    char *p, *str;
+    char *p;
+    const char *str;
 
     /*
      * Perform the splitting, using objectified, vfs-aware code.
@@ -438,38 +559,41 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
     tmpPtr = Tcl_NewStringObj(path, -1);
     Tcl_IncrRefCount(tmpPtr);
     resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
+    Tcl_IncrRefCount(resultPtr);
     Tcl_DecrRefCount(tmpPtr);
 
-    /* Calculate space required for the result */
-    
+    /*
+     * Calculate space required for the result.
+     */
+
     size = 1;
     for (i = 0; i < *argcPtr; i++) {
 	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
 	Tcl_GetStringFromObj(eltPtr, &len);
 	size += len + 1;
     }
-    
+
     /*
-     * Allocate a buffer large enough to hold the contents of all of
-     * the list plus the argv pointers and the terminating NULL pointer.
+     * Allocate a buffer large enough to hold the contents of all of the list
+     * plus the argv pointers and the terminating NULL pointer.
      */
 
-    *argvPtr = (CONST char **) ckalloc((unsigned)
+    *argvPtr = (const char **) ckalloc((unsigned)
 	    ((((*argcPtr) + 1) * sizeof(char *)) + size));
 
     /*
-     * Position p after the last argv pointer and copy the contents of
-     * the list in, piece by piece.
+     * Position p after the last argv pointer and copy the contents of the
+     * list in, piece by piece.
      */
 
     p = (char *) &(*argvPtr)[(*argcPtr) + 1];
     for (i = 0; i < *argcPtr; i++) {
 	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
 	str = Tcl_GetStringFromObj(eltPtr, &len);
-	memcpy((VOID *) p, (VOID *) str, (size_t) len+1);
+	memcpy(p, str, (size_t) len+1);
 	p += len+1;
     }
-    
+
     /*
      * Now set up the argv pointers.
      */
@@ -478,7 +602,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
 
     for (i = 0; i < *argcPtr; i++) {
 	(*argvPtr)[i] = p;
-	while ((*p++) != '\0') {}
+	for (; *(p++)!='\0'; );
     }
     (*argvPtr)[i] = NULL;
 
@@ -494,8 +618,8 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
  *
  * SplitUnixPath --
  *
- *	This routine is used by Tcl_(FS)SplitPath to handle splitting
- *	Unix paths.
+ *	This routine is used by Tcl_(FS)SplitPath to handle splitting Unix
+ *	paths.
  *
  * Results:
  *	Returns a newly allocated Tcl list object.
@@ -506,74 +630,85 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj*
-SplitUnixPath(path)
-    CONST char *path;		/* Pointer to string containing a path. */
+static Tcl_Obj *
+SplitUnixPath(
+    const char *path)		/* Pointer to string containing a path. */
 {
     int length;
-    CONST char *p, *elementStart;
+    const char *origPath = path, *elementStart;
     Tcl_Obj *result = Tcl_NewObj();
 
     /*
      * Deal with the root directory as a special case.
      */
 
-#ifdef __QNX__
-    /*
-     * Check for QNX //<node id> prefix
-     */
-    if ((path[0] == '/') && (path[1] == '/')
-	    && isdigit(UCHAR(path[2]))) { /* INTL: digit */
-	path += 3;
-	while (isdigit(UCHAR(*path))) { /* INTL: digit */
-	    ++path;
+    if (*path == '/') {
+	Tcl_Obj *rootElt;
+	++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
+	/*
+	 * Check for "//" network path prefix
+	 */
+	if ((*path == '/') && path[1] && (path[1] != '/')) {
+	    path += 2;
+	    while (*path && *path != '/') {
+		++path;
+	    }
+#if defined(__CYGWIN__)
+	    /* UNC paths need to be followed by a share name */
+	    if (*path++ && (*path && *path != '/')) {
+		++path;
+		while (*path && *path != '/') {
+		    ++path;
+		}
+	    } else {
+		path = origPath + 1;
+	    }
+#endif
 	}
-    }
 #endif
-
-    if (path[0] == '/') {
-	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
-	p = path+1;
-    } else {
-	p = path;
+	rootElt = Tcl_NewStringObj(origPath, path - origPath);
+	Tcl_ListObjAppendElement(NULL, result, rootElt);
+	while (*path == '/') {
+	    ++path;
+	}
     }
 
     /*
-     * Split on slashes.  Embedded elements that start with tilde will be
+     * Split on slashes. Embedded elements that start with tilde will be
      * prefixed with "./" so they are not affected by tilde substitution.
      */
 
     for (;;) {
-	elementStart = p;
-	while ((*p != '\0') && (*p != '/')) {
-	    p++;
+	elementStart = path;
+	while ((*path != '\0') && (*path != '/')) {
+	    path++;
 	}
-	length = p - elementStart;
+	length = path - elementStart;
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
-	    if ((elementStart[0] == '~') && (elementStart != path)) {
-		nextElt = Tcl_NewStringObj("./",2);
+	    if ((elementStart[0] == '~') && (elementStart != origPath)) {
+		TclNewLiteralStringObj(nextElt, "./");
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
 	    }
 	    Tcl_ListObjAppendElement(NULL, result, nextElt);
 	}
-	if (*p++ == '\0') {
+	if (*path++ == '\0') {
 	    break;
 	}
     }
     return result;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * SplitWinPath --
  *
- *	This routine is used by Tcl_(FS)SplitPath to handle splitting
- *	Windows paths.
+ *	This routine is used by Tcl_(FS)SplitPath to handle splitting Windows
+ *	paths.
  *
  * Results:
  *	Returns a newly allocated Tcl list object.
@@ -584,17 +719,17 @@ SplitUnixPath(path)
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj*
-SplitWinPath(path)
-    CONST char *path;		/* Pointer to string containing a path. */
+static Tcl_Obj *
+SplitWinPath(
+    const char *path)		/* Pointer to string containing a path. */
 {
     int length;
-    CONST char *p, *elementStart;
+    const char *p, *elementStart;
     Tcl_PathType type = TCL_PATH_ABSOLUTE;
     Tcl_DString buf;
     Tcl_Obj *result = Tcl_NewObj();
     Tcl_DStringInit(&buf);
-    
+
     p = ExtractWinRoot(path, &buf, 0, &type);
 
     /*
@@ -602,16 +737,15 @@ SplitWinPath(path)
      */
 
     if (p != path) {
-	Tcl_ListObjAppendElement(NULL, result, 
-				 Tcl_NewStringObj(Tcl_DStringValue(&buf), 
-						  Tcl_DStringLength(&buf)));
+	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
+		Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
     }
     Tcl_DStringFree(&buf);
-    
+
     /*
-     * Split on slashes.  Embedded elements that start with tilde 
-     * or a drive letter will be prefixed with "./" so they are not 
-     * affected by tilde substitution.
+     * Split on slashes. Embedded elements that start with tilde or a drive
+     * letter will be prefixed with "./" so they are not affected by tilde
+     * substitution.
      */
 
     do {
@@ -622,11 +756,10 @@ SplitWinPath(path)
 	length = p - elementStart;
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
-	    if ((elementStart != path)
-		&& ((elementStart[0] == '~')
+	    if ((elementStart != path) && ((elementStart[0] == '~')
 		    || (isalpha(UCHAR(elementStart[0]))
 			&& elementStart[1] == ':'))) {
-		nextElt = Tcl_NewStringObj("./",2);
+		TclNewLiteralStringObj(nextElt, "./");
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
@@ -643,12 +776,17 @@ SplitWinPath(path)
  *
  * Tcl_FSJoinToPath --
  *
- *      This function takes the given object, which should usually be a
- *      valid path or NULL, and joins onto it the array of paths
- *      segments given.
+ *	This function takes the given object, which should usually be a valid
+ *	path or NULL, and joins onto it the array of paths segments given.
+ *
+ *	The objects in the array given will temporarily have their refCount
+ *	increased by one, and then decreased by one when this function exits
+ *	(which means if they had zero refCount when we were called, they will
+ *	be freed).
  *
  * Results:
- *      Returns object with refCount of zero
+ *	Returns object owned by the caller (which should increment its
+ *	refCount) - typically an object with refCount of zero.
  *
  * Side effects:
  *	None.
@@ -656,26 +794,37 @@ SplitWinPath(path)
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj* 
-Tcl_FSJoinToPath(basePtr, objc, objv)
-    Tcl_Obj *basePtr;
-    int objc;
-    Tcl_Obj *CONST objv[];
+Tcl_Obj *
+Tcl_FSJoinToPath(
+    Tcl_Obj *pathPtr,		/* Valid path or NULL. */
+    int objc,			/* Number of array elements to join */
+    Tcl_Obj *const objv[])	/* Path elements to join. */
 {
     int i;
     Tcl_Obj *lobj, *ret;
 
-    if (basePtr == NULL) {
+    if (pathPtr == NULL) {
 	lobj = Tcl_NewListObj(0, NULL);
     } else {
-	lobj = Tcl_NewListObj(1, &basePtr);
+	lobj = Tcl_NewListObj(1, &pathPtr);
     }
-    
+
     for (i = 0; i<objc;i++) {
 	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
     }
     ret = Tcl_FSJoinPath(lobj, -1);
+
+    /*
+     * It is possible that 'ret' is just a member of the list and is therefore
+     * going to be freed here. Therefore we must adjust the refCount manually.
+     * (It would be better if we changed the documentation of this function
+     * and Tcl_FSJoinPath so that the returned object already has a refCount
+     * for the caller, hence avoiding these subtleties (and code ugliness)).
+     */
+
+    Tcl_IncrRefCount(ret);
     Tcl_DecrRefCount(lobj);
+    ret->refCount--;
     return ret;
 }
 
@@ -684,10 +833,10 @@ Tcl_FSJoinToPath(basePtr, objc, objv)
  *
  * TclpNativeJoinPath --
  *
- *      'prefix' is absolute, 'joining' is relative to prefix.
+ *	'prefix' is absolute, 'joining' is relative to prefix.
  *
  * Results:
- *      modifies prefix
+ *	modifies prefix
  *
  * Side effects:
  *	None.
@@ -696,28 +845,28 @@ Tcl_FSJoinToPath(basePtr, objc, objv)
  */
 
 void
-TclpNativeJoinPath(prefix, joining)
-    Tcl_Obj *prefix;
-    char* joining;
+TclpNativeJoinPath(
+    Tcl_Obj *prefix,
+    const char *joining)
 {
     int length, needsSep;
-    char *dest, *p, *start;
-    
+    char *dest;
+    const char *p;
+    const char *start;
+
     start = Tcl_GetStringFromObj(prefix, &length);
 
     /*
-     * Remove the ./ from tilde prefixed elements, and drive-letter
-     * prefixed elements on Windows, unless it is the first component.
+     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
+     * elements on Windows, unless it is the first component.
      */
-    
+
     p = joining;
-    
+
     if (length != 0) {
-	if ((p[0] == '.') && (p[1] == '/')
-	    && ((p[2] == '~')
-		|| ((tclPlatform == TCL_PLATFORM_WINDOWS)
-		    && isalpha(UCHAR(p[2]))
-		    && (p[3] == ':')))) {
+	if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~')
+		|| (tclPlatform==TCL_PLATFORM_WINDOWS && isalpha(UCHAR(p[2]))
+		&& (p[3] == ':')))) {
 	    p += 2;
 	}
     }
@@ -726,80 +875,75 @@ TclpNativeJoinPath(prefix, joining)
     }
 
     switch (tclPlatform) {
-        case TCL_PLATFORM_UNIX:
-	    /*
-	     * Append a separator if needed.
-	     */
+    case TCL_PLATFORM_UNIX:
+	/*
+	 * Append a separator if needed.
+	 */
 
-	    if (length > 0 && (start[length-1] != '/')) {
-		Tcl_AppendToObj(prefix, "/", 1);
-		Tcl_GetStringFromObj(prefix, &length);
-	    }
-	    needsSep = 0;
-	    
-	    /*
-	     * Append the element, eliminating duplicate and trailing
-	     * slashes.
-	     */
+	if (length > 0 && (start[length-1] != '/')) {
+	    Tcl_AppendToObj(prefix, "/", 1);
+	    Tcl_GetStringFromObj(prefix, &length);
+	}
+	needsSep = 0;
 
-	    Tcl_SetObjLength(prefix, length + (int) strlen(p));
-	    
-	    dest = Tcl_GetString(prefix) + length;
-	    for (; *p != '\0'; p++) {
-		if (*p == '/') {
-		    while (p[1] == '/') {
-			p++;
-		    }
-		    if (p[1] != '\0') {
-			if (needsSep) {
-			    *dest++ = '/';
-			}
-		    }
-		} else {
-		    *dest++ = *p;
-		    needsSep = 1;
+	/*
+	 * Append the element, eliminating duplicate and trailing slashes.
+	 */
+
+	Tcl_SetObjLength(prefix, length + (int) strlen(p));
+
+	dest = Tcl_GetString(prefix) + length;
+	for (; *p != '\0'; p++) {
+	    if (*p == '/') {
+		while (p[1] == '/') {
+		    p++;
+		}
+		if (p[1] != '\0' && needsSep) {
+		    *dest++ = '/';
 		}
+	    } else {
+		*dest++ = *p;
+		needsSep = 1;
 	    }
-	    length = dest - Tcl_GetString(prefix);
-	    Tcl_SetObjLength(prefix, length);
-	    break;
+	}
+	length = dest - Tcl_GetString(prefix);
+	Tcl_SetObjLength(prefix, length);
+	break;
 
-	case TCL_PLATFORM_WINDOWS:
-	    /*
-	     * Check to see if we need to append a separator.
-	     */
+    case TCL_PLATFORM_WINDOWS:
+	/*
+	 * Check to see if we need to append a separator.
+	 */
 
-	    if ((length > 0) && 
+	if ((length > 0) &&
 		(start[length-1] != '/') && (start[length-1] != ':')) {
-		Tcl_AppendToObj(prefix, "/", 1);
-		Tcl_GetStringFromObj(prefix, &length);
-	    }
-	    needsSep = 0;
-	    
-	    /*
-	     * Append the element, eliminating duplicate and
-	     * trailing slashes.
-	     */
+	    Tcl_AppendToObj(prefix, "/", 1);
+	    Tcl_GetStringFromObj(prefix, &length);
+	}
+	needsSep = 0;
 
-	    Tcl_SetObjLength(prefix, length + (int) strlen(p));
-	    dest = Tcl_GetString(prefix) + length;
-	    for (; *p != '\0'; p++) {
-		if ((*p == '/') || (*p == '\\')) {
-		    while ((p[1] == '/') || (p[1] == '\\')) {
-			p++;
-		    }
-		    if ((p[1] != '\0') && needsSep) {
-			*dest++ = '/';
-		    }
-		} else {
-		    *dest++ = *p;
-		    needsSep = 1;
+	/*
+	 * Append the element, eliminating duplicate and trailing slashes.
+	 */
+
+	Tcl_SetObjLength(prefix, length + (int) strlen(p));
+	dest = Tcl_GetString(prefix) + length;
+	for (; *p != '\0'; p++) {
+	    if ((*p == '/') || (*p == '\\')) {
+		while ((p[1] == '/') || (p[1] == '\\')) {
+		    p++;
+		}
+		if ((p[1] != '\0') && needsSep) {
+		    *dest++ = '/';
 		}
+	    } else {
+		*dest++ = *p;
+		needsSep = 1;
 	    }
-	    length = dest - Tcl_GetString(prefix);
-	    Tcl_SetObjLength(prefix, length);
-	    break;
-
+	}
+	length = dest - Tcl_GetString(prefix);
+	Tcl_SetObjLength(prefix, length);
+	break;
     }
     return;
 }
@@ -809,14 +953,13 @@ TclpNativeJoinPath(prefix, joining)
  *
  * Tcl_JoinPath --
  *
- *	Combine a list of paths in a platform specific manner.  The
- *	function 'Tcl_FSJoinPath' should be used in preference where
- *	possible.
+ *	Combine a list of paths in a platform specific manner. The function
+ *	'Tcl_FSJoinPath' should be used in preference where possible.
  *
  * Results:
- *	Appends the joined path to the end of the specified 
- *	Tcl_DString returning a pointer to the resulting string.  Note
- *	that the Tcl_DString must already be initialized.
+ *	Appends the joined path to the end of the specified Tcl_DString
+ *	returning a pointer to the resulting string. Note that the
+ *	Tcl_DString must already be initialized.
  *
  * Side effects:
  *	Modifies the Tcl_DString.
@@ -825,34 +968,46 @@ TclpNativeJoinPath(prefix, joining)
  */
 
 char *
-Tcl_JoinPath(argc, argv, resultPtr)
-    int argc;
-    CONST char * CONST *argv;
-    Tcl_DString *resultPtr;	/* Pointer to previously initialized DString */
+Tcl_JoinPath(
+    int argc,
+    const char *const *argv,
+    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
 {
     int i, len;
     Tcl_Obj *listObj = Tcl_NewObj();
     Tcl_Obj *resultObj;
-    char *resultStr;
+    const char *resultStr;
+
+    /*
+     * Build the list of paths.
+     */
 
-    /* Build the list of paths */
     for (i = 0; i < argc; i++) {
-        Tcl_ListObjAppendElement(NULL, listObj,
+	Tcl_ListObjAppendElement(NULL, listObj,
 		Tcl_NewStringObj(argv[i], -1));
     }
 
-    /* Ask the objectified code to join the paths */
+    /*
+     * Ask the objectified code to join the paths.
+     */
+
     Tcl_IncrRefCount(listObj);
     resultObj = Tcl_FSJoinPath(listObj, argc);
     Tcl_IncrRefCount(resultObj);
     Tcl_DecrRefCount(listObj);
 
-    /* Store the result */
+    /*
+     * Store the result.
+     */
+
     resultStr = Tcl_GetStringFromObj(resultObj, &len);
     Tcl_DStringAppend(resultPtr, resultStr, len);
     Tcl_DecrRefCount(resultObj);
 
-    /* Return a pointer to the result */
+    /*
+     * Return a pointer to the result.
+     */
+
     return Tcl_DStringValue(resultPtr);
 }
 
@@ -862,19 +1017,19 @@ Tcl_JoinPath(argc, argv, resultPtr)
  * Tcl_TranslateFileName --
  *
  *	Converts a file name into a form usable by the native system
- *	interfaces.  If the name starts with a tilde, it will produce a
- *	name where the tilde and following characters have been replaced
- *	by the home directory location for the named user.
+ *	interfaces. If the name starts with a tilde, it will produce a name
+ *	where the tilde and following characters have been replaced by the
+ *	home directory location for the named user.
  *
  * Results:
- *	The return value is a pointer to a string containing the name
- *	after tilde substitution.  If there was no tilde substitution,
- *	the return value is a pointer to a copy of the original string.
- *	If there was an error in processing the name, then an error
- *	message is left in the interp's result (if interp was not NULL)
- *	and the return value is NULL.  Space for the return value is
- *	allocated in bufferPtr; the caller must call Tcl_DStringFree()
- *	to free the space if the return value was not NULL.
+ *	The return value is a pointer to a string containing the name after
+ *	tilde substitution. If there was no tilde substitution, the return
+ *	value is a pointer to a copy of the original string. If there was an
+ *	error in processing the name, then an error message is left in the
+ *	interp's result (if interp was not NULL) and the return value is NULL.
+ *	Space for the return value is allocated in bufferPtr; the caller must
+ *	call Tcl_DStringFree() to free the space if the return value was not
+ *	NULL.
  *
  * Side effects:
  *	None.
@@ -883,15 +1038,15 @@ Tcl_JoinPath(argc, argv, resultPtr)
  */
 
 char *
-Tcl_TranslateFileName(interp, name, bufferPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to store error
-				 * message (if necessary). */
-    CONST char *name;		/* File name, which may begin with "~" (to
+Tcl_TranslateFileName(
+    Tcl_Interp *interp,		/* Interpreter in which to store error message
+				 * (if necessary). */
+    const char *name,		/* File name, which may begin with "~" (to
 				 * indicate current user's home directory) or
 				 * "~<user>" (to indicate any user's home
 				 * directory). */
-    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
-				 * with name after tilde substitution. */
+    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
+				 * name after tilde substitution. */
 {
     Tcl_Obj *path = Tcl_NewStringObj(name, -1);
     Tcl_Obj *transPtr;
@@ -902,15 +1057,15 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
 	Tcl_DecrRefCount(path);
 	return NULL;
     }
-    
+
     Tcl_DStringInit(bufferPtr);
     Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
     Tcl_DecrRefCount(path);
     Tcl_DecrRefCount(transPtr);
-    
+
     /*
-     * Convert forward slashes to backslashes in Windows paths because
-     * some system interfaces don't accept forward slashes.
+     * Convert forward slashes to backslashes in Windows paths because some
+     * system interfaces don't accept forward slashes.
      */
 
     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
@@ -921,6 +1076,7 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
 	    }
 	}
     }
+
     return Tcl_DStringValue(bufferPtr);
 }
 
@@ -929,12 +1085,12 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
  *
  * TclGetExtension --
  *
- *	This function returns a pointer to the beginning of the
- *	extension part of a file name.
+ *	This function returns a pointer to the beginning of the extension part
+ *	of a file name.
  *
  * Results:
  *	Returns a pointer into name which indicates where the extension
- *	starts.  If there is no extension, returns NULL.
+ *	starts. If there is no extension, returns NULL.
  *
  * Side effects:
  *	None.
@@ -942,11 +1098,11 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
  *----------------------------------------------------------------------
  */
 
-char *
-TclGetExtension(name)
-    char *name;			/* File name to parse. */
+const char *
+TclGetExtension(
+    const char *name)		/* File name to parse. */
 {
-    char *p, *lastSep;
+    const char *p, *lastSep;
 
     /*
      * First find the last directory separator.
@@ -954,18 +1110,18 @@ TclGetExtension(name)
 
     lastSep = NULL;		/* Needed only to prevent gcc warnings. */
     switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    lastSep = strrchr(name, '/');
-	    break;
-
-	case TCL_PLATFORM_WINDOWS:
-	    lastSep = NULL;
-	    for (p = name; *p != '\0'; p++) {
-		if (strchr("/\\:", *p) != NULL) {
-		    lastSep = p;
-		}
+    case TCL_PLATFORM_UNIX:
+	lastSep = strrchr(name, '/');
+	break;
+
+    case TCL_PLATFORM_WINDOWS:
+	lastSep = NULL;
+	for (p = name; *p != '\0'; p++) {
+	    if (strchr("/\\:", *p) != NULL) {
+		lastSep = p;
 	    }
-	    break;
+	}
+	break;
     }
     p = strrchr(name, '.');
     if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) {
@@ -974,7 +1130,7 @@ TclGetExtension(name)
 
     /*
      * In earlier versions, we used to back up to the first period in a series
-     * so that "foo..o" would be split into "foo" and "..o".  This is a
+     * so that "foo..o" would be split into "foo" and "..o". This is a
      * confusing and usually incorrect behavior, so now we split at the last
      * period in the name.
      */
@@ -992,11 +1148,10 @@ TclGetExtension(name)
  *
  * Results:
  *	The result is a pointer to a static string containing the home
- *	directory in native format.  If there was an error in processing
- *	the substitution, then an error message is left in the interp's
- *	result and the return value is NULL.  On success, the results
- *	are appended to resultPtr, and the contents of resultPtr are
- *	returned.
+ *	directory in native format. If there was an error in processing the
+ *	substitution, then an error message is left in the interp's result and
+ *	the return value is NULL. On success, the results are appended to
+ *	resultPtr, and the contents of resultPtr are returned.
  *
  * Side effects:
  *	Information may be left in resultPtr.
@@ -1004,40 +1159,38 @@ TclGetExtension(name)
  *----------------------------------------------------------------------
  */
 
-static CONST char *
-DoTildeSubst(interp, user, resultPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to store error
-				 * message (if necessary). */
-    CONST char *user;		/* Name of user whose home directory should be
+static const char *
+DoTildeSubst(
+    Tcl_Interp *interp,		/* Interpreter in which to store error message
+				 * (if necessary). */
+    const char *user,		/* Name of user whose home directory should be
 				 * substituted, or "" for current user. */
-    Tcl_DString *resultPtr;	/* Initialized DString filled with name
-				 * after tilde substitution. */
+    Tcl_DString *resultPtr)	/* Initialized DString filled with name after
+				 * tilde substitution. */
 {
-    CONST char *dir;
+    const char *dir;
 
     if (*user == '\0') {
 	Tcl_DString dirString;
-	
+
 	dir = TclGetEnv("HOME", &dirString);
 	if (dir == NULL) {
 	    if (interp) {
 		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "couldn't find HOME environment ",
-			"variable to expand path", (char *) NULL);
+		Tcl_AppendResult(interp, "couldn't find HOME environment "
+			"variable to expand path", NULL);
 	    }
 	    return NULL;
 	}
 	Tcl_JoinPath(1, &dir, resultPtr);
 	Tcl_DStringFree(&dirString);
-    } else {
-	if (TclpGetUserHome(user, resultPtr) == NULL) {	
-	    if (interp) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
-			(char *) NULL);
-	    }
-	    return NULL;
+    } else if (TclpGetUserHome(user, resultPtr) == NULL) {
+	if (interp) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+		    NULL);
 	}
+	return NULL;
     }
     return Tcl_DStringValue(resultPtr);
 }
@@ -1047,8 +1200,8 @@ DoTildeSubst(interp, user, resultPtr)
  *
  * Tcl_GlobObjCmd --
  *
- *	This procedure is invoked to process the "glob" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "glob" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1061,23 +1214,24 @@ DoTildeSubst(interp, user, resultPtr)
 
 	/* ARGSUSED */
 int
-Tcl_GlobObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_GlobObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int index, i, globFlags, length, join, dir, result;
-    char *string, *separators;
+    char *string;
+    const char *separators;
     Tcl_Obj *typePtr, *resultPtr, *look;
     Tcl_Obj *pathOrDir = NULL;
     Tcl_DString prefix;
-    static CONST char *options[] = {
-	"-directory", "-join", "-nocomplain", "-path", "-tails", 
+    static const char *options[] = {
+	"-directory", "-join", "-nocomplain", "-path", "-tails",
 	"-types", "--", NULL
     };
     enum options {
-	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, 
+	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
 	GLOB_TYPE, GLOB_LAST
     };
     enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
@@ -1088,156 +1242,180 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
     dir = PATH_NONE;
     typePtr = NULL;
     for (i = 1; i < objc; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
-		!= TCL_OK) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		&index) != TCL_OK) {
 	    string = Tcl_GetStringFromObj(objv[i], &length);
 	    if (string[0] == '-') {
 		/*
-		 * It looks like the command contains an option so signal
-		 * an error
+		 * It looks like the command contains an option so signal an
+		 * error.
 		 */
+
 		return TCL_ERROR;
 	    } else {
 		/*
-		 * This clearly isn't an option; assume it's the first
-		 * glob pattern.  We must clear the error
+		 * This clearly isn't an option; assume it's the first glob
+		 * pattern. We must clear the error.
 		 */
+
 		Tcl_ResetResult(interp);
 		break;
 	    }
 	}
+
 	switch (index) {
-	    case GLOB_NOCOMPLAIN:			/* -nocomplain */
-	        globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
-		break;
-	    case GLOB_DIR:				/* -dir */
-		if (i == (objc-1)) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "missing argument to \"-directory\"", -1));
-		    return TCL_ERROR;
-		}
-		if (dir != PATH_NONE) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "\"-directory\" cannot be used with \"-path\"",
-			    -1));
-		    return TCL_ERROR;
-		}
-		dir = PATH_DIR;
-		globFlags |= TCL_GLOBMODE_DIR;
-		pathOrDir = objv[i+1];
-		i++;
-		break;
-	    case GLOB_JOIN:				/* -join */
-		join = 1;
-		break;
-	    case GLOB_TAILS:				/* -tails */
-	        globFlags |= TCL_GLOBMODE_TAILS;
-		break;
-	    case GLOB_PATH:				/* -path */
-	        if (i == (objc-1)) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "missing argument to \"-path\"", -1));
-		    return TCL_ERROR;
-		}
-		if (dir != PATH_NONE) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "\"-path\" cannot be used with \"-directory\"",
-			    -1));
-		    return TCL_ERROR;
-		}
-		dir = PATH_GENERAL;
-		pathOrDir = objv[i+1];
-		i++;
-		break;
-	    case GLOB_TYPE:				/* -types */
-	        if (i == (objc-1)) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "missing argument to \"-types\"", -1));
-		    return TCL_ERROR;
-		}
-		typePtr = objv[i+1];
-		if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		i++;
-		break;
-	    case GLOB_LAST:				/* -- */
-	        i++;
-		goto endOfForLoop;
+	case GLOB_NOCOMPLAIN:			/* -nocomplain */
+	    globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
+	    break;
+	case GLOB_DIR:				/* -dir */
+	    if (i == (objc-1)) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"missing argument to \"-directory\"", -1));
+		return TCL_ERROR;
+	    }
+	    if (dir != PATH_NONE) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-directory\" cannot be used with \"-path\"", -1));
+		return TCL_ERROR;
+	    }
+	    dir = PATH_DIR;
+	    globFlags |= TCL_GLOBMODE_DIR;
+	    pathOrDir = objv[i+1];
+	    i++;
+	    break;
+	case GLOB_JOIN:				/* -join */
+	    join = 1;
+	    break;
+	case GLOB_TAILS:				/* -tails */
+	    globFlags |= TCL_GLOBMODE_TAILS;
+	    break;
+	case GLOB_PATH:				/* -path */
+	    if (i == (objc-1)) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"missing argument to \"-path\"", -1));
+		return TCL_ERROR;
+	    }
+	    if (dir != PATH_NONE) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-path\" cannot be used with \"-directory\"", -1));
+		return TCL_ERROR;
+	    }
+	    dir = PATH_GENERAL;
+	    pathOrDir = objv[i+1];
+	    i++;
+	    break;
+	case GLOB_TYPE:				/* -types */
+	    if (i == (objc-1)) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"missing argument to \"-types\"", -1));
+		return TCL_ERROR;
+	    }
+	    typePtr = objv[i+1];
+	    if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    i++;
+	    break;
+	case GLOB_LAST:				/* -- */
+	    i++;
+	    goto endOfForLoop;
 	}
     }
-    endOfForLoop:
+
+  endOfForLoop:
     if (objc - i < 1) {
-        Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
 	return TCL_ERROR;
     }
     if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-	  "\"-tails\" must be used with either \"-directory\" or \"-path\"",
-	  -1));
+	Tcl_AppendResult(interp,
+		"\"-tails\" must be used with either "
+		"\"-directory\" or \"-path\"", NULL);
 	return TCL_ERROR;
     }
-    
+
     separators = NULL;		/* lint. */
     switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    separators = "/";
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    separators = "/\\:";
-	    break;
+    case TCL_PLATFORM_UNIX:
+	separators = "/";
+	break;
+    case TCL_PLATFORM_WINDOWS:
+	separators = "/\\:";
+	break;
     }
+
     if (dir == PATH_GENERAL) {
 	int pathlength;
-	char *last;
-	char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+	const char *last;
+	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
 
 	/*
 	 * Find the last path separator in the path
 	 */
+
 	last = first + pathlength;
 	for (; last != first; last--) {
 	    if (strchr(separators, *(last-1)) != NULL) {
 		break;
 	    }
 	}
+
 	if (last == first + pathlength) {
-	    /* It's really a directory */
+	    /*
+	     * It's really a directory.
+	     */
+
 	    dir = PATH_DIR;
+
 	} else {
 	    Tcl_DString pref;
 	    char *search, *find;
 	    Tcl_DStringInit(&pref);
 	    if (last == first) {
-		/* The whole thing is a prefix */
+		/*
+		 * The whole thing is a prefix. This means we must remove any
+		 * 'tails' flag too, since it is irrelevant now (the same
+		 * effect will happen without it), but in particular its use
+		 * in TclGlob requires a non-NULL pathOrDir.
+		 */
+
 		Tcl_DStringAppend(&pref, first, -1);
+		globFlags &= ~TCL_GLOBMODE_TAILS;
 		pathOrDir = NULL;
 	    } else {
-		/* Have to split off the end */
+		/*
+		 * Have to split off the end.
+		 */
+
 		Tcl_DStringAppend(&pref, last, first+pathlength-last);
 		pathOrDir = Tcl_NewStringObj(first, last-first-1);
-		/* 
-		 * We must ensure that we haven't cut off too much,
-		 * and turned a valid path like '/' or 'C:/' into
-		 * an incorrect path like '' or 'C:'.  The way we
-		 * do this is to add a separator if there are none
-		 * presently in the prefix.
+
+		/*
+		 * We must ensure that we haven't cut off too much, and turned
+		 * a valid path like '/' or 'C:/' into an incorrect path like
+		 * '' or 'C:'. The way we do this is to add a separator if
+		 * there are none presently in the prefix.
 		 */
+
 		if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
-		    Tcl_AppendToObj(pathOrDir, last-1, 1); 
+		    Tcl_AppendToObj(pathOrDir, last-1, 1);
 		}
 	    }
-	    /* Need to quote 'prefix' */
+
+	    /*
+	     * Need to quote 'prefix'.
+	     */
+
 	    Tcl_DStringInit(&prefix);
 	    search = Tcl_DStringValue(&pref);
 	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
-	        Tcl_DStringAppend(&prefix, search, find-search);
-	        Tcl_DStringAppend(&prefix, "\\", 1);
-	        Tcl_DStringAppend(&prefix, find, 1);
-	        search = find+1;
-	        if (*search == '\0') {
-	            break;
-	        }
+		Tcl_DStringAppend(&prefix, search, find-search);
+		Tcl_DStringAppend(&prefix, "\\", 1);
+		Tcl_DStringAppend(&prefix, find, 1);
+		search = find+1;
+		if (*search == '\0') {
+		    break;
+		}
 	    }
 	    if (*search != '\0') {
 		Tcl_DStringAppend(&prefix, search, -1);
@@ -1245,29 +1423,33 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 	    Tcl_DStringFree(&pref);
 	}
     }
-    
+
     if (pathOrDir != NULL) {
 	Tcl_IncrRefCount(pathOrDir);
     }
-    
+
     if (typePtr != NULL) {
-	/* 
-	 * The rest of the possible type arguments (except 'd') are
-	 * platform specific.  We don't complain when they are used
-	 * on an incompatible platform.
+	/*
+	 * The rest of the possible type arguments (except 'd') are platform
+	 * specific. We don't complain when they are used on an incompatible
+	 * platform.
 	 */
+
 	Tcl_ListObjLength(interp, typePtr, &length);
 	if (length <= 0) {
 	    goto skipTypes;
 	}
-	globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
+	globTypes = (Tcl_GlobTypeData*)
+		TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
 	globTypes->type = 0;
 	globTypes->perm = 0;
 	globTypes->macType = NULL;
 	globTypes->macCreator = NULL;
-	while(--length >= 0) {
+
+	while (--length >= 0) {
 	    int len;
-	    char *str;
+	    const char *str;
+
 	    Tcl_ListObjIndex(interp, typePtr, length, &look);
 	    str = Tcl_GetStringFromObj(look, &len);
 	    if (strcmp("readonly", str) == 0) {
@@ -1276,50 +1458,56 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
 	    } else if (len == 1) {
 		switch (str[0]) {
-		  case 'r':
+		case 'r':
 		    globTypes->perm |= TCL_GLOB_PERM_R;
 		    break;
-		  case 'w':
+		case 'w':
 		    globTypes->perm |= TCL_GLOB_PERM_W;
 		    break;
-		  case 'x':
+		case 'x':
 		    globTypes->perm |= TCL_GLOB_PERM_X;
 		    break;
-		  case 'b':
+		case 'b':
 		    globTypes->type |= TCL_GLOB_TYPE_BLOCK;
 		    break;
-		  case 'c':
+		case 'c':
 		    globTypes->type |= TCL_GLOB_TYPE_CHAR;
 		    break;
-		  case 'd':
+		case 'd':
 		    globTypes->type |= TCL_GLOB_TYPE_DIR;
 		    break;
-		  case 'p':
+		case 'p':
 		    globTypes->type |= TCL_GLOB_TYPE_PIPE;
 		    break;
-		  case 'f':
+		case 'f':
 		    globTypes->type |= TCL_GLOB_TYPE_FILE;
 		    break;
-	          case 'l':
+		case 'l':
 		    globTypes->type |= TCL_GLOB_TYPE_LINK;
 		    break;
-		  case 's':
+		case 's':
 		    globTypes->type |= TCL_GLOB_TYPE_SOCK;
 		    break;
-		  default:
+		default:
 		    goto badTypesArg;
 		}
+
 	    } else if (len == 4) {
-		/* This is assumed to be a MacOS file type */
+		/*
+		 * This is assumed to be a MacOS file type.
+		 */
+
 		if (globTypes->macType != NULL) {
 		    goto badMacTypesArg;
 		}
 		globTypes->macType = look;
 		Tcl_IncrRefCount(look);
+
 	    } else {
-		Tcl_Obj* item;
-		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
-			(len == 3)) {
+		Tcl_Obj *item;
+
+		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
+			&& (len == 3)) {
 		    Tcl_ListObjIndex(interp, look, 0, &item);
 		    if (!strcmp("macintosh", Tcl_GetString(item))) {
 			Tcl_ListObjIndex(interp, look, 1, &item);
@@ -1342,22 +1530,25 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 			}
 		    }
 		}
+
 		/*
-		 * Error cases.  We reset
-		 * the 'join' flag to zero, since we haven't yet
-		 * made use of it.
+		 * Error cases. We reset the 'join' flag to zero, since we
+		 * haven't yet made use of it.
 		 */
-		badTypesArg:
-		resultPtr = Tcl_GetObjResult(interp);
+
+	    badTypesArg:
+		TclNewObj(resultPtr);
 		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
 		Tcl_AppendObjToObj(resultPtr, look);
+		Tcl_SetObjResult(interp, resultPtr);
 		result = TCL_ERROR;
 		join = 0;
 		goto endOfGlob;
-		badMacTypesArg:
+
+	    badMacTypesArg:
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		   "only one MacOS type or creator argument"
-		   " to \"-types\" allowed", -1));
+			"only one MacOS type or creator argument"
+			" to \"-types\" allowed", -1));
 		result = TCL_ERROR;
 		join = 0;
 		goto endOfGlob;
@@ -1366,15 +1557,16 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
     }
 
   skipTypes:
-    /* 
-     * Now we perform the actual glob below.  This may involve joining
-     * together the pattern arguments, dealing with particular file types
-     * etc.  We use a 'goto' to ensure we free any memory allocated along
-     * the way.
+    /*
+     * Now we perform the actual glob below. This may involve joining together
+     * the pattern arguments, dealing with particular file types etc. We use a
+     * 'goto' to ensure we free any memory allocated along the way.
      */
+
     objc -= i;
     objv += i;
     result = TCL_OK;
+
     if (join) {
 	if (dir != PATH_GENERAL) {
 	    Tcl_DStringInit(&prefix);
@@ -1386,66 +1578,70 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 		Tcl_DStringAppend(&prefix, separators, 1);
 	    }
 	}
-	if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir,
-		globFlags, globTypes) != TCL_OK) {
+	if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags,
+		globTypes) != TCL_OK) {
 	    result = TCL_ERROR;
 	    goto endOfGlob;
 	}
-    } else {
-	if (dir == PATH_GENERAL) {
-	    Tcl_DString str;
-	    for (i = 0; i < objc; i++) {
-		Tcl_DStringInit(&str);
-		if (dir == PATH_GENERAL) {
-		    Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
-			    Tcl_DStringLength(&prefix));
-		}
-		string = Tcl_GetStringFromObj(objv[i], &length);
-		Tcl_DStringAppend(&str, string, length);
-		if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir,
-			globFlags, globTypes) != TCL_OK) {
-		    result = TCL_ERROR;
-		    Tcl_DStringFree(&str);
-		    goto endOfGlob;
-		}
+    } else if (dir == PATH_GENERAL) {
+	Tcl_DString str;
+
+	for (i = 0; i < objc; i++) {
+	    Tcl_DStringInit(&str);
+	    if (dir == PATH_GENERAL) {
+		Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
+			Tcl_DStringLength(&prefix));
 	    }
-	    Tcl_DStringFree(&str);
-	} else {
-	    for (i = 0; i < objc; i++) {
-		string = Tcl_GetString(objv[i]);
-		if (TclGlob(interp, string, pathOrDir,
-			globFlags, globTypes) != TCL_OK) {
-		    result = TCL_ERROR;
-		    goto endOfGlob;
-		}
+	    string = Tcl_GetStringFromObj(objv[i], &length);
+	    Tcl_DStringAppend(&str, string, length);
+	    if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
+		    globTypes) != TCL_OK) {
+		result = TCL_ERROR;
+		Tcl_DStringFree(&str);
+		goto endOfGlob;
+	    }
+	}
+	Tcl_DStringFree(&str);
+    } else {
+	for (i = 0; i < objc; i++) {
+	    string = Tcl_GetString(objv[i]);
+	    if (TclGlob(interp, string, pathOrDir, globFlags,
+		    globTypes) != TCL_OK) {
+		result = TCL_ERROR;
+		goto endOfGlob;
 	    }
 	}
     }
+
     if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
 	if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
 		&length) != TCL_OK) {
-	    /* This should never happen.  Maybe we should be more dramatic */
+	    /*
+	     * This should never happen. Maybe we should be more dramatic.
+	     */
+
 	    result = TCL_ERROR;
 	    goto endOfGlob;
 	}
+
 	if (length == 0) {
 	    Tcl_AppendResult(interp, "no files matched glob pattern",
-		    (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
+		    (join || (objc == 1)) ? " \"" : "s \"", NULL);
 	    if (join) {
-		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
-			(char *) NULL);
+		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
 	    } else {
-		char *sep = "";
+		const char *sep = "";
 		for (i = 0; i < objc; i++) {
 		    string = Tcl_GetString(objv[i]);
-		    Tcl_AppendResult(interp, sep, string, (char *) NULL);
+		    Tcl_AppendResult(interp, sep, string, NULL);
 		    sep = " ";
 		}
 	    }
-	    Tcl_AppendResult(interp, "\"", (char *) NULL);
+	    Tcl_AppendResult(interp, "\"", NULL);
 	    result = TCL_ERROR;
 	}
     }
+
   endOfGlob:
     if (join || (dir == PATH_GENERAL)) {
 	Tcl_DStringFree(&prefix);
@@ -1460,7 +1656,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 	if (globTypes->macCreator != NULL) {
 	    Tcl_DecrRefCount(globTypes->macCreator);
 	}
-	ckfree((char *) globTypes);
+	TclStackFree(interp, globTypes);
     }
     return result;
 }
@@ -1470,24 +1666,24 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
  *
  * TclGlob --
  *
- *	This procedure prepares arguments for the TclDoGlob call.
- *	It sets the separator string based on the platform, performs
- *      tilde substitution, and calls TclDoGlob.
- *      
- *      The interpreter's result, on entry to this function, must
- *      be a valid Tcl list (e.g. it could be empty), since we will
- *      lappend any new results to that list.  If it is not a valid
- *      list, this function will fail to do anything very meaningful.
+ *	This procedure prepares arguments for the DoGlob call. It sets the
+ *	separator string based on the platform, performs * tilde substitution,
+ *	and calls DoGlob.
+ *
+ *	The interpreter's result, on entry to this function, must be a valid
+ *	Tcl list (e.g. it could be empty), since we will lappend any new
+ *	results to that list. If it is not a valid list, this function will
+ *	fail to do anything very meaningful.
+ *
+ *	Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then pathPrefix
+ *	cannot be NULL (it is only allowed with -dir or -path).
  *
  * Results:
- *	The return value is a standard Tcl result indicating whether
- *	an error occurred in globbing.  After a normal return the
- *	result in interp (set by TclDoGlob) holds all of the file names
- *	given by the pattern and unquotedPrefix arguments.  After an 
- *	error the result in interp will hold an error message, unless
- *	the 'TCL_GLOBMODE_NO_COMPLAIN' flag was given, in which case
- *	an error results in a TCL_OK return leaving the interpreter's
- *	result unmodified.
+ *	The return value is a standard Tcl result indicating whether an error
+ *	occurred in globbing. After a normal return the result in interp (set
+ *	by DoGlob) holds all of the file names given by the pattern and
+ *	pathPrefix arguments. After an error the result in interp will hold
+ *	an error message.
  *
  * Side effects:
  *	The 'pattern' is written to.
@@ -1497,195 +1693,349 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
-    Tcl_Interp *interp;		/* Interpreter for returning error message
-				 * or appending list of matching file names. */
-    char *pattern;		/* Glob pattern to match. Must not refer
-				 * to a static string. */
-    Tcl_Obj *unquotedPrefix;	/* Prefix to glob pattern, if non-null, which
-                             	 * is considered literally. */
-    int globFlags;		/* Stores or'ed combination of flags */
-    Tcl_GlobTypeData *types;	/* Struct containing acceptable types.
-				 * May be NULL. */
+TclGlob(
+    Tcl_Interp *interp,		/* Interpreter for returning error message or
+				 * appending list of matching file names. */
+    char *pattern,		/* Glob pattern to match. Must not refer to a
+				 * static string. */
+    Tcl_Obj *pathPrefix,	/* Path prefix to glob pattern, if non-null,
+				 * which is considered literally. */
+    int globFlags,		/* Stores or'ed combination of flags */
+    Tcl_GlobTypeData *types)	/* Struct containing acceptable types. May be
+				 * NULL. */
 {
-    char *separators;
-    CONST char *head;
+    const char *separators;
+    const char *head;
     char *tail, *start;
-    char c;
-    int result, prefixLen;
-    Tcl_DString buffer;
-    Tcl_Obj *oldResult;
+    int result;
+    Tcl_Obj *filenamesObj, *savedResultObj;
 
     separators = NULL;		/* lint. */
     switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    separators = "/";
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    separators = "/\\:";
-	    break;
+    case TCL_PLATFORM_UNIX:
+	separators = "/";
+	break;
+    case TCL_PLATFORM_WINDOWS:
+	separators = "/\\:";
+	break;
     }
 
-    Tcl_DStringInit(&buffer);
-    if (unquotedPrefix != NULL) {
-	start = Tcl_GetString(unquotedPrefix);
-    } else {
-	start = pattern;
-    }
+    if (pathPrefix == NULL) {
+	char c;
+	Tcl_DString buffer;
+	Tcl_DStringInit(&buffer);
 
-    /*
-     * Perform tilde substitution, if needed.
-     */
+	start = pattern;
 
-    if (start[0] == '~') {
-	
 	/*
-	 * Find the first path separator after the tilde.
+	 * Perform tilde substitution, if needed.
 	 */
-	for (tail = start; *tail != '\0'; tail++) {
-	    if (*tail == '\\') {
-		if (strchr(separators, tail[1]) != NULL) {
+
+	if (start[0] == '~') {
+	    /*
+	     * Find the first path separator after the tilde.
+	     */
+
+	    for (tail = start; *tail != '\0'; tail++) {
+		if (*tail == '\\') {
+		    if (strchr(separators, tail[1]) != NULL) {
+			break;
+		    }
+		} else if (strchr(separators, *tail) != NULL) {
 		    break;
 		}
-	    } else if (strchr(separators, *tail) != NULL) {
-		break;
 	    }
-	}
 
-	/*
-	 * Determine the home directory for the specified user.  
-	 */
-	
-	c = *tail;
-	*tail = '\0';
-	if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
-	    /* 
-	     * We will ignore any error message here, and we
-	     * don't want to mess up the interpreter's result.
+	    /*
+	     * Determine the home directory for the specified user.
 	     */
-	    head = DoTildeSubst(NULL, start+1, &buffer);
-	} else {
+
+	    c = *tail;
+	    *tail = '\0';
 	    head = DoTildeSubst(interp, start+1, &buffer);
-	}
-	*tail = c;
-	if (head == NULL) {
-	    if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
-		return TCL_OK;
-	    } else {
+	    *tail = c;
+	    if (head == NULL) {
 		return TCL_ERROR;
 	    }
-	}
-	if (head != Tcl_DStringValue(&buffer)) {
-	    Tcl_DStringAppend(&buffer, head, -1);
-	}
-	if (unquotedPrefix != NULL) {
-	    Tcl_DStringAppend(&buffer, tail, -1);
+	    if (head != Tcl_DStringValue(&buffer)) {
+		Tcl_DStringAppend(&buffer, head, -1);
+	    }
+	    pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
+		    Tcl_DStringLength(&buffer));
+	    Tcl_IncrRefCount(pathPrefix);
+	    globFlags |= TCL_GLOBMODE_DIR;
+	    if (c != '\0') {
+		tail++;
+	    }
+	    Tcl_DStringFree(&buffer);
+	} else {
 	    tail = pattern;
 	}
     } else {
+	Tcl_IncrRefCount(pathPrefix);
 	tail = pattern;
-	if (unquotedPrefix != NULL) {
-	    Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
-	}
     }
-    
-    /* 
-     * We want to remember the length of the current prefix,
-     * in case we are using TCL_GLOBMODE_TAILS.  Also if we
-     * are using TCL_GLOBMODE_DIR, we must make sure the
-     * prefix ends in a directory separator.
+
+    /*
+     * Handling empty path prefixes with glob patterns like 'C:' or
+     * 'c:////////' is a pain on Windows if we leave it too late, since these
+     * aren't really patterns at all! We therefore check the head of the
+     * pattern now for such cases, if we don't have an unquoted prefix yet.
+     *
+     * Similarly on Unix with '/' at the head of the pattern -- it just
+     * indicates the root volume, so we treat it as such.
      */
-    prefixLen = Tcl_DStringLength(&buffer);
-
-    if (prefixLen > 0) {
-	c = Tcl_DStringValue(&buffer)[prefixLen-1];
-	if (strchr(separators, c) == NULL) {
-	    /* 
-	     * If the prefix is a directory, make sure it ends in a
-	     * directory separator.
-	     */
-	    if (globFlags & TCL_GLOBMODE_DIR) {
-		Tcl_DStringAppend(&buffer,separators,1);
-		/* Try to borrow that separator from the tail */
-		if (*tail == *separators) {
+
+    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+	if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') {
+	    char *p = tail + 1;
+	    pathPrefix = Tcl_NewStringObj(tail, 1);
+	    while (*p != '\0') {
+		char c = p[1];
+		if (*p == '\\') {
+		    if (strchr(separators, c) != NULL) {
+			if (c == '\\') {
+			    c = '/';
+			}
+			Tcl_AppendToObj(pathPrefix, &c, 1);
+			p++;
+		    } else {
+			break;
+		    }
+		} else if (strchr(separators, *p) != NULL) {
+		    Tcl_AppendToObj(pathPrefix, p, 1);
+		} else {
+		    break;
+		}
+		p++;
+	    }
+	    tail = p;
+	    Tcl_IncrRefCount(pathPrefix);
+	} else if (pathPrefix == NULL && (tail[0] == '/'
+		|| (tail[0] == '\\' && tail[1] == '\\'))) {
+	    int driveNameLen;
+	    Tcl_Obj *driveName;
+	    Tcl_Obj *temp = Tcl_NewStringObj(tail, -1);
+	    Tcl_IncrRefCount(temp);
+
+	    switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) {
+	    case TCL_PATH_VOLUME_RELATIVE: {
+		/*
+		 * Volume relative path which is equivalent to a path in the
+		 * root of the cwd's volume. We will actually return
+		 * non-volume-relative paths here. i.e. 'glob /foo*' will
+		 * return 'C:/foobar'. This is much the same as globbing for a
+		 * path with '\\' will return one with '/' on Windows.
+		 */
+
+		Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
+
+		if (cwd == NULL) {
+		    Tcl_DecrRefCount(temp);
+		    return TCL_ERROR;
+		}
+		pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3);
+		Tcl_DecrRefCount(cwd);
+		if (tail[0] == '/') {
 		    tail++;
+		} else {
+		    tail += 2;
 		}
+		Tcl_IncrRefCount(pathPrefix);
+		break;
 	    }
-	    prefixLen++;
+	    case TCL_PATH_ABSOLUTE:
+		/*
+		 * Absolute, possibly network path //Machine/Share. Use that
+		 * as the path prefix (it already has a refCount).
+		 */
+
+		pathPrefix = driveName;
+		tail += driveNameLen;
+		break;
+	    case TCL_PATH_RELATIVE:
+		/* Do nothing */
+		break;
+	    }
+	    Tcl_DecrRefCount(temp);
+	}
+
+	/*
+	 * ':' no longer needed as a separator. It is only relevant to the
+	 * beginning of the path.
+	 */
+
+	separators = "/\\";
+
+    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
+	if (pathPrefix == NULL && tail[0] == '/') {
+	    pathPrefix = Tcl_NewStringObj(tail, 1);
+	    tail++;
+	    Tcl_IncrRefCount(pathPrefix);
 	}
     }
 
-    /* 
-     * We need to get the old result, in case it is over-written
-     * below when we still need it.
+    /*
+     * Finally if we still haven't managed to generate a path prefix, check if
+     * the path starts with a current volume.
+     */
+
+    if (pathPrefix == NULL) {
+	int driveNameLen;
+	Tcl_Obj *driveName;
+	if (TclFSNonnativePathType(tail, (int) strlen(tail), NULL,
+		&driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) {
+	    pathPrefix = driveName;
+	    tail += driveNameLen;
+	}
+    }
+
+    /*
+     * To process a [glob] invokation, this function may be called multiple
+     * times. Each time, the previously discovered filenames are in the
+     * interpreter result. We stash that away here so the result is free for
+     * error messsages.
      */
-    oldResult = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(oldResult);
+
+    savedResultObj = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(savedResultObj);
     Tcl_ResetResult(interp);
-    
-    result = TclDoGlob(interp, separators, &buffer, tail, types);
-    
-    if (result != TCL_OK) {
-	if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
-	    /* Put back the old result and reset the return code */
-	    Tcl_SetObjResult(interp, oldResult);
+    TclNewObj(filenamesObj);
+    Tcl_IncrRefCount(filenamesObj);
+
+    /*
+     * Now we do the actual globbing, adding filenames as we go to buffer in
+     * filenamesObj
+     */
+
+    if (*tail == '\0' && pathPrefix != NULL) {
+	/*
+	 * An empty pattern. This means 'pathPrefix' is actually a full path
+	 * of a file/directory we want to simply check for existence and type.
+	 */
+
+	if (types == NULL) {
+	    /*
+	     * We just want to check for existence. In this case we make it
+	     * easy on Tcl_FSMatchInDirectory and its sub-implementations by
+	     * not bothering them (even though they should support this
+	     * situation) and we just use the simple existence check with
+	     * Tcl_FSAccess.
+	     */
+
+	    if (Tcl_FSAccess(pathPrefix, F_OK) == 0) {
+		Tcl_ListObjAppendElement(interp, filenamesObj, pathPrefix);
+	    }
 	    result = TCL_OK;
+	} else {
+	    /*
+	     * We want to check for the correct type. Tcl_FSMatchInDirectory
+	     * is documented to do this for us, if we give it a NULL pattern.
+	     */
+
+	    result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
+		    NULL, types);
 	}
     } else {
-	/* 
-	 * Now we must concatenate the 'oldResult' and the current
-	 * result, and then place that into the interpreter.
-	 * 
-	 * If we only want the tails, we must strip off the prefix now.
-	 * It may seem more efficient to pass the tails flag down into
-	 * TclDoGlob, Tcl_FSMatchInDirectory, but those functions are
-	 * continually adjusting the prefix as the various pieces of
-	 * the pattern are assimilated, so that would add a lot of
-	 * complexity to the code.  This way is a little slower (when
-	 * the -tails flag is given), but much simpler to code.
-	 */
+	result = DoGlob(interp, filenamesObj, separators, pathPrefix,
+		globFlags & TCL_GLOBMODE_DIR, tail, types);
+    }
+
+    /*
+     * Check for errors...
+     */
+
+    if (result != TCL_OK) {
+	TclDecrRefCount(filenamesObj);
+	TclDecrRefCount(savedResultObj);
+	if (pathPrefix != NULL) {
+	    Tcl_DecrRefCount(pathPrefix);
+	}
+	return result;
+    }
+
+    /*
+     * If we only want the tails, we must strip off the prefix now. It may
+     * seem more efficient to pass the tails flag down into DoGlob,
+     * Tcl_FSMatchInDirectory, but those functions are continually adjusting
+     * the prefix as the various pieces of the pattern are assimilated, so
+     * that would add a lot of complexity to the code. This way is a little
+     * slower (when the -tails flag is given), but much simpler to code.
+     *
+     * We do it by rewriting the result list in-place.
+     */
+
+    if (globFlags & TCL_GLOBMODE_TAILS) {
 	int objc, i;
 	Tcl_Obj **objv;
+	int prefixLen;
+	const char *pre;
 
-	/* Ensure sole ownership */
-	if (Tcl_IsShared(oldResult)) {
-	    Tcl_DecrRefCount(oldResult);
-	    oldResult = Tcl_DuplicateObj(oldResult);
-	    Tcl_IncrRefCount(oldResult);
+	/*
+	 * If this length has never been set, set it here.
+	 */
+
+	if (pathPrefix == NULL) {
+	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
 	}
 
-	Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), 
-			       &objc, &objv);
+	pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
+	if (prefixLen > 0
+		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
+	    /*
+	     * If we're on Windows and the prefix is a volume relative one
+	     * like 'C:', then there won't be a path separator in between, so
+	     * no need to skip it here.
+	     */
+
+	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
+		    || (pre[1] != ':')) {
+		prefixLen++;
+	    }
+	}
+
+	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
 	for (i = 0; i< objc; i++) {
-	    Tcl_Obj* elt;
-	    if (globFlags & TCL_GLOBMODE_TAILS) {
-		int len;
-		char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
-		if (len == prefixLen) {
-		    if ((pattern[0] == '\0')
+	    int len;
+	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+	    Tcl_Obj *elem;
+
+	    if (len == prefixLen) {
+		if ((pattern[0] == '\0')
 			|| (strchr(separators, pattern[0]) == NULL)) {
-			elt = Tcl_NewStringObj(".",1);
-		    } else {
-			elt = Tcl_NewStringObj("/",1);
-		    }
+		    TclNewLiteralStringObj(elem, ".");
 		} else {
-		    elt = Tcl_NewStringObj(oldStr + prefixLen, 
-						len - prefixLen);
+		    TclNewLiteralStringObj(elem, "/");
 		}
 	    } else {
-		elt = objv[i];
+		elem = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
 	    }
-	    /* Assumption that 'oldResult' is a valid list */
-	    Tcl_ListObjAppendElement(interp, oldResult, elt);
+	    Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, &elem);
 	}
-	Tcl_SetObjResult(interp, oldResult);
     }
-    /* 
-     * Release our temporary copy.  All code paths above must
-     * end here so we free our reference.
+
+    /*
+     * Now we have a list of discovered filenames in filenamesObj and a list
+     * of previously discovered (saved earlier from the interpreter result) in
+     * savedResultObj. Merge them and put them back in the interpreter result.
      */
-    Tcl_DecrRefCount(oldResult);
-    Tcl_DStringFree(&buffer);
+
+    if (Tcl_IsShared(savedResultObj)) {
+	TclDecrRefCount(savedResultObj);
+	savedResultObj = Tcl_DuplicateObj(savedResultObj);
+	Tcl_IncrRefCount(savedResultObj);
+    }
+    if (Tcl_ListObjAppendList(interp, savedResultObj, filenamesObj) != TCL_OK){
+	result = TCL_ERROR;
+    } else {
+	Tcl_SetObjResult(interp, savedResultObj);
+    }
+    TclDecrRefCount(savedResultObj);
+    TclDecrRefCount(filenamesObj);
+    if (pathPrefix != NULL) {
+	Tcl_DecrRefCount(pathPrefix);
+    }
+
     return result;
 }
 
@@ -1694,14 +2044,13 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
  *
  * SkipToChar --
  *
- *	This function traverses a glob pattern looking for the next
- *	unquoted occurance of the specified character at the same braces
- *	nesting level.
+ *	This function traverses a glob pattern looking for the next unquoted
+ *	occurance of the specified character at the same braces nesting level.
  *
  * Results:
- *	Updates stringPtr to point to the matching character, or to
- *	the end of the string if nothing matched.  The return value
- *	is 1 if a match was found at the top level, otherwise it is 0.
+ *	Updates stringPtr to point to the matching character, or to the end of
+ *	the string if nothing matched. The return value is 1 if a match was
+ *	found at the top level, otherwise it is 0.
  *
  * Side effects:
  *	None.
@@ -1710,9 +2059,9 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
  */
 
 static int
-SkipToChar(stringPtr, match)
-    char **stringPtr;			/* Pointer string to check. */
-    char *match;			/* Pointer to character to find. */
+SkipToChar(
+    char **stringPtr,		/* Pointer string to check. */
+    int match)			/* Character to find. */
 {
     int quoted, level;
     register char *p;
@@ -1725,7 +2074,7 @@ SkipToChar(stringPtr, match)
 	    quoted = 0;
 	    continue;
 	}
-	if ((level == 0) && (*p == *match)) {
+	if ((level == 0) && (*p == match)) {
 	    *stringPtr = p;
 	    return 1;
 	}
@@ -1744,23 +2093,23 @@ SkipToChar(stringPtr, match)
 /*
  *----------------------------------------------------------------------
  *
- * TclDoGlob --
+ * DoGlob --
  *
- *	This recursive procedure forms the heart of the globbing
- *	code.  It performs a depth-first traversal of the tree
- *	given by the path name to be globbed.  The directory and
- *	remainder are assumed to be native format paths.  The prefix 
- *	contained in 'headPtr' is not used as a glob pattern, simply
- *	as a path specifier, so it can contain unquoted glob-sensitive
- *	characters (if the directories to which it points contain
- *	such strange characters).
+ *	This recursive procedure forms the heart of the globbing code. It
+ *	performs a depth-first traversal of the tree given by the path name to
+ *	be globbed and the pattern. The directory and remainder are assumed to
+ *	be native format paths. The prefix contained in 'pathPtr' is either a
+ *	directory or path from which to start the search (or NULL). If pathPtr
+ *	is NULL, then the pattern must not start with an absolute path
+ *	specification (that case should be handled by moving the absolute path
+ *	prefix into pathPtr before calling DoGlob).
  *
  * Results:
- *	The return value is a standard Tcl result indicating whether
- *	an error occurred in globbing.  After a normal return the
- *	result in interp will be set to hold all of the file names
- *	given by the dir and rem arguments.  After an error the
- *	result in interp will hold an error message.
+ *	The return value is a standard Tcl result indicating whether an error
+ *	occurred in globbing. After a normal return the result in interp will
+ *	be set to hold all of the file names given by the dir and remaining
+ *	arguments. After an error the result in interp will hold an error
+ *	message.
  *
  * Side effects:
  *	None.
@@ -1768,140 +2117,98 @@ SkipToChar(stringPtr, match)
  *----------------------------------------------------------------------
  */
 
-int
-TclDoGlob(interp, separators, headPtr, tail, types)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting
+static int
+DoGlob(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting
 				 * (e.g. unmatched brace). */
-    char *separators;		/* String containing separator characters
-				 * that should be used to identify globbing
+    Tcl_Obj *matchesObj,	/* Unshared list object in which to place all
+				 * resulting filenames. Caller allocates and
+				 * deallocates; DoGlob must not touch the
+				 * refCount of this object. */
+    const char *separators,	/* String containing separator characters that
+				 * should be used to identify globbing
 				 * boundaries. */
-    Tcl_DString *headPtr;	/* Completely expanded prefix. */
-    char *tail;			/* The unexpanded remainder of the path.
-				 * Must not be a pointer to a static string. */
-    Tcl_GlobTypeData *types;	/* List object containing list of acceptable 
-                            	 * types. May be NULL. */
+    Tcl_Obj *pathPtr,		/* Completely expanded prefix. */
+    int flags,			/* If non-zero then pathPtr is a directory */
+    char *pattern,		/* The pattern to match against. Must not be a
+				 * pointer to a static string. */
+    Tcl_GlobTypeData *types)	/* List object containing list of acceptable
+				 * types. May be NULL. */
 {
     int baseLength, quoted, count;
     int result = TCL_OK;
-    char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
-    /*
-    char lastChar = 0;
-    */
-    
-    int length = Tcl_DStringLength(headPtr);
+    char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;
+    Tcl_Obj *joinedPtr;
 
     /*
-    if (length > 0) {
-	lastChar = Tcl_DStringValue(headPtr)[length-1];
-    }
-    */
-
-    /*
-     * Consume any leading directory separators, leaving tail pointing
-     * just past the last initial separator.
+     * Consume any leading directory separators, leaving pattern pointing just
+     * past the last initial separator.
      */
 
     count = 0;
-    name = tail;
-    for (; *tail != '\0'; tail++) {
-	if (*tail == '\\') {
-	    /* 
+    name = pattern;
+    for (; *pattern != '\0'; pattern++) {
+	if (*pattern == '\\') {
+	    /*
 	     * If the first character is escaped, either we have a directory
-	     * separator, or we have any other character.  In the latter case
-	     * the rest of tail is a pattern, and we must break from the loop.
-	     * This is particularly important on Windows where '\' is both
-	     * the escaping character and a directory separator.
+	     * separator, or we have any other character. In the latter case
+	     * the rest is a pattern, and we must break from the loop. This
+	     * is particularly important on Windows where '\' is both the
+	     * escaping character and a directory separator.
 	     */
-	    if (strchr(separators, tail[1]) != NULL) {
-		tail++;
+
+	    if (strchr(separators, pattern[1]) != NULL) {
+		pattern++;
 	    } else {
 		break;
 	    }
-	} else if (strchr(separators, *tail) == NULL) {
+	} else if (strchr(separators, *pattern) == NULL) {
 	    break;
 	}
-	    if (*tail == '\\') {
-		Tcl_DStringAppend(headPtr, separators, 1);
-	    } else {
-		Tcl_DStringAppend(headPtr, tail, 1);
-	    }
 	count++;
     }
 
     /*
-     * Deal with path separators.  On the Mac, we have to watch out
-     * for multiple separators, since they are special in Mac-style
-     * paths.
-     */
-
-    switch (tclPlatform) {
-	case TCL_PLATFORM_WINDOWS:
-	    /*
-	     * If this is a drive relative path, add the colon and the
-	     * trailing slash if needed.  Otherwise add the slash if
-	     * this is the first absolute element, or a later relative
-	     * element.  Add an extra slash if this is a UNC path.
-
-	    if (*name == ':') {
-		Tcl_DStringAppend(headPtr, ":", 1);
-		if (count > 1) {
-		    Tcl_DStringAppend(headPtr, "/", 1);
-		}
-	    } else if ((*tail != '\0')
-		    && (((length > 0)
-			    && (strchr(separators, lastChar) == NULL))
-			    || ((length == 0) && (count > 0)))) {
-		Tcl_DStringAppend(headPtr, "/", 1);
-		if ((length == 0) && (count > 1)) {
-		    Tcl_DStringAppend(headPtr, "/", 1);
-		}
-	    }
-	     */
-	    
-	    break;
-	case TCL_PLATFORM_UNIX: {
-	    /*
-	     * Add a separator if this is the first absolute element, or
-	     * a later relative element.
-
-	    if ((*tail != '\0')
-		    && (((length > 0)
-			    && (strchr(separators, lastChar) == NULL))
-			    || ((length == 0) && (count > 0)))) {
-		Tcl_DStringAppend(headPtr, "/", 1);
-	    }
-	     */
-	    break;
-	}
-    }
-
-    /*
-     * Look for the first matching pair of braces or the first
-     * directory separator that is not inside a pair of braces.
+     * Look for the first matching pair of braces or the first directory
+     * separator that is not inside a pair of braces.
      */
 
     openBrace = closeBrace = NULL;
     quoted = 0;
-    for (p = tail; *p != '\0'; p++) {
+    for (p = pattern; *p != '\0'; p++) {
 	if (quoted) {
 	    quoted = 0;
+
 	} else if (*p == '\\') {
 	    quoted = 1;
 	    if (strchr(separators, p[1]) != NULL) {
-		break;			/* Quoted directory separator. */
+		/*
+		 * Quoted directory separator.
+		 */
+		break;
 	    }
+
 	} else if (strchr(separators, *p) != NULL) {
-	    break;			/* Unquoted directory separator. */
+	    /*
+	     * Unquoted directory separator.
+	     */
+	    break;
+
 	} else if (*p == '{') {
 	    openBrace = p;
 	    p++;
-	    if (SkipToChar(&p, "}")) {
-		closeBrace = p;		/* Balanced braces. */
+	    if (SkipToChar(&p, '}')) {
+		/*
+		 * Balanced braces.
+		 */
+
+		closeBrace = p;
 		break;
 	    }
 	    Tcl_SetResult(interp, "unmatched open-brace in file name",
 		    TCL_STATIC);
 	    return TCL_ERROR;
+
 	} else if (*p == '}') {
 	    Tcl_SetResult(interp, "unmatched close-brace in file name",
 		    TCL_STATIC);
@@ -1916,28 +2223,27 @@ TclDoGlob(interp, separators, headPtr, tail, types)
     if (openBrace != NULL) {
 	char *element;
 	Tcl_DString newName;
+
 	Tcl_DStringInit(&newName);
 
 	/*
-	 * For each element within in the outermost pair of braces,
-	 * append the element and the remainder to the fixed portion
-	 * before the first brace and recursively call TclDoGlob.
+	 * For each element within in the outermost pair of braces, append the
+	 * element and the remainder to the fixed portion before the first
+	 * brace and recursively call DoGlob.
 	 */
 
-	Tcl_DStringAppend(&newName, tail, openBrace-tail);
+	Tcl_DStringAppend(&newName, pattern, openBrace-pattern);
 	baseLength = Tcl_DStringLength(&newName);
-	length = Tcl_DStringLength(headPtr);
 	*closeBrace = '\0';
 	for (p = openBrace; p != closeBrace; ) {
 	    p++;
 	    element = p;
-	    SkipToChar(&p, ",");
-	    Tcl_DStringSetLength(headPtr, length);
+	    SkipToChar(&p, ',');
 	    Tcl_DStringSetLength(&newName, baseLength);
 	    Tcl_DStringAppend(&newName, element, p-element);
 	    Tcl_DStringAppend(&newName, closeBrace+1, -1);
-	    result = TclDoGlob(interp, separators, headPtr, 
-			       Tcl_DStringValue(&newName), types);
+	    result = DoGlob(interp, matchesObj, separators, pathPtr, flags,
+		    Tcl_DStringValue(&newName), types);
 	    if (result != TCL_OK) {
 		break;
 	    }
@@ -1948,254 +2254,266 @@ TclDoGlob(interp, separators, headPtr, tail, types)
     }
 
     /*
-     * At this point, there are no more brace substitutions to perform on
-     * this path component.  The variable p is pointing at a quoted or
-     * unquoted directory separator or the end of the string.  So we need
-     * to check for special globbing characters in the current pattern.
-     * We avoid modifying tail if p is pointing at the end of the string.
+     * At this point, there are no more brace substitutions to perform on this
+     * path component. The variable p is pointing at a quoted or unquoted
+     * directory separator or the end of the string. So we need to check for
+     * special globbing characters in the current pattern. We avoid modifying
+     * pattern if p is pointing at the end of the string.
+     *
+     * If we find any globbing characters, then we must call
+     * Tcl_FSMatchInDirectory. If we're at the end of the string, then that's
+     * all we need to do. If we're not at the end of the string, then we must
+     * recurse, so we do that below.
+     *
+     * Alternatively, if there are no globbing characters then again there are
+     * two cases. If we're at the end of the string, we just need to check for
+     * the given path's existence and type. If we're not at the end of the
+     * string, we recurse.
      */
 
     if (*p != '\0') {
+	char savedChar = *p;
 
 	/*
-	 * Note that we are modifying the string in place.  This won't work
-	 * if the string is a static.
+	 * Note that we are modifying the string in place. This won't work if
+	 * the string is a static.
 	 */
 
-	savedChar = *p;
 	*p = '\0';
-	firstSpecialChar = strpbrk(tail, "*[]?\\");
+	firstSpecialChar = strpbrk(pattern, "*[]?\\");
 	*p = savedChar;
     } else {
-	firstSpecialChar = strpbrk(tail, "*[]?\\");
+	firstSpecialChar = strpbrk(pattern, "*[]?\\");
     }
 
     if (firstSpecialChar != NULL) {
-	int ret;
-	Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1);
-	Tcl_IncrRefCount(head);
 	/*
-	 * Look for matching files in the given directory.  The
-	 * implementation of this function is platform specific.  For
-	 * each file that matches, it will add the match onto the
-	 * resultPtr given.
+	 * Look for matching files in the given directory. The implementation
+	 * of this function is filesystem specific. For each file that
+	 * matches, it will add the match onto the resultPtr given.
 	 */
+
+	static Tcl_GlobTypeData dirOnly = {
+	    TCL_GLOB_TYPE_DIR, 0, NULL, NULL
+	};
+	char save = *p;
+	Tcl_Obj *subdirsPtr;
+
 	if (*p == '\0') {
-	    ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), 
-					 head, tail, types);
-	} else {
-	    /* 
-	     * We do the recursion ourselves.  This makes implementing
-	     * Tcl_FSMatchInDirectory for each filesystem much easier.
-	     */
-	    Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL };
-	    char save = *p;
-	    Tcl_Obj *resultPtr;
-
-	    resultPtr = Tcl_NewListObj(0, NULL);
-	    Tcl_IncrRefCount(resultPtr);
-	    *p = '\0';
-	    ret = Tcl_FSMatchInDirectory(interp, resultPtr, 
-					 head, tail, &dirOnly);
-	    *p = save;
-	    if (ret == TCL_OK) {
-		int resLength, repair = -1;
-		ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
-		if (ret == TCL_OK) {
-		    int i;
-		    for (i =0; i< resLength; i++) {
-			Tcl_Obj *elt;
-			Tcl_DString ds;
-			Tcl_ListObjIndex(NULL, resultPtr, i, &elt);
-			Tcl_DStringInit(&ds);
-			if (Tcl_GetString(elt)[0] == '~') {
-			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
-
-			    Tcl_ListObjLength(NULL, paths, &repair);
-			    Tcl_DStringAppend(&ds, "./", 2);
-			}
-			Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
-			    Tcl_DStringAppend(&ds, "/",1);
-			ret = TclDoGlob(interp, separators, &ds, p+1, types);
-			Tcl_DStringFree(&ds);
-			if (ret != TCL_OK) {
-			    break;
-			}
-			if (repair >= 0) {
-			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
-			    int end;
-
-			    Tcl_ListObjLength(NULL, paths, &end);
-			    while (repair < end) {
-				CONST char *bytes;
-				int numBytes;
-				Tcl_Obj *fixme, *newObj;
-				Tcl_ListObjIndex(NULL, paths, repair, &fixme);
-				bytes = Tcl_GetStringFromObj(fixme, &numBytes);
-				newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
-				Tcl_ListObjReplace(NULL, paths, repair, 1,
-					1, &newObj);
-				repair++;
-			    }
-			    repair = -1;
-			}
+	    return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr,
+		    pattern, types);
+	}
+
+	/*
+	 * We do the recursion ourselves. This makes implementing
+	 * Tcl_FSMatchInDirectory for each filesystem much easier.
+	 */
+
+	*p = '\0';
+	TclNewObj(subdirsPtr);
+	Tcl_IncrRefCount(subdirsPtr);
+	result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
+		pattern, &dirOnly);
+	*p = save;
+	if (result == TCL_OK) {
+	    int subdirc, i, repair = -1;
+	    Tcl_Obj **subdirv;
+
+	    result = Tcl_ListObjGetElements(interp, subdirsPtr,
+		    &subdirc, &subdirv);
+	    for (i=0; result==TCL_OK && i<subdirc; i++) {
+		Tcl_Obj *copy = NULL;
+
+		if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
+		    Tcl_ListObjLength(NULL, matchesObj, &repair);
+		    copy = subdirv[i];
+		    subdirv[i] = Tcl_NewStringObj("./", 2);
+		    Tcl_AppendObjToObj(subdirv[i], copy);
+		    Tcl_IncrRefCount(subdirv[i]);
+		}
+		result = DoGlob(interp, matchesObj, separators, subdirv[i],
+			1, p+1, types);
+		if (copy) {
+		    int end;
+
+		    Tcl_DecrRefCount(subdirv[i]);
+		    subdirv[i] = copy;
+		    Tcl_ListObjLength(NULL, matchesObj, &end);
+		    while (repair < end) {
+			const char *bytes;
+			int numBytes;
+			Tcl_Obj *fixme, *newObj;
+
+			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
+			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
+			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
+			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
+				1, &newObj);
+			repair++;
 		    }
+		    repair = -1;
 		}
 	    }
-	    Tcl_DecrRefCount(resultPtr);
 	}
-	Tcl_DecrRefCount(head);
-	return ret;
+	TclDecrRefCount(subdirsPtr);
+	return result;
     }
-    Tcl_DStringAppend(headPtr, tail, p-tail);
-    if (*p != '\0') {
-	return TclDoGlob(interp, separators, headPtr, p, types);
-    } else {
+
+    /*
+     * We reach here with no pattern char in current section
+     */
+
+    if (*p == '\0') {
+	int length;
+	Tcl_DString append;
+
 	/*
 	 * This is the code path reached by a command like 'glob foo'.
 	 *
-	 * There are no more wildcards in the pattern and no more
-	 * unprocessed characters in the tail, so now we can construct
-	 * the path, and pass it to Tcl_FSMatchInDirectory with an
-	 * empty pattern to verify the existence of the file and check
-	 * it is of the correct type (if a 'types' flag it given -- if
-	 * no such flag was given, we could just use 'Tcl_FSLStat', but
-	 * for simplicity we keep to a common approach).
+	 * There are no more wildcards in the pattern and no more unprocessed
+	 * characters in the pattern, so now we can construct the path, and
+	 * pass it to Tcl_FSMatchInDirectory with an empty pattern to verify
+	 * the existence of the file and check it is of the correct type (if a
+	 * 'types' flag it given -- if no such flag was given, we could just
+	 * use 'Tcl_FSLStat', but for simplicity we keep to a common
+	 * approach).
 	 */
 
-	Tcl_Obj *nameObj;
+	Tcl_DStringInit(&append);
+	Tcl_DStringAppend(&append, pattern, p-pattern);
+
+	if (pathPtr != NULL) {
+	    (void) Tcl_GetStringFromObj(pathPtr, &length);
+	} else {
+	    length = 0;
+	}
 
 	switch (tclPlatform) {
-	    case TCL_PLATFORM_WINDOWS: {
-		if (Tcl_DStringLength(headPtr) == 0) {
-		    if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
-			    || (*name == '/')) {
-			Tcl_DStringAppend(headPtr, "/", 1);
-		    } else {
-			Tcl_DStringAppend(headPtr, ".", 1);
-		    }
-		}
-		/* 
-		 * Convert to forward slashes.  This is required to pass
-		 * some Tcl tests.  We should probably remove the conversions
-		 * here and in tclWinFile.c, since they aren't needed since
-		 * the dropping of support for Win32s.
-		 */
-		for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
-		    if (*p == '\\') {
-			*p = '/';
-		    }
+	case TCL_PLATFORM_WINDOWS:
+	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
+		if (((*name == '\\') && (name[1] == '/' ||
+			name[1] == '\\')) || (*name == '/')) {
+		    Tcl_DStringAppend(&append, "/", 1);
+		} else {
+		    Tcl_DStringAppend(&append, ".", 1);
 		}
-		break;
 	    }
-	    case TCL_PLATFORM_UNIX: {
-		if (Tcl_DStringLength(headPtr) == 0) {
-		    if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
-			Tcl_DStringAppend(headPtr, "/", 1);
-		    } else {
-			Tcl_DStringAppend(headPtr, ".", 1);
-		    }
+
+	    break;
+
+	case TCL_PLATFORM_UNIX:
+	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
+		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+		    Tcl_DStringAppend(&append, "/", 1);
+		} else {
+		    Tcl_DStringAppend(&append, ".", 1);
 		}
-		break;
 	    }
+	    break;
 	}
-	/* Common for all platforms */
-	name = Tcl_DStringValue(headPtr);
-	nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
 
-	Tcl_IncrRefCount(nameObj);
-	result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
-		nameObj, NULL, types);
-	Tcl_DecrRefCount(nameObj);
-	return result;
-    }
-}
+	/*
+	 * Common for all platforms.
+	 */
 
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFileDirname
- *
- *	This procedure calculates the directory above a given 
- *	path: basically 'file dirname'.  It is used both by
- *	the 'dirname' subcommand of file and by code in tclIOUtil.c.
- *
- * Results:
- *	NULL if an error occurred, otherwise a Tcl_Obj owned by
- *	the caller (i.e. most likely with refCount 1).
- *
- * Side effects:
- *      None.
- *
- *---------------------------------------------------------------------------
- */
+	if (pathPtr == NULL) {
+	    joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
+		    Tcl_DStringLength(&append));
+	} else if (flags) {
+	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
+		    Tcl_DStringLength(&append));
+	} else {
+	    joinedPtr = Tcl_DuplicateObj(pathPtr);
+	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
+		/*
+		 * The current prefix must end in a separator.
+		 */
 
-Tcl_Obj*
-TclFileDirname(interp, pathPtr)
-    Tcl_Interp *interp;		/* Used for error reporting */
-    Tcl_Obj *pathPtr;           /* Path to take dirname of */
-{
-    int splitElements;
-    Tcl_Obj *splitPtr;
-    Tcl_Obj *splitResultPtr = NULL;
-
-    /* 
-     * The behaviour we want here is slightly different to
-     * the standard Tcl_FSSplitPath in the handling of home
-     * directories; Tcl_FSSplitPath preserves the "~" while 
-     * this code computes the actual full path name, if we
-     * had just a single component.
-     */	    
-    splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
-    if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) {
-	Tcl_DecrRefCount(splitPtr);
-	splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
-	if (splitPtr == NULL) {
-	    return NULL;
+		int len;
+		const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+
+		if (strchr(separators, joined[len-1]) == NULL) {
+		    Tcl_AppendToObj(joinedPtr, "/", 1);
+		}
+	    }
+	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
+		    Tcl_DStringLength(&append));
 	}
-	splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
+	Tcl_IncrRefCount(joinedPtr);
+	Tcl_DStringFree(&append);
+	result = Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL,
+		types);
+	Tcl_DecrRefCount(joinedPtr);
+	return result;
     }
 
     /*
-     * Return all but the last component.  If there is only one
-     * component, return it if the path was non-relative, otherwise
-     * return the current directory.
+     * If it's not the end of the string, we must recurse
      */
 
-    if (splitElements > 1) {
-	splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
-    } else if (splitElements == 0 || 
-      (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
-	splitResultPtr = Tcl_NewStringObj(".", 1);
+    if (pathPtr == NULL) {
+	joinedPtr = Tcl_NewStringObj(pattern, p-pattern);
+    } else if (flags) {
+	joinedPtr = TclNewFSPathObj(pathPtr, pattern, p-pattern);
     } else {
-	Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
+	joinedPtr = Tcl_DuplicateObj(pathPtr);
+	if (strchr(separators, pattern[0]) == NULL) {
+	    /*
+	     * The current prefix must end in a separator, unless this is a
+	     * volume-relative path. In particular globbing in Windows shares,
+	     * when not using -dir or -path, e.g. 'glob [file join
+	     * //machine/share/subdir *]' requires adding a separator here.
+	     * This behaviour is not currently tested for in the test suite.
+	     */
+
+	    int len;
+	    const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+
+	    if (strchr(separators, joined[len-1]) == NULL) {
+		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
+		    Tcl_AppendToObj(joinedPtr, "/", 1);
+		}
+	    }
+	}
+	Tcl_AppendToObj(joinedPtr, pattern, p-pattern);
     }
-    Tcl_IncrRefCount(splitResultPtr);
-    Tcl_DecrRefCount(splitPtr);
-    return splitResultPtr;
+
+    Tcl_IncrRefCount(joinedPtr);
+    result = DoGlob(interp, matchesObj, separators, joinedPtr, 1, p, types);
+    Tcl_DecrRefCount(joinedPtr);
+
+    return result;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_AllocStatBuf
+ * Tcl_AllocStatBuf --
  *
- *     This procedure allocates a Tcl_StatBuf on the heap.  It exists
- *     so that extensions may be used unchanged on systems where
- *     largefile support is optional.
+ *	This procedure allocates a Tcl_StatBuf on the heap. It exists so that
+ *	extensions may be used unchanged on systems where largefile support is
+ *	optional.
  *
  * Results:
- *     A pointer to a Tcl_StatBuf which may be deallocated by being
- *     passed to ckfree().
+ *	A pointer to a Tcl_StatBuf which may be deallocated by being passed to
+ *	ckfree().
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *---------------------------------------------------------------------------
  */
 
 Tcl_StatBuf *
-Tcl_AllocStatBuf() {
+Tcl_AllocStatBuf(void)
+{
     return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
new file mode 100644
index 0000000..02cb424
--- /dev/null
+++ b/generic/tclFileSystem.h
@@ -0,0 +1,74 @@
+/*
+ * tclFileSystem.h --
+ *
+ *	This file contains the common defintions and prototypes for use by
+ *	Tcl's filesystem and path handling layers.
+ *
+ * Copyright (c) 2003 Vince Darley.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLFILESYSTEM
+#define _TCLFILESYSTEM
+
+#include "tcl.h"
+
+/*
+ * The internal TclFS API provides routines for handling and manipulating
+ * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
+ *
+ * These functions are not exported at all at present.
+ */
+
+MODULE_SCOPE int	TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
+MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr, int startAt);
+MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
+MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
+			    Tcl_Filesystem **fsPtrPtr);
+MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
+			    Tcl_Filesystem *fsPtr, ClientData clientData);
+MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr);
+MODULE_SCOPE int	TclFSEpoch(void);
+
+/*
+ * Private shared variables for use by tclIOUtil.c and tclPathObj.c
+ */
+
+MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem;
+
+/*
+ * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
+ * tclFileName.c, and any platform-specific filesystem code.
+ */
+
+MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
+			    Tcl_Filesystem **filesystemPtrPtr,
+			    int *driveNameLengthPtr);
+MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(CONST char *pathPtr,
+			    int pathLen, Tcl_Filesystem **filesystemPtrPtr,
+			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
+MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
+			    Tcl_Filesystem **filesystemPtrPtr,
+			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
+MODULE_SCOPE int	TclFSEpochOk(int filesystemEpoch);
+MODULE_SCOPE int	TclFSCwdIsNative(void);
+MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
+			    CONST char *path, Tcl_Obj **useThisCwdPtr);
+
+MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
+MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
+
+#endif /* _TCLFILESYSTEM */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclGet.c b/generic/tclGet.c
index c16da0d..28734d1 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -1,21 +1,18 @@
-/* 
+/*
  * tclGet.c --
  *
- *	This file contains procedures to convert strings into
- *	other forms, like integers or floating-point numbers or
- *	booleans, doing syntax checking along the way.
+ *	This file contains functions to convert strings into other forms, like
+ *	integers or floating-point numbers or booleans, doing syntax checking
+ *	along the way.
  *
  * Copyright (c) 1990-1993 The Regents of the University of California.
  * Copyright (c) 1994-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
-#include <math.h>
-
 
 /*
  *----------------------------------------------------------------------
@@ -25,10 +22,10 @@
  *	Given a string, produce the corresponding integer value.
  *
  * Results:
- *	The return value is normally TCL_OK;  in this case *intPtr
- *	will be set to the integer value equivalent to string.  If
- *	string is improperly formed then TCL_ERROR is returned and
- *	an error message will be left in the interp's result.
+ *	The return value is normally TCL_OK; in this case *intPtr will be set
+ *	to the integer value equivalent to src.  If src is improperly formed
+ *	then TCL_ERROR is returned and an error message will be left in the
+ *	interp's result.
  *
  * Side effects:
  *	None.
@@ -37,80 +34,27 @@
  */
 
 int
-Tcl_GetInt(interp, string, intPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    CONST char *string;		/* String containing a (possibly signed)
-				 * integer in a form acceptable to strtol. */
-    int *intPtr;		/* Place to store converted result. */
+Tcl_GetInt(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
+    CONST char *src,		/* String containing a (possibly signed)
+				 * integer in a form acceptable to
+				 * Tcl_GetIntFromObj(). */
+    int *intPtr)		/* Place to store converted result. */
 {
-    char *end;
-    CONST char *p = string;
-    long i;
-
-    /*
-     * 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.
-     */
-
-    errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
-    /*
-     * This special sign check actually causes bad numbers to be allowed
-     * when strtoul.  I can't find a strtoul that doesn't validly handle
-     * signed characters, and the C standard implies that this is all
-     * unnecessary. [Bug #634856]
-     */
-    for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
-	/* Empty loop body. */
-    }
-    if (*p == '-') {
-	p++;
-	i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
-    } else if (*p == '+') {
-	p++;
-	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    } else
-#else
-	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-#endif
-    if (end == p) {
-	badInteger:
-        if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_AppendResult(interp, "expected integer but got \"", string,
-		    "\"", (char *) NULL);
-	    TclCheckBadOctal(interp, string);
-        }
-	return TCL_ERROR;
-    }
+    Tcl_Obj obj;
+    int code;
 
-    /*
-     * The second test below is needed on platforms where "long" is
-     * larger than "int" to detect values that fit in a long but not in
-     * an int.
-     */
+    obj.refCount = 1;
+    obj.bytes = (char *) src;
+    obj.length = strlen(src);
+    obj.typePtr = NULL;
 
-    if ((errno == ERANGE) 
-#if (LONG_MAX > INT_MAX)
-	    || (i > UINT_MAX) || (i < -(long)UINT_MAX)
-#endif
-    ) {
-        if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_SetResult(interp, "integer value too large to represent",
-		    TCL_STATIC);
-            Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-		    Tcl_GetStringResult(interp), (char *) NULL);
-        }
-	return TCL_ERROR;
-    }
-    while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (*end != 0) {
-	goto badInteger;
+    code = Tcl_GetIntFromObj(interp, &obj, intPtr);
+    if (obj.refCount > 1) {
+	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
-    *intPtr = (int) i;
-    return TCL_OK;
+    TclFreeIntRep(&obj);
+    return code;
 }
 
 /*
@@ -118,16 +62,15 @@ Tcl_GetInt(interp, string, intPtr)
  *
  * TclGetLong --
  *
- *	Given a string, produce the corresponding long integer value.
- *	This routine is a version of Tcl_GetInt but returns a "long"
- *	instead of an "int".
+ *	Given a string, produce the corresponding long integer value. This
+ *	routine is a version of Tcl_GetInt but returns a "long" instead of an
+ *	"int" (a difference that matters on 64-bit architectures).
  *
  * Results:
- *	The return value is normally TCL_OK; in this case *longPtr
- *	will be set to the long integer value equivalent to string. If
- *	string is improperly formed then TCL_ERROR is returned and
- *	an error message will be left in the interp's result if interp
- *	is non-NULL. 
+ *	The return value is normally TCL_OK; in this case *longPtr will be set
+ *	to the long integer value equivalent to src. If src is improperly
+ *	formed then TCL_ERROR is returned and an error message will be left in
+ *	the interp's result if interp is non-NULL.
  *
  * Side effects:
  *	None.
@@ -136,64 +79,28 @@ Tcl_GetInt(interp, string, intPtr)
  */
 
 int
-TclGetLong(interp, string, longPtr)
-    Tcl_Interp *interp;		/* Interpreter used for error reporting
-				 * if not NULL. */
-    CONST char *string;		/* String containing a (possibly signed)
-				 * long integer in a form acceptable to
-				 * strtoul. */
-    long *longPtr;		/* Place to store converted long result. */
+TclGetLong(
+    Tcl_Interp *interp,		/* Interpreter used for error reporting if not
+				 * NULL. */
+    CONST char *src,		/* String containing a (possibly signed) long
+				 * integer in a form acceptable to
+				 * Tcl_GetLongFromObj(). */
+    long *longPtr)		/* Place to store converted long result. */
 {
-    char *end;
-    CONST char *p = string;
-    long i;
+    Tcl_Obj obj;
+    int code;
 
-    /*
-     * Note: don't depend on strtoul to handle sign characters; it won't
-     * in some implementations.
-     */
+    obj.refCount = 1;
+    obj.bytes = (char *) src;
+    obj.length = strlen(src);
+    obj.typePtr = NULL;
 
-    errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
-    for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
-	/* Empty loop body. */
-    }
-    if (*p == '-') {
-	p++;
-	i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
-    } else if (*p == '+') {
-	p++;
-	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-    } else
-#else
-	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-#endif
-    if (end == p) {
-	badInteger:
-        if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_AppendResult(interp, "expected integer but got \"", string,
-		    "\"", (char *) NULL);
-	    TclCheckBadOctal(interp, string);
-        }
-	return TCL_ERROR;
-    }
-    if (errno == ERANGE) {
-        if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_SetResult(interp, "integer value too large to represent",
-		    TCL_STATIC);
-            Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-                    Tcl_GetStringResult(interp), (char *) NULL);
-        }
-	return TCL_ERROR;
+    code = Tcl_GetLongFromObj(interp, &obj, longPtr);
+    if (obj.refCount > 1) {
+	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
-    while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (*end != 0) {
-	goto badInteger;
-    }
-    *longPtr = i;
-    return TCL_OK;
+    TclFreeIntRep(&obj);
+    return code;
 }
 
 /*
@@ -205,10 +112,10 @@ TclGetLong(interp, string, longPtr)
  *	floating-point value.
  *
  * Results:
- *	The return value is normally TCL_OK; in this case *doublePtr
- *	will be set to the double-precision value equivalent to string.
- *	If string is improperly formed then TCL_ERROR is returned and
- *	an error message will be left in the interp's result.
+ *	The return value is normally TCL_OK; in this case *doublePtr will be
+ *	set to the double-precision value equivalent to src. If src is
+ *	improperly formed then TCL_ERROR is returned and an error message will
+ *	be left in the interp's result.
  *
  * Side effects:
  *	None.
@@ -217,40 +124,27 @@ TclGetLong(interp, string, longPtr)
  */
 
 int
-Tcl_GetDouble(interp, string, doublePtr)
-    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
-    CONST char *string;		/* String containing a floating-point number
-				 * in a form acceptable to strtod. */
-    double *doublePtr;		/* Place to store converted result. */
+Tcl_GetDouble(
+    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
+    CONST char *src,		/* String containing a floating-point number
+				 * in a form acceptable to 
+				 * Tcl_GetDoubleFromObj(). */
+    double *doublePtr)		/* Place to store converted result. */
 {
-    char *end;
-    double d;
+    Tcl_Obj obj;
+    int code;
 
-    errno = 0;
-    d = strtod(string, &end); /* INTL: Tcl source. */
-    if (end == string) {
-	badDouble:
-        if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp,
-                    "expected floating-point number but got \"",
-                    string, "\"", (char *) NULL);
-        }
-	return TCL_ERROR;
-    }
-    if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
-        if (interp != (Tcl_Interp *) NULL) {
-            TclExprFloatError(interp, d); 
-        }
-	return TCL_ERROR;
-    }
-    while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (*end != 0) {
-	goto badDouble;
+    obj.refCount = 1;
+    obj.bytes = (char *) src;
+    obj.length = strlen(src);
+    obj.typePtr = NULL;
+
+    code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
+    if (obj.refCount > 1) {
+	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
-    *doublePtr = d;
-    return TCL_OK;
+    TclFreeIntRep(&obj);
+    return code;
 }
 
 /*
@@ -258,14 +152,14 @@ Tcl_GetDouble(interp, string, doublePtr)
  *
  * Tcl_GetBoolean --
  *
- *	Given a string, return a 0/1 boolean value corresponding
- *	to the string.
+ *	Given a string, return a 0/1 boolean value corresponding to the
+ *	string.
  *
  * Results:
- *	The return value is normally TCL_OK;  in this case *boolPtr
- *	will be set to the 0/1 value equivalent to string.  If
- *	string is improperly formed then TCL_ERROR is returned and
- *	an error message will be left in the interp's result.
+ *	The return value is normally TCL_OK; in this case *boolPtr will be set
+ *	to the 0/1 value equivalent to src. If src is improperly formed then
+ *	TCL_ERROR is returned and an error message will be left in the
+ *	interp's result.
  *
  * Side effects:
  *	None.
@@ -274,64 +168,35 @@ Tcl_GetDouble(interp, string, doublePtr)
  */
 
 int
-Tcl_GetBoolean(interp, string, boolPtr)
-    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
-    CONST char *string;		/* String containing a boolean number
-				 * specified either as 1/0 or true/false or
-				 * yes/no. */
-    int *boolPtr;		/* Place to store converted result, which
-				 * will be 0 or 1. */
+Tcl_GetBoolean(
+    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
+    CONST char *src,		/* String containing one of the boolean values
+				 * 1, 0, true, false, yes, no, on off. */
+    int *boolPtr)		/* Place to store converted result, which will
+				 * be 0 or 1. */
 {
-    int i;
-    char lowerCase[10], c;
-    size_t length;
+    Tcl_Obj obj;
+    int code;
 
-    /*
-     * Convert the input string to all lower-case. 
-     * INTL: This code will work on UTF strings.
-     */
+    obj.refCount = 1;
+    obj.bytes = (char *) src;
+    obj.length = strlen(src);
+    obj.typePtr = NULL;
 
-    for (i = 0; i < 9; i++) {
-	c = string[i];
-	if (c == 0) {
-	    break;
-	}
-	if ((c >= 'A') && (c <= 'Z')) {
-	    c += (char) ('a' - 'A');
-	}
-	lowerCase[i] = c;
+    code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
+    if (obj.refCount > 1) {
+	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
-    lowerCase[i] = 0;
-
-    length = strlen(lowerCase);
-    c = lowerCase[0];
-    if ((c == '0') && (lowerCase[1] == '\0')) {
-	*boolPtr = 0;
-    } else if ((c == '1') && (lowerCase[1] == '\0')) {
-	*boolPtr = 1;
-    } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
-	*boolPtr = 1;
-    } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
-	*boolPtr = 0;
-    } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
-	*boolPtr = 1;
-    } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
-	*boolPtr = 0;
-    } else if ((c == 'o') && (length >= 2)) {
-	if (strncmp(lowerCase, "on", length) == 0) {
-	    *boolPtr = 1;
-	} else if (strncmp(lowerCase, "off", length) == 0) {
-	    *boolPtr = 0;
-	} else {
-	    goto badBoolean;
-	}
-    } else {
-	badBoolean:
-        if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "expected boolean value but got \"",
-                    string, "\"", (char *) NULL);
-        }
-	return TCL_ERROR;
+    if (code == TCL_OK) {
+	*boolPtr = obj.internalRep.longValue;
     }
-    return TCL_OK;
+    return code;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index 52a5052..551b1ed 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -1,331 +1,409 @@
-/* 
+/*
  * tclGetDate.y --
  *
- *	Contains yacc grammar for parsing date and time strings.
- *	The output of this file should be the file tclDate.c which
- *	is used directly in the Tcl sources.
+ *	Contains yacc grammar for parsing date and time strings. The output of
+ *	this file should be the file tclDate.c which is used directly in the
+ *	Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
+ *	only used when doing free-form date parsing, an ill-defined process
+ *	anyway.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+%parse-param {DateInfo* info}
+%lex-param {DateInfo* info}
+%pure-parser
+ /* %error-verbose would be nice, but our token names are meaningless */
+%locations
+
 %{
-/* 
+/*
  * tclDate.c --
  *
- *	This file is generated from a yacc grammar defined in
- *	the file tclGetDate.y.  It should not be edited directly.
+ *	This file is generated from a yacc grammar defined in the file
+ *	tclGetDate.y. It should not be edited directly.
  *
  * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCSID
  */
-
 #include "tclInt.h"
-#include "tclPort.h"
 
-#define EPOCH           1970
-#define START_OF_TIME   1902
-#define END_OF_TIME     2037
+/*
+ * Bison generates several labels that happen to be unused. MS Visual C++
+ * doesn't like that, and complains. Tell it to shut up.
+ */
+
+#ifdef _MSC_VER
+#pragma warning( disable : 4102 )
+#endif /* _MSC_VER */
+
+/*
+ * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
+ * parsed fields will be returned.
+ */
+
+typedef struct DateInfo {
+
+    Tcl_Obj* messages;		/* Error messages */
+    const char* separatrix;	/* String separating messages */
+
+    time_t dateYear;
+    time_t dateMonth;
+    time_t dateDay;
+    int dateHaveDate;
+
+    time_t dateHour;
+    time_t dateMinutes;
+    time_t dateSeconds;
+    int dateMeridian;
+    int dateHaveTime;
+
+    time_t dateTimezone;
+    int dateDSTmode;
+    int dateHaveZone;
+
+    time_t dateRelMonth;
+    time_t dateRelDay;
+    time_t dateRelSeconds;
+    int dateHaveRel;
+
+    time_t dateMonthOrdinal;
+    int dateHaveOrdinalMonth;
+
+    time_t dateDayOrdinal;
+    time_t dateDayNumber;
+    int dateHaveDay;
+
+    const char *dateStart;
+    const char *dateInput;
+    time_t *dateRelPointer;
+
+    int dateDigitCount;
+} DateInfo;
+
+#define YYMALLOC	ckalloc
+#define YYFREE(x)	(ckfree((void*) (x)))
+
+#define yyDSTmode	(info->dateDSTmode)
+#define yyDayOrdinal	(info->dateDayOrdinal)
+#define yyDayNumber	(info->dateDayNumber)
+#define yyMonthOrdinal	(info->dateMonthOrdinal)
+#define yyHaveDate	(info->dateHaveDate)
+#define yyHaveDay	(info->dateHaveDay)
+#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
+#define yyHaveRel	(info->dateHaveRel)
+#define yyHaveTime	(info->dateHaveTime)
+#define yyHaveZone	(info->dateHaveZone)
+#define yyTimezone	(info->dateTimezone)
+#define yyDay		(info->dateDay)
+#define yyMonth		(info->dateMonth)
+#define yyYear		(info->dateYear)
+#define yyHour		(info->dateHour)
+#define yyMinutes	(info->dateMinutes)
+#define yySeconds	(info->dateSeconds)
+#define yyMeridian	(info->dateMeridian)
+#define yyRelMonth	(info->dateRelMonth)
+#define yyRelDay	(info->dateRelDay)
+#define yyRelSeconds	(info->dateRelSeconds)
+#define yyRelPointer	(info->dateRelPointer)
+#define yyInput		(info->dateInput)
+#define yyDigitCount	(info->dateDigitCount)
+
+#define EPOCH		1970
+#define START_OF_TIME	1902
+#define END_OF_TIME	2037
 
 /*
  * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
- * I don't know how universal this is; K&R II, the NetBSD manpages, and
- * ../compat/strftime.c all agree that tm_year is the year-1900.  However,
- * some systems may have a different value.  This #define should be the
- * same as in ../compat/strftime.c.
+ * Posix requires 1900.
  */
-#define TM_YEAR_BASE 1900
 
-#define HOUR(x)         ((int) (60 * x))
-#define SECSPERDAY      (24L * 60L * 60L)
-#define IsLeapYear(x)   ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
+#define TM_YEAR_BASE	1900
+
+#define HOUR(x)		((int) (60 * x))
+#define SECSPERDAY	(24L * 60L * 60L)
+#define IsLeapYear(x)	((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
 
 /*
- *  An entry in the lexical lookup table.
+ * An entry in the lexical lookup table.
  */
+
 typedef struct _TABLE {
-    char        *name;
-    int         type;
-    time_t      value;
+    const char *name;
+    int type;
+    time_t value;
 } TABLE;
 
-
 /*
- *  Daylight-savings mode:  on, off, or not yet known.
+ * Daylight-savings mode: on, off, or not yet known.
  */
+
 typedef enum _DSTMODE {
     DSTon, DSToff, DSTmaybe
 } DSTMODE;
 
 /*
- *  Meridian:  am, pm, or 24-hour style.
+ * Meridian: am, pm, or 24-hour style.
  */
+
 typedef enum _MERIDIAN {
     MERam, MERpm, MER24
 } MERIDIAN;
 
+%}
 
-/*
- *  Global variables.  We could get rid of most of these by using a good
- *  union as the yacc stack.  (This routine was originally written before
- *  yacc had the %union construct.)  Maybe someday; right now we only use
- *  the %union very rarely.
- */
-static char     *yyInput;
-static DSTMODE  yyDSTmode;
-static time_t   yyDayOrdinal;
-static time_t   yyDayNumber;
-static time_t   yyMonthOrdinal;
-static int      yyHaveDate;
-static int      yyHaveDay;
-static int      yyHaveOrdinalMonth;
-static int      yyHaveRel;
-static int      yyHaveTime;
-static int      yyHaveZone;
-static time_t   yyTimezone;
-static time_t   yyDay;
-static time_t   yyHour;
-static time_t   yyMinutes;
-static time_t   yyMonth;
-static time_t   yySeconds;
-static time_t   yyYear;
-static MERIDIAN yyMeridian;
-static time_t   yyRelMonth;
-static time_t   yyRelDay;
-static time_t   yyRelSeconds;
-static time_t  *yyRelPointer;
+%union {
+    time_t Number;
+    enum _MERIDIAN Meridian;
+}
+
+%{
 
 /*
  * Prototypes of internal functions.
  */
-static void	yyerror _ANSI_ARGS_((char *s));
-static time_t	ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes,
-		    time_t Seconds, MERIDIAN Meridian));
-static int	Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
-		    time_t Hours, time_t Minutes, time_t Seconds,
-		    MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
-static time_t	DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
-static time_t	NamedDay _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
-		    time_t DayNumber));
-static time_t   NamedMonth _ANSI_ARGS_((time_t Start, time_t MonthOrdinal,
-                    time_t MonthNumber));
-static int	RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
-		    time_t *TimePtr));
-static int	RelativeDay _ANSI_ARGS_((time_t Start, time_t RelDay,
-		    time_t *TimePtr));
-static int	LookupWord _ANSI_ARGS_((char *buff));
-static int	yylex _ANSI_ARGS_((void));
 
-int
-yyparse _ANSI_ARGS_((void));
+static int		LookupWord(YYSTYPE* yylvalPtr, char *buff);
+ static void		TclDateerror(YYLTYPE* location,
+				     DateInfo* info, const char *s);
+ static int		TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
+				   DateInfo* info);
+static time_t		ToSeconds(time_t Hours, time_t Minutes,
+			    time_t Seconds, MERIDIAN Meridian);
+MODULE_SCOPE int	yyparse(DateInfo*);
+
 %}
 
-%union {
-    time_t              Number;
-    enum _MERIDIAN      Meridian;
-}
-
-%token  tAGO tDAY tDAYZONE tID tMERIDIAN tMINUTE_UNIT tMONTH tMONTH_UNIT
-%token  tSTARDATE tSEC_UNIT tSNUMBER tUNUMBER tZONE tEPOCH tDST tISOBASE
-%token  tDAY_UNIT tNEXT
-
-%type   <Number>        tDAY tDAYZONE tMINUTE_UNIT tMONTH tMONTH_UNIT tDST
-%type   <Number>        tSEC_UNIT tSNUMBER tUNUMBER tZONE tISOBASE tDAY_UNIT
-%type   <Number>        unit sign tNEXT tSTARDATE
-%type   <Meridian>      tMERIDIAN o_merid
+%token	tAGO
+%token	tDAY
+%token	tDAYZONE
+%token	tID
+%token	tMERIDIAN
+%token	tMONTH
+%token	tMONTH_UNIT
+%token	tSTARDATE
+%token	tSEC_UNIT
+%token	tSNUMBER
+%token	tUNUMBER
+%token	tZONE
+%token	tEPOCH
+%token	tDST
+%token	tISOBASE
+%token	tDAY_UNIT
+%token	tNEXT
+
+%type	<Number>	tDAY
+%type	<Number>	tDAYZONE
+%type	<Number>	tMONTH
+%type	<Number>	tMONTH_UNIT
+%type	<Number>	tDST
+%type	<Number>	tSEC_UNIT
+%type	<Number>	tSNUMBER
+%type	<Number>	tUNUMBER
+%type	<Number>	tZONE
+%type	<Number>	tISOBASE
+%type	<Number>	tDAY_UNIT
+%type	<Number>	unit
+%type	<Number>	sign
+%type	<Number>	tNEXT
+%type	<Number>	tSTARDATE
+%type	<Meridian>	tMERIDIAN
+%type	<Meridian>	o_merid
 
 %%
 
-spec    : /* NULL */
-        | spec item
-        ;
-
-item    : time {
-            yyHaveTime++;
-        }
-        | zone {
-            yyHaveZone++;
-        }
-        | date {
-            yyHaveDate++;
-        }
-        | ordMonth {
-            yyHaveOrdinalMonth++;
-        }
-        | day {
-            yyHaveDay++;
-        }
-        | relspec {
-            yyHaveRel++;
-        }
-        | iso {
+spec	: /* NULL */
+	| spec item
+	;
+
+item	: time {
+	    yyHaveTime++;
+	}
+	| zone {
+	    yyHaveZone++;
+	}
+	| date {
+	    yyHaveDate++;
+	}
+	| ordMonth {
+	    yyHaveOrdinalMonth++;
+	}
+	| day {
+	    yyHaveDay++;
+	}
+	| relspec {
+	    yyHaveRel++;
+	}
+	| iso {
 	    yyHaveTime++;
 	    yyHaveDate++;
 	}
-        | trek {
+	| trek {
 	    yyHaveTime++;
 	    yyHaveDate++;
 	    yyHaveRel++;
-        }
-        | number
-        ;
-
-time    : tUNUMBER tMERIDIAN {
-            yyHour = $1;
-            yyMinutes = 0;
-            yySeconds = 0;
-            yyMeridian = $2;
-        }
-        | tUNUMBER ':' tUNUMBER o_merid {
-            yyHour = $1;
-            yyMinutes = $3;
-            yySeconds = 0;
-            yyMeridian = $4;
-        }
-        | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
-            yyHour = $1;
-            yyMinutes = $3;
-            yyMeridian = MER24;
-            yyDSTmode = DSToff;
-            yyTimezone = ($5 % 100 + ($5 / 100) * 60);
-        }
-        | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
-            yyHour = $1;
-            yyMinutes = $3;
-            yySeconds = $5;
-            yyMeridian = $6;
-        }
-        | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
-            yyHour = $1;
-            yyMinutes = $3;
-            yySeconds = $5;
-            yyMeridian = MER24;
-            yyDSTmode = DSToff;
-            yyTimezone = ($7 % 100 + ($7 / 100) * 60);
-        }
-        ;
-
-zone    : tZONE tDST {
-            yyTimezone = $1;
-            yyDSTmode = DSTon;
-        }
-        | tZONE {
-            yyTimezone = $1;
-            yyDSTmode = DSToff;
-        }
-        | tDAYZONE {
-            yyTimezone = $1;
-            yyDSTmode = DSTon;
-        }
-        ;
-
-day     : tDAY {
-            yyDayOrdinal = 1;
-            yyDayNumber = $1;
-        }
-        | tDAY ',' {
-            yyDayOrdinal = 1;
-            yyDayNumber = $1;
-        }
-        | tUNUMBER tDAY {
-            yyDayOrdinal = $1;
-            yyDayNumber = $2;
-        }
-        | sign tUNUMBER tDAY {
-            yyDayOrdinal = $1 * $2;
-            yyDayNumber = $3;
-        }
-        | tNEXT tDAY {
-            yyDayOrdinal = 2;
-            yyDayNumber = $2;
-        }
-        ;
-
-date    : tUNUMBER '/' tUNUMBER {
-            yyMonth = $1;
-            yyDay = $3;
-        }
-        | tUNUMBER '/' tUNUMBER '/' tUNUMBER {
-            yyMonth = $1;
-            yyDay = $3;
-            yyYear = $5;
-        }
-        | tISOBASE {
+	}
+	| number
+	;
+
+time	: tUNUMBER tMERIDIAN {
+	    yyHour = $1;
+	    yyMinutes = 0;
+	    yySeconds = 0;
+	    yyMeridian = $2;
+	}
+	| tUNUMBER ':' tUNUMBER o_merid {
+	    yyHour = $1;
+	    yyMinutes = $3;
+	    yySeconds = 0;
+	    yyMeridian = $4;
+	}
+	| tUNUMBER ':' tUNUMBER '-' tUNUMBER {
+	    yyHour = $1;
+	    yyMinutes = $3;
+	    yyMeridian = MER24;
+	    yyDSTmode = DSToff;
+	    yyTimezone = ($5 % 100 + ($5 / 100) * 60);
+	    ++yyHaveZone;
+	}
+	| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
+	    yyHour = $1;
+	    yyMinutes = $3;
+	    yySeconds = $5;
+	    yyMeridian = $6;
+	}
+	| tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
+	    yyHour = $1;
+	    yyMinutes = $3;
+	    yySeconds = $5;
+	    yyMeridian = MER24;
+	    yyDSTmode = DSToff;
+	    yyTimezone = ($7 % 100 + ($7 / 100) * 60);
+	    ++yyHaveZone;
+	}
+	;
+
+zone	: tZONE tDST {
+	    yyTimezone = $1;
+	    yyDSTmode = DSTon;
+	}
+	| tZONE {
+	    yyTimezone = $1;
+	    yyDSTmode = DSToff;
+	}
+	| tDAYZONE {
+	    yyTimezone = $1;
+	    yyDSTmode = DSTon;
+	}
+	;
+
+day	: tDAY {
+	    yyDayOrdinal = 1;
+	    yyDayNumber = $1;
+	}
+	| tDAY ',' {
+	    yyDayOrdinal = 1;
+	    yyDayNumber = $1;
+	}
+	| tUNUMBER tDAY {
+	    yyDayOrdinal = $1;
+	    yyDayNumber = $2;
+	}
+	| sign tUNUMBER tDAY {
+	    yyDayOrdinal = $1 * $2;
+	    yyDayNumber = $3;
+	}
+	| tNEXT tDAY {
+	    yyDayOrdinal = 2;
+	    yyDayNumber = $2;
+	}
+	;
+
+date	: tUNUMBER '/' tUNUMBER {
+	    yyMonth = $1;
+	    yyDay = $3;
+	}
+	| tUNUMBER '/' tUNUMBER '/' tUNUMBER {
+	    yyMonth = $1;
+	    yyDay = $3;
+	    yyYear = $5;
+	}
+	| tISOBASE {
 	    yyYear = $1 / 10000;
 	    yyMonth = ($1 % 10000)/100;
 	    yyDay = $1 % 100;
 	}
-        | tUNUMBER '-' tMONTH '-' tUNUMBER {
+	| tUNUMBER '-' tMONTH '-' tUNUMBER {
 	    yyDay = $1;
 	    yyMonth = $3;
 	    yyYear = $5;
 	}
-        | tUNUMBER '-' tUNUMBER '-' tUNUMBER {
-            yyMonth = $3;
-            yyDay = $5;
-            yyYear = $1;
-        }
-        | tMONTH tUNUMBER {
-            yyMonth = $1;
-            yyDay = $2;
-        }
-        | tMONTH tUNUMBER ',' tUNUMBER {
-            yyMonth = $1;
-            yyDay = $2;
-            yyYear = $4;
-        }
-        | tUNUMBER tMONTH {
-            yyMonth = $2;
-            yyDay = $1;
-        }
-        | tEPOCH {
+	| tUNUMBER '-' tUNUMBER '-' tUNUMBER {
+	    yyMonth = $3;
+	    yyDay = $5;
+	    yyYear = $1;
+	}
+	| tMONTH tUNUMBER {
+	    yyMonth = $1;
+	    yyDay = $2;
+	}
+	| tMONTH tUNUMBER ',' tUNUMBER {
+	    yyMonth = $1;
+	    yyDay = $2;
+	    yyYear = $4;
+	}
+	| tUNUMBER tMONTH {
+	    yyMonth = $2;
+	    yyDay = $1;
+	}
+	| tEPOCH {
 	    yyMonth = 1;
 	    yyDay = 1;
 	    yyYear = EPOCH;
 	}
-        | tUNUMBER tMONTH tUNUMBER {
-            yyMonth = $2;
-            yyDay = $1;
-            yyYear = $3;
-        }
-        ;
+	| tUNUMBER tMONTH tUNUMBER {
+	    yyMonth = $2;
+	    yyDay = $1;
+	    yyYear = $3;
+	}
+	;
 
 ordMonth: tNEXT tMONTH {
 	    yyMonthOrdinal = 1;
 	    yyMonth = $2;
 	}
-        | tNEXT tUNUMBER tMONTH {
+	| tNEXT tUNUMBER tMONTH {
 	    yyMonthOrdinal = $2;
 	    yyMonth = $3;
 	}
-        ;
+	;
 
-iso     : tISOBASE tZONE tISOBASE {
-            if ($2 != HOUR(- 7)) YYABORT;
+iso	: tISOBASE tZONE tISOBASE {
+	    if ($2 != HOUR( 7)) YYABORT;
 	    yyYear = $1 / 10000;
 	    yyMonth = ($1 % 10000)/100;
 	    yyDay = $1 % 100;
 	    yyHour = $3 / 10000;
 	    yyMinutes = ($3 % 10000)/100;
 	    yySeconds = $3 % 100;
-        }
-        | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
-            if ($2 != HOUR(- 7)) YYABORT;
+	}
+	| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
+	    if ($2 != HOUR( 7)) YYABORT;
 	    yyYear = $1 / 10000;
 	    yyMonth = ($1 % 10000)/100;
 	    yyDay = $1 % 100;
 	    yyHour = $3;
 	    yyMinutes = $5;
 	    yySeconds = $7;
-        }
+	}
 	| tISOBASE tISOBASE {
 	    yyYear = $1 / 10000;
 	    yyMonth = ($1 % 10000)/100;
@@ -333,21 +411,22 @@ iso     : tISOBASE tZONE tISOBASE {
 	    yyHour = $2 / 10000;
 	    yyMinutes = ($2 % 10000)/100;
 	    yySeconds = $2 % 100;
-        }
-        ;
+	}
+	;
 
-trek    : tSTARDATE tUNUMBER '.' tUNUMBER {
-            /*
-	     * Offset computed year by -377 so that the returned years will
-	     * be in a range accessible with a 32 bit clock seconds value
+trek	: tSTARDATE tUNUMBER '.' tUNUMBER {
+	    /*
+	     * Offset computed year by -377 so that the returned years will be
+	     * in a range accessible with a 32 bit clock seconds value.
 	     */
-            yyYear = $2/1000 + 2323 - 377;
-            yyDay  = 1;
+
+	    yyYear = $2/1000 + 2323 - 377;
+	    yyDay  = 1;
 	    yyMonth = 1;
 	    yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000;
 	    yyRelSeconds += $4 * 144 * 60;
-        }
-        ;
+	}
+	;
 
 relspec : relunits tAGO {
 	    yyRelSeconds *= -1;
@@ -356,209 +435,241 @@ relspec : relunits tAGO {
 	}
 	| relunits
 	;
-relunits : sign tUNUMBER unit  { *yyRelPointer += $1 * $2 * $3; }
-        | tUNUMBER unit        { *yyRelPointer += $1 * $2; }
-        | tNEXT unit           { *yyRelPointer += $2; }
-        | tNEXT tUNUMBER unit  { *yyRelPointer += $2 * $3; }
-        | unit                 { *yyRelPointer += $1; }
-        ;
-sign    : '-'            { $$ = -1; }
-        | '+'            { $$ =  1; }
-        ;
-unit    : tSEC_UNIT      { $$ = $1; yyRelPointer = &yyRelSeconds; }
-        | tDAY_UNIT      { $$ = $1; yyRelPointer = &yyRelDay; }
-        | tMONTH_UNIT    { $$ = $1; yyRelPointer = &yyRelMonth; }
-        ;
-
-number  : tUNUMBER
-    {
-	if (yyHaveTime && yyHaveDate && !yyHaveRel) {
-	    yyYear = $1;
-	} else {
-	    yyHaveTime++;
-	    if ($1 < 100) {
-		yyHour = $1;
-		yyMinutes = 0;
+
+relunits : sign tUNUMBER unit {
+	    *yyRelPointer += $1 * $2 * $3;
+	}
+	| tUNUMBER unit {
+	    *yyRelPointer += $1 * $2;
+	}
+	| tNEXT unit {
+	    *yyRelPointer += $2;
+	}
+	| tNEXT tUNUMBER unit {
+	    *yyRelPointer += $2 * $3;
+	}
+	| unit {
+	    *yyRelPointer += $1;
+	}
+	;
+
+sign	: '-' {
+	    $$ = -1;
+	}
+	| '+' {
+	    $$ =  1;
+	}
+	;
+
+unit	: tSEC_UNIT {
+	    $$ = $1;
+	    yyRelPointer = &yyRelSeconds;
+	}
+	| tDAY_UNIT {
+	    $$ = $1;
+	    yyRelPointer = &yyRelDay;
+	}
+	| tMONTH_UNIT {
+	    $$ = $1;
+	    yyRelPointer = &yyRelMonth;
+	}
+	;
+
+number	: tUNUMBER {
+	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
+		yyYear = $1;
 	    } else {
-		yyHour = $1 / 100;
-		yyMinutes = $1 % 100;
+		yyHaveTime++;
+		if (yyDigitCount <= 2) {
+		    yyHour = $1;
+		    yyMinutes = 0;
+		} else {
+		    yyHour = $1 / 100;
+		    yyMinutes = $1 % 100;
+		}
+		yySeconds = 0;
+		yyMeridian = MER24;
 	    }
-	    yySeconds = 0;
-	    yyMeridian = MER24;
 	}
-    }
-;
+	;
 
 o_merid : /* NULL */ {
-            $$ = MER24;
-        }
-        | tMERIDIAN {
-            $$ = $1;
-        }
-        ;
+	    $$ = MER24;
+	}
+	| tMERIDIAN {
+	    $$ = $1;
+	}
+	;
 
 %%
+MODULE_SCOPE int yychar;
+MODULE_SCOPE YYSTYPE yylval;
+MODULE_SCOPE int yynerrs;
 
 /*
  * Month and day table.
  */
-static CONST TABLE MonthDayTable[] = {
-    { "january",        tMONTH,  1 },
-    { "february",       tMONTH,  2 },
-    { "march",          tMONTH,  3 },
-    { "april",          tMONTH,  4 },
-    { "may",            tMONTH,  5 },
-    { "june",           tMONTH,  6 },
-    { "july",           tMONTH,  7 },
-    { "august",         tMONTH,  8 },
-    { "september",      tMONTH,  9 },
-    { "sept",           tMONTH,  9 },
-    { "october",        tMONTH, 10 },
-    { "november",       tMONTH, 11 },
-    { "december",       tMONTH, 12 },
-    { "sunday",         tDAY, 0 },
-    { "monday",         tDAY, 1 },
-    { "tuesday",        tDAY, 2 },
-    { "tues",           tDAY, 2 },
-    { "wednesday",      tDAY, 3 },
-    { "wednes",         tDAY, 3 },
-    { "thursday",       tDAY, 4 },
-    { "thur",           tDAY, 4 },
-    { "thurs",          tDAY, 4 },
-    { "friday",         tDAY, 5 },
-    { "saturday",       tDAY, 6 },
+
+static const TABLE MonthDayTable[] = {
+    { "january",	tMONTH,	 1 },
+    { "february",	tMONTH,	 2 },
+    { "march",		tMONTH,	 3 },
+    { "april",		tMONTH,	 4 },
+    { "may",		tMONTH,	 5 },
+    { "june",		tMONTH,	 6 },
+    { "july",		tMONTH,	 7 },
+    { "august",		tMONTH,	 8 },
+    { "september",	tMONTH,	 9 },
+    { "sept",		tMONTH,	 9 },
+    { "october",	tMONTH, 10 },
+    { "november",	tMONTH, 11 },
+    { "december",	tMONTH, 12 },
+    { "sunday",		tDAY, 0 },
+    { "monday",		tDAY, 1 },
+    { "tuesday",	tDAY, 2 },
+    { "tues",		tDAY, 2 },
+    { "wednesday",	tDAY, 3 },
+    { "wednes",		tDAY, 3 },
+    { "thursday",	tDAY, 4 },
+    { "thur",		tDAY, 4 },
+    { "thurs",		tDAY, 4 },
+    { "friday",		tDAY, 5 },
+    { "saturday",	tDAY, 6 },
     { NULL }
 };
 
 /*
  * Time units table.
  */
-static CONST TABLE UnitsTable[] = {
-    { "year",           tMONTH_UNIT,    12 },
-    { "month",          tMONTH_UNIT,     1 },
-    { "fortnight",      tDAY_UNIT,      14 },
-    { "week",           tDAY_UNIT,       7 },
-    { "day",            tDAY_UNIT,       1 },
-    { "hour",           tSEC_UNIT, 60 * 60 },
-    { "minute",         tSEC_UNIT,      60 },
-    { "min",            tSEC_UNIT,      60 },
-    { "second",         tSEC_UNIT,       1 },
-    { "sec",            tSEC_UNIT,       1 },
+
+static const TABLE UnitsTable[] = {
+    { "year",		tMONTH_UNIT,	12 },
+    { "month",		tMONTH_UNIT,	 1 },
+    { "fortnight",	tDAY_UNIT,	14 },
+    { "week",		tDAY_UNIT,	 7 },
+    { "day",		tDAY_UNIT,	 1 },
+    { "hour",		tSEC_UNIT, 60 * 60 },
+    { "minute",		tSEC_UNIT,	60 },
+    { "min",		tSEC_UNIT,	60 },
+    { "second",		tSEC_UNIT,	 1 },
+    { "sec",		tSEC_UNIT,	 1 },
     { NULL }
 };
 
 /*
  * Assorted relative-time words.
  */
-static CONST TABLE OtherTable[] = {
-    { "tomorrow",       tDAY_UNIT,      1 },
-    { "yesterday",      tDAY_UNIT,     -1 },
-    { "today",          tDAY_UNIT,      0 },
-    { "now",            tSEC_UNIT,      0 },
-    { "last",           tUNUMBER,      -1 },
-    { "this",           tSEC_UNIT,      0 },
-    { "next",           tNEXT,          1 },
+
+static const TABLE OtherTable[] = {
+    { "tomorrow",	tDAY_UNIT,	1 },
+    { "yesterday",	tDAY_UNIT,	-1 },
+    { "today",		tDAY_UNIT,	0 },
+    { "now",		tSEC_UNIT,	0 },
+    { "last",		tUNUMBER,	-1 },
+    { "this",		tSEC_UNIT,	0 },
+    { "next",		tNEXT,		1 },
 #if 0
-    { "first",          tUNUMBER,       1 },
-    { "second",         tUNUMBER,       2 },
-    { "third",          tUNUMBER,       3 },
-    { "fourth",         tUNUMBER,       4 },
-    { "fifth",          tUNUMBER,       5 },
-    { "sixth",          tUNUMBER,       6 },
-    { "seventh",        tUNUMBER,       7 },
-    { "eighth",         tUNUMBER,       8 },
-    { "ninth",          tUNUMBER,       9 },
-    { "tenth",          tUNUMBER,       10 },
-    { "eleventh",       tUNUMBER,       11 },
-    { "twelfth",        tUNUMBER,       12 },
+    { "first",		tUNUMBER,	1 },
+    { "second",		tUNUMBER,	2 },
+    { "third",		tUNUMBER,	3 },
+    { "fourth",		tUNUMBER,	4 },
+    { "fifth",		tUNUMBER,	5 },
+    { "sixth",		tUNUMBER,	6 },
+    { "seventh",	tUNUMBER,	7 },
+    { "eighth",		tUNUMBER,	8 },
+    { "ninth",		tUNUMBER,	9 },
+    { "tenth",		tUNUMBER,	10 },
+    { "eleventh",	tUNUMBER,	11 },
+    { "twelfth",	tUNUMBER,	12 },
 #endif
-    { "ago",            tAGO,   1 },
-    { "epoch",          tEPOCH,   0 },
-    { "stardate",       tSTARDATE, 0},
+    { "ago",		tAGO,		1 },
+    { "epoch",		tEPOCH,		0 },
+    { "stardate",	tSTARDATE,	0 },
     { NULL }
 };
 
 /*
- * The timezone table.  (Note: This table was modified to not use any floating
+ * The timezone table. (Note: This table was modified to not use any floating
  * point constants to work around an SGI compiler bug).
  */
-static CONST TABLE TimezoneTable[] = {
-    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
-    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
-    { "utc",    tZONE,     HOUR( 0) },
-    { "uct",    tZONE,     HOUR( 0) },      /* Universal Coordinated Time */
-    { "wet",    tZONE,     HOUR( 0) },      /* Western European */
-    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
-    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
-    { "at",     tZONE,     HOUR( 2) },      /* Azores */
-#if     0
+
+static const TABLE TimezoneTable[] = {
+    { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
+    { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
+    { "utc",	tZONE,	   HOUR( 0) },
+    { "uct",	tZONE,	   HOUR( 0) },	    /* Universal Coordinated Time */
+    { "wet",	tZONE,	   HOUR( 0) },	    /* Western European */
+    { "bst",	tDAYZONE,  HOUR( 0) },	    /* British Summer */
+    { "wat",	tZONE,	   HOUR( 1) },	    /* West Africa */
+    { "at",	tZONE,	   HOUR( 2) },	    /* Azores */
+#if	0
     /* For completeness.  BST is also British Summer, and GST is
      * also Guam Standard. */
-    { "bst",    tZONE,     HOUR( 3) },      /* Brazil Standard */
-    { "gst",    tZONE,     HOUR( 3) },      /* Greenland Standard */
+    { "bst",	tZONE,	   HOUR( 3) },	    /* Brazil Standard */
+    { "gst",	tZONE,	   HOUR( 3) },	    /* Greenland Standard */
 #endif
-    { "nft",    tZONE,     HOUR( 7/2) },    /* Newfoundland */
-    { "nst",    tZONE,     HOUR( 7/2) },    /* Newfoundland Standard */
-    { "ndt",    tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
-    { "ast",    tZONE,     HOUR( 4) },      /* Atlantic Standard */
-    { "adt",    tDAYZONE,  HOUR( 4) },      /* Atlantic Daylight */
-    { "est",    tZONE,     HOUR( 5) },      /* Eastern Standard */
-    { "edt",    tDAYZONE,  HOUR( 5) },      /* Eastern Daylight */
-    { "cst",    tZONE,     HOUR( 6) },      /* Central Standard */
-    { "cdt",    tDAYZONE,  HOUR( 6) },      /* Central Daylight */
-    { "mst",    tZONE,     HOUR( 7) },      /* Mountain Standard */
-    { "mdt",    tDAYZONE,  HOUR( 7) },      /* Mountain Daylight */
-    { "pst",    tZONE,     HOUR( 8) },      /* Pacific Standard */
-    { "pdt",    tDAYZONE,  HOUR( 8) },      /* Pacific Daylight */
-    { "yst",    tZONE,     HOUR( 9) },      /* Yukon Standard */
-    { "ydt",    tDAYZONE,  HOUR( 9) },      /* Yukon Daylight */
-    { "hst",    tZONE,     HOUR(10) },      /* Hawaii Standard */
-    { "hdt",    tDAYZONE,  HOUR(10) },      /* Hawaii Daylight */
-    { "cat",    tZONE,     HOUR(10) },      /* Central Alaska */
-    { "ahst",   tZONE,     HOUR(10) },      /* Alaska-Hawaii Standard */
-    { "nt",     tZONE,     HOUR(11) },      /* Nome */
-    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
-    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
-    { "cest",   tDAYZONE, -HOUR( 1) },      /* Central European Summer */
-    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
-    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
-    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
-    { "swt",    tZONE,    -HOUR( 1) },      /* Swedish Winter */
-    { "sst",    tDAYZONE, -HOUR( 1) },      /* Swedish Summer */
-    { "fwt",    tZONE,    -HOUR( 1) },      /* French Winter */
-    { "fst",    tDAYZONE, -HOUR( 1) },      /* French Summer */
-    { "eet",    tZONE,    -HOUR( 2) },      /* Eastern Europe, USSR Zone 1 */
-    { "bt",     tZONE,    -HOUR( 3) },      /* Baghdad, USSR Zone 2 */
-    { "it",     tZONE,    -HOUR( 7/2) },    /* Iran */
-    { "zp4",    tZONE,    -HOUR( 4) },      /* USSR Zone 3 */
-    { "zp5",    tZONE,    -HOUR( 5) },      /* USSR Zone 4 */
-    { "ist",    tZONE,    -HOUR(11/2) },    /* Indian Standard */
-    { "zp6",    tZONE,    -HOUR( 6) },      /* USSR Zone 5 */
-#if     0
+    { "nft",	tZONE,	   HOUR( 7/2) },    /* Newfoundland */
+    { "nst",	tZONE,	   HOUR( 7/2) },    /* Newfoundland Standard */
+    { "ndt",	tDAYZONE,  HOUR( 7/2) },    /* Newfoundland Daylight */
+    { "ast",	tZONE,	   HOUR( 4) },	    /* Atlantic Standard */
+    { "adt",	tDAYZONE,  HOUR( 4) },	    /* Atlantic Daylight */
+    { "est",	tZONE,	   HOUR( 5) },	    /* Eastern Standard */
+    { "edt",	tDAYZONE,  HOUR( 5) },	    /* Eastern Daylight */
+    { "cst",	tZONE,	   HOUR( 6) },	    /* Central Standard */
+    { "cdt",	tDAYZONE,  HOUR( 6) },	    /* Central Daylight */
+    { "mst",	tZONE,	   HOUR( 7) },	    /* Mountain Standard */
+    { "mdt",	tDAYZONE,  HOUR( 7) },	    /* Mountain Daylight */
+    { "pst",	tZONE,	   HOUR( 8) },	    /* Pacific Standard */
+    { "pdt",	tDAYZONE,  HOUR( 8) },	    /* Pacific Daylight */
+    { "yst",	tZONE,	   HOUR( 9) },	    /* Yukon Standard */
+    { "ydt",	tDAYZONE,  HOUR( 9) },	    /* Yukon Daylight */
+    { "hst",	tZONE,	   HOUR(10) },	    /* Hawaii Standard */
+    { "hdt",	tDAYZONE,  HOUR(10) },	    /* Hawaii Daylight */
+    { "cat",	tZONE,	   HOUR(10) },	    /* Central Alaska */
+    { "ahst",	tZONE,	   HOUR(10) },	    /* Alaska-Hawaii Standard */
+    { "nt",	tZONE,	   HOUR(11) },	    /* Nome */
+    { "idlw",	tZONE,	   HOUR(12) },	    /* International Date Line West */
+    { "cet",	tZONE,	  -HOUR( 1) },	    /* Central European */
+    { "cest",	tDAYZONE, -HOUR( 1) },	    /* Central European Summer */
+    { "met",	tZONE,	  -HOUR( 1) },	    /* Middle European */
+    { "mewt",	tZONE,	  -HOUR( 1) },	    /* Middle European Winter */
+    { "mest",	tDAYZONE, -HOUR( 1) },	    /* Middle European Summer */
+    { "swt",	tZONE,	  -HOUR( 1) },	    /* Swedish Winter */
+    { "sst",	tDAYZONE, -HOUR( 1) },	    /* Swedish Summer */
+    { "fwt",	tZONE,	  -HOUR( 1) },	    /* French Winter */
+    { "fst",	tDAYZONE, -HOUR( 1) },	    /* French Summer */
+    { "eet",	tZONE,	  -HOUR( 2) },	    /* Eastern Europe, USSR Zone 1 */
+    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
+    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
+    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
+    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
+    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
+    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
+#if	0
     /* For completeness.  NST is also Newfoundland Stanard, nad SST is
      * also Swedish Summer. */
-    { "nst",    tZONE,    -HOUR(13/2) },    /* North Sumatra */
-    { "sst",    tZONE,    -HOUR( 7) },      /* South Sumatra, USSR Zone 6 */
-#endif  /* 0 */
-    { "wast",   tZONE,    -HOUR( 7) },      /* West Australian Standard */
-    { "wadt",   tDAYZONE, -HOUR( 7) },      /* West Australian Daylight */
-    { "jt",     tZONE,    -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
-    { "cct",    tZONE,    -HOUR( 8) },      /* China Coast, USSR Zone 7 */
-    { "jst",    tZONE,    -HOUR( 9) },      /* Japan Standard, USSR Zone 8 */
-    { "jdt",    tDAYZONE, -HOUR( 9) },      /* Japan Daylight */
-    { "kst",    tZONE,    -HOUR( 9) },      /* Korea Standard */
-    { "kdt",    tDAYZONE, -HOUR( 9) },      /* Korea Daylight */
-    { "cast",   tZONE,    -HOUR(19/2) },    /* Central Australian Standard */
-    { "cadt",   tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
-    { "east",   tZONE,    -HOUR(10) },      /* Eastern Australian Standard */
-    { "eadt",   tDAYZONE, -HOUR(10) },      /* Eastern Australian Daylight */
-    { "gst",    tZONE,    -HOUR(10) },      /* Guam Standard, USSR Zone 9 */
-    { "nzt",    tZONE,    -HOUR(12) },      /* New Zealand */
-    { "nzst",   tZONE,    -HOUR(12) },      /* New Zealand Standard */
-    { "nzdt",   tDAYZONE, -HOUR(12) },      /* New Zealand Daylight */
-    { "idle",   tZONE,    -HOUR(12) },      /* International Date Line East */
+    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
+    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
+#endif	/* 0 */
+    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
+    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
+    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */
+    { "cct",	tZONE,	  -HOUR( 8) },	    /* China Coast, USSR Zone 7 */
+    { "jst",	tZONE,	  -HOUR( 9) },	    /* Japan Standard, USSR Zone 8 */
+    { "jdt",	tDAYZONE, -HOUR( 9) },	    /* Japan Daylight */
+    { "kst",	tZONE,	  -HOUR( 9) },	    /* Korea Standard */
+    { "kdt",	tDAYZONE, -HOUR( 9) },	    /* Korea Daylight */
+    { "cast",	tZONE,	  -HOUR(19/2) },    /* Central Australian Standard */
+    { "cadt",	tDAYZONE, -HOUR(19/2) },    /* Central Australian Daylight */
+    { "east",	tZONE,	  -HOUR(10) },	    /* Eastern Australian Standard */
+    { "eadt",	tDAYZONE, -HOUR(10) },	    /* Eastern Australian Daylight */
+    { "gst",	tZONE,	  -HOUR(10) },	    /* Guam Standard, USSR Zone 9 */
+    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
+    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
+    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
+    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
     /* ADDED BY Marco Nijdam */
-    { "dst",    tDST,     HOUR( 0) },       /* DST on (hour is ignored) */
+    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
     /* End ADDED */
     {  NULL  }
 };
@@ -566,311 +677,102 @@ static CONST TABLE TimezoneTable[] = {
 /*
  * Military timezone table.
  */
-static CONST TABLE MilitaryTable[] = {
-    { "a",      tZONE,  HOUR(  1) },
-    { "b",      tZONE,  HOUR(  2) },
-    { "c",      tZONE,  HOUR(  3) },
-    { "d",      tZONE,  HOUR(  4) },
-    { "e",      tZONE,  HOUR(  5) },
-    { "f",      tZONE,  HOUR(  6) },
-    { "g",      tZONE,  HOUR(  7) },
-    { "h",      tZONE,  HOUR(  8) },
-    { "i",      tZONE,  HOUR(  9) },
-    { "k",      tZONE,  HOUR( 10) },
-    { "l",      tZONE,  HOUR( 11) },
-    { "m",      tZONE,  HOUR( 12) },
-    { "n",      tZONE,  HOUR(- 1) },
-    { "o",      tZONE,  HOUR(- 2) },
-    { "p",      tZONE,  HOUR(- 3) },
-    { "q",      tZONE,  HOUR(- 4) },
-    { "r",      tZONE,  HOUR(- 5) },
-    { "s",      tZONE,  HOUR(- 6) },
-    { "t",      tZONE,  HOUR(- 7) },
-    { "u",      tZONE,  HOUR(- 8) },
-    { "v",      tZONE,  HOUR(- 9) },
-    { "w",      tZONE,  HOUR(-10) },
-    { "x",      tZONE,  HOUR(-11) },
-    { "y",      tZONE,  HOUR(-12) },
-    { "z",      tZONE,  HOUR(  0) },
+
+static const TABLE MilitaryTable[] = {
+    { "a",	tZONE,	-HOUR( 1) },
+    { "b",	tZONE,	-HOUR( 2) },
+    { "c",	tZONE,	-HOUR( 3) },
+    { "d",	tZONE,	-HOUR( 4) },
+    { "e",	tZONE,	-HOUR( 5) },
+    { "f",	tZONE,	-HOUR( 6) },
+    { "g",	tZONE,	-HOUR( 7) },
+    { "h",	tZONE,	-HOUR( 8) },
+    { "i",	tZONE,	-HOUR( 9) },
+    { "k",	tZONE,	-HOUR(10) },
+    { "l",	tZONE,	-HOUR(11) },
+    { "m",	tZONE,	-HOUR(12) },
+    { "n",	tZONE,	HOUR(  1) },
+    { "o",	tZONE,	HOUR(  2) },
+    { "p",	tZONE,	HOUR(  3) },
+    { "q",	tZONE,	HOUR(  4) },
+    { "r",	tZONE,	HOUR(  5) },
+    { "s",	tZONE,	HOUR(  6) },
+    { "t",	tZONE,	HOUR(  7) },
+    { "u",	tZONE,	HOUR(  8) },
+    { "v",	tZONE,	HOUR(  9) },
+    { "w",	tZONE,	HOUR( 10) },
+    { "x",	tZONE,	HOUR( 11) },
+    { "y",	tZONE,	HOUR( 12) },
+    { "z",	tZONE,	HOUR( 0) },
     { NULL }
 };
 
-
 /*
  * Dump error messages in the bit bucket.
  */
+
 static void
-yyerror(s)
-    char  *s;
+TclDateerror(
+    YYLTYPE* location,
+    DateInfo* infoPtr,
+    const char *s)
 {
+    Tcl_Obj* t;
+    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
+    Tcl_AppendToObj(infoPtr->messages, s, -1);
+    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
+    t = Tcl_NewIntObj(location->first_column);
+    Tcl_IncrRefCount(t);
+    Tcl_AppendObjToObj(infoPtr->messages, t);
+    Tcl_DecrRefCount(t);
+    Tcl_AppendToObj(infoPtr->messages, "-", -1);
+    t = Tcl_NewIntObj(location->last_column);
+    Tcl_IncrRefCount(t);
+    Tcl_AppendObjToObj(infoPtr->messages, t);
+    Tcl_DecrRefCount(t);
+    Tcl_AppendToObj(infoPtr->messages, ")", -1);
+    infoPtr->separatrix = "\n";
 }
 
-
 static time_t
-ToSeconds(Hours, Minutes, Seconds, Meridian)
-    time_t      Hours;
-    time_t      Minutes;
-    time_t      Seconds;
-    MERIDIAN    Meridian;
+ToSeconds(
+    time_t Hours,
+    time_t Minutes,
+    time_t Seconds,
+    MERIDIAN Meridian)
 {
-    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
-        return -1;
+    if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
+	return -1;
+    }
     switch (Meridian) {
     case MER24:
-        if (Hours < 0 || Hours > 23)
-            return -1;
-        return (Hours * 60L + Minutes) * 60L + Seconds;
+	if (Hours < 0 || Hours > 23) {
+	    return -1;
+	}
+	return (Hours * 60L + Minutes) * 60L + Seconds;
     case MERam:
-        if (Hours < 1 || Hours > 12)
-            return -1;
-        return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
+	if (Hours < 1 || Hours > 12) {
+	    return -1;
+	}
+	return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
     case MERpm:
-        if (Hours < 1 || Hours > 12)
-            return -1;
-        return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
-    }
-    return -1;  /* Should never be reached */
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * Convert --
- *
- *      Convert a {month, day, year, hours, minutes, seconds, meridian, dst}
- *      tuple into a clock seconds value.
- *
- * Results:
- *      0 or -1 indicating success or failure.
- *
- * Side effects:
- *      Fills TimePtr with the computed value.
- *
- *-----------------------------------------------------------------------------
- */
-static int
-Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
-    time_t      Month;
-    time_t      Day;
-    time_t      Year;
-    time_t      Hours;
-    time_t      Minutes;
-    time_t      Seconds;
-    MERIDIAN    Meridian;
-    DSTMODE     DSTmode;
-    time_t     *TimePtr;
-{
-    static int  DaysInMonth[12] = {
-        31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
-    };
-    time_t tod;
-    time_t Julian;
-    int i;
-
-    /* Figure out how many days are in February for the given year.
-     * Every year divisible by 4 is a leap year.
-     * But, every year divisible by 100 is not a leap year.
-     * But, every year divisible by 400 is a leap year after all.
-     */
-    DaysInMonth[1] = IsLeapYear(Year) ? 29 : 28;
-
-    /* Check the inputs for validity */
-    if (Month < 1 || Month > 12
-	    || Year < START_OF_TIME || Year > END_OF_TIME
-	    || Day < 1 || Day > DaysInMonth[(int)--Month])
-        return -1;
-
-    /* Start computing the value.  First determine the number of days
-     * represented by the date, then multiply by the number of seconds/day.
-     */
-    for (Julian = Day - 1, i = 0; i < Month; i++)
-        Julian += DaysInMonth[i];
-    if (Year >= EPOCH) {
-        for (i = EPOCH; i < Year; i++)
-            Julian += 365 + IsLeapYear(i);
-    } else {
-        for (i = Year; i < EPOCH; i++)
-            Julian -= 365 + IsLeapYear(i);
-    }
-    Julian *= SECSPERDAY;
-
-    /* Add the timezone offset ?? */
-    Julian += yyTimezone * 60L;
-
-    /* Add the number of seconds represented by the time component */
-    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
-        return -1;
-    Julian += tod;
-
-    /* Perform a preliminary DST compensation ?? */
-    if (DSTmode == DSTon
-     || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
-        Julian -= 60 * 60;
-    *TimePtr = Julian;
-    return 0;
-}
-
-
-static time_t
-DSTcorrect(Start, Future)
-    time_t      Start;
-    time_t      Future;
-{
-    time_t      StartDay;
-    time_t      FutureDay;
-    StartDay = (TclpGetDate((TclpTime_t)&Start, 0)->tm_hour + 1) % 24;
-    FutureDay = (TclpGetDate((TclpTime_t)&Future, 0)->tm_hour + 1) % 24;
-    return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
-}
-
-
-static time_t
-NamedDay(Start, DayOrdinal, DayNumber)
-    time_t      Start;
-    time_t      DayOrdinal;
-    time_t      DayNumber;
-{
-    struct tm   *tm;
-    time_t      now;
-
-    now = Start;
-    tm = TclpGetDate((TclpTime_t)&now, 0);
-    now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
-    now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
-    return DSTcorrect(Start, now);
-}
-
-static time_t
-NamedMonth(Start, MonthOrdinal, MonthNumber)
-    time_t Start;
-    time_t MonthOrdinal;
-    time_t MonthNumber;
-{
-    struct tm *tm;
-    time_t now;
-    int result;
-    
-    now = Start;
-    tm = TclpGetDate((TclpTime_t)&now, 0);
-    /* To compute the next n'th month, we use this alg:
-     * add n to year value
-     * if currentMonth < requestedMonth decrement year value by 1 (so that
-     *  doing next february from january gives us february of the current year)
-     * set day to 1, time to 0
-     */
-    tm->tm_year += MonthOrdinal;
-    if (tm->tm_mon < MonthNumber - 1) {
-	tm->tm_year--;
-    }
-    result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE,
-	    (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now);
-    if (result < 0) {
-	return 0;
-    }
-    return DSTcorrect(Start, now);
-}
-
-static int
-RelativeMonth(Start, RelMonth, TimePtr)
-    time_t Start;
-    time_t RelMonth;
-    time_t *TimePtr;
-{
-    struct tm *tm;
-    time_t Month;
-    time_t Year;
-    time_t Julian;
-    int result;
-
-    if (RelMonth == 0) {
-        *TimePtr = 0;
-        return 0;
-    }
-    tm = TclpGetDate((TclpTime_t)&Start, 0);
-    Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
-    Year = Month / 12;
-    Month = Month % 12 + 1;
-    result = Convert(Month, (time_t) tm->tm_mday, Year,
-	    (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
-	    MER24, DSTmaybe, &Julian);
-
-    /*
-     * The Julian time returned above is behind by one day, if "month" 
-     * or "year" is used to specify relative time and the GMT flag is true.
-     * This problem occurs only when the current time is closer to
-     * midnight, the difference being not more than its time difference
-     * with GMT. For example, in US/Pacific time zone, the problem occurs
-     * whenever the current time is between midnight to 8:00am or 7:00amDST.
-     * See Bug# 413397 for more details and sample script.
-     * To resolve this bug, we simply add the number of seconds corresponding
-     * to timezone difference with GMT to Julian time, if GMT flag is true.
-     */
-
-    if (TclDateTimezone == 0) {
-        Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
-    }
-
-    /*
-     * The following iteration takes into account the case were we jump
-     * into a "short month".  Far example, "one month from Jan 31" will
-     * fail because there is no Feb 31.  The code below will reduce the
-     * day and try converting the date until we succed or the date equals
-     * 28 (which always works unless the date is bad in another way).
-     */
-
-    while ((result != 0) && (tm->tm_mday > 28)) {
-	tm->tm_mday--;
-	result = Convert(Month, (time_t) tm->tm_mday, Year,
-		(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
-		MER24, DSTmaybe, &Julian);
-    }
-    if (result != 0) {
-	return -1;
+	if (Hours < 1 || Hours > 12) {
+	    return -1;
+	}
+	return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
     }
-    *TimePtr = DSTcorrect(Start, Julian);
-    return 0;
-}
-
-
-/*
- *-----------------------------------------------------------------------------
- *
- * RelativeDay --
- *
- *      Given a starting time and a number of days before or after, compute the
- *      DST corrected difference between those dates.
- *
- * Results:
- *     1 or -1 indicating success or failure.
- *
- * Side effects:
- *      Fills TimePtr with the computed value.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-RelativeDay(Start, RelDay, TimePtr)
-    time_t Start;
-    time_t RelDay;
-    time_t *TimePtr;
-{
-    time_t new;
-
-    new = Start + (RelDay * 60 * 60 * 24);
-    *TimePtr = DSTcorrect(Start, new);
-    return 1;
+    return -1;			/* Should never be reached */
 }
 
 static int
-LookupWord(buff)
-    char                *buff;
+LookupWord(
+    YYSTYPE* yylvalPtr,
+    char *buff)
 {
     register char *p;
     register char *q;
-    register CONST TABLE *tp;
-    int i;
-    int abbrev;
+    register const TABLE *tp;
+    int i, abbrev;
 
     /*
      * Make it lowercase.
@@ -879,273 +781,346 @@ LookupWord(buff)
     Tcl_UtfToLower(buff);
 
     if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
-        yylval.Meridian = MERam;
-        return tMERIDIAN;
+	yylvalPtr->Meridian = MERam;
+	return tMERIDIAN;
     }
     if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
-        yylval.Meridian = MERpm;
-        return tMERIDIAN;
+	yylvalPtr->Meridian = MERpm;
+	return tMERIDIAN;
     }
 
     /*
      * See if we have an abbreviation for a month.
      */
+
     if (strlen(buff) == 3) {
-        abbrev = 1;
+	abbrev = 1;
     } else if (strlen(buff) == 4 && buff[3] == '.') {
-        abbrev = 1;
-        buff[3] = '\0';
+	abbrev = 1;
+	buff[3] = '\0';
     } else {
-        abbrev = 0;
+	abbrev = 0;
     }
 
     for (tp = MonthDayTable; tp->name; tp++) {
-        if (abbrev) {
-            if (strncmp(buff, tp->name, 3) == 0) {
-                yylval.Number = tp->value;
-                return tp->type;
-            }
-        } else if (strcmp(buff, tp->name) == 0) {
-            yylval.Number = tp->value;
-            return tp->type;
-        }
+	if (abbrev) {
+	    if (strncmp(buff, tp->name, 3) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
+	} else if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     for (tp = TimezoneTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            yylval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     for (tp = UnitsTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            yylval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     /*
      * Strip off any plural and try the units table again.
      */
+
     i = strlen(buff) - 1;
-    if (buff[i] == 's') {
-        buff[i] = '\0';
-        for (tp = UnitsTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                yylval.Number = tp->value;
-                return tp->type;
-            }
+    if (i > 0 && buff[i] == 's') {
+	buff[i] = '\0';
+	for (tp = UnitsTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
 
     for (tp = OtherTable; tp->name; tp++) {
-        if (strcmp(buff, tp->name) == 0) {
-            yylval.Number = tp->value;
-            return tp->type;
-        }
+	if (strcmp(buff, tp->name) == 0) {
+	    yylvalPtr->Number = tp->value;
+	    return tp->type;
+	}
     }
 
     /*
      * Military timezones.
      */
+
     if (buff[1] == '\0' && !(*buff & 0x80)
-	    && isalpha(UCHAR(*buff))) {	/* INTL: ISO only */
-        for (tp = MilitaryTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                yylval.Number = tp->value;
-                return tp->type;
-            }
+	    && isalpha(UCHAR(*buff))) {			/* INTL: ISO only */
+	for (tp = MilitaryTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
 
     /*
      * Drop out any periods and try the timezone table again.
      */
-    for (i = 0, p = q = buff; *q; q++)
-        if (*q != '.') {
-            *p++ = *q;
-        } else {
-            i++;
+
+    for (i = 0, p = q = buff; *q; q++) {
+	if (*q != '.') {
+	    *p++ = *q;
+	} else {
+	    i++;
 	}
+    }
     *p = '\0';
     if (i) {
-        for (tp = TimezoneTable; tp->name; tp++) {
-            if (strcmp(buff, tp->name) == 0) {
-                yylval.Number = tp->value;
-                return tp->type;
-            }
+	for (tp = TimezoneTable; tp->name; tp++) {
+	    if (strcmp(buff, tp->name) == 0) {
+		yylvalPtr->Number = tp->value;
+		return tp->type;
+	    }
 	}
     }
-    
+
     return tID;
 }
 
-
 static int
-yylex()
+TclDatelex(
+    YYSTYPE* yylvalPtr,
+    YYLTYPE* location,
+    DateInfo *info)
 {
-    register char       c;
-    register char       *p;
-    char                buff[20];
-    int                 Count;
+    register char c;
+    register char *p;
+    char buff[20];
+    int Count;
 
+    location->first_column = yyInput - info->dateStart;
     for ( ; ; ) {
-        while (isspace(UCHAR(*yyInput))) {
-            yyInput++;
+	while (isspace(UCHAR(*yyInput))) {
+	    yyInput++;
 	}
 
-        if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
-	    /* convert the string into a number; count the number of digits */
+	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+	    /*
+	     * Convert the string into a number; count the number of digits.
+	     */
+
 	    Count = 0;
-            for (yylval.Number = 0;
-		    isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
-                yylval.Number = 10 * yylval.Number + c - '0';
+	    for (yylvalPtr->Number = 0;
+		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
+		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
 		Count++;
 	    }
-            yyInput--;
-	    /* A number with 6 or more digits is considered an ISO 8601 base */
+	    yyInput--;
+	    yyDigitCount = Count;
+
+	    /*
+	     * A number with 6 or more digits is considered an ISO 8601 base.
+	     */
+
 	    if (Count >= 6) {
+		location->last_column = yyInput - info->dateStart - 1;
 		return tISOBASE;
 	    } else {
+		location->last_column = yyInput - info->dateStart - 1;
 		return tUNUMBER;
 	    }
-        }
-        if (!(c & 0x80) && isalpha(UCHAR(c))) {	/* INTL: ISO only. */
-            for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
+	}
+	if (!(c & 0x80) && isalpha(UCHAR(c))) {		  /* INTL: ISO only. */
+	    for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
 		     || c == '.'; ) {
-                if (p < &buff[sizeof buff - 1]) {
-                    *p++ = c;
+		if (p < &buff[sizeof buff - 1]) {
+		    *p++ = c;
 		}
 	    }
-            *p = '\0';
-            yyInput--;
-            return LookupWord(buff);
-        }
-        if (c != '(') {
-            return *yyInput++;
-	}
-        Count = 0;
-        do {
-            c = *yyInput++;
-            if (c == '\0') {
-                return c;
+	    *p = '\0';
+	    yyInput--;
+	    location->last_column = yyInput - info->dateStart - 1;
+	    return LookupWord(yylvalPtr, buff);
+	}
+	if (c != '(') {
+	    location->last_column = yyInput - info->dateStart;
+	    return *yyInput++;
+	}
+	Count = 0;
+	do {
+	    c = *yyInput++;
+	    if (c == '\0') {
+		location->last_column = yyInput - info->dateStart - 1;
+		return c;
 	    } else if (c == '(') {
-                Count++;
+		Count++;
 	    } else if (c == ')') {
-                Count--;
+		Count--;
 	    }
-        } while (Count > 0);
+	} while (Count > 0);
     }
 }
 
-/*
- * Specify zone is of -50000 to force GMT.  (This allows BST to work).
- */
-
 int
-TclGetDate(p, now, zone, timePtr)
-    char *p;
-    Tcl_WideInt now;
-    long zone;
-    Tcl_WideInt *timePtr;
+TclClockOldscanObjCmd(
+    ClientData clientData,	/* Unused */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Count of paraneters */
+    Tcl_Obj *CONST *objv)	/* Parameters */
 {
-    struct tm *tm;
-    time_t Start;
-    time_t Time;
-    time_t tod;
-    int thisyear;
-
-    yyInput = p;
-    /* now has to be cast to a time_t for 64bit compliance */
-    Start = (time_t) now;
-    tm = TclpGetDate((TclpTime_t) &Start, (zone == -50000));
-    thisyear = tm->tm_year + TM_YEAR_BASE;
-    yyYear = thisyear;
-    yyMonth = tm->tm_mon + 1;
-    yyDay = tm->tm_mday;
-    yyTimezone = zone;
-    if (zone == -50000) {
-        yyDSTmode = DSToff;  /* assume GMT */
-        yyTimezone = 0;
-    } else {
-        yyDSTmode = DSTmaybe;
+    Tcl_Obj *result, *resultElement;
+    int yr, mo, da;
+    DateInfo dateInfo;
+    DateInfo* info = &dateInfo;
+    int status;
+
+    if (objc != 5) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"stringToParse baseYear baseMonth baseDay" );
+	return TCL_ERROR;
     }
-    yyHour = 0;
-    yyMinutes = 0;
-    yySeconds = 0;
-    yyMeridian = MER24;
-    yyRelSeconds = 0;
-    yyRelMonth = 0;
-    yyRelDay = 0;
-    yyRelPointer = NULL;
+
+    yyInput = Tcl_GetString( objv[1] );
+    dateInfo.dateStart = yyInput;
 
     yyHaveDate = 0;
-    yyHaveDay = 0;
-    yyHaveOrdinalMonth = 0;
-    yyHaveRel = 0;
+    if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    yyYear = yr; yyMonth = mo; yyDay = da;
+
     yyHaveTime = 0;
+    yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
+
     yyHaveZone = 0;
+    yyTimezone = 0; yyDSTmode = DSTmaybe;
+
+    yyHaveOrdinalMonth = 0;
+    yyMonthOrdinal = 0;
+
+    yyHaveDay = 0;
+    yyDayOrdinal = 0; yyDayNumber = 0;
 
-    if (yyparse() || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 ||
-	    yyHaveDay > 1 || yyHaveOrdinalMonth > 1) {
-        return -1;
+    yyHaveRel = 0;
+    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+
+    dateInfo.messages = Tcl_NewObj();
+    dateInfo.separatrix = "";
+    Tcl_IncrRefCount(dateInfo.messages);
+
+    status = yyparse(&dateInfo);
+    if (status == 1) {
+	Tcl_SetObjResult(interp, dateInfo.messages);
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
+    } else if (status == 2) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
+    } else if (status != 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
+						  "from date parser. Please "
+						  "report this error as a "
+						  "bug in Tcl.", -1));
+	Tcl_DecrRefCount(dateInfo.messages);
+	return TCL_ERROR;
     }
-    
-    if (yyHaveDate || yyHaveTime || yyHaveDay) {
-	if (TclDateYear < 0) {
-	    TclDateYear = -TclDateYear;
-	}
-	/*
-	 * The following line handles years that are specified using
-	 * only two digits.  The line of code below implements a policy
-	 * defined by the X/Open workgroup on the millinium rollover.
-	 * Note: some of those dates may not actually be valid on some
-	 * platforms.  The POSIX standard startes that the dates 70-99
-	 * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
-	 * This later definition should work on all platforms.
-	 */
-
-	if (TclDateYear < 100) {
-	    if (TclDateYear >= 69) {
-		TclDateYear += 1900;
-	    } else {
-		TclDateYear += 2000;
-	    }
-	}
-	if (Convert(yyMonth, yyDay, yyYear, yyHour, yyMinutes, yySeconds,
-		yyMeridian, yyDSTmode, &Start) < 0) {
-            return -1;
-	}
-    } else {
-        Start = (time_t) now;
-        if (!yyHaveRel) {
-            Start -= ((tm->tm_hour * 60L * 60L) +
-		    tm->tm_min * 60L) +	tm->tm_sec;
-	}
+    Tcl_DecrRefCount(dateInfo.messages);
+
+    if (yyHaveDate > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one date in string", -1));
+	return TCL_ERROR;
+    }
+    if (yyHaveTime > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one time of day in string", -1));
+	return TCL_ERROR;
+    }
+    if (yyHaveZone > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one time zone in string", -1));
+	return TCL_ERROR;
+    }
+    if (yyHaveDay > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one weekday in string", -1));
+	return TCL_ERROR;
+    }
+    if (yyHaveOrdinalMonth > 1) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("more than one ordinal month in string", -1));
+	return TCL_ERROR;
     }
 
-    Start += yyRelSeconds;
-    if (RelativeMonth(Start, yyRelMonth, &Time) < 0) {
-        return -1;
+    result = Tcl_NewObj();
+    resultElement = Tcl_NewObj();
+    if (yyHaveDate) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyYear));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonth));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDay));
     }
-    Start += Time;
+    Tcl_ListObjAppendElement(interp, result, resultElement);
 
-    if (RelativeDay(Start, yyRelDay, &Time) < 0) {
-	return -1;
+    if (yyHaveTime) {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
+		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
+    } else {
+	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
+    }
+
+    resultElement = Tcl_NewObj();
+    if (yyHaveZone) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) -yyTimezone));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj(1 - yyDSTmode));
+    }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    resultElement = Tcl_NewObj();
+    if (yyHaveRel) {
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelMonth));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelDay));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyRelSeconds));
     }
-    Start += Time;
-    
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    resultElement = Tcl_NewObj();
     if (yyHaveDay && !yyHaveDate) {
-        tod = NamedDay(Start, yyDayOrdinal, yyDayNumber);
-        Start += tod;
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDayOrdinal));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyDayNumber));
     }
+    Tcl_ListObjAppendElement(interp, result, resultElement);
 
+    resultElement = Tcl_NewObj();
     if (yyHaveOrdinalMonth) {
-	tod = NamedMonth(Start, yyMonthOrdinal, yyMonth);
-	Start += tod;
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonthOrdinal));
+	Tcl_ListObjAppendElement(interp, resultElement,
+		Tcl_NewIntObj((int) yyMonth));
     }
-    
-    *timePtr = Start;
-    return 0;
+    Tcl_ListObjAppendElement(interp, result, resultElement);
+
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 3eaf395..256b073 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -7,8 +7,8 @@
  * 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -17,24 +17,21 @@
  * Prevent macros from clashing with function definitions.
  */
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-#   undef Tcl_FindHashEntry
-#   undef Tcl_CreateHashEntry
-#endif
+#undef Tcl_FindHashEntry
+#undef Tcl_CreateHashEntry
 
 /*
- * When there are this many entries per bucket, on average, rebuild
- * the hash table to make it larger.
+ * When there are this many entries per bucket, on average, rebuild the hash
+ * table to make it larger.
  */
 
 #define REBUILD_MULTIPLIER	3
 
 /*
- * The following macro takes a preliminary integer hash value and
- * produces an index into a hash tables bucket list.  The idea is
- * to make it so that preliminary values that are arbitrarily similar
- * will end up in different buckets.  The hash function was taken
- * from a random-number generator.
+ * The following macro takes a preliminary integer hash value and produces an
+ * index into a hash tables bucket list. The idea is to make it so that
+ * preliminary values that are arbitrarily similar will end up in different
+ * buckets. The hash function was taken from a random-number generator.
  */
 
 #define RANDOM_INDEX(tablePtr, i) \
@@ -44,60 +41,41 @@
  * Prototypes for the array hash key methods.
  */
 
-static Tcl_HashEntry *	AllocArrayEntry _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
-static int		CompareArrayKeys _ANSI_ARGS_((
-			    VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int	HashArrayKey _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
+static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, VOID *keyPtr);
+static int		CompareArrayKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashArrayKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
 
 /*
  * Prototypes for the one word hash key methods.
  */
 
 #if 0
-static Tcl_HashEntry *	AllocOneWordEntry _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
-static int		CompareOneWordKeys _ANSI_ARGS_((
-			    VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int	HashOneWordKey _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
+static Tcl_HashEntry *	AllocOneWordEntry(Tcl_HashTable *tablePtr,
+			    VOID *keyPtr);
+static int		CompareOneWordKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
 #endif
 
 /*
  * Prototypes for the string hash key methods.
  */
 
-static Tcl_HashEntry *	AllocStringEntry _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
-static int		CompareStringKeys _ANSI_ARGS_((
-			    VOID *keyPtr, Tcl_HashEntry *hPtr));
-static unsigned int	HashStringKey _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
+static Tcl_HashEntry *	AllocStringEntry(Tcl_HashTable *tablePtr,
+			    VOID *keyPtr);
+static int		CompareStringKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashStringKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
 
 /*
- * Procedure prototypes for static procedures in this file:
+ * Function prototypes for static functions in this file:
  */
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    CONST char *key));
-static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    CONST char *key, int *newPtr));
-static Tcl_HashEntry *	FindHashEntry _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    CONST char *key));
-static Tcl_HashEntry *  CreateHashEntry _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-			    CONST char *key, int *newPtr));
-
-#endif
-
-static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+static Tcl_HashEntry *	BogusFind(Tcl_HashTable *tablePtr, const char *key);
+static Tcl_HashEntry *	BogusCreate(Tcl_HashTable *tablePtr, const char *key,
+			    int *newPtr);
+static Tcl_HashEntry *	CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
+			    int *newPtr);
+static Tcl_HashEntry *	FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
+static void		RebuildTable(Tcl_HashTable *tablePtr);
 
 Tcl_HashKeyType tclArrayHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
@@ -125,15 +103,14 @@ Tcl_HashKeyType tclStringHashKeyType = {
     AllocStringEntry,			/* allocEntryProc */
     NULL				/* freeEntryProc */
 };
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_InitHashTable --
  *
- *	Given storage for a hash table, set up the fields to prepare
- *	the hash table for use.
+ *	Given storage for a hash table, set up the fields to prepare the hash
+ *	table for use.
  *
  * Results:
  *	None.
@@ -147,19 +124,21 @@ Tcl_HashKeyType tclStringHashKeyType = {
 
 #undef Tcl_InitHashTable
 void
-Tcl_InitHashTable(tablePtr, keyType)
-    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
-					 * is supplied by the caller. */
-    int keyType;			/* Type of keys to use in table:
-					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
-					 * or an integer >= 2. */
+Tcl_InitHashTable(
+    register Tcl_HashTable *tablePtr,
+				/* Pointer to table record, which is supplied
+				 * by the caller. */
+    int keyType)		/* Type of keys to use in table:
+				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
+				 * integer >= 2. */
 {
     /*
-     * Use a special value to inform the extended version that it must
-     * not access any of the new fields in the Tcl_HashTable. If an
-     * extension is rebuilt then any calls to this function will be
-     * redirected to the extended version by a macro.
+     * Use a special value to inform the extended version that it must not
+     * access any of the new fields in the Tcl_HashTable. If an extension is
+     * rebuilt then any calls to this function will be redirected to the
+     * extended version by a macro.
      */
+
     Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
 }
 
@@ -168,9 +147,9 @@ Tcl_InitHashTable(tablePtr, keyType)
  *
  * Tcl_InitCustomHashTable --
  *
- *	Given storage for a hash table, set up the fields to prepare
- *	the hash table for use. This is an extended version of
- *	Tcl_InitHashTable which supports user defined keys.
+ *	Given storage for a hash table, set up the fields to prepare the hash
+ *	table for use. This is an extended version of Tcl_InitHashTable which
+ *	supports user defined keys.
  *
  * Results:
  *	None.
@@ -183,19 +162,19 @@ Tcl_InitHashTable(tablePtr, keyType)
  */
 
 void
-Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
-    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
-					 * is supplied by the caller. */
-    int keyType;			/* Type of keys to use in table:
-					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
-					 * TCL_CUSTOM_TYPE_KEYS,
-					 * TCL_CUSTOM_PTR_KEYS,  or an
-					 * integer >= 2. */
-    Tcl_HashKeyType *typePtr;		/* Pointer to structure which defines
-					 * the behaviour of this table. */
+Tcl_InitCustomHashTable(
+    register Tcl_HashTable *tablePtr,
+				/* Pointer to table record, which is supplied
+				 * by the caller. */
+    int keyType,		/* Type of keys to use in table:
+				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
+				 * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS,
+				 * or an integer >= 2. */
+    Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
+				 * behaviour of this table. */
 {
 #if (TCL_SMALL_HASH_TABLE != 4)
-    panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+    Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
 	    TCL_SMALL_HASH_TABLE);
 #endif
 
@@ -208,7 +187,6 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
     tablePtr->downShift = 28;
     tablePtr->mask = 3;
     tablePtr->keyType = keyType;
-#if TCL_PRESERVE_BINARY_COMPATABILITY
     tablePtr->findProc = FindHashEntry;
     tablePtr->createProc = CreateHashEntry;
 
@@ -219,41 +197,16 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
 	 */
     } else if (typePtr != (Tcl_HashKeyType *) -1) {
 	/*
-	 * The caller is requesting a customized hash table so it must be
-	 * an extended version.
+	 * The caller is requesting a customized hash table so it must be an
+	 * extended version.
 	 */
+
 	tablePtr->typePtr = typePtr;
     } else {
 	/*
-	 * The caller has not been rebuilt so the hash table is not
-	 * extended.
-	 */
-    }
-#else
-    if (typePtr == NULL) {
-	/*
-	 * Use the key type to decide which key type is needed.
-	 */
-	if (keyType == TCL_STRING_KEYS) {
-	    typePtr = &tclStringHashKeyType;
-	} else if (keyType == TCL_ONE_WORD_KEYS) {
-	    typePtr = &tclOneWordHashKeyType;
-	} else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
-	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
-	} else if (keyType == TCL_CUSTOM_PTR_KEYS) {
-	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
-	} else {
-	    typePtr = &tclArrayHashKeyType;
-	}
-    } else if (typePtr == (Tcl_HashKeyType *) -1) {
-	/*
-	 * If the caller has not been rebuilt then we cannot continue as
-	 * the hash table is not an extended version.
+	 * The caller has not been rebuilt so the hash table is not extended.
 	 */
-	Tcl_Panic ("Hash table is not compatible");
     }
-    tablePtr->typePtr = typePtr;
-#endif
 }
 
 /*
@@ -264,8 +217,8 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
  *	Given a hash table find the entry with a matching key.
  *
  * Results:
- *	The return value is a token for the matching entry in the
- *	hash table, or NULL if there was no matching entry.
+ *	The return value is a token for the matching entry in the hash table,
+ *	or NULL if there was no matching entry.
  *
  * Side effects:
  *	None.
@@ -274,104 +227,36 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
  */
 
 Tcl_HashEntry *
-Tcl_FindHashEntry(tablePtr, key)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find matching entry. */
-#if TCL_PRESERVE_BINARY_COMPATABILITY
+Tcl_FindHashEntry(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key)		/* Key to use to find matching entry. */
 {
-    return tablePtr->findProc(tablePtr, key);
+    return (*((tablePtr)->findProc))(tablePtr, key);
 }
 
 static Tcl_HashEntry *
-FindHashEntry(tablePtr, key)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find matching entry. */
-#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */
+FindHashEntry(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key)		/* Key to use to find matching entry. */
 {
-    register Tcl_HashEntry *hPtr;
-    Tcl_HashKeyType *typePtr;
-    unsigned int hash;
-    int index;
-
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-    if (tablePtr->keyType == TCL_STRING_KEYS) {
-	typePtr = &tclStringHashKeyType;
-    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
-	typePtr = &tclOneWordHashKeyType;
-    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
-	typePtr = tablePtr->typePtr;
-    } else {
-	typePtr = &tclArrayHashKeyType;
-    }
-#else
-    typePtr = tablePtr->typePtr;
-    if (typePtr == NULL) {
-	Tcl_Panic("called Tcl_FindHashEntry on deleted table");
-	return NULL;
-    }
-#endif
-
-    if (typePtr->hashKeyProc) {
-	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
-	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-	    index = RANDOM_INDEX (tablePtr, hash);
-	} else {
-	    index = hash & tablePtr->mask;
-	}
-    } else {
-	hash = (unsigned int) key;
-	index = RANDOM_INDEX (tablePtr, hash);
-    }
-
-    /*
-     * Search all of the entries in the appropriate bucket.
-     */
-
-    if (typePtr->compareKeysProc) {
-	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
-	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-	        hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
-	    if (hash != (unsigned int) hPtr->hash) {
-		continue;
-	    }
-#endif
-	    if (compareKeysProc ((VOID *) key, hPtr)) {
-		return hPtr;
-	    }
-	}
-    } else {
-	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-	        hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
-	    if (hash != (unsigned int) hPtr->hash) {
-		continue;
-	    }
-#endif
-	    if (key == hPtr->key.oneWordValue) {
-		return hPtr;
-	    }
-	}
-    }
-
-    return NULL;
+    return CreateHashEntry(tablePtr, key, NULL);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_CreateHashEntry --
  *
- *	Given a hash table with string keys, and a string key, find
- *	the entry with a matching key.  If there is no matching entry,
- *	then create a new entry that does match.
+ *	Given a hash table with string keys, and a string key, find the entry
+ *	with a matching key. If there is no matching entry, then create a new
+ *	entry that does match.
  *
  * Results:
- *	The return value is a pointer to the matching entry.  If this
- *	is a newly-created entry, then *newPtr will be set to a non-zero
- *	value;  otherwise *newPtr will be set to 0.  If this is a new
- *	entry the value stored in the entry will initially be 0.
+ *	The return value is a pointer to the matching entry. If this is a
+ *	newly-created entry, then *newPtr will be set to a non-zero value;
+ *	otherwise *newPtr will be set to 0. If this is a new entry the value
+ *	stored in the entry will initially be 0.
  *
  * Side effects:
  *	A new entry may be added to the hash table.
@@ -380,59 +265,49 @@ FindHashEntry(tablePtr, key)
  */
 
 Tcl_HashEntry *
-Tcl_CreateHashEntry(tablePtr, key, newPtr)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find or create matching
+Tcl_CreateHashEntry(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key,		/* Key to use to find or create matching
 				 * entry. */
-    int *newPtr;		/* Store info here telling whether a new
-				 * entry was created. */
-#if TCL_PRESERVE_BINARY_COMPATABILITY
+    int *newPtr)		/* Store info here telling whether a new entry
+				 * was created. */
 {
-    return tablePtr->createProc(tablePtr, key, newPtr);
+    return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
 }
 
 static Tcl_HashEntry *
-CreateHashEntry(tablePtr, key, newPtr)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find or create matching
+CreateHashEntry(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key,		/* Key to use to find or create matching
 				 * entry. */
-    int *newPtr;		/* Store info here telling whether a new
-				 * entry was created. */
-#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */
+    int *newPtr)		/* Store info here telling whether a new entry
+				 * was created. */
 {
     register Tcl_HashEntry *hPtr;
-    Tcl_HashKeyType *typePtr;
+    const Tcl_HashKeyType *typePtr;
     unsigned int hash;
     int index;
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
     if (tablePtr->keyType == TCL_STRING_KEYS) {
 	typePtr = &tclStringHashKeyType;
     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 	typePtr = &tclOneWordHashKeyType;
     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 	typePtr = tablePtr->typePtr;
     } else {
 	typePtr = &tclArrayHashKeyType;
     }
-#else
-    typePtr = tablePtr->typePtr;
-    if (typePtr == NULL) {
-	Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
-	return NULL;
-    }
-#endif
 
     if (typePtr->hashKeyProc) {
-	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
+	hash = typePtr->hashKeyProc(tablePtr, (VOID *) key);
 	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 	    index = RANDOM_INDEX (tablePtr, hash);
 	} else {
 	    index = hash & tablePtr->mask;
 	}
     } else {
-	hash = (unsigned int) key;
+	hash = PTR2UINT(key);
 	index = RANDOM_INDEX (tablePtr, hash);
     }
 
@@ -443,51 +318,56 @@ CreateHashEntry(tablePtr, key, newPtr)
     if (typePtr->compareKeysProc) {
 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-	        hPtr = hPtr->nextPtr) {
+		hPtr = hPtr->nextPtr) {
 #if TCL_HASH_KEY_STORE_HASH
-	    if (hash != (unsigned int) hPtr->hash) {
+	    if (hash != PTR2UINT(hPtr->hash)) {
 		continue;
 	    }
 #endif
-	    if (compareKeysProc ((VOID *) key, hPtr)) {
-		*newPtr = 0;
+	    if (compareKeysProc((VOID *) key, hPtr)) {
+		if (newPtr) {
+		    *newPtr = 0;
+		}
 		return hPtr;
 	    }
 	}
     } else {
 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
-	        hPtr = hPtr->nextPtr) {
+		hPtr = hPtr->nextPtr) {
 #if TCL_HASH_KEY_STORE_HASH
-	    if (hash != (unsigned int) hPtr->hash) {
+	    if (hash != PTR2UINT(hPtr->hash)) {
 		continue;
 	    }
 #endif
 	    if (key == hPtr->key.oneWordValue) {
-		*newPtr = 0;
+		if (newPtr) {
+		    *newPtr = 0;
+		}
 		return hPtr;
 	    }
 	}
     }
 
+    if (!newPtr) {
+	return NULL;
+    }
+
     /*
-     * Entry not found.  Add a new one to the bucket.
+     * Entry not found. Add a new one to the bucket.
      */
 
     *newPtr = 1;
     if (typePtr->allocEntryProc) {
-	hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
+	hPtr = typePtr->allocEntryProc(tablePtr, (VOID *) key);
     } else {
 	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
 	hPtr->key.oneWordValue = (char *) key;
+	hPtr->clientData = 0;
     }
 
     hPtr->tablePtr = tablePtr;
 #if TCL_HASH_KEY_STORE_HASH
-#   if TCL_PRESERVE_BINARY_COMPATABILITY
-    hPtr->hash = (VOID *) hash;
-#   else
-    hPtr->hash = hash;
-#   endif
+    hPtr->hash = UINT2PTR(hash);
     hPtr->nextPtr = tablePtr->buckets[index];
     tablePtr->buckets[index] = hPtr;
 #else
@@ -495,12 +375,11 @@ CreateHashEntry(tablePtr, key, newPtr)
     hPtr->nextPtr = *hPtr->bucketPtr;
     *hPtr->bucketPtr = hPtr;
 #endif
-    hPtr->clientData = 0;
     tablePtr->numEntries++;
 
     /*
-     * If the table has exceeded a decent size, rebuild it with many
-     * more buckets.
+     * If the table has exceeded a decent size, rebuild it with many more
+     * buckets.
      */
 
     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
@@ -520,20 +399,19 @@ CreateHashEntry(tablePtr, key, newPtr)
  *	None.
  *
  * Side effects:
- *	The entry given by entryPtr is deleted from its table and
- *	should never again be used by the caller.  It is up to the
- *	caller to free the clientData field of the entry, if that
- *	is relevant.
+ *	The entry given by entryPtr is deleted from its table and should never
+ *	again be used by the caller. It is up to the caller to free the
+ *	clientData field of the entry, if that is relevant.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteHashEntry(entryPtr)
-    Tcl_HashEntry *entryPtr;
+Tcl_DeleteHashEntry(
+    Tcl_HashEntry *entryPtr)
 {
     register Tcl_HashEntry *prevPtr;
-    Tcl_HashKeyType *typePtr;
+    const Tcl_HashKeyType *typePtr;
     Tcl_HashTable *tablePtr;
     Tcl_HashEntry **bucketPtr;
 #if TCL_HASH_KEY_STORE_HASH
@@ -542,27 +420,23 @@ Tcl_DeleteHashEntry(entryPtr)
 
     tablePtr = entryPtr->tablePtr;
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
     if (tablePtr->keyType == TCL_STRING_KEYS) {
 	typePtr = &tclStringHashKeyType;
     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 	typePtr = &tclOneWordHashKeyType;
     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 	typePtr = tablePtr->typePtr;
     } else {
 	typePtr = &tclArrayHashKeyType;
     }
-#else
-    typePtr = tablePtr->typePtr;
-#endif
 
 #if TCL_HASH_KEY_STORE_HASH
     if (typePtr->hashKeyProc == NULL
-	|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-	index = RANDOM_INDEX (tablePtr, entryPtr->hash);
+	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+	index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash));
     } else {
-	index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
+	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
     }
 
     bucketPtr = &(tablePtr->buckets[index]);
@@ -575,7 +449,7 @@ Tcl_DeleteHashEntry(entryPtr)
     } else {
 	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
 	    if (prevPtr == NULL) {
-		panic("malformed bucket chain in Tcl_DeleteHashEntry");
+		Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
 	    }
 	    if (prevPtr->nextPtr == entryPtr) {
 		prevPtr->nextPtr = entryPtr->nextPtr;
@@ -597,8 +471,8 @@ Tcl_DeleteHashEntry(entryPtr)
  *
  * Tcl_DeleteHashTable --
  *
- *	Free up everything associated with a hash table except for
- *	the record for the table itself.
+ *	Free up everything associated with a hash table except for the record
+ *	for the table itself.
  *
  * Results:
  *	None.
@@ -610,27 +484,23 @@ Tcl_DeleteHashEntry(entryPtr)
  */
 
 void
-Tcl_DeleteHashTable(tablePtr)
-    register Tcl_HashTable *tablePtr;		/* Table to delete. */
+Tcl_DeleteHashTable(
+    register Tcl_HashTable *tablePtr)	/* Table to delete. */
 {
     register Tcl_HashEntry *hPtr, *nextPtr;
-    Tcl_HashKeyType *typePtr;
+    const Tcl_HashKeyType *typePtr;
     int i;
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
     if (tablePtr->keyType == TCL_STRING_KEYS) {
 	typePtr = &tclStringHashKeyType;
     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 	typePtr = &tclOneWordHashKeyType;
     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 	typePtr = tablePtr->typePtr;
     } else {
 	typePtr = &tclArrayHashKeyType;
     }
-#else
-    typePtr = tablePtr->typePtr;
-#endif
 
     /*
      * Free up all the entries in the table.
@@ -654,7 +524,11 @@ Tcl_DeleteHashTable(tablePtr)
      */
 
     if (tablePtr->buckets != tablePtr->staticBuckets) {
-	ckfree((char *) tablePtr->buckets);
+	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+	    TclpSysFree((char *) tablePtr->buckets);
+	} else {
+	    ckfree((char *) tablePtr->buckets);
+	}
     }
 
     /*
@@ -662,12 +536,8 @@ Tcl_DeleteHashTable(tablePtr)
      * re-initialization.
      */
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
     tablePtr->findProc = BogusFind;
     tablePtr->createProc = BogusCreate;
-#else
-    tablePtr->typePtr = NULL;
-#endif
 }
 
 /*
@@ -675,16 +545,14 @@ Tcl_DeleteHashTable(tablePtr)
  *
  * Tcl_FirstHashEntry --
  *
- *	Locate the first entry in a hash table and set up a record
- *	that can be used to step through all the remaining entries
- *	of the table.
+ *	Locate the first entry in a hash table and set up a record that can be
+ *	used to step through all the remaining entries of the table.
  *
  * Results:
- *	The return value is a pointer to the first entry in tablePtr,
- *	or NULL if tablePtr has no entries in it.  The memory at
- *	*searchPtr is initialized so that subsequent calls to
- *	Tcl_NextHashEntry will return all of the entries in the table,
- *	one at a time.
+ *	The return value is a pointer to the first entry in tablePtr, or NULL
+ *	if tablePtr has no entries in it. The memory at *searchPtr is
+ *	initialized so that subsequent calls to Tcl_NextHashEntry will return
+ *	all of the entries in the table, one at a time.
  *
  * Side effects:
  *	None.
@@ -693,10 +561,10 @@ Tcl_DeleteHashTable(tablePtr)
  */
 
 Tcl_HashEntry *
-Tcl_FirstHashEntry(tablePtr, searchPtr)
-    Tcl_HashTable *tablePtr;		/* Table to search. */
-    Tcl_HashSearch *searchPtr;		/* Place to store information about
-					 * progress through the table. */
+Tcl_FirstHashEntry(
+    Tcl_HashTable *tablePtr,	/* Table to search. */
+    Tcl_HashSearch *searchPtr)	/* Place to store information about progress
+				 * through the table. */
 {
     searchPtr->tablePtr = tablePtr;
     searchPtr->nextIndex = 0;
@@ -710,12 +578,12 @@ Tcl_FirstHashEntry(tablePtr, searchPtr)
  * Tcl_NextHashEntry --
  *
  *	Once a hash table enumeration has been initiated by calling
- *	Tcl_FirstHashEntry, this procedure may be called to return
- *	successive elements of the table.
+ *	Tcl_FirstHashEntry, this function may be called to return successive
+ *	elements of the table.
  *
  * Results:
- *	The return value is the next entry in the hash table being
- *	enumerated, or NULL if the end of the table is reached.
+ *	The return value is the next entry in the hash table being enumerated,
+ *	or NULL if the end of the table is reached.
  *
  * Side effects:
  *	None.
@@ -724,11 +592,12 @@ Tcl_FirstHashEntry(tablePtr, searchPtr)
  */
 
 Tcl_HashEntry *
-Tcl_NextHashEntry(searchPtr)
-    register Tcl_HashSearch *searchPtr;	/* Place to store information about
-					 * progress through the table.  Must
-					 * have been initialized by calling
-					 * Tcl_FirstHashEntry. */
+Tcl_NextHashEntry(
+    register Tcl_HashSearch *searchPtr)
+				/* Place to store information about progress
+				 * through the table. Must have been
+				 * initialized by calling
+				 * Tcl_FirstHashEntry. */
 {
     Tcl_HashEntry *hPtr;
     Tcl_HashTable *tablePtr = searchPtr->tablePtr;
@@ -751,13 +620,12 @@ Tcl_NextHashEntry(searchPtr)
  *
  * Tcl_HashStats --
  *
- *	Return statistics describing the layout of the hash table
- *	in its hash buckets.
+ *	Return statistics describing the layout of the hash table in its hash
+ *	buckets.
  *
  * Results:
- *	The return value is a malloc-ed string containing information
- *	about tablePtr.  It is the caller's responsibility to free
- *	this string.
+ *	The return value is a malloc-ed string containing information about
+ *	tablePtr. It is the caller's responsibility to free this string.
  *
  * Side effects:
  *	None.
@@ -766,14 +634,26 @@ Tcl_NextHashEntry(searchPtr)
  */
 
 char *
-Tcl_HashStats(tablePtr)
-    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
+Tcl_HashStats(
+    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
 {
 #define NUM_COUNTERS 10
     int count[NUM_COUNTERS], overflow, i, j;
     double average, tmp;
     register Tcl_HashEntry *hPtr;
     char *result, *p;
+    const Tcl_HashKeyType *typePtr;
+
+    if (tablePtr->keyType == TCL_STRING_KEYS) {
+	typePtr = &tclStringHashKeyType;
+    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+	typePtr = &tclOneWordHashKeyType;
+    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
+	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+	typePtr = tablePtr->typePtr;
+    } else {
+	typePtr = &tclArrayHashKeyType;
+    }
 
     /*
      * Compute a histogram of bucket usage.
@@ -795,14 +675,20 @@ Tcl_HashStats(tablePtr)
 	    overflow++;
 	}
 	tmp = j;
-	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+	if (tablePtr->numEntries != 0) {
+	    average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+	}
     }
 
     /*
      * Print out the histogram and a few other pieces of information.
      */
 
-    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+	result = (char *) TclpSysAlloc((unsigned) (NUM_COUNTERS*60) + 300, 0);
+    } else {
+	result = (char *) ckalloc((unsigned) (NUM_COUNTERS*60) + 300);
+    }
     sprintf(result, "%d entries in table, %d buckets\n",
 	    tablePtr->numEntries, tablePtr->numBuckets);
     p = result + strlen(result);
@@ -835,9 +721,9 @@ Tcl_HashStats(tablePtr)
  */
 
 static Tcl_HashEntry *
-AllocArrayEntry(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key to store in the hash table entry. */
+AllocArrayEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key to store in the hash table entry. */
 {
     int *array = (int *) keyPtr;
     register int *iPtr1, *iPtr2;
@@ -848,14 +734,16 @@ AllocArrayEntry(tablePtr, keyPtr)
     count = tablePtr->keyType;
 
     size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
-    if (size < sizeof(Tcl_HashEntry))
+    if (size < sizeof(Tcl_HashEntry)) {
 	size = sizeof(Tcl_HashEntry);
+    }
     hPtr = (Tcl_HashEntry *) ckalloc(size);
 
     for (iPtr1 = array, iPtr2 = hPtr->key.words;
 	    count > 0; count--, iPtr1++, iPtr2++) {
 	*iPtr2 = *iPtr1;
     }
+    hPtr->clientData = 0;
 
     return hPtr;
 }
@@ -868,8 +756,8 @@ AllocArrayEntry(tablePtr, keyPtr)
  *	Compares two array keys.
  *
  * Results:
- *	The return value is 0 if they are different and 1 if they are
- *	the same.
+ *	The return value is 0 if they are different and 1 if they are the
+ *	same.
  *
  * Side effects:
  *	None.
@@ -878,12 +766,12 @@ AllocArrayEntry(tablePtr, keyPtr)
  */
 
 static int
-CompareArrayKeys(keyPtr, hPtr)
-    VOID *keyPtr;		/* New key to compare. */
-    Tcl_HashEntry *hPtr;	/* Existing key to compare. */
+CompareArrayKeys(
+    VOID *keyPtr,		/* New key to compare. */
+    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
-    register CONST int *iPtr1 = (CONST int *) keyPtr;
-    register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
+    register const int *iPtr1 = (const int *) keyPtr;
+    register const int *iPtr2 = (const int *) hPtr->key.words;
     Tcl_HashTable *tablePtr = hPtr->tablePtr;
     int count;
 
@@ -903,8 +791,8 @@ CompareArrayKeys(keyPtr, hPtr)
  *
  * HashArrayKey --
  *
- *	Compute a one-word summary of an array, which can be
- *	used to generate a hash index.
+ *	Compute a one-word summary of an array, which can be used to generate
+ *	a hash index.
  *
  * Results:
  *	The return value is a one-word summary of the information in
@@ -917,11 +805,11 @@ CompareArrayKeys(keyPtr, hPtr)
  */
 
 static unsigned int
-HashArrayKey(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key from which to compute hash value. */
+HashArrayKey(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key from which to compute hash value. */
 {
-    register CONST int *array = (CONST int *) keyPtr;
+    register const int *array = (const int *) keyPtr;
     register unsigned int result;
     int count;
 
@@ -949,11 +837,11 @@ HashArrayKey(tablePtr, keyPtr)
  */
 
 static Tcl_HashEntry *
-AllocStringEntry(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key to store in the hash table entry. */
+AllocStringEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key to store in the hash table entry. */
 {
-    CONST char *string = (CONST char *) keyPtr;
+    const char *string = (const char *) keyPtr;
     Tcl_HashEntry *hPtr;
     unsigned int size, allocsize;
 
@@ -963,6 +851,7 @@ AllocStringEntry(tablePtr, keyPtr)
     }
     hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
     memcpy(hPtr->key.string, string, size);
+    hPtr->clientData = 0;
     return hPtr;
 }
 
@@ -974,8 +863,8 @@ AllocStringEntry(tablePtr, keyPtr)
  *	Compares two string keys.
  *
  * Results:
- *	The return value is 0 if they are different and 1 if they are
- *	the same.
+ *	The return value is 0 if they are different and 1 if they are the
+ *	same.
  *
  * Side effects:
  *	None.
@@ -984,22 +873,14 @@ AllocStringEntry(tablePtr, keyPtr)
  */
 
 static int
-CompareStringKeys(keyPtr, hPtr)
-    VOID *keyPtr;		/* New key to compare. */
-    Tcl_HashEntry *hPtr;		/* Existing key to compare. */
+CompareStringKeys(
+    VOID *keyPtr,		/* New key to compare. */
+    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
-    register CONST char *p1 = (CONST char *) keyPtr;
-    register CONST char *p2 = (CONST char *) hPtr->key.string;
+    register const char *p1 = (const char *) keyPtr;
+    register const char *p2 = (const char *) hPtr->key.string;
 
-    for (;; p1++, p2++) {
-	if (*p1 != *p2) {
-	    break;
-	}
-	if (*p1 == '\0') {
-	    return 1;
-	}
-    }
-    return 0;
+    return !strcmp(p1, p2);
 }
 
 /*
@@ -1007,12 +888,11 @@ CompareStringKeys(keyPtr, hPtr)
  *
  * HashStringKey --
  *
- *	Compute a one-word summary of a text string, which can be
- *	used to generate a hash index.
+ *	Compute a one-word summary of a text string, which can be used to
+ *	generate a hash index.
  *
  * Results:
- *	The return value is a one-word summary of the information in
- *	string.
+ *	The return value is a one-word summary of the information in string.
  *
  * Side effects:
  *	None.
@@ -1021,54 +901,49 @@ CompareStringKeys(keyPtr, hPtr)
  */
 
 static unsigned int
-HashStringKey(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key from which to compute hash value. */
+HashStringKey(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key from which to compute hash value. */
 {
-    register CONST char *string = (CONST char *) keyPtr;
+    register const char *string = (const char *) keyPtr;
     register unsigned int result;
     register int c;
 
     /*
-     * I tried a zillion different hash functions and asked many other
-     * people for advice.  Many people had their own favorite functions,
-     * all different, but no-one had much idea why they were good ones.
-     * I chose the one below (multiply by 9 and add new character)
-     * because of the following reasons:
+     * I tried a zillion different hash functions and asked many other people
+     * for advice. Many people had their own favorite functions, all
+     * different, but no-one had much idea why they were good ones. I chose
+     * the one below (multiply by 9 and add new character) because of the
+     * following reasons:
      *
-     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
-     *    and multiplying by 9 is just about as good.
-     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
-     *    character's bits hang around in the low-order bits of the
-     *    hash value for ever, plus they spread fairly rapidly up to
-     *    the high-order bits to fill out the hash value.  This seems
-     *    works well both for decimal and non-decimal strings.
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
+     *	  multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old). This means that each
+     *	  character's bits hang around in the low-order bits of the hash value
+     *	  for ever, plus they spread fairly rapidly up to the high-order bits
+     *	  to fill out the hash value. This seems works well both for decimal
+     *	  and non-decimal strings, but isn't strong against maliciously-chosen
+     *	  keys.
      */
 
     result = 0;
-    while (1) {
-	c = *string;
-	if (c == 0) {
-	    break;
-	}
+
+    for (c=*string++ ; c ; c=*string++) {
 	result += (result<<3) + c;
-	string++;
     }
     return result;
 }
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
 /*
  *----------------------------------------------------------------------
  *
  * BogusFind --
  *
- *	This procedure is invoked when an Tcl_FindHashEntry is called
- *	on a table that has been deleted.
+ *	This function is invoked when an Tcl_FindHashEntry is called on a
+ *	table that has been deleted.
  *
  * Results:
- *	If panic returns (which it shouldn't) this procedure returns
- *	NULL.
+ *	If Tcl_Panic returns (which it shouldn't) this function returns NULL.
  *
  * Side effects:
  *	Generates a panic.
@@ -1078,11 +953,11 @@ HashStringKey(tablePtr, keyPtr)
 
 	/* ARGSUSED */
 static Tcl_HashEntry *
-BogusFind(tablePtr, key)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find matching entry. */
+BogusFind(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key)		/* Key to use to find matching entry. */
 {
-    panic("called Tcl_FindHashEntry on deleted table");
+    Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
     return NULL;
 }
 
@@ -1091,12 +966,11 @@ BogusFind(tablePtr, key)
  *
  * BogusCreate --
  *
- *	This procedure is invoked when an Tcl_CreateHashEntry is called
- *	on a table that has been deleted.
+ *	This function is invoked when an Tcl_CreateHashEntry is called on a
+ *	table that has been deleted.
  *
  * Results:
- *	If panic returns (which it shouldn't) this procedure returns
- *	NULL.
+ *	If panic returns (which it shouldn't) this function returns NULL.
  *
  * Side effects:
  *	Generates a panic.
@@ -1106,59 +980,72 @@ BogusFind(tablePtr, key)
 
 	/* ARGSUSED */
 static Tcl_HashEntry *
-BogusCreate(tablePtr, key, newPtr)
-    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
-    CONST char *key;		/* Key to use to find or create matching
+BogusCreate(
+    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
+    const char *key,		/* Key to use to find or create matching
 				 * entry. */
-    int *newPtr;		/* Store info here telling whether a new
-				 * entry was created. */
+    int *newPtr)		/* Store info here telling whether a new entry
+				 * was created. */
 {
-    panic("called Tcl_CreateHashEntry on deleted table");
+    Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
     return NULL;
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * RebuildTable --
  *
- *	This procedure is invoked when the ratio of entries to hash
- *	buckets becomes too large.  It creates a new table with a
- *	larger bucket array and moves all of the entries into the
- *	new table.
+ *	This function is invoked when the ratio of entries to hash buckets
+ *	becomes too large. It creates a new table with a larger bucket array
+ *	and moves all of the entries into the new table.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Memory gets reallocated and entries get re-hashed to new
- *	buckets.
+ *	Memory gets reallocated and entries get re-hashed to new buckets.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-RebuildTable(tablePtr)
-    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
+RebuildTable(
+    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
 {
     int oldSize, count, index;
     Tcl_HashEntry **oldBuckets;
     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
     register Tcl_HashEntry *hPtr;
-    Tcl_HashKeyType *typePtr;
+    const Tcl_HashKeyType *typePtr;
+
+    if (tablePtr->keyType == TCL_STRING_KEYS) {
+	typePtr = &tclStringHashKeyType;
+    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
+	typePtr = &tclOneWordHashKeyType;
+    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
+	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
+	typePtr = tablePtr->typePtr;
+    } else {
+	typePtr = &tclArrayHashKeyType;
+    }
 
     oldSize = tablePtr->numBuckets;
     oldBuckets = tablePtr->buckets;
 
     /*
-     * Allocate and initialize the new bucket array, and set up
-     * hashing constants for new array size.
+     * Allocate and initialize the new bucket array, and set up hashing
+     * constants for new array size.
      */
 
     tablePtr->numBuckets *= 4;
-    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
-	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
+		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
+    } else {
+	tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
+		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+    }
     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
 	    count > 0; count--, newChainPtr++) {
 	*newChainPtr = NULL;
@@ -1167,21 +1054,6 @@ RebuildTable(tablePtr)
     tablePtr->downShift -= 2;
     tablePtr->mask = (tablePtr->mask << 2) + 3;
 
-#if TCL_PRESERVE_BINARY_COMPATABILITY
-    if (tablePtr->keyType == TCL_STRING_KEYS) {
-	typePtr = &tclStringHashKeyType;
-    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
-	typePtr = &tclOneWordHashKeyType;
-    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
-	typePtr = tablePtr->typePtr;
-    } else {
-	typePtr = &tclArrayHashKeyType;
-    }
-#else
-    typePtr = tablePtr->typePtr;
-#endif
-
     /*
      * Rehash all of the existing entries into the new bucket array.
      */
@@ -1189,21 +1061,22 @@ RebuildTable(tablePtr)
     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
 	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
 	    *oldChainPtr = hPtr->nextPtr;
-
 #if TCL_HASH_KEY_STORE_HASH
 	    if (typePtr->hashKeyProc == NULL
-		|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-		index = RANDOM_INDEX (tablePtr, hPtr->hash);
+		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+		index = RANDOM_INDEX (tablePtr, PTR2UINT(hPtr->hash));
 	    } else {
-		index = ((unsigned int) hPtr->hash) & tablePtr->mask;
+		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
 	    }
 	    hPtr->nextPtr = tablePtr->buckets[index];
 	    tablePtr->buckets[index] = hPtr;
 #else
-	    VOID *key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
+	    VOID *key = (VOID *) Tcl_GetHashKey(tablePtr, hPtr);
+
 	    if (typePtr->hashKeyProc) {
 		unsigned int hash;
-		hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
+
+		hash = typePtr->hashKeyProc(tablePtr, key);
 		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 		    index = RANDOM_INDEX (tablePtr, hash);
 		} else {
@@ -1225,6 +1098,18 @@ RebuildTable(tablePtr)
      */
 
     if (oldBuckets != tablePtr->staticBuckets) {
-	ckfree((char *) oldBuckets);
+	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
+	    TclpSysFree((char *) oldBuckets);
+	} else {
+	    ckfree((char *) oldBuckets);
+	}
     }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 9ff3f49..a23e102 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclHistory.c --
  *
  *	This module and the Tcl library file history.tcl together implement
@@ -9,13 +9,11 @@
  * Copyright (c) 1990-1993 The Regents of the University of California.
  * Copyright (c) 1994-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
-
 
 /*
  *----------------------------------------------------------------------
@@ -23,8 +21,7 @@
  * Tcl_RecordAndEval --
  *
  *	This procedure adds its command argument to the current list of
- *	recorded events and then executes the command by calling
- *	Tcl_Eval.
+ *	recorded events and then executes the command by calling Tcl_Eval.
  *
  * Results:
  *	The return value is a standard Tcl return value, the result of
@@ -37,12 +34,12 @@
  */
 
 int
-Tcl_RecordAndEval(interp, cmd, flags)
-    Tcl_Interp *interp;		/* Token for interpreter in which command
-				 * will be executed. */
-    CONST char *cmd;		/* Command to record. */
-    int flags;			/* Additional flags.  TCL_NO_EVAL means
-				 * only record: don't execute command.
+Tcl_RecordAndEval(
+    Tcl_Interp *interp,		/* Token for interpreter in which command will
+				 * be executed. */
+    CONST char *cmd,		/* Command to record. */
+    int flags)			/* Additional flags. TCL_NO_EVAL means only
+				 * record: don't execute command.
 				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
 				 * instead of Tcl_Eval. */
 {
@@ -60,18 +57,17 @@ Tcl_RecordAndEval(interp, cmd, flags)
 	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
 
 	/*
-	 * Move the interpreter's object result to the string result, 
-	 * then reset the object result.
+	 * Move the interpreter's object result to the string result, then
+	 * reset the object result.
 	 */
 
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
+	(void) Tcl_GetStringResult(interp);
 
 	/*
 	 * Discard the Tcl object created to hold the command.
 	 */
-	
-	Tcl_DecrRefCount(cmdPtr);	
+
+	Tcl_DecrRefCount(cmdPtr);
     } else {
 	/*
 	 * An empty string. Just reset the interpreter's result.
@@ -103,33 +99,56 @@ Tcl_RecordAndEval(interp, cmd, flags)
  */
 
 int
-Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
-    Tcl_Interp *interp;		/* Token for interpreter in which command
-				 * will be executed. */
-    Tcl_Obj *cmdPtr;		/* Points to object holding the command to
+Tcl_RecordAndEvalObj(
+    Tcl_Interp *interp,		/* Token for interpreter in which command will
+				 * be executed. */
+    Tcl_Obj *cmdPtr,		/* Points to object holding the command to
 				 * record and execute. */
-    int flags;			/* Additional flags. TCL_NO_EVAL means
-				 * record only: don't execute the command.
-				 * TCL_EVAL_GLOBAL means evaluate the
-				 * script in global variable context instead
-				 * of the current procedure. */
+    int flags)			/* Additional flags. TCL_NO_EVAL means record
+				 * only: don't execute the command.
+				 * TCL_EVAL_GLOBAL means evaluate the script
+				 * in global variable context instead of the
+				 * current procedure. */
 {
-    int result;
+    int result, call = 1;
     Tcl_Obj *list[3];
     register Tcl_Obj *objPtr;
+    Tcl_CmdInfo info;
 
     /*
-     * Do recording by eval'ing a tcl history command: history add $cmd.
+     * Do not call [history] if it has been replaced by an empty proc
      */
 
-    list[0] = Tcl_NewStringObj("history", -1);
-    list[1] = Tcl_NewStringObj("add", -1);
-    list[2] = cmdPtr;
-    
-    objPtr = Tcl_NewListObj(3, list);
-    Tcl_IncrRefCount(objPtr);
-    (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-    Tcl_DecrRefCount(objPtr);
+    result = Tcl_GetCommandInfo(interp, "history", &info);
+
+    if (result && (info.objProc == TclObjInterpProc)) {
+	Proc *procPtr = (Proc *)(info.objClientData);
+	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
+    }
+
+    if (call) {
+
+	/*
+	 * Do recording by eval'ing a tcl history command: history add $cmd. 
+	 */
+
+	TclNewLiteralStringObj(list[0], "history");
+	TclNewLiteralStringObj(list[1], "add");
+	list[2] = cmdPtr;
+	
+	objPtr = Tcl_NewListObj(3, list);
+	Tcl_IncrRefCount(objPtr);
+	(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(objPtr);
+	
+	/*
+	 * One possible failure mode above: exceeding a resource limit.
+	 */
+	
+	if (Tcl_LimitExceeded(interp)) {
+	    return TCL_ERROR;
+	}
+    }
 
     /*
      * Execute the command.
@@ -141,3 +160,11 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
     }
     return result;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index eace472..de7f228 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclIO.c --
  *
  *	This file provides the generic portions (those that are the same on
@@ -7,64 +7,38 @@
  * Copyright (c) 1998-2000 Ajuba Solutions
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclIO.h"
 #include <assert.h>
 
-#ifndef TCL_INHERIT_STD_CHANNELS
-#define TCL_INHERIT_STD_CHANNELS 1
-#endif
-
-
 /*
- * All static variables used in this file are collected into a single
- * instance of the following structure.  For multi-threaded implementations,
- * there is one instance of this structure for each thread.
+ * All static variables used in this file are collected into a single instance
+ * of the following structure. For multi-threaded implementations, there is
+ * one instance of this structure for each thread.
  *
- * Notice that different structures with the same name appear in other
- * files.  The structure defined below is used in this file only.
+ * Notice that different structures with the same name appear in other files.
+ * The structure defined below is used in this file only.
  */
 
 typedef struct ThreadSpecificData {
-
-    /*
-     * This variable holds the list of nested ChannelHandlerEventProc 
-     * invocations.
-     */
     NextChannelHandler *nestedHandlerPtr;
-
-    /*
-     * List of all channels currently open, indexed by ChannelState,
-     * as only one ChannelState exists per set of stacked channels.
-     */
-    ChannelState *firstCSPtr;
-#ifdef oldcode
-    /*
-     * Has a channel exit handler been created yet?
-     */
-    int channelExitHandlerCreated;
-
-    /*
-     * Has the channel event source been created and registered with the
-     * notifier?
-     */
-    int channelEventSourceCreated;
-#endif
-    /*
-     * Static variables to hold channels for stdin, stdout and stderr.
-     */
-    Tcl_Channel stdinChannel;
+				/* This variable holds the list of nested
+				 * ChannelHandlerEventProc invocations. */
+    ChannelState *firstCSPtr;	/* List of all channels currently open,
+				 * indexed by ChannelState, as only one
+				 * ChannelState exists per set of stacked
+				 * channels. */
+    Tcl_Channel stdinChannel;	/* Static variable for the stdin channel. */
     int stdinInitialized;
-    Tcl_Channel stdoutChannel;
+    Tcl_Channel stdoutChannel;	/* Static variable for the stdout channel. */
     int stdoutInitialized;
-    Tcl_Channel stderrChannel;
+    Tcl_Channel stderrChannel;	/* Static variable for the stderr channel. */
     int stderrInitialized;
-
+    Tcl_Encoding binaryEncoding;
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
@@ -73,86 +47,181 @@ static Tcl_ThreadDataKey dataKey;
  * Static functions in this file:
  */
 
-static ChannelBuffer *	AllocChannelBuffer _ANSI_ARGS_((int length));
-static void		ChannelTimerProc _ANSI_ARGS_((
-				ClientData clientData));
-static int		CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
-				int direction));
-static int		CheckFlush _ANSI_ARGS_((Channel *chanPtr,
-				ChannelBuffer *bufPtr, int newlineFlag));
-static int		CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				ChannelState *statePtr));
-static void		CheckForStdChannelsBeingClosed _ANSI_ARGS_((
-				Tcl_Channel chan));
-static void		CleanupChannelHandlers _ANSI_ARGS_((
-				Tcl_Interp *interp, Channel *chanPtr));
-static int		CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Channel *chanPtr, int errorCode));
-static void		CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
-				Tcl_Encoding encoding));
-static int		CopyAndTranslateBuffer _ANSI_ARGS_((
-				ChannelState *statePtr, char *result,
-				int space));
-static int		CopyBuffer _ANSI_ARGS_((
-				Channel *chanPtr, char *result, int space));
-static int		CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
-static void		CopyEventProc _ANSI_ARGS_((ClientData clientData,
-				int mask));
-static void		CreateScriptRecord _ANSI_ARGS_((
-				Tcl_Interp *interp, Channel *chanPtr,
-				int mask, Tcl_Obj *scriptPtr));
-static void		DeleteChannelTable _ANSI_ARGS_((
-				ClientData clientData, Tcl_Interp *interp));
-static void		DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
-				Channel *chanPtr, int mask));
-static int              DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
-static void		DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
-				int discardSavedBuffers));
-static void		DiscardOutputQueued _ANSI_ARGS_((
-				ChannelState *chanPtr));
-static int		DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
-				int slen));
-static int		DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src,
-				int srcLen));
-static int		DoReadChars _ANSI_ARGS_ ((Channel* chan,
-				Tcl_Obj* objPtr, int toRead, int appendFlag));
-static int		DoWriteChars _ANSI_ARGS_ ((Channel* chan,
-				CONST char* src, int len));
-static int		FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
-				GetsState *statePtr));
-static int		FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
-				Channel *chanPtr, int calledFromAsyncFlush));
-static Tcl_HashTable *	GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
-static int		GetInput _ANSI_ARGS_((Channel *chanPtr));
-static int		HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
-				Tcl_ChannelTypeVersion minimumVersion));
-static void		PeekAhead _ANSI_ARGS_((Channel *chanPtr,
-				char **dstEndPtr, GetsState *gsPtr));
-static int		ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
-				Tcl_Obj *objPtr, int charsLeft,
-				int *offsetPtr));
-static int		ReadChars _ANSI_ARGS_((ChannelState *statePtr,
-				Tcl_Obj *objPtr, int charsLeft,
-				int *offsetPtr, int *factorPtr));
-static void		RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
-				ChannelBuffer *bufPtr, int mustDiscard));
-static int		StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
-				int mode));
-static int		SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
-				Channel *chanPtr, int mode));
-static void		StopCopy _ANSI_ARGS_((CopyState *csPtr));
-static int		TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
-				char *dst, CONST char *src,
-				int *dstLenPtr, int *srcLenPtr));
-static int		TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
-				char *dst, CONST char *src,
-				int *dstLenPtr, int *srcLenPtr));
-static void		UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
-static int		WriteBytes _ANSI_ARGS_((Channel *chanPtr,
-				CONST char *src, int srcLen));
-static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,
-				CONST char *src, int srcLen));
+static ChannelBuffer *	AllocChannelBuffer(int length);
+static void		ChannelTimerProc(ClientData clientData);
+static int		CheckChannelErrors(ChannelState *statePtr,
+			    int direction);
+static int		CheckFlush(Channel *chanPtr, ChannelBuffer *bufPtr,
+			    int newlineFlag);
+static int		CheckForDeadChannel(Tcl_Interp *interp,
+			    ChannelState *statePtr);
+static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
+static void		CleanupChannelHandlers(Tcl_Interp *interp,
+			    Channel *chanPtr);
+static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
+			    int errorCode);
+static void		CommonGetsCleanup(Channel *chanPtr);
+static int		CopyAndTranslateBuffer(ChannelState *statePtr,
+			    char *result, int space);
+static int		CopyBuffer(Channel *chanPtr, char *result, int space);
+static int		CopyData(CopyState *csPtr, int mask);
+static void		CopyEventProc(ClientData clientData, int mask);
+static void		CreateScriptRecord(Tcl_Interp *interp,
+			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
+static void		DeleteChannelTable(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		DeleteScriptRecord(Tcl_Interp *interp,
+			    Channel *chanPtr, int mask);
+static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
+static void		DiscardInputQueued(ChannelState *statePtr,
+			    int discardSavedBuffers);
+static void		DiscardOutputQueued(ChannelState *chanPtr);
+static int		DoRead(Channel *chanPtr, char *srcPtr, int slen);
+static int		DoWrite(Channel *chanPtr, const char *src, int srcLen);
+static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
+			    int appendFlag);
+static int		DoWriteChars(Channel *chan, const char *src, int len);
+static int		FilterInputBytes(Channel *chanPtr,
+			    GetsState *statePtr);
+static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
+			    int calledFromAsyncFlush);
+static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
+static void		FreeBinaryEncoding(ClientData clientData);
+static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
+static int		GetInput(Channel *chanPtr);
+static int		HaveVersion(const Tcl_ChannelType *typePtr,
+			    Tcl_ChannelTypeVersion minimumVersion);
+static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
+			    GetsState *gsPtr);
+static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
+			    int charsLeft, int *offsetPtr);
+static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
+			    int charsLeft, int *offsetPtr, int *factorPtr);
+static void		RecycleBuffer(ChannelState *statePtr,
+			    ChannelBuffer *bufPtr, int mustDiscard);
+static int		StackSetBlockMode(Channel *chanPtr, int mode);
+static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
+			    int mode);
+static void		StopCopy(CopyState *csPtr);
+static int		TranslateInputEOL(ChannelState *statePtr, char *dst,
+			    const char *src, int *dstLenPtr, int *srcLenPtr);
+static int		TranslateOutputEOL(ChannelState *statePtr, char *dst,
+			    const char *src, int *dstLenPtr, int *srcLenPtr);
+static void		UpdateInterest(Channel *chanPtr);
+static int		WriteBytes(Channel *chanPtr, const char *src,
+			    int srcLen);
+static int		WriteChars(Channel *chanPtr, const char *src,
+			    int srcLen);
+static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
+static void		SpliceChannel(Tcl_Channel chan);
+static void		CutChannel(Tcl_Channel chan);
+
+/*
+ * Simplifying helper macros. All may use their argument(s) multiple times.
+ * The ANSI C "prototypes" for the macros are listed below, together with a
+ * short description of what the macro does.
+ *
+ * --------------------------------------------------------------------------
+ * int BytesLeft(ChannelBuffer *bufPtr)
+ *
+ *	Returns the number of bytes of data remaining in the buffer.
+ *
+ * int SpaceLeft(ChannelBuffer *bufPtr)
+ *
+ *	Returns the number of bytes of space remaining at the end of the
+ *	buffer.
+ *
+ * int IsBufferReady(ChannelBuffer *bufPtr)
+ *
+ *	Returns whether a buffer has bytes available within it.
+ *
+ * int IsBufferEmpty(ChannelBuffer *bufPtr)
+ *
+ *	Returns whether a buffer is entirely empty. Note that this is not the
+ *	inverse of the above operation; trying to merge the two seems to lead
+ *	to occasional crashes...
+ *
+ * int IsBufferFull(ChannelBuffer *bufPtr)
+ *
+ *	Returns whether more data can be added to a buffer.
+ *
+ * int IsBufferOverflowing(ChannelBuffer *bufPtr)
+ *
+ *	Returns whether a buffer has more data in it than it should.
+ *
+ * char *InsertPoint(ChannelBuffer *bufPtr)
+ *
+ *	Returns a pointer to where characters should be added to the buffer.
+ *
+ * char *RemovePoint(ChannelBuffer *bufPtr)
+ *
+ *	Returns a pointer to where characters should be removed from the
+ *	buffer.
+ * --------------------------------------------------------------------------
+ */
+
+#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
+
+#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
+
+#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
+
+#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
+
+#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+
+#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
+
+#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
+
+#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
+
+/*
+ * For working with channel state flag bits.
+ */
+
+#define SetFlag(statePtr, flag)		((statePtr)->flags |= (flag))
+#define ResetFlag(statePtr, flag)	((statePtr)->flags &= ~(flag))
+
+/*
+ * Macro for testing whether a string (in optionName, length len) matches a
+ * value (prefix matching rules). Arguments are the minimum length to match
+ * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is
+ * used in a situation where no objects are available.)
+ */
+
+#define HaveOpt(minLength, nameString) \
+	((len > (minLength)) && (optionName[1] == (nameString)[1]) \
+		&& (strncmp(optionName, (nameString), len) == 0))
+
+/*
+ * The ChannelObjType type.  We actually store the ChannelState structure
+ * as that lives longest and we want to return the bottomChanPtr when
+ * requested (consistent with Tcl_GetChannel).  The setFromAny and
+ * updateString can be NULL as they should not be called.
+ */
+
+static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static int		SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfChannel(Tcl_Obj *objPtr);
+static void		FreeChannelIntRep(Tcl_Obj *objPtr);
+
+static Tcl_ObjType tclChannelType = {
+    "channel",			/* name for this type */
+    FreeChannelIntRep,		/* freeIntRepProc */
+    DupChannelIntRep,		/* dupIntRepProc */
+    NULL,			/* updateStringProc UpdateStringOfChannel */
+    NULL			/* setFromAnyProc SetChannelFromAny */
+};
+
+#define GET_CHANNELSTATE(objPtr) \
+    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_CHANNELSTATE(objPtr, storePtr) \
+    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
+#define GET_CHANNELINTERP(objPtr) \
+    ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
+#define SET_CHANNELINTERP(objPtr, storePtr) \
+    ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
 
 #define BUSY_STATE(st,fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
@@ -166,7 +235,7 @@ static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,
  * TclInitIOSubsystem --
  *
  *	Initialize all resources used by this subsystem on a per-process
- *	basis.  
+ *	basis.
  *
  * Results:
  *	None.
@@ -178,23 +247,24 @@ static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,
  */
 
 void
-TclInitIOSubsystem()
+TclInitIOSubsystem(void)
 {
     /*
-     * By fetching thread local storage we take care of
-     * allocating it for each thread.
+     * By fetching thread local storage we take care of allocating it for each
+     * thread.
      */
+
     (void) TCL_TSD_INIT(&dataKey);
-}   
+}
 
 /*
  *-------------------------------------------------------------------------
  *
  * TclFinalizeIOSubsystem --
  *
- *	Releases all resources used by this subsystem on a per-thread
- *	basis.  Closes all extant channels that have not already been 
- *	closed because they were not owned by any interp.  
+ *	Releases all resources used by this subsystem on a per-process basis.
+ *	Closes all extant channels that have not already been closed because
+ *	they were not owned by any interp.
  *
  * Results:
  *	None.
@@ -215,23 +285,21 @@ TclFinalizeIOSubsystem(void)
     int active = 1;		/* Flag == 1 while there's still work to do */
 
     /*
-     * Walk all channel state structures known to this thread and
-     * close corresponding channels.
+     * Walk all channel state structures known to this thread and close
+     * corresponding channels.
      */
 
     while (active) {
-
 	/*
-	 * Iterate through the open channel list, and find the first
-	 * channel that isn't dead. We start from the head of the list
-	 * each time, because the close action on one channel can close
-	 * others.
+	 * Iterate through the open channel list, and find the first channel
+	 * that isn't dead. We start from the head of the list each time,
+	 * because the close action on one channel can close others.
 	 */
 
 	active = 0;
 	for (statePtr = tsdPtr->firstCSPtr;
-	     statePtr != NULL;
-	     statePtr = statePtr->nextCSPtr) {
+		statePtr != NULL;
+		statePtr = statePtr->nextCSPtr) {
 	    chanPtr = statePtr->topChanPtr;
 	    if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
 		active = 1;
@@ -240,67 +308,65 @@ TclFinalizeIOSubsystem(void)
 	}
 
 	/*
-	 * We've found a live channel.  Close it.
+	 * We've found a live channel. Close it.
 	 */
 
 	if (active) {
-
 	    /*
-	     * Set the channel back into blocking mode to ensure that we 
-	     * wait for all data to flush out.
+	     * Set the channel back into blocking mode to ensure that we wait
+	     * for all data to flush out.
 	     */
-	    
+
 	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
-					"-blocking", "on");
-	    
+		    "-blocking", "on");
+
 	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
-		(chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
-		(chanPtr == (Channel *) tsdPtr->stderrChannel)) {
+		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
+		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
 		/*
-		 * Decrement the refcount which was earlier artificially 
+		 * Decrement the refcount which was earlier artificially
 		 * bumped up to keep the channel from being closed.
 		 */
-		
+
 		statePtr->refCount--;
 	    }
-	    
+
 	    if (statePtr->refCount <= 0) {
 		/*
-		 * Close it only if the refcount indicates that the channel 
-		 * is not referenced from any interpreter. If it is, that
+		 * Close it only if the refcount indicates that the channel is
+		 * not referenced from any interpreter. If it is, that
 		 * interpreter will close the channel when it gets destroyed.
 		 */
-		
+
 		(void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
 	    } else {
 		/*
 		 * The refcount is greater than zero, so flush the channel.
 		 */
-		
+
 		Tcl_Flush((Tcl_Channel) chanPtr);
-		
+
 		/*
-		 * Call the device driver to actually close the underlying 
+		 * Call the device driver to actually close the underlying
 		 * device for this channel.
 		 */
-		
+
 		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
 		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
 		} else {
 		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
-						   NULL, 0);
+			    NULL, 0);
 		}
-		
+
 		/*
-		 * Finally, we clean up the fields in the channel data 
-		 * structure since all of them have been deleted already. 
-		 * We mark the channel with CHANNEL_DEAD to prevent any 
-		 * further IO operations
-		 * on it.
+		 * Finally, we clean up the fields in the channel data
+		 * structure since all of them have been deleted already. We
+		 * mark the channel with CHANNEL_DEAD to prevent any further
+		 * IO operations on it.
 		 */
-		
+
 		chanPtr->instanceData = NULL;
-		statePtr->flags |= CHANNEL_DEAD;
+		SetFlag(statePtr, CHANNEL_DEAD);
 	    }
 	}
     }
@@ -308,15 +374,14 @@ TclFinalizeIOSubsystem(void)
     TclpFinalizeSockets();
     TclpFinalizePipes();
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SetStdChannel --
  *
- *	This function is used to change the channels that are used
- *	for stdin/stdout/stderr in new interpreters.
+ *	This function is used to change the channels that are used for
+ *	stdin/stdout/stderr in new interpreters.
  *
  * Results:
  *	None
@@ -328,24 +393,24 @@ TclFinalizeIOSubsystem(void)
  */
 
 void
-Tcl_SetStdChannel(channel, type)
-    Tcl_Channel channel;
-    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_SetStdChannel(
+    Tcl_Channel channel,
+    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     switch (type) {
-	case TCL_STDIN:
-	    tsdPtr->stdinInitialized = 1;
-	    tsdPtr->stdinChannel = channel;
-	    break;
-	case TCL_STDOUT:
-	    tsdPtr->stdoutInitialized = 1;
-	    tsdPtr->stdoutChannel = channel;
-	    break;
-	case TCL_STDERR:
-	    tsdPtr->stderrInitialized = 1;
-	    tsdPtr->stderrChannel = channel;
-	    break;
+    case TCL_STDIN:
+	tsdPtr->stdinInitialized = 1;
+	tsdPtr->stdinChannel = channel;
+	break;
+    case TCL_STDOUT:
+	tsdPtr->stdoutInitialized = 1;
+	tsdPtr->stdoutChannel = channel;
+	break;
+    case TCL_STDERR:
+	tsdPtr->stderrInitialized = 1;
+	tsdPtr->stderrChannel = channel;
+	break;
     }
 }
 
@@ -360,71 +425,67 @@ Tcl_SetStdChannel(channel, type)
  *	Returns the specified standard channel, or NULL.
  *
  * Side effects:
- *	May cause the creation of a standard channel and the underlying
- *	file.
+ *	May cause the creation of a standard channel and the underlying file.
  *
  *----------------------------------------------------------------------
  */
+
 Tcl_Channel
-Tcl_GetStdChannel(type)
-    int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_GetStdChannel(
+    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 {
     Tcl_Channel channel = NULL;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
-     * If the channels were not created yet, create them now and
-     * store them in the static variables. 
+     * If the channels were not created yet, create them now and store them in
+     * the static variables.
      */
 
     switch (type) {
-	case TCL_STDIN:
-	    if (!tsdPtr->stdinInitialized) {
-		tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
-		tsdPtr->stdinInitialized = 1;
+    case TCL_STDIN:
+	if (!tsdPtr->stdinInitialized) {
+	    tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
+	    tsdPtr->stdinInitialized = 1;
 
-		/*
-                 * Artificially bump the refcount to ensure that the channel
-                 * is only closed on exit.
-                 *
-                 * NOTE: Must only do this if stdinChannel is not NULL. It
-                 * can be NULL in situations where Tcl is unable to connect
-                 * to the standard input.
-                 */
-
-                if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
-                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
-                            tsdPtr->stdinChannel);
-                }
-	    }
-	    channel = tsdPtr->stdinChannel;
-	    break;
-	case TCL_STDOUT:
-	    if (!tsdPtr->stdoutInitialized) {
-		tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
-		tsdPtr->stdoutInitialized = 1;
-                if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
-                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
-                            tsdPtr->stdoutChannel);
-                }
-	    }
-	    channel = tsdPtr->stdoutChannel;
-	    break;
-	case TCL_STDERR:
-	    if (!tsdPtr->stderrInitialized) {
-		tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
-		tsdPtr->stderrInitialized = 1;
-                if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
-                    (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
-                            tsdPtr->stderrChannel);
-                }
-	    }
-	    channel = tsdPtr->stderrChannel;
-	    break;
+	    /*
+	     * Artificially bump the refcount to ensure that the channel is
+	     * only closed on exit.
+	     *
+	     * NOTE: Must only do this if stdinChannel is not NULL. It can be
+	     * NULL in situations where Tcl is unable to connect to the
+	     * standard input.
+	     */
+
+	    if (tsdPtr->stdinChannel != NULL) {
+		Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
+	    }
+	}
+	channel = tsdPtr->stdinChannel;
+	break;
+    case TCL_STDOUT:
+	if (!tsdPtr->stdoutInitialized) {
+	    tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
+	    tsdPtr->stdoutInitialized = 1;
+	    if (tsdPtr->stdoutChannel != NULL) {
+		Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
+	    }
+	}
+	channel = tsdPtr->stdoutChannel;
+	break;
+    case TCL_STDERR:
+	if (!tsdPtr->stderrInitialized) {
+	    tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
+	    tsdPtr->stderrInitialized = 1;
+	    if (tsdPtr->stderrChannel != NULL) {
+		Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
+	    }
+	}
+	channel = tsdPtr->stderrChannel;
+	break;
     }
     return channel;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -438,27 +499,27 @@ Tcl_GetStdChannel(type)
  *	None.
  *
  * Side effects:
- *	Causes the callback to be called in the future when the channel
- *	will be closed.
+ *	Causes the callback to be called in the future when the channel will
+ *	be closed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CreateCloseHandler(chan, proc, clientData)
-    Tcl_Channel chan;		/* The channel for which to create the
-                                 * close callback. */
-    Tcl_CloseProc *proc;	/* The callback routine to call when the
-                                 * channel will be closed. */
-    ClientData clientData;	/* Arbitrary data to pass to the
-                                 * close callback. */
+Tcl_CreateCloseHandler(
+    Tcl_Channel chan,		/* The channel for which to create the close
+				 * callback. */
+    Tcl_CloseProc *proc,	/* The callback routine to call when the
+				 * channel will be closed. */
+    ClientData clientData)	/* Arbitrary data to pass to the close
+				 * callback. */
 {
     ChannelState *statePtr;
     CloseCallback *cbPtr;
 
     statePtr = ((Channel *) chan)->state;
 
-    cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
+    cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
     cbPtr->proc = proc;
     cbPtr->clientData = clientData;
 
@@ -471,45 +532,43 @@ Tcl_CreateCloseHandler(chan, proc, clientData)
  *
  * Tcl_DeleteCloseHandler --
  *
- *	Removes a callback that would have been called on closing
- *	the channel. If there is no matching callback then this
- *	function has no effect.
+ *	Removes a callback that would have been called on closing the channel.
+ *	If there is no matching callback then this function has no effect.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The callback will not be called in the future when the channel
- *	is eventually closed.
+ *	The callback will not be called in the future when the channel is
+ *	eventually closed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteCloseHandler(chan, proc, clientData)
-    Tcl_Channel chan;		/* The channel for which to cancel the
-                                 * close callback. */
-    Tcl_CloseProc *proc;	/* The procedure for the callback to
-                                 * remove. */
-    ClientData clientData;	/* The callback data for the callback
-                                 * to remove. */
+Tcl_DeleteCloseHandler(
+    Tcl_Channel chan,		/* The channel for which to cancel the close
+				 * callback. */
+    Tcl_CloseProc *proc,	/* The procedure for the callback to
+				 * remove. */
+    ClientData clientData)	/* The callback data for the callback to
+				 * remove. */
 {
     ChannelState *statePtr;
     CloseCallback *cbPtr, *cbPrevPtr;
 
     statePtr = ((Channel *) chan)->state;
-    for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
-	 cbPtr != (CloseCallback *) NULL;
-	 cbPtr = cbPtr->nextPtr) {
-        if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
-            if (cbPrevPtr == (CloseCallback *) NULL) {
-                statePtr->closeCbPtr = cbPtr->nextPtr;
-            }
-            ckfree((char *) cbPtr);
-            break;
-        } else {
-            cbPrevPtr = cbPtr;
-        }
+    for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
+	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
+	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
+	    if (cbPrevPtr == NULL) {
+		statePtr->closeCbPtr = cbPtr->nextPtr;
+	    }
+	    ckfree((char *) cbPtr);
+	    break;
+	} else {
+	    cbPrevPtr = cbPtr;
+	}
     }
 }
 
@@ -518,58 +577,53 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
  *
  * GetChannelTable --
  *
- *	Gets and potentially initializes the channel table for an
- *	interpreter. If it is initializing the table it also inserts
- *	channels for stdin, stdout and stderr if the interpreter is
- *	trusted.
+ *	Gets and potentially initializes the channel table for an interpreter.
+ *	If it is initializing the table it also inserts channels for stdin,
+ *	stdout and stderr if the interpreter is trusted.
  *
  * Results:
  *	A pointer to the hash table created, for use by the caller.
  *
  * Side effects:
- *	Initializes the channel table for an interpreter. May create
- *	channels for stdin, stdout and stderr.
+ *	Initializes the channel table for an interpreter. May create channels
+ *	for stdin, stdout and stderr.
  *
  *----------------------------------------------------------------------
  */
 
 static Tcl_HashTable *
-GetChannelTable(interp)
-    Tcl_Interp *interp;
+GetChannelTable(
+    Tcl_Interp *interp)
 {
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_Channel stdinChan, stdoutChan, stderrChan;
 
-    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-    if (hTblPtr == (Tcl_HashTable *) NULL) {
-        hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
-
-        (void) Tcl_SetAssocData(interp, "tclIO",
-                (Tcl_InterpDeleteProc *) DeleteChannelTable,
-                (ClientData) hTblPtr);
-
-        /*
-         * If the interpreter is trusted (not "safe"), insert channels
-         * for stdin, stdout and stderr (possibly creating them in the
-         * process).
-         */
-
-        if (Tcl_IsSafe(interp) == 0) {
-            stdinChan = Tcl_GetStdChannel(TCL_STDIN);
-            if (stdinChan != NULL) {
-                Tcl_RegisterChannel(interp, stdinChan);
-            }
-            stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
-            if (stdoutChan != NULL) {
-                Tcl_RegisterChannel(interp, stdoutChan);
-            }
-            stderrChan = Tcl_GetStdChannel(TCL_STDERR);
-            if (stderrChan != NULL) {
-                Tcl_RegisterChannel(interp, stderrChan);
-            }
-        }
+    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+    if (hTblPtr == NULL) {
+	hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
+	Tcl_SetAssocData(interp, "tclIO",
+		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
 
+	/*
+	 * If the interpreter is trusted (not "safe"), insert channels for
+	 * stdin, stdout and stderr (possibly creating them in the process).
+	 */
+
+	if (Tcl_IsSafe(interp) == 0) {
+	    stdinChan = Tcl_GetStdChannel(TCL_STDIN);
+	    if (stdinChan != NULL) {
+		Tcl_RegisterChannel(interp, stdinChan);
+	    }
+	    stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
+	    if (stdoutChan != NULL) {
+		Tcl_RegisterChannel(interp, stdoutChan);
+	    }
+	    stderrChan = Tcl_GetStdChannel(TCL_STDERR);
+	    if (stderrChan != NULL) {
+		Tcl_RegisterChannel(interp, stderrChan);
+	    }
+	}
     }
     return hTblPtr;
 }
@@ -580,9 +634,8 @@ GetChannelTable(interp)
  * DeleteChannelTable --
  *
  *	Deletes the channel table for an interpreter, closing any open
- *	channels whose refcount reaches zero. This procedure is invoked
- *	when an interpreter is deleted, via the AssocData cleanup
- *	mechanism.
+ *	channels whose refcount reaches zero. This procedure is invoked when
+ *	an interpreter is deleted, via the AssocData cleanup mechanism.
  *
  * Results:
  *	None.
@@ -596,9 +649,9 @@ GetChannelTable(interp)
  */
 
 static void
-DeleteChannelTable(clientData, interp)
-    ClientData clientData;	/* The per-interpreter data structure. */
-    Tcl_Interp *interp;		/* The interpreter being deleted. */
+DeleteChannelTable(
+    ClientData clientData,	/* The per-interpreter data structure. */
+    Tcl_Interp *interp)		/* The interpreter being deleted. */
 {
     Tcl_HashTable *hTblPtr;	/* The hash table. */
     Tcl_HashSearch hSearch;	/* Search variable. */
@@ -606,63 +659,61 @@ DeleteChannelTable(clientData, interp)
     Channel *chanPtr;		/* Channel being deleted. */
     ChannelState *statePtr;	/* State of Channel being deleted. */
     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
-    				/* Variables to loop over all channel events
-                                 * registered, to delete the ones that refer
-                                 * to the interpreter being deleted. */
+				/* Variables to loop over all channel events
+				 * registered, to delete the ones that refer
+				 * to the interpreter being deleted. */
 
     /*
      * Delete all the registered channels - this will close channels whose
      * refcount reaches zero.
      */
-    
-    hTblPtr = (Tcl_HashTable *) clientData;
-    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	 hPtr != (Tcl_HashEntry *) NULL;
-	 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
 
-        chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+    hTblPtr = clientData;
+    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
+	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
+	chanPtr = Tcl_GetHashValue(hPtr);
 	statePtr = chanPtr->state;
 
-        /*
-         * Remove any fileevents registered in this interpreter.
-         */
-        
-        for (sPtr = statePtr->scriptRecordPtr,
-                 prevPtr = (EventScriptRecord *) NULL;
-	     sPtr != (EventScriptRecord *) NULL;
-	     sPtr = nextPtr) {
-            nextPtr = sPtr->nextPtr;
-            if (sPtr->interp == interp) {
-                if (prevPtr == (EventScriptRecord *) NULL) {
-                    statePtr->scriptRecordPtr = nextPtr;
-                } else {
-                    prevPtr->nextPtr = nextPtr;
-                }
-
-                Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-                        TclChannelEventScriptInvoker, (ClientData) sPtr);
-
-		Tcl_DecrRefCount(sPtr->scriptPtr);
-                ckfree((char *) sPtr);
-            } else {
-                prevPtr = sPtr;
-            }
-        }
-
-        /*
-         * Cannot call Tcl_UnregisterChannel because that procedure calls
-         * Tcl_GetAssocData to get the channel table, which might already
-         * be inaccessible from the interpreter structure. Instead, we
-         * emulate the behavior of Tcl_UnregisterChannel directly here.
-         */
-
-        Tcl_DeleteHashEntry(hPtr);
-        statePtr->refCount--;
-        if (statePtr->refCount <= 0) {
-            if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
-                (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
-            }
-        }
+	/*
+	 * Remove any fileevents registered in this interpreter.
+	 */
+
+	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
+		sPtr != NULL; sPtr = nextPtr) {
+	    nextPtr = sPtr->nextPtr;
+	    if (sPtr->interp == interp) {
+		if (prevPtr == NULL) {
+		    statePtr->scriptRecordPtr = nextPtr;
+		} else {
+		    prevPtr->nextPtr = nextPtr;
+		}
+
+		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+			TclChannelEventScriptInvoker, (ClientData) sPtr);
+
+		TclDecrRefCount(sPtr->scriptPtr);
+		ckfree((char *) sPtr);
+	    } else {
+		prevPtr = sPtr;
+	    }
+	}
+
+	/*
+	 * Cannot call Tcl_UnregisterChannel because that procedure calls
+	 * Tcl_GetAssocData to get the channel table, which might already be
+	 * inaccessible from the interpreter structure. Instead, we emulate
+	 * the behavior of Tcl_UnregisterChannel directly here.
+	 */
+
+	Tcl_DeleteHashEntry(hPtr);
+	SetFlag(statePtr, CHANNEL_TAINTED);
+	statePtr->refCount--;
+	if (statePtr->refCount <= 0) {
+	    if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
+	    }
+	}
+
     }
     Tcl_DeleteHashTable(hTblPtr);
     ckfree((char *) hTblPtr);
@@ -674,11 +725,11 @@ DeleteChannelTable(clientData, interp)
  * CheckForStdChannelsBeingClosed --
  *
  *	Perform special handling for standard channels being closed. When
- *	given a standard channel, if the refcount is now 1, it means that
- *	the last reference to the standard channel is being explicitly
- *	closed. Now bump the refcount artificially down to 0, to ensure the
- *	normal handling of channels being closed will occur. Also reset the
- *	static pointer to the channel to NULL, to avoid dangling references.
+ *	given a standard channel, if the refcount is now 1, it means that the
+ *	last reference to the standard channel is being explicitly closed. Now
+ *	bump the refcount artificially down to 0, to ensure the normal
+ *	handling of channels being closed will occur. Also reset the static
+ *	pointer to the channel to NULL, to avoid dangling references.
  *
  * Results:
  *	None.
@@ -691,8 +742,8 @@ DeleteChannelTable(clientData, interp)
  */
 
 static void
-CheckForStdChannelsBeingClosed(chan)
-    Tcl_Channel chan;
+CheckForStdChannelsBeingClosed(
+    Tcl_Channel chan)
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -729,27 +780,28 @@ CheckForStdChannelsBeingClosed(chan)
  *
  * Tcl_IsStandardChannel --
  *
- *	Test if the given channel is a standard channel.  No attempt
- *	is made to check if the channel or the standard channels
- *	are initialized or otherwise valid.
+ *	Test if the given channel is a standard channel. No attempt is made to
+ *	check if the channel or the standard channels are initialized or
+ *	otherwise valid.
  *
  * Results:
  *	Returns 1 if true, 0 if false.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
-int 
-Tcl_IsStandardChannel(chan)
-    Tcl_Channel chan;		/* Channel to check. */
+
+int
+Tcl_IsStandardChannel(
+    Tcl_Channel chan)		/* Channel to check. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if ((chan == tsdPtr->stdinChannel) 
-	|| (chan == tsdPtr->stdoutChannel)
-	|| (chan == tsdPtr->stderrChannel)) {
+    if ((chan == tsdPtr->stdinChannel)
+	    || (chan == tsdPtr->stdoutChannel)
+	    || (chan == tsdPtr->stderrChannel)) {
 	return 1;
     } else {
 	return 0;
@@ -762,8 +814,8 @@ Tcl_IsStandardChannel(chan)
  * Tcl_RegisterChannel --
  *
  *	Adds an already-open channel to the channel table of an interpreter.
- *	If the interpreter passed as argument is NULL, it only increments
- *	the channel refCount.
+ *	If the interpreter passed as argument is NULL, it only increments the
+ *	channel refCount.
  *
  * Results:
  *	None.
@@ -775,41 +827,41 @@ Tcl_IsStandardChannel(chan)
  */
 
 void
-Tcl_RegisterChannel(interp, chan)
-    Tcl_Interp *interp;		/* Interpreter in which to add the channel. */
-    Tcl_Channel chan;		/* The channel to add to this interpreter
-                                 * channel table. */
+Tcl_RegisterChannel(
+    Tcl_Interp *interp,		/* Interpreter in which to add the channel. */
+    Tcl_Channel chan)		/* The channel to add to this interpreter
+				 * channel table. */
 {
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
-    int new;			/* Is the hash entry new or does it exist? */
+    int isNew;			/* Is the hash entry new or does it exist? */
     Channel *chanPtr;		/* The actual channel. */
     ChannelState *statePtr;	/* State of the actual channel. */
 
     /*
-     * Always (un)register bottom-most channel in the stack.  This makes
+     * Always (un)register bottom-most channel in the stack. This makes
      * management of the channel list easier because no manipulation is
      * necessary during (un)stack operation.
      */
+
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
     statePtr = chanPtr->state;
 
-    if (statePtr->channelName == (CONST char *) NULL) {
-        panic("Tcl_RegisterChannel: channel without name");
+    if (statePtr->channelName == NULL) {
+	Tcl_Panic("Tcl_RegisterChannel: channel without name");
     }
-    if (interp != (Tcl_Interp *) NULL) {
-        hTblPtr = GetChannelTable(interp);
-        hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
-        if (new == 0) {
-            if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
-                return;
-            }
+    if (interp != NULL) {
+	hTblPtr = GetChannelTable(interp);
+	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew);
+	if (!isNew) {
+	    if (chan == Tcl_GetHashValue(hPtr)) {
+		return;
+	    }
 
-	    panic("Tcl_RegisterChannel: duplicate channel names");
-        }
-        Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
+	    Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");
+	}
+	Tcl_SetHashValue(hPtr, chanPtr);
     }
-
     statePtr->refCount++;
 }
 
@@ -820,19 +872,19 @@ Tcl_RegisterChannel(interp, chan)
  *
  *	Deletes the hash entry for a channel associated with an interpreter.
  *	If the interpreter given as argument is NULL, it only decrements the
- *	reference count.  (This all happens in the Tcl_DetachChannel helper
+ *	reference count. (This all happens in the Tcl_DetachChannel helper
  *	function).
- *	
- *	Finally, if the reference count of the channel drops to zero,
- *	it is deleted.
+ *
+ *	Finally, if the reference count of the channel drops to zero, it is
+ *	deleted.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Calls Tcl_DetachChannel which deletes the hash entry for a channel 
+ *	Calls Tcl_DetachChannel which deletes the hash entry for a channel
  *	associated with an interpreter.
- *	
+ *
  *	May delete the channel, which can have a variety of consequences,
  *	especially if we are forced to close the channel.
  *
@@ -840,27 +892,26 @@ Tcl_RegisterChannel(interp, chan)
  */
 
 int
-Tcl_UnregisterChannel(interp, chan)
-    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan;		/* Channel to delete. */
+Tcl_UnregisterChannel(
+    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
+    Tcl_Channel chan)		/* Channel to delete. */
 {
     ChannelState *statePtr;	/* State of the real channel. */
 
     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
- 
+
     if (statePtr->flags & CHANNEL_INCLOSE) {
-        if (interp != (Tcl_Interp*) NULL) {
-	    Tcl_AppendResult(interp, 
-	     "Illegal recursive call to close through close-handler of channel",
-	     (char *) NULL);
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "Illegal recursive call to close "
+		    "through close-handler of channel", NULL);
 	}
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
- 
+
     if (DetachChannel(interp, chan) != TCL_OK) {
-        return TCL_OK;
+	return TCL_OK;
     }
-    
+
     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
 
     /*
@@ -878,29 +929,30 @@ Tcl_UnregisterChannel(interp, chan)
      */
 
     if (statePtr->refCount <= 0) {
+	/*
+	 * Ensure that if there is another buffer, it gets flushed whether or
+	 * not we are doing a background flush.
+	 */
 
-        /*
-         * Ensure that if there is another buffer, it gets flushed
-         * whether or not we are doing a background flush.
-         */
-
-        if ((statePtr->curOutPtr != NULL) &&
-                (statePtr->curOutPtr->nextAdded >
-                        statePtr->curOutPtr->nextRemoved)) {
-            statePtr->flags |= BUFFER_READY;
-        }
+	if ((statePtr->curOutPtr != NULL) &&
+		IsBufferReady(statePtr->curOutPtr)) {
+	    SetFlag(statePtr, BUFFER_READY);
+	}
 	Tcl_Preserve((ClientData)statePtr);
-        if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
-	    /* We don't want to re-enter Tcl_Close */
+	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	    /*
+	     * We don't want to re-enter Tcl_Close().
+	     */
+
 	    if (!(statePtr->flags & CHANNEL_CLOSED)) {
 		if (Tcl_Close(interp, chan) != TCL_OK) {
-		    statePtr->flags |= CHANNEL_CLOSED;
+		    SetFlag(statePtr, CHANNEL_CLOSED);
 		    Tcl_Release((ClientData)statePtr);
 		    return TCL_ERROR;
 		}
 	    }
-        }
-        statePtr->flags |= CHANNEL_CLOSED;
+	}
+	SetFlag(statePtr, CHANNEL_CLOSED);
 	Tcl_Release((ClientData)statePtr);
     }
     return TCL_OK;
@@ -913,45 +965,42 @@ Tcl_UnregisterChannel(interp, chan)
  *
  *	Deletes the hash entry for a channel associated with an interpreter.
  *	If the interpreter given as argument is NULL, it only decrements the
- *	reference count.  Even if the ref count drops to zero, the 
- *	channel is NOT closed or cleaned up.  This allows a channel to
- *	be detached from an interpreter and left in the same state it
- *	was in when it was originally returned by 'Tcl_OpenFileChannel',
- *	for example.
- *	
- *	This function cannot be used on the standard channels, and
- *	will return TCL_ERROR if that is attempted.
- *	
- *	This function should only be necessary for special purposes
- *	in which you need to generate a pristine channel from one
- *	that has already been used.  All ordinary purposes will almost
- *	always want to use Tcl_UnregisterChannel instead.
- *	
- *	Provided the channel is not attached to any other interpreter,
- *	it can then be closed with Tcl_Close, rather than with 
- *	Tcl_UnregisterChannel.
+ *	reference count. Even if the ref count drops to zero, the channel is
+ *	NOT closed or cleaned up. This allows a channel to be detached from an
+ *	interpreter and left in the same state it was in when it was
+ *	originally returned by 'Tcl_OpenFileChannel', for example.
+ *
+ *	This function cannot be used on the standard channels, and will return
+ *	TCL_ERROR if that is attempted.
+ *
+ *	This function should only be necessary for special purposes in which
+ *	you need to generate a pristine channel from one that has already been
+ *	used. All ordinary purposes will almost always want to use
+ *	Tcl_UnregisterChannel instead.
+ *
+ *	Provided the channel is not attached to any other interpreter, it can
+ *	then be closed with Tcl_Close, rather than with Tcl_UnregisterChannel.
  *
  * Results:
- *	A standard Tcl result.  If the channel is not currently registered
- *	with the given interpreter, TCL_ERROR is returned, otherwise
- *	TCL_OK.  However no error messages are left in the interp's result.
+ *	A standard Tcl result. If the channel is not currently registered with
+ *	the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
+ *	However no error messages are left in the interp's result.
  *
  * Side effects:
- *	Deletes the hash entry for a channel associated with an 
- *	interpreter.
+ *	Deletes the hash entry for a channel associated with an interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_DetachChannel(interp, chan)
-    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan;		/* Channel to delete. */
+Tcl_DetachChannel(
+    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
+    Tcl_Channel chan)		/* Channel to delete. */
 {
     if (Tcl_IsStandardChannel(chan)) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    
+
     return DetachChannel(interp, chan);
 }
 
@@ -962,28 +1011,26 @@ Tcl_DetachChannel(interp, chan)
  *
  *	Deletes the hash entry for a channel associated with an interpreter.
  *	If the interpreter given as argument is NULL, it only decrements the
- *	reference count.  Even if the ref count drops to zero, the 
- *	channel is NOT closed or cleaned up.  This allows a channel to
- *	be detached from an interpreter and left in the same state it
- *	was in when it was originally returned by 'Tcl_OpenFileChannel',
- *	for example.
+ *	reference count. Even if the ref count drops to zero, the channel is
+ *	NOT closed or cleaned up. This allows a channel to be detached from an
+ *	interpreter and left in the same state it was in when it was
+ *	originally returned by 'Tcl_OpenFileChannel', for example.
  *
  * Results:
- *	A standard Tcl result.  If the channel is not currently registered
- *	with the given interpreter, TCL_ERROR is returned, otherwise
- *	TCL_OK.  However no error messages are left in the interp's result.
+ *	A standard Tcl result. If the channel is not currently registered with
+ *	the given interpreter, TCL_ERROR is returned, otherwise TCL_OK.
+ *	However no error messages are left in the interp's result.
  *
  * Side effects:
- *	Deletes the hash entry for a channel associated with an 
- *	interpreter.
+ *	Deletes the hash entry for a channel associated with an interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-DetachChannel(interp, chan)
-    Tcl_Interp *interp;		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan;		/* Channel to delete. */
+DetachChannel(
+    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
+    Tcl_Channel chan)		/* Channel to delete. */
 {
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
@@ -991,43 +1038,44 @@ DetachChannel(interp, chan)
     ChannelState *statePtr;	/* State of the real channel. */
 
     /*
-     * Always (un)register bottom-most channel in the stack.  This makes
+     * Always (un)register bottom-most channel in the stack. This makes
      * management of the channel list easier because no manipulation is
      * necessary during (un)stack operation.
      */
+
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
     statePtr = chanPtr->state;
 
-    if (interp != (Tcl_Interp *) NULL) {
-	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-	if (hTblPtr == (Tcl_HashTable *) NULL) {
+    if (interp != NULL) {
+	hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+	if (hTblPtr == NULL) {
 	    return TCL_ERROR;
 	}
 	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
-	if (hPtr == (Tcl_HashEntry *) NULL) {
+	if (hPtr == NULL) {
 	    return TCL_ERROR;
 	}
 	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
 	    return TCL_ERROR;
 	}
 	Tcl_DeleteHashEntry(hPtr);
+	SetFlag(statePtr, CHANNEL_TAINTED);
 
 	/*
-	 * Remove channel handlers that refer to this interpreter, so that they
-	 * will not be present if the actual close is delayed and more events
-	 * happen on the channel. This may occur if the channel is shared
-	 * between several interpreters, or if the channel has async
+	 * Remove channel handlers that refer to this interpreter, so that
+	 * they will not be present if the actual close is delayed and more
+	 * events happen on the channel. This may occur if the channel is
+	 * shared between several interpreters, or if the channel has async
 	 * flushing active.
 	 */
-    
+
 	CleanupChannelHandlers(interp, chanPtr);
     }
 
     statePtr->refCount--;
-    
+
     return TCL_OK;
 }
-
 
 /*
  *---------------------------------------------------------------------------
@@ -1039,9 +1087,9 @@ DetachChannel(interp, chan)
  *	channel-type-specific functions.
  *
  * Results:
- *	A Tcl_Channel or NULL on failure. If failed, interp's result
- *	object contains an error message.  *modePtr is filled with the
- *	modes in which the channel was opened.
+ *	A Tcl_Channel or NULL on failure. If failed, interp's result object
+ *	contains an error message. *modePtr is filled with the modes in which
+ *	the channel was opened.
  *
  * Side effects:
  *	None.
@@ -1050,26 +1098,26 @@ DetachChannel(interp, chan)
  */
 
 Tcl_Channel
-Tcl_GetChannel(interp, chanName, modePtr)
-    Tcl_Interp *interp;		/* Interpreter in which to find or create
-                                 * the channel. */
-    CONST char *chanName;	/* The name of the channel. */
-    int *modePtr;		/* Where to store the mode in which the
-                                 * channel was opened? Will contain an ORed
-                                 * combination of TCL_READABLE and
-                                 * TCL_WRITABLE, if non-NULL. */
+Tcl_GetChannel(
+    Tcl_Interp *interp,		/* Interpreter in which to find or create the
+				 * channel. */
+    const char *chanName,	/* The name of the channel. */
+    int *modePtr)		/* Where to store the mode in which the
+				 * channel was opened? Will contain an ORed
+				 * combination of TCL_READABLE and
+				 * TCL_WRITABLE, if non-NULL. */
 {
     Channel *chanPtr;		/* The actual channel. */
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
-    CONST char *name;		/* Translated name. */
+    const char *name;		/* Translated name. */
 
     /*
-     * Substitute "stdin", etc.  Note that even though we immediately
-     * find the channel using Tcl_GetStdChannel, we still need to look
-     * it up in the specified interpreter to ensure that it is present
-     * in the channel table.  Otherwise, safe interpreters would always
-     * have access to the standard channels.
+     * Substitute "stdin", etc. Note that even though we immediately find the
+     * channel using Tcl_GetStdChannel, we still need to look it up in the
+     * specified interpreter to ensure that it is present in the channel
+     * table. Otherwise, safe interpreters would always have access to the
+     * standard channels.
      */
 
     name = chanName;
@@ -1089,57 +1137,104 @@ Tcl_GetChannel(interp, chanName, modePtr)
 
     hTblPtr = GetChannelTable(interp);
     hPtr = Tcl_FindHashEntry(hTblPtr, name);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        Tcl_AppendResult(interp, "can not find channel named \"",
-                chanName, "\"", (char *) NULL);
-        return NULL;
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "can not find channel named \"", chanName,
+		"\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
+	return NULL;
     }
 
     /*
-     * Always return bottom-most channel in the stack.  This one lives
-     * the longest - other channels may go away unnoticed.
-     * The other APIs compensate where necessary to retrieve the
-     * topmost channel again.
+     * Always return bottom-most channel in the stack. This one lives the
+     * longest - other channels may go away unnoticed. The other APIs
+     * compensate where necessary to retrieve the topmost channel again.
      */
-    chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+
+    chanPtr = Tcl_GetHashValue(hPtr);
     chanPtr = chanPtr->state->bottomChanPtr;
     if (modePtr != NULL) {
-        *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+	*modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
     }
-    
+
     return (Tcl_Channel) chanPtr;
 }
 
 /*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetChannelFromObj --
+ *
+ *	Finds an existing Tcl_Channel structure by name in a given
+ *	interpreter. This function is public because it is used by
+ *	channel-type-specific functions.
+ *
+ * Results:
+ *	A Tcl_Channel or NULL on failure. If failed, interp's result object
+ *	contains an error message. *modePtr is filled with the modes in which
+ *	the channel was opened.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetChannelFromObj(
+    Tcl_Interp *interp,		/* Interpreter in which to find or create the
+				 * channel. */
+    Tcl_Obj *objPtr,
+    Tcl_Channel *channelPtr,
+    int *modePtr,		/* Where to store the mode in which the
+				 * channel was opened? Will contain an ORed
+				 * combination of TCL_READABLE and
+				 * TCL_WRITABLE, if non-NULL. */
+    int flags)
+{
+    ChannelState *statePtr;
+
+    if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    statePtr = GET_CHANNELSTATE(objPtr);
+    *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
+
+    if (modePtr != NULL) {
+	*modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+    }
+
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_CreateChannel --
  *
- *	Creates a new entry in the hash table for a Tcl_Channel
- *	record.
+ *	Creates a new entry in the hash table for a Tcl_Channel record.
  *
  * Results:
  *	Returns the new Tcl_Channel.
  *
  * Side effects:
- *	Creates a new Tcl_Channel instance and inserts it into the
- *	hash table.
+ *	Creates a new Tcl_Channel instance and inserts it into the hash table.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Channel
-Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
-    Tcl_ChannelType *typePtr;	/* The channel type record. */
-    CONST char *chanName;	/* Name of channel to record. */
-    ClientData instanceData;	/* Instance specific data. */
-    int mask;			/* TCL_READABLE & TCL_WRITABLE to indicate
-                                 * if the channel is readable, writable. */
+Tcl_CreateChannel(
+    Tcl_ChannelType *typePtr, /* The channel type record. */
+    const char *chanName,	/* Name of channel to record. */
+    ClientData instanceData,	/* Instance specific data. */
+    int mask)			/* TCL_READABLE & TCL_WRITABLE to indicate if
+				 * the channel is readable, writable. */
 {
     Channel *chanPtr;		/* The channel structure newly created. */
-    ChannelState *statePtr;	/* The stack-level independent state info
-				 * for the channel. */
-    CONST char *name;
+    ChannelState *statePtr;	/* The stack-level independent state info for
+				 * the channel. */
+    const char *name;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
@@ -1147,59 +1242,67 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
      * 8.3.2+, we have to make sure that our assumption that the structure
      * remains a binary compatible size is true.
      *
-     * If this assertion fails on some system, then it can be removed
-     * only if the user recompiles code with older channel drivers in
-     * the new system as well.
+     * If this assertion fails on some system, then it can be removed only if
+     * the user recompiles code with older channel drivers in the new system
+     * as well.
      */
 
     assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
 
     /*
-     * JH: We could subsequently memset these to 0 to avoid the
-     * numerous assignments to 0/NULL below.
+     * JH: We could subsequently memset these to 0 to avoid the numerous
+     * assignments to 0/NULL below.
      */
-    chanPtr  = (Channel *) ckalloc((unsigned) sizeof(Channel));
-    statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
+
+    chanPtr = (Channel *) ckalloc(sizeof(Channel));
+    statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
     chanPtr->state = statePtr;
 
-    chanPtr->instanceData	= instanceData;
-    chanPtr->typePtr		= typePtr;
+    chanPtr->instanceData = instanceData;
+    chanPtr->typePtr = typePtr;
 
     /*
      * Set all the bits that are part of the stack-independent state
      * information for the channel.
      */
 
-    if (chanName != (char *) NULL) {
+    if (chanName != NULL) {
 	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
-        statePtr->channelName = tmp;
-        strcpy(tmp, chanName);
+
+	statePtr->channelName = tmp;
+	strcpy(tmp, chanName);
     } else {
-        panic("Tcl_CreateChannel: NULL channel name");
+	Tcl_Panic("Tcl_CreateChannel: NULL channel name");
     }
 
-    statePtr->flags		= mask;
+    statePtr->flags = mask;
 
     /*
      * Set the channel to system default encoding.
+     *
+     * Note the strange bit of protection taking place here. If the system
+     * encoding name is reported back as "binary", something weird is
+     * happening. Tcl provides no "binary" encoding, so someone else has
+     * provided one. We ignore it so as not to interfere with the "magic"
+     * interpretation that Tcl_Channels give to the "-encoding binary" option.
      */
 
     statePtr->encoding = NULL;
     name = Tcl_GetEncodingName(NULL);
     if (strcmp(name, "binary") != 0) {
-    	statePtr->encoding = Tcl_GetEncoding(NULL, name);
+	statePtr->encoding = Tcl_GetEncoding(NULL, name);
     }
-    statePtr->inputEncodingState	= NULL;
-    statePtr->inputEncodingFlags	= TCL_ENCODING_START;
-    statePtr->outputEncodingState	= NULL;
-    statePtr->outputEncodingFlags	= TCL_ENCODING_START;
+    statePtr->inputEncodingState  = NULL;
+    statePtr->inputEncodingFlags  = TCL_ENCODING_START;
+    statePtr->outputEncodingState = NULL;
+    statePtr->outputEncodingFlags = TCL_ENCODING_START;
 
     /*
-     * Set the channel up initially in AUTO input translation mode to
-     * accept "\n", "\r" and "\r\n". Output translation mode is set to
-     * a platform specific default value. The eofChar is set to 0 for both
-     * input and output, so that Tcl does not look for an in-file EOF
-     * indicator (e.g. ^Z) and does not append an EOF indicator to files.
+     * Set the channel up initially in AUTO input translation mode to accept
+     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
+     * specific default value. The eofChar is set to 0 for both input and
+     * output, so that Tcl does not look for an in-file EOF indicator (e.g.
+     * ^Z) and does not append an EOF indicator to files.
      */
 
     statePtr->inputTranslation	= TCL_TRANSLATE_AUTO;
@@ -1209,16 +1312,16 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
 
     statePtr->unreportedError	= 0;
     statePtr->refCount		= 0;
-    statePtr->closeCbPtr	= (CloseCallback *) NULL;
-    statePtr->curOutPtr		= (ChannelBuffer *) NULL;
-    statePtr->outQueueHead	= (ChannelBuffer *) NULL;
-    statePtr->outQueueTail	= (ChannelBuffer *) NULL;
-    statePtr->saveInBufPtr	= (ChannelBuffer *) NULL;
-    statePtr->inQueueHead	= (ChannelBuffer *) NULL;
-    statePtr->inQueueTail	= (ChannelBuffer *) NULL;
-    statePtr->chPtr		= (ChannelHandler *) NULL;
+    statePtr->closeCbPtr	= NULL;
+    statePtr->curOutPtr		= NULL;
+    statePtr->outQueueHead	= NULL;
+    statePtr->outQueueTail	= NULL;
+    statePtr->saveInBufPtr	= NULL;
+    statePtr->inQueueHead	= NULL;
+    statePtr->inQueueTail	= NULL;
+    statePtr->chPtr		= NULL;
     statePtr->interestMask	= 0;
-    statePtr->scriptRecordPtr	= (EventScriptRecord *) NULL;
+    statePtr->scriptRecordPtr	= NULL;
     statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;
     statePtr->timer		= NULL;
     statePtr->csPtrR		= NULL;
@@ -1227,58 +1330,64 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
     statePtr->outputStage	= NULL;
     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
 	statePtr->outputStage = (char *)
-	    ckalloc((unsigned) (statePtr->bufSize + 2));
+		ckalloc((unsigned) (statePtr->bufSize + 2));
     }
 
     /*
-     * As we are creating the channel, it is obviously the top for now
+     * As we are creating the channel, it is obviously the top for now.
      */
+
     statePtr->topChanPtr	= chanPtr;
     statePtr->bottomChanPtr	= chanPtr;
-    chanPtr->downChanPtr	= (Channel *) NULL;
-    chanPtr->upChanPtr		= (Channel *) NULL;
-    chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
-    chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
+    chanPtr->downChanPtr	= NULL;
+    chanPtr->upChanPtr		= NULL;
+    chanPtr->inQueueHead	= NULL;
+    chanPtr->inQueueTail	= NULL;
+
+    /*
+     * TIP #219, Tcl Channel Reflection API
+     */
+
+    statePtr->chanMsg		= NULL;
+    statePtr->unreportedMsg	= NULL;
 
     /*
      * Link the channel into the list of all channels; create an on-exit
-     * handler if there is not one already, to close off all the channels
-     * in the list on exit.
+     * handler if there is not one already, to close off all the channels in
+     * the list on exit.
      *
      * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
      *
      * TIP #218.
      * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
-     *     We need Tcl_SpliceChannel, for the threadAction calls.
-     *     There is no real reason to duplicate all of this.
+     *	   We need Tcl_SpliceChannel, for the threadAction calls. There is no
+     *	   real reason to duplicate all of this.
      * NOTE: All drivers using thread actions now have to perform their TSD
-     *       manipulation only in their thread action proc. Doing it when
-     *       creating their instance structures will collide with the thread
-     *       action activity and lead to damaged lists.
+     *	     manipulation only in their thread action proc. Doing it when
+     *	     creating their instance structures will collide with the thread
+     *	     action activity and lead to damaged lists.
      */
 
-    statePtr->nextCSPtr = (ChannelState *) NULL;
-    Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
+    statePtr->nextCSPtr = NULL;
+    SpliceChannel((Tcl_Channel) chanPtr);
 
     /*
-     * Install this channel in the first empty standard channel slot, if
-     * the channel was previously closed explicitly.
+     * Install this channel in the first empty standard channel slot, if the
+     * channel was previously closed explicitly.
      */
-#if TCL_INHERIT_STD_CHANNELS
-    if ((tsdPtr->stdinChannel == NULL) &&
-	    (tsdPtr->stdinInitialized == 1)) {
+
+    if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
-        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
     } else if ((tsdPtr->stdoutChannel == NULL) &&
 	    (tsdPtr->stdoutInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
-        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
     } else if ((tsdPtr->stderrChannel == NULL) &&
 	    (tsdPtr->stderrInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
-        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
     }
-#endif
     return (Tcl_Channel) chanPtr;
 }
 
@@ -1287,53 +1396,52 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
  *
  * Tcl_StackChannel --
  *
- *	Replaces an entry in the hash table for a Tcl_Channel
- *	record. The replacement is a new channel with same name,
- *	it supercedes the replaced channel. Input and output of
- *	the superceded channel is now going through the newly
- *	created channel and allows the arbitrary filtering/manipulation
- *	of the dataflow.
+ *	Replaces an entry in the hash table for a Tcl_Channel record. The
+ *	replacement is a new channel with same name, it supercedes the
+ *	replaced channel. Input and output of the superceded channel is now
+ *	going through the newly created channel and allows the arbitrary
+ *	filtering/manipulation of the dataflow.
  *
- *	Andreas Kupries <a.kupries@westend.com>, 12/13/1998
- *	"Trf-Patch for filtering channels"
+ *	Andreas Kupries <a.kupries@westend.com>, 12/13/1998 "Trf-Patch for
+ *	filtering channels"
  *
  * Results:
- *	Returns the new Tcl_Channel, which actually contains the
- *      saved information about prevChan.
+ *	Returns the new Tcl_Channel, which actually contains the saved
+ *	information about prevChan.
  *
  * Side effects:
- *    A new channel structure is allocated and linked below
- *    the existing channel.  The channel operations and client
- *    data of the existing channel are copied down to the newly
- *    created channel, and the current channel has its operations
- *    replaced by the new typePtr.
+ *	A new channel structure is allocated and linked below the existing
+ *	channel. The channel operations and client data of the existing
+ *	channel are copied down to the newly created channel, and the current
+ *	channel has its operations replaced by the new typePtr.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Channel
-Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
-    Tcl_Interp	    *interp;	   /* The interpreter we are working in */
-    Tcl_ChannelType *typePtr;	   /* The channel type record for the new
-				    * channel. */
-    ClientData	     instanceData; /* Instance specific data for the new
-				    * channel. */
-    int		     mask;	   /* TCL_READABLE & TCL_WRITABLE to indicate
-				    * if the channel is readable, writable. */
-    Tcl_Channel	     prevChan;	   /* The channel structure to replace */
-{
-    ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
-    Channel		*chanPtr, *prevChanPtr;
-    ChannelState	*statePtr;
-
-    /*
-     * Find the given channel in the list of all channels.
-     * If we don't find it, then it was never registered correctly.
+Tcl_StackChannel(
+    Tcl_Interp *interp,		/* The interpreter we are working in */
+    Tcl_ChannelType *typePtr,	/* The channel type record for the new
+				 * channel. */
+    ClientData instanceData,	/* Instance specific data for the new
+				 * channel. */
+    int mask,			/* TCL_READABLE & TCL_WRITABLE to indicate if
+				 * the channel is readable, writable. */
+    Tcl_Channel prevChan)	/* The channel structure to replace */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Channel *chanPtr, *prevChanPtr;
+    ChannelState *statePtr;
+    Tcl_DriverThreadActionProc *threadActionProc;
+
+    /*
+     * Find the given channel (prevChan) in the list of all channels. If we do
+     * not find it, then it was never registered correctly.
      *
      * This operation should occur at the top of a channel stack.
      */
 
-    statePtr    = (ChannelState *) tsdPtr->firstCSPtr;
+    statePtr = (ChannelState *) tsdPtr->firstCSPtr;
     prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
 
     while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
@@ -1343,21 +1451,21 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
     if (statePtr == NULL) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "couldn't find state for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+		    Tcl_GetChannelName(prevChan), "\"", NULL);
 	}
-        return (Tcl_Channel) NULL;
+	return NULL;
     }
 
     /*
-     * Here we check if the given "mask" matches the "flags"
-     * of the already existing channel.
+     * Here we check if the given "mask" matches the "flags" of the already
+     * existing channel.
      *
      *	  | - | R | W | RW |
      *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
      *	- |   |   |   |    |
-     *	R |   | + |   | +  |	The superceding channel is allowed to
-     *	W |   |   | + | +  |	restrict the capabilities of the
-     *	RW|   | + | + | +  |	superceded one !
+     *	R |   | + |   | +  |	The superceding channel is allowed to restrict
+     *	W |   |   | + | +  |	the capabilities of the superceded one!
+     *	RW|   | + | + | +  |
      *	--+---+---+---+----+
      */
 
@@ -1365,16 +1473,16 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
 	if (interp) {
 	    Tcl_AppendResult(interp,
 		    "reading and writing both disallowed for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+		    Tcl_GetChannelName(prevChan), "\"", NULL);
 	}
-        return (Tcl_Channel) NULL;
+	return NULL;
     }
 
     /*
-     * Flush the buffers. This ensures that any data still in them
-     * at this time is not handled by the new transformation. Restrict
-     * this to writable channels. Take care to hide a possible bg-copy
-     * in progress from Tcl_Flush and the CheckForChannelErrors inside.
+     * Flush the buffers. This ensures that any data still in them at this
+     * time is not handled by the new transformation. Restrict this to
+     * writable channels. Take care to hide a possible bg-copy in progress
+     * from Tcl_Flush and the CheckForChannelErrors inside.
      */
 
     if ((mask & TCL_WRITABLE) != 0) {
@@ -1382,63 +1490,62 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
         CopyState *csPtrW;
 
         csPtrR           = statePtr->csPtrR;
-	statePtr->csPtrR = (CopyState*) NULL;
+	statePtr->csPtrR = NULL;
 
         csPtrW           = statePtr->csPtrW;
-	statePtr->csPtrW = (CopyState*) NULL;
+	statePtr->csPtrW = NULL;
 
 	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
-	    statePtr->csPtrR  = csPtrR;
+	    statePtr->csPtrR = csPtrR;
 	    statePtr->csPtrW = csPtrW;
 	    if (interp) {
 		Tcl_AppendResult(interp, "could not flush channel \"",
-			Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+			Tcl_GetChannelName(prevChan), "\"", NULL);
 	    }
-	    return (Tcl_Channel) NULL;
+	    return NULL;
 	}
 
-	statePtr->csPtrR  = csPtrR;
+	statePtr->csPtrR = csPtrR;
 	statePtr->csPtrW = csPtrW;
     }
+
     /*
-     * Discard any input in the buffers. They are not yet read by the
-     * user of the channel, so they have to go through the new
-     * transformation before reading. As the buffers contain the
-     * untransformed form their contents are not only useless but actually
-     * distorts our view of the system.
+     * Discard any input in the buffers. They are not yet read by the user of
+     * the channel, so they have to go through the new transformation before
+     * reading. As the buffers contain the untransformed form their contents
+     * are not only useless but actually distorts our view of the system.
      *
-     * To preserve the information without having to read them again and
-     * to avoid problems with the location in the channel (seeking might
-     * be impossible) we move the buffers from the common state structure
-     * into the channel itself. We use the buffers in the channel below
-     * the new transformation to hold the data. In the future this allows
-     * us to write transformations which pre-read data and push the unused
-     * part back when they are going away.
+     * To preserve the information without having to read them again and to
+     * avoid problems with the location in the channel (seeking might be
+     * impossible) we move the buffers from the common state structure into
+     * the channel itself. We use the buffers in the channel below the new
+     * transformation to hold the data. In the future this allows us to write
+     * transformations which pre-read data and push the unused part back when
+     * they are going away.
      */
 
-    if (((mask & TCL_READABLE) != 0) &&
-	(statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
-      /*
-       * Remark: It is possible that the channel buffers contain data from
-       * some earlier push-backs.
-       */
+    if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+	/*
+	 * Remark: It is possible that the channel buffers contain data from
+	 * some earlier push-backs.
+	 */
 
-      statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
-      prevChanPtr->inQueueHead       = statePtr->inQueueHead;
+	statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
+	prevChanPtr->inQueueHead = statePtr->inQueueHead;
 
-      if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
-	prevChanPtr->inQueueTail = statePtr->inQueueTail;
-      }
+	if (prevChanPtr->inQueueTail == NULL) {
+	    prevChanPtr->inQueueTail = statePtr->inQueueTail;
+	}
 
-      statePtr->inQueueHead          = (ChannelBuffer*) NULL;
-      statePtr->inQueueTail          = (ChannelBuffer*) NULL;
+	statePtr->inQueueHead = NULL;
+	statePtr->inQueueTail = NULL;
     }
 
-    chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+    chanPtr = (Channel *) ckalloc(sizeof(Channel));
 
     /*
-     * Save some of the current state into the new structure,
-     * reinitialize the parts which will stay with the transformation.
+     * Save some of the current state into the new structure, reinitialize the
+     * parts which will stay with the transformation.
      *
      * Remarks:
      */
@@ -1447,9 +1554,9 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
     chanPtr->instanceData	= instanceData;
     chanPtr->typePtr		= typePtr;
     chanPtr->downChanPtr	= prevChanPtr;
-    chanPtr->upChanPtr		= (Channel *) NULL;
-    chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
-    chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
+    chanPtr->upChanPtr		= NULL;
+    chanPtr->inQueueHead	= NULL;
+    chanPtr->inQueueTail	= NULL;
 
     /*
      * Place new block at the head of a possibly existing list of previously
@@ -1459,6 +1566,22 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
     prevChanPtr->upChanPtr	= chanPtr;
     statePtr->topChanPtr	= chanPtr;
 
+    /*
+     * TIP #218, Channel Thread Actions.
+     *
+     * We call the thread actions for the new channel directly. We _cannot_
+     * use SpliceChannel, because the (thread-)global list of all channels
+     * always contains the _ChannelState_ for a stack of channels, not the
+     * individual channels. And SpliceChannel would not only call the thread
+     * actions, but also add the shared ChannelState to this list a second
+     * time, mangling it.
+     */
+
+    threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+    if (threadActionProc != NULL) {
+	(*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT);
+    }
+
     return (Tcl_Channel) chanPtr;
 }
 
@@ -1467,27 +1590,28 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
  *
  * Tcl_UnstackChannel --
  *
- *	Unstacks an entry in the hash table for a Tcl_Channel
- *	record. This is the reverse to 'Tcl_StackChannel'.
+ *	Unstacks an entry in the hash table for a Tcl_Channel record. This is
+ *	the reverse to 'Tcl_StackChannel'.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	If TCL_ERROR is returned, the posix error code will be set
- *	with Tcl_SetErrno.
+ *	If TCL_ERROR is returned, the posix error code will be set with
+ *	Tcl_SetErrno. May leave a message in interp result as well.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UnstackChannel (interp, chan)
-    Tcl_Interp *interp; /* The interpreter we are working in */
-    Tcl_Channel chan;   /* The channel to unstack */
+Tcl_UnstackChannel(
+    Tcl_Interp *interp,		/* The interpreter we are working in */
+    Tcl_Channel chan)		/* The channel to unstack */
 {
-    Channel      *chanPtr  = (Channel *) chan;
+    Channel *chanPtr = (Channel *) chan;
     ChannelState *statePtr = chanPtr->state;
     int result = 0;
+    Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
      * This operation should occur at the top of a channel stack.
@@ -1495,20 +1619,21 @@ Tcl_UnstackChannel (interp, chan)
 
     chanPtr = statePtr->topChanPtr;
 
-    if (chanPtr->downChanPtr != (Channel *) NULL) {
-        /*
+    if (chanPtr->downChanPtr != NULL) {
+	/*
 	 * Instead of manipulating the per-thread / per-interp list/hashtable
 	 * of registered channels we wind down the state of the transformation,
 	 * and then restore the state of underlying channel into the old
 	 * structure.
 	 */
+
 	Channel *downChanPtr = chanPtr->downChanPtr;
 
 	/*
-	 * Flush the buffers. This ensures that any data still in them
-	 * at this time _is_ handled by the transformation we are unstacking
-	 * right now. Restrict this to writable channels. Take care to hide
-	 * a possible bg-copy in progress from Tcl_Flush and the
+	 * Flush the buffers. This ensures that any data still in them at this
+	 * time _is_ handled by the transformation we are unstacking right
+	 * now. Restrict this to writable channels. Take care to hide a
+	 * possible bg-copy in progress from Tcl_Flush and the
 	 * CheckForChannelErrors inside.
 	 */
 
@@ -1517,18 +1642,27 @@ Tcl_UnstackChannel (interp, chan)
 	    CopyState *csPtrW;
 
 	    csPtrR           = statePtr->csPtrR;
-	    statePtr->csPtrR = (CopyState*) NULL;
+	    statePtr->csPtrR = NULL;
 
 	    csPtrW           = statePtr->csPtrW;
-	    statePtr->csPtrW = (CopyState*) NULL;
+	    statePtr->csPtrW = NULL;
 
 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
-	        statePtr->csPtrR  = csPtrR;
+		statePtr->csPtrR = csPtrR;
 		statePtr->csPtrW = csPtrW;
-		if (interp) {
+
+		/*
+		 * TIP #219, Tcl Channel Reflection API.
+		 * Move error messages put by the driver into the chan/ip
+		 * bypass area into the regular interpreter result. Fall back
+		 * to the regular message if nothing was found in the
+		 * bypasses.
+		 */
+
+		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
 		    Tcl_AppendResult(interp, "could not flush channel \"",
 			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
-			    (char *) NULL);
+			    NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -1538,42 +1672,60 @@ Tcl_UnstackChannel (interp, chan)
 	}
 
 	/*
-	 * Anything in the input queue and the push-back buffers of
-	 * the transformation going away is transformed data, but not
-	 * yet read. As unstacking means that the caller does not want
-	 * to see transformed data any more we have to discard these
-	 * bytes. To avoid writing an analogue to 'DiscardInputQueued'
-	 * we move the information in the push back buffers to the
-	 * input queue and then call 'DiscardInputQueued' on that.
+	 * Anything in the input queue and the push-back buffers of the
+	 * transformation going away is transformed data, but not yet read. As
+	 * unstacking means that the caller does not want to see transformed
+	 * data any more we have to discard these bytes. To avoid writing an
+	 * analogue to 'DiscardInputQueued' we move the information in the
+	 * push back buffers to the input queue and then call
+	 * 'DiscardInputQueued' on that.
 	 */
 
-	if (((statePtr->flags & TCL_READABLE)  != 0) &&
-	    ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
-	     (chanPtr->inQueueHead  != (ChannelBuffer*) NULL))) {
+	if ((((statePtr->flags & TCL_READABLE) != 0)) &&
+		((statePtr->inQueueHead != NULL) ||
+		(chanPtr->inQueueHead != NULL))) {
 
-	    if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
-		(chanPtr->inQueueHead  != (ChannelBuffer*) NULL)) {
-	        statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
+	    if ((statePtr->inQueueHead != NULL) &&
+		    (chanPtr->inQueueHead != NULL)) {
+		statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
-	        statePtr->inQueueHead = statePtr->inQueueTail;
+		statePtr->inQueueHead = statePtr->inQueueTail;
 
-	    } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
-	        statePtr->inQueueHead = chanPtr->inQueueHead;
+	    } else if (chanPtr->inQueueHead != NULL) {
+		statePtr->inQueueHead = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
 	    }
 
-	    chanPtr->inQueueHead          = (ChannelBuffer*) NULL;
-	    chanPtr->inQueueTail          = (ChannelBuffer*) NULL;
+	    chanPtr->inQueueHead = NULL;
+	    chanPtr->inQueueTail = NULL;
+
+	    DiscardInputQueued(statePtr, 0);
+	}
+
+	/*
+	 * TIP #218, Channel Thread Actions.
+	 *
+	 * We call the thread actions for the new channel directly. We
+	 * _cannot_ use CutChannel, because the (thread-)global list of all
+	 * channels always contains the _ChannelState_ for a stack of
+	 * channels, not the individual channels. And SpliceChannel would not
+	 * only call the thread actions, but also remove the shared
+	 * ChannelState from this list despite there being more channels for
+	 * the state which are still active.
+	 */
 
-	    DiscardInputQueued (statePtr, 0);
+	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+	if (threadActionProc != NULL) {
+	    (*threadActionProc)(chanPtr->instanceData,
+		    TCL_CHANNEL_THREAD_REMOVE);
 	}
 
-	statePtr->topChanPtr	= downChanPtr;
-	downChanPtr->upChanPtr	= (Channel *) NULL;
+	statePtr->topChanPtr = downChanPtr;
+	downChanPtr->upChanPtr = NULL;
 
 	/*
 	 * Leave this link intact for closeproc
-	 *  chanPtr->downChanPtr	= (Channel *) NULL;
+	 *  chanPtr->downChanPtr = NULL;
 	 */
 
 	/*
@@ -1588,28 +1740,51 @@ Tcl_UnstackChannel (interp, chan)
 		    interp, 0);
 	}
 
-	chanPtr->typePtr	= NULL;
+	chanPtr->typePtr = NULL;
+
 	/*
 	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory
 	 */
-	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+
+	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 	UpdateInterest(downChanPtr);
 
 	if (result != 0) {
 	    Tcl_SetErrno(result);
+
+	    /*
+	     * TIP #219, Tcl Channel Reflection API.
+	     * Move error messages put by the driver into the chan/ip bypass
+	     * area into the regular interpreter result.
+	     */
+
+	    TclChanCaughtErrorBypass(interp, chan);
 	    return TCL_ERROR;
 	}
     } else {
-        /*
-	 * This channel does not cover another one.
-	 * Simply do a close, if necessary.
+	/*
+	 * This channel does not cover another one. Simply do a close, if
+	 * necessary.
 	 */
 
-        if (statePtr->refCount <= 0) {
-            if (Tcl_Close(interp, chan) != TCL_OK) {
-                return TCL_ERROR;
-            }
+	if (statePtr->refCount <= 0) {
+	    if (Tcl_Close(interp, chan) != TCL_OK) {
+		/*
+		 * TIP #219, Tcl Channel Reflection API.
+		 * "TclChanCaughtErrorBypass" is not required here, it was
+		 * done already by "Tcl_Close".
+		 */
+
+		return TCL_ERROR;
+	    }
 	}
+
+	/*
+	 * TIP #218, Channel Thread Actions.
+	 * Not required in this branch, this is done by Tcl_Close. If
+	 * Tcl_Close is not called then the ChannelState is still active in
+	 * the thread and no action has to be taken either.
+	 */
     }
 
     return TCL_OK;
@@ -1623,9 +1798,9 @@ Tcl_UnstackChannel (interp, chan)
  *	Determines whether the specified channel is stacked upon another.
  *
  * Results:
- *	NULL if the channel is not stacked upon another one, or a reference
- *	to the channel it is stacked upon. This reference can be used in
- *	queries, but modification is not allowed.
+ *	NULL if the channel is not stacked upon another one, or a reference to
+ *	the channel it is stacked upon. This reference can be used in queries,
+ *	but modification is not allowed.
  *
  * Side effects:
  *	None.
@@ -1634,10 +1809,11 @@ Tcl_UnstackChannel (interp, chan)
  */
 
 Tcl_Channel
-Tcl_GetStackedChannel(chan)
-    Tcl_Channel chan;
+Tcl_GetStackedChannel(
+    Tcl_Channel chan)
 {
-    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
 
     return (Tcl_Channel) chanPtr->downChanPtr;
 }
@@ -1650,9 +1826,9 @@ Tcl_GetStackedChannel(chan)
  *	Returns the top channel of a channel stack.
  *
  * Results:
- *	NULL if the channel is not stacked upon another one, or a reference
- *	to the channel it is stacked upon. This reference can be used in
- *	queries, but modification is not allowed.
+ *	NULL if the channel is not stacked upon another one, or a reference to
+ *	the channel it is stacked upon. This reference can be used in queries,
+ *	but modification is not allowed.
  *
  * Side effects:
  *	None.
@@ -1661,10 +1837,11 @@ Tcl_GetStackedChannel(chan)
  */
 
 Tcl_Channel
-Tcl_GetTopChannel(chan)
-    Tcl_Channel chan;
+Tcl_GetTopChannel(
+    Tcl_Channel chan)
 {
-    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
 
     return (Tcl_Channel) chanPtr->state->topChanPtr;
 }
@@ -1686,10 +1863,11 @@ Tcl_GetTopChannel(chan)
  */
 
 ClientData
-Tcl_GetChannelInstanceData(chan)
-    Tcl_Channel chan;		/* Channel for which to return client data. */
+Tcl_GetChannelInstanceData(
+    Tcl_Channel chan)		/* Channel for which to return client data. */
 {
-    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
 
     return chanPtr->instanceData;
 }
@@ -1699,8 +1877,7 @@ Tcl_GetChannelInstanceData(chan)
  *
  * Tcl_GetChannelThread --
  *
- *	Given a channel structure, returns the thread managing it.
- *	TIP #10
+ *	Given a channel structure, returns the thread managing it. TIP #10
  *
  * Results:
  *	Returns the id of the thread managing the channel.
@@ -1712,10 +1889,12 @@ Tcl_GetChannelInstanceData(chan)
  */
 
 Tcl_ThreadId
-Tcl_GetChannelThread(chan)
-    Tcl_Channel chan;		/* The channel to return managing thread for. */
+Tcl_GetChannelThread(
+    Tcl_Channel chan)		/* The channel to return the managing thread
+				 * for. */
 {
-    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
 
     return chanPtr->state->managingThread;
 }
@@ -1737,10 +1916,11 @@ Tcl_GetChannelThread(chan)
  */
 
 Tcl_ChannelType *
-Tcl_GetChannelType(chan)
-    Tcl_Channel chan;		/* The channel to return type for. */
+Tcl_GetChannelType(
+    Tcl_Channel chan)		/* The channel to return type for. */
 {
-    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
 
     return chanPtr->typePtr;
 }
@@ -1750,8 +1930,8 @@ Tcl_GetChannelType(chan)
  *
  * Tcl_GetChannelMode --
  *
- *	Computes a mask indicating whether the channel is open for
- *	reading and writing.
+ *	Computes a mask indicating whether the channel is open for reading and
+ *	writing.
  *
  * Results:
  *	An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
@@ -1763,12 +1943,12 @@ Tcl_GetChannelType(chan)
  */
 
 int
-Tcl_GetChannelMode(chan)
-    Tcl_Channel chan;		/* The channel for which the mode is
-                                 * being computed. */
+Tcl_GetChannelMode(
+    Tcl_Channel chan)		/* The channel for which the mode is being
+				 * computed. */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of actual channel. */
+				/* State of actual channel. */
 
     return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
 }
@@ -1781,9 +1961,8 @@ Tcl_GetChannelMode(chan)
  *	Returns the string identifying the channel name.
  *
  * Results:
- *	The string containing the channel name. This memory is
- *	owned by the generic layer and should not be modified by
- *	the caller.
+ *	The string containing the channel name. This memory is owned by the
+ *	generic layer and should not be modified by the caller.
  *
  * Side effects:
  *	None.
@@ -1791,9 +1970,9 @@ Tcl_GetChannelMode(chan)
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetChannelName(chan)
-    Tcl_Channel chan;		/* The channel for which to return the name. */
+const char *
+Tcl_GetChannelName(
+    Tcl_Channel chan)		/* The channel for which to return the name. */
 {
     ChannelState *statePtr;	/* State of actual channel. */
 
@@ -1819,16 +1998,24 @@ Tcl_GetChannelName(chan)
  */
 
 int
-Tcl_GetChannelHandle(chan, direction, handlePtr)
-    Tcl_Channel chan;		/* The channel to get file from. */
-    int direction;		/* TCL_WRITABLE or TCL_READABLE. */
-    ClientData *handlePtr;	/* Where to store handle */
+Tcl_GetChannelHandle(
+    Tcl_Channel chan,		/* The channel to get file from. */
+    int direction,		/* TCL_WRITABLE or TCL_READABLE. */
+    ClientData *handlePtr)	/* Where to store handle */
 {
     Channel *chanPtr;		/* The actual channel. */
     ClientData handle;
     int result;
 
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+    if (!chanPtr->typePtr->getHandleProc) {
+	Tcl_Obj* err;
+	TclNewLiteralStringObj(err, "channel \"");
+	Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
+	Tcl_AppendToObj(err, "\" does not support OS handles", -1);
+	Tcl_SetChannelError (chan,err);
+	return TCL_ERROR;
+    }
     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
 	    direction, &handle);
     if (handlePtr) {
@@ -1842,16 +2029,15 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
  *
  * AllocChannelBuffer --
  *
- *	A channel buffer has BUFFER_PADDING bytes extra at beginning to
- *	hold any bytes of a native-encoding character that got split by
- *	the end of the previous buffer and need to be moved to the
- *	beginning of the next buffer to make a contiguous string so it
- *	can be converted to UTF-8.
+ *	A channel buffer has BUFFER_PADDING bytes extra at beginning to hold
+ *	any bytes of a native-encoding character that got split by the end of
+ *	the previous buffer and need to be moved to the beginning of the next
+ *	buffer to make a contiguous string so it can be converted to UTF-8.
  *
- *	A channel buffer has BUFFER_PADDING bytes extra at the end to
- *	hold any bytes of a native-encoding character (generated from a
- *	UTF-8 character) that overflow past the end of the buffer and
- *	need to be moved to the next buffer.
+ *	A channel buffer has BUFFER_PADDING bytes extra at the end to hold any
+ *	bytes of a native-encoding character (generated from a UTF-8
+ *	character) that overflow past the end of the buffer and need to be
+ *	moved to the next buffer.
  *
  * Results:
  *	A newly allocated channel buffer.
@@ -1863,8 +2049,8 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
  */
 
 static ChannelBuffer *
-AllocChannelBuffer(length)
-    int length;			/* Desired length of channel buffer. */
+AllocChannelBuffer(
+    int length)			/* Desired length of channel buffer. */
 {
     ChannelBuffer *bufPtr;
     int n;
@@ -1874,7 +2060,7 @@ AllocChannelBuffer(length)
     bufPtr->nextAdded	= BUFFER_PADDING;
     bufPtr->nextRemoved	= BUFFER_PADDING;
     bufPtr->bufLength	= length + BUFFER_PADDING;
-    bufPtr->nextPtr	= (ChannelBuffer *) NULL;
+    bufPtr->nextPtr	= NULL;
     return bufPtr;
 }
 
@@ -1883,11 +2069,10 @@ AllocChannelBuffer(length)
  *
  * RecycleBuffer --
  *
- *	Helper function to recycle input and output buffers. Ensures
- *	that two input buffers are saved (one in the input queue and
- *	another in the saveInBufPtr field) and that curOutPtr is set
- *	to a buffer. Only if these conditions are met is the buffer
- *	freed to the OS.
+ *	Helper function to recycle input and output buffers. Ensures that two
+ *	input buffers are saved (one in the input queue and another in the
+ *	saveInBufPtr field) and that curOutPtr is set to a buffer. Only if
+ *	these conditions are met is the buffer freed to the OS.
  *
  * Results:
  *	None.
@@ -1899,46 +2084,46 @@ AllocChannelBuffer(length)
  */
 
 static void
-RecycleBuffer(statePtr, bufPtr, mustDiscard)
-    ChannelState *statePtr;	/* ChannelState in which to recycle buffers. */
-    ChannelBuffer *bufPtr;	/* The buffer to recycle. */
-    int mustDiscard;		/* If nonzero, free the buffer to the
-                                 * OS, always. */
+RecycleBuffer(
+    ChannelState *statePtr,	/* ChannelState in which to recycle buffers. */
+    ChannelBuffer *bufPtr,	/* The buffer to recycle. */
+    int mustDiscard)		/* If nonzero, free the buffer to the OS,
+				 * always. */
 {
     /*
      * Do we have to free the buffer to the OS?
      */
 
     if (mustDiscard) {
-        ckfree((char *) bufPtr);
-        return;
+	ckfree((char *) bufPtr);
+	return;
     }
 
     /*
-     * Only save buffers which are at least as big as the requested
-     * buffersize for the channel. This is to honor dynamic changes
-     * of the buffersize made by the user.
+     * Only save buffers which are at least as big as the requested buffersize
+     * for the channel. This is to honor dynamic changes of the buffersize
+     * made by the user.
      */
 
     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
-        ckfree((char *) bufPtr);
-        return;
+	ckfree((char *) bufPtr);
+	return;
     }
 
     /*
      * Only save buffers for the input queue if the channel is readable.
      */
-    
+
     if (statePtr->flags & TCL_READABLE) {
-        if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
-            statePtr->inQueueHead = bufPtr;
-            statePtr->inQueueTail = bufPtr;
-            goto keepit;
-        }
-        if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
-            statePtr->saveInBufPtr = bufPtr;
-            goto keepit;
-        }
+	if (statePtr->inQueueHead == NULL) {
+	    statePtr->inQueueHead = bufPtr;
+	    statePtr->inQueueTail = bufPtr;
+	    goto keepBuffer;
+	}
+	if (statePtr->saveInBufPtr == NULL) {
+	    statePtr->saveInBufPtr = bufPtr;
+	    goto keepBuffer;
+	}
     }
 
     /*
@@ -1946,10 +2131,10 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
      */
 
     if (statePtr->flags & TCL_WRITABLE) {
-        if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
-            statePtr->curOutPtr = bufPtr;
-            goto keepit;
-        }
+	if (statePtr->curOutPtr == NULL) {
+	    statePtr->curOutPtr = bufPtr;
+	    goto keepBuffer;
+	}
     }
 
     /*
@@ -1959,10 +2144,10 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
     ckfree((char *) bufPtr);
     return;
 
-    keepit:
+  keepBuffer:
     bufPtr->nextRemoved = BUFFER_PADDING;
     bufPtr->nextAdded = BUFFER_PADDING;
-    bufPtr->nextPtr = (ChannelBuffer *) NULL;
+    bufPtr->nextPtr = NULL;
 }
 
 /*
@@ -1982,18 +2167,18 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
  */
 
 static void
-DiscardOutputQueued(statePtr)
-    ChannelState *statePtr;	/* ChannelState for which to discard output. */
+DiscardOutputQueued(
+    ChannelState *statePtr)	/* ChannelState for which to discard output. */
 {
     ChannelBuffer *bufPtr;
-    
-    while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
-        bufPtr = statePtr->outQueueHead;
-        statePtr->outQueueHead = bufPtr->nextPtr;
-        RecycleBuffer(statePtr, bufPtr, 0);
+
+    while (statePtr->outQueueHead != NULL) {
+	bufPtr = statePtr->outQueueHead;
+	statePtr->outQueueHead = bufPtr->nextPtr;
+	RecycleBuffer(statePtr, bufPtr, 0);
     }
-    statePtr->outQueueHead = (ChannelBuffer *) NULL;
-    statePtr->outQueueTail = (ChannelBuffer *) NULL;
+    statePtr->outQueueHead = NULL;
+    statePtr->outQueueTail = NULL;
 }
 
 /*
@@ -2001,29 +2186,28 @@ DiscardOutputQueued(statePtr)
  *
  * CheckForDeadChannel --
  *
- *	This function checks is a given channel is Dead.
- *      (A channel that has been closed but not yet deallocated.)
+ *	This function checks is a given channel is Dead (a channel that has
+ *	been closed but not yet deallocated.)
  *
  * Results:
  *	True (1) if channel is Dead, False (0) if channel is Ok
  *
  * Side effects:
- *      None
+ *	None
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CheckForDeadChannel(interp, statePtr)
-    Tcl_Interp *interp;		/* For error reporting (can be NULL) */
-    ChannelState *statePtr;	/* The channel state to check. */
+CheckForDeadChannel(
+    Tcl_Interp *interp,		/* For error reporting (can be NULL) */
+    ChannelState *statePtr)	/* The channel state to check. */
 {
     if (statePtr->flags & CHANNEL_DEAD) {
-        Tcl_SetErrno(EINVAL);
+	Tcl_SetErrno(EINVAL);
 	if (interp) {
 	    Tcl_AppendResult(interp,
-		    "unable to access channel: invalid channel",
-		    (char *) NULL);   
+		    "unable to access channel: invalid channel", NULL);
 	}
 	return 1;
     }
@@ -2040,221 +2224,253 @@ CheckForDeadChannel(interp, statePtr)
  *	event handler to flush channel output asynchronously.
  *
  * Results:
- *	0 if successful, else the error code that was returned by the
- *	channel type operation.
+ *	0 if successful, else the error code that was returned by the channel
+ *	type operation. May leave a message in the interp result.
  *
  * Side effects:
- *	May produce output on a channel. May block indefinitely if the
- *	channel is synchronous. May schedule an async flush on the channel.
- *	May recycle memory for buffers in the output queue.
+ *	May produce output on a channel. May block indefinitely if the channel
+ *	is synchronous. May schedule an async flush on the channel. May
+ *	recycle memory for buffers in the output queue.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-FlushChannel(interp, chanPtr, calledFromAsyncFlush)
-    Tcl_Interp *interp;			/* For error reporting during close. */
-    Channel *chanPtr;			/* The channel to flush on. */
-    int calledFromAsyncFlush;		/* If nonzero then we are being
-                                         * called from an asynchronous
-                                         * flush callback. */
+FlushChannel(
+    Tcl_Interp *interp,		/* For error reporting during close. */
+    Channel *chanPtr,		/* The channel to flush on. */
+    int calledFromAsyncFlush)	/* If nonzero then we are being called from an
+				 * asynchronous flush callback. */
 {
     ChannelState *statePtr = chanPtr->state;
-					/* State of the channel stack. */
-    ChannelBuffer *bufPtr;		/* Iterates over buffered output
-                                         * queue. */
-    int toWrite;			/* Amount of output data in current
-                                         * buffer available to be written. */
-    int written;			/* Amount of output data actually
-                                         * written in current round. */
-    int errorCode = 0;			/* Stores POSIX error codes from
-                                         * channel driver operations. */
-    int wroteSome = 0;			/* Set to one if any data was
-					 * written to the driver. */
+				/* State of the channel stack. */
+    ChannelBuffer *bufPtr;	/* Iterates over buffered output queue. */
+    int toWrite;		/* Amount of output data in current buffer
+				 * available to be written. */
+    int written;		/* Amount of output data actually written in
+				 * current round. */
+    int errorCode = 0;		/* Stores POSIX error codes from channel
+				 * driver operations. */
+    int wroteSome = 0;		/* Set to one if any data was written to the
+				 * driver. */
 
     /*
-     * Prevent writing on a dead channel -- a channel that has been closed
-     * but not yet deallocated. This can occur if the exit handler for the
-     * channel deallocation runs before all channels are deregistered in
-     * all interpreters.
+     * Prevent writing on a dead channel -- a channel that has been closed but
+     * not yet deallocated. This can occur if the exit handler for the channel
+     * deallocation runs before all channels are deregistered in all
+     * interpreters.
      */
-    
-    if (CheckForDeadChannel(interp, statePtr)) return -1;
-    
+
+    if (CheckForDeadChannel(interp, statePtr)) {
+	return -1;
+    }
+
     /*
-     * Loop over the queued buffers and attempt to flush as
-     * much as possible of the queued output to the channel.
+     * Loop over the queued buffers and attempt to flush as much as possible
+     * of the queued output to the channel.
      */
 
     while (1) {
+	/*
+	 * If the queue is empty and there is a ready current buffer, OR if
+	 * the current buffer is full, then move the current buffer to the
+	 * queue.
+	 */
+
+	if (((statePtr->curOutPtr != NULL) &&
+		IsBufferFull(statePtr->curOutPtr))
+		|| ((statePtr->flags & BUFFER_READY) &&
+			(statePtr->outQueueHead == NULL))) {
+	    ResetFlag(statePtr, BUFFER_READY);
+	    statePtr->curOutPtr->nextPtr = NULL;
+	    if (statePtr->outQueueHead == NULL) {
+		statePtr->outQueueHead = statePtr->curOutPtr;
+	    } else {
+		statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
+	    }
+	    statePtr->outQueueTail = statePtr->curOutPtr;
+	    statePtr->curOutPtr = NULL;
+	}
+	bufPtr = statePtr->outQueueHead;
+
+	/*
+	 * If we are not being called from an async flush and an async flush
+	 * is active, we just return without producing any output.
+	 */
 
-        /*
-         * If the queue is empty and there is a ready current buffer, OR if
-         * the current buffer is full, then move the current buffer to the
-         * queue.
-         */
-
-        if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
-                (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
-                || ((statePtr->flags & BUFFER_READY) &&
-                        (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
-            statePtr->flags &= (~(BUFFER_READY));
-            statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
-            if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
-                statePtr->outQueueHead = statePtr->curOutPtr;
-            } else {
-                statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
-            }
-            statePtr->outQueueTail = statePtr->curOutPtr;
-            statePtr->curOutPtr = (ChannelBuffer *) NULL;
-        }
-        bufPtr = statePtr->outQueueHead;
-
-        /*
-         * If we are not being called from an async flush and an async
-         * flush is active, we just return without producing any output.
-         */
-
-        if ((!calledFromAsyncFlush) &&
-                (statePtr->flags & BG_FLUSH_SCHEDULED)) {
-            return 0;
-        }
-
-        /*
-         * If the output queue is still empty, break out of the while loop.
-         */
-
-        if (bufPtr == (ChannelBuffer *) NULL) {
-            break;	/* Out of the "while (1)". */
-        }
-
-        /*
-         * Produce the output on the channel.
-         */
-
-        toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
+	if ((!calledFromAsyncFlush) &&
+		(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	    return 0;
+	}
+
+	/*
+	 * If the output queue is still empty, break out of the while loop.
+	 */
+
+	if (bufPtr == NULL) {
+	    break;	/* Out of the "while (1)". */
+	}
+
+	/*
+	 * Produce the output on the channel.
+	 */
+
+	toWrite = BytesLeft(bufPtr);
 	if (toWrite == 0) {
 	    written = 0;
 	} else {
-	    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
-                bufPtr->buf + bufPtr->nextRemoved, toWrite,
-		&errorCode);
+	    written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
+		RemovePoint(bufPtr), toWrite, &errorCode);
 	}
 
 	/*
-         * If the write failed completely attempt to start the asynchronous
-         * flush mechanism and break out of this loop - do not attempt to
-         * write any more output at this time.
-         */
-
-        if (written < 0) {
-            
-            /*
-             * If the last attempt to write was interrupted, simply retry.
-             */
-            
-            if (errorCode == EINTR) {
-                errorCode = 0;
-                continue;
-            }
-
-            /*
-             * If the channel is non-blocking and we would have blocked,
-             * start a background flushing handler and break out of the loop.
-             */
-
-            if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
+	 * If the write failed completely attempt to start the asynchronous
+	 * flush mechanism and break out of this loop - do not attempt to
+	 * write any more output at this time.
+	 */
+
+	if (written < 0) {
+	    /*
+	     * If the last attempt to write was interrupted, simply retry.
+	     */
+
+	    if (errorCode == EINTR) {
+		errorCode = 0;
+		continue;
+	    }
+
+	    /*
+	     * If the channel is non-blocking and we would have blocked, start
+	     * a background flushing handler and break out of the loop.
+	     */
+
+	    if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
 		/*
-		 * This used to check for CHANNEL_NONBLOCKING, and panic
-		 * if the channel was blocking.  However, it appears
-		 * that setting stdin to -blocking 0 has some effect on
-		 * the stdout when it's a tty channel (dup'ed underneath)
+		 * This used to check for CHANNEL_NONBLOCKING, and panic if
+		 * the channel was blocking. However, it appears that setting
+		 * stdin to -blocking 0 has some effect on the stdout when
+		 * it's a tty channel (dup'ed underneath)
 		 */
+
 		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
-		    statePtr->flags |= BG_FLUSH_SCHEDULED;
+		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
 		    UpdateInterest(chanPtr);
 		}
 		errorCode = 0;
 		break;
-            }
+	    }
+
+	    /*
+	     * Decide whether to report the error upwards or defer it.
+	     */
 
-            /*
-             * Decide whether to report the error upwards or defer it.
-             */
+	    if (calledFromAsyncFlush) {
+		/*
+		 * TIP #219, Tcl Channel Reflection API.
+		 * When defering the error copy a message from the bypass into
+		 * the unreported area. Or discard it if the new error is to be
+		 * ignored in favor of an earlier defered error.
+		 */
 
-            if (calledFromAsyncFlush) {
-                if (statePtr->unreportedError == 0) {
-                    statePtr->unreportedError = errorCode;
-                }
-            } else {
-                Tcl_SetErrno(errorCode);
-		if (interp != NULL) {
+		Tcl_Obj *msg = statePtr->chanMsg;
+
+		if (statePtr->unreportedError == 0) {
+		    statePtr->unreportedError = errorCode;
+		    statePtr->unreportedMsg = msg;
+		    if (msg != NULL) {
+			Tcl_IncrRefCount(msg);
+		    }
+		} else {
+		    /*
+		     * An old unreported error is kept, and this error thrown
+		     * away.
+		     */
+
+		    statePtr->chanMsg = NULL;
+		    if (msg != NULL) {
+			TclDecrRefCount(msg);
+		    }
+		}
+	    } else {
+		/*
+		 * TIP #219, Tcl Channel Reflection API.
+		 * Move error messages put by the driver into the chan bypass
+		 * area into the regular interpreter result. Fall back to the
+		 * regular message if nothing was found in the bypasses.
+		 */
 
+		Tcl_SetErrno(errorCode);
+		if (interp != NULL && !TclChanCaughtErrorBypass(interp,
+			(Tcl_Channel) chanPtr)) {
 		    /*
-		     * Casting away CONST here is safe because the
-		     * TCL_VOLATILE flag guarantees CONST treatment
-		     * of the Posix error string.
+		     * Casting away const here is safe because the
+		     * TCL_VOLATILE flag guarantees const treatment of the
+		     * Posix error string.
 		     */
 
-		    Tcl_SetResult(interp,
-			    (char *) Tcl_PosixError(interp), TCL_VOLATILE);
+		    Tcl_SetResult(interp, (char *) Tcl_PosixError(interp),
+			    TCL_VOLATILE);
 		}
-            }
 
-            /*
-             * When we get an error we throw away all the output
-             * currently queued.
-             */
+		/*
+		 * An unreportable bypassed message is kept, for the caller of
+		 * Tcl_Seek, Tcl_Write, etc.
+		 */
+	    }
 
-            DiscardOutputQueued(statePtr);
-            continue;
-        } else {
+	    /*
+	     * When we get an error we throw away all the output currently
+	     * queued.
+	     */
+
+	    DiscardOutputQueued(statePtr);
+	    continue;
+	} else {
 	    wroteSome = 1;
 	}
 
-        bufPtr->nextRemoved += written;
+	bufPtr->nextRemoved += written;
 
-        /*
-         * If this buffer is now empty, recycle it.
-         */
+	/*
+	 * If this buffer is now empty, recycle it.
+	 */
 
-        if (bufPtr->nextRemoved == bufPtr->nextAdded) {
-            statePtr->outQueueHead = bufPtr->nextPtr;
-            if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
-                statePtr->outQueueTail = (ChannelBuffer *) NULL;
-            }
-            RecycleBuffer(statePtr, bufPtr, 0);
-        }
+	if (IsBufferEmpty(bufPtr)) {
+	    statePtr->outQueueHead = bufPtr->nextPtr;
+	    if (statePtr->outQueueHead == NULL) {
+		statePtr->outQueueTail = NULL;
+	    }
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	}
     }	/* Closes "while (1)". */
 
     /*
      * If we wrote some data while flushing in the background, we are done.
-     * We can't finish the background flush until we run out of data and
-     * the channel becomes writable again.  This ensures that all of the
-     * pending data has been flushed at the system level.
+     * We can't finish the background flush until we run out of data and the
+     * channel becomes writable again. This ensures that all of the pending
+     * data has been flushed at the system level.
      */
 
     if (statePtr->flags & BG_FLUSH_SCHEDULED) {
 	if (wroteSome) {
 	    return errorCode;
-	} else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
-	    statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
+	} else if (statePtr->outQueueHead == NULL) {
+	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
 		    statePtr->interestMask);
 	}
     }
 
     /*
-     * If the channel is flagged as closed, delete it when the refCount
-     * drops to zero, the output queue is empty and there is no output
-     * in the current output buffer.
+     * If the channel is flagged as closed, delete it when the refCount drops
+     * to zero, the output queue is empty and there is no output in the
+     * current output buffer.
      */
 
     if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
-            (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
-            ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
-                    (statePtr->curOutPtr->nextAdded ==
-                            statePtr->curOutPtr->nextRemoved))) {
+	    (statePtr->outQueueHead == NULL) &&
+	    ((statePtr->curOutPtr == NULL) ||
+	    IsBufferEmpty(statePtr->curOutPtr))) {
 	return CloseChannel(interp, chanPtr, errorCode);
     }
     return errorCode;
@@ -2269,34 +2485,33 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
  *
  *	If the channel was stacked, then the it will copy the necessary
  *	elements of the NEXT channel into the TOP channel, in essence
- *	unstacking the channel.  The NEXT channel will then be freed.
+ *	unstacking the channel. The NEXT channel will then be freed.
  *
- *	If the channel was not stacked, then we will free all the bits
- *	for the TOP channel, including the data structure itself.
+ *	If the channel was not stacked, then we will free all the bits for the
+ *	TOP channel, including the data structure itself.
  *
  * Results:
- *	1 if the channel was stacked, 0 otherwise.
+ *	Error code from an unreported error or the driver close operation.
  *
  * Side effects:
- *	May close the actual channel; may free memory.
- *	May change the value of errno.
+ *	May close the actual channel, may free memory, may change the value of
+ *	errno.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CloseChannel(interp, chanPtr, errorCode)
-    Tcl_Interp *interp;			/* For error reporting. */
-    Channel *chanPtr;			/* The channel to close. */
-    int errorCode;			/* Status of operation so far. */
-{
-    int result = 0;			/* Of calling driver close
-                                         * operation. */
-    ChannelState *statePtr;		/* state of the channel stack. */
+CloseChannel(
+    Tcl_Interp *interp,		/* For error reporting. */
+    Channel *chanPtr,		/* The channel to close. */
+    int errorCode)		/* Status of operation so far. */
+{
+    int result = 0;		/* Of calling driver close operation. */
+    ChannelState *statePtr;	/* State of the channel stack. */
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (chanPtr == NULL) {
-        return result;
+	return result;
     }
     statePtr = chanPtr->state;
 
@@ -2310,57 +2525,70 @@ CloseChannel(interp, chanPtr, errorCode)
      * Discard a leftover buffer in the current output buffer field.
      */
 
-    if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
-        ckfree((char *) statePtr->curOutPtr);
-        statePtr->curOutPtr = (ChannelBuffer *) NULL;
+    if (statePtr->curOutPtr != NULL) {
+	ckfree((char *) statePtr->curOutPtr);
+	statePtr->curOutPtr = NULL;
     }
-    
+
     /*
-     * The caller guarantees that there are no more buffers
-     * queued for output.
+     * The caller guarantees that there are no more buffers queued for output.
      */
 
-    if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
-        panic("TclFlush, closed channel: queued output left");
+    if (statePtr->outQueueHead != NULL) {
+	Tcl_Panic("TclFlush, closed channel: queued output left");
     }
 
     /*
-     * If the EOF character is set in the channel, append that to the
-     * output device.
+     * If the EOF character is set in the channel, append that to the output
+     * device.
      */
 
     if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
-        int dummy;
-        char c;
+	int dummy;
+	char c = (char) statePtr->outEofChar;
 
-        c = (char) statePtr->outEofChar;
-        (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
+	(chanPtr->typePtr->outputProc)(chanPtr->instanceData, &c, 1, &dummy);
+    }
+
+    /*
+     * TIP #219, Tcl Channel Reflection API.
+     * Move a leftover error message in the channel bypass into the
+     * interpreter bypass. Just clear it if there is no interpreter.
+     */
+
+    if (statePtr->chanMsg != NULL) {
+	if (interp != NULL) {
+	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+	}
+	TclDecrRefCount(statePtr->chanMsg);
+	statePtr->chanMsg = NULL;
     }
 
     /*
      * Remove this channel from of the list of all channels.
      */
-    Tcl_CutChannel((Tcl_Channel) chanPtr);
+
+    CutChannel((Tcl_Channel) chanPtr);
 
     /*
      * Close and free the channel driver state.
+     * This may leave a TIP #219 error message in the interp.
      */
 
     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
 	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
     } else {
-	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
-		0);
+	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+		interp, 0);
     }
 
     /*
-     * Some resources can be cleared only if the bottom channel
-     * in a stack is closed. All the other channels in the stack
-     * are not allowed to remove.
+     * Some resources can be cleared only if the bottom channel in a stack is
+     * closed. All the other channels in the stack are not allowed to remove.
      */
 
     if (chanPtr == statePtr->bottomChanPtr) {
-	if (statePtr->channelName != (char *) NULL) {
+	if (statePtr->channelName != NULL) {
 	    ckfree((char *) statePtr->channelName);
 	    statePtr->channelName = NULL;
 	}
@@ -2368,23 +2596,37 @@ CloseChannel(interp, chanPtr, errorCode)
 	Tcl_FreeEncoding(statePtr->encoding);
 	if (statePtr->outputStage != NULL) {
 	    ckfree((char *) statePtr->outputStage);
-	    statePtr->outputStage = (char *) NULL;
+	    statePtr->outputStage = NULL;
 	}
     }
 
     /*
-     * If we are being called synchronously, report either
-     * any latent error on the channel or the current error.
+     * If we are being called synchronously, report either any latent error on
+     * the channel or the current error.
      */
 
     if (statePtr->unreportedError != 0) {
-        errorCode = statePtr->unreportedError;
+	errorCode = statePtr->unreportedError;
+
+	/*
+	 * TIP #219, Tcl Channel Reflection API.
+	 * Move an error message found in the unreported area into the regular
+	 * bypass (interp). This kills any message in the channel bypass area.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    TclDecrRefCount(statePtr->chanMsg);
+	    statePtr->chanMsg = NULL;
+	}
+	if (interp) {
+	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+	}
     }
     if (errorCode == 0) {
-        errorCode = result;
-        if (errorCode != 0) {
-            Tcl_SetErrno(errorCode);
-        }
+	errorCode = result;
+	if (errorCode != 0) {
+	    Tcl_SetErrno(errorCode);
+	}
     }
 
     /*
@@ -2397,31 +2639,31 @@ CloseChannel(interp, chanPtr, errorCode)
      * Mark the channel as deleted by clearing the type structure.
      */
 
-    if (chanPtr->downChanPtr != (Channel *) NULL) {
+    if (chanPtr->downChanPtr != NULL) {
 	Channel *downChanPtr = chanPtr->downChanPtr;
 
-	statePtr->nextCSPtr	= tsdPtr->firstCSPtr;
-	tsdPtr->firstCSPtr	= statePtr;
+	statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+	tsdPtr->firstCSPtr = statePtr;
 
-	statePtr->topChanPtr	= downChanPtr;
-	downChanPtr->upChanPtr	= (Channel *) NULL;
-	chanPtr->typePtr	= NULL;
+	statePtr->topChanPtr = downChanPtr;
+	downChanPtr->upChanPtr = NULL;
+	chanPtr->typePtr = NULL;
 
-	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
     }
 
     /*
-     * There is only the TOP Channel, so we free the remaining
-     * pointers we have and then ourselves.  Since this is the
-     * last of the channels in the stack, make sure to free the
-     * ChannelState structure associated with it.  We use
-     * Tcl_EventuallyFree to allow for any last
+     * There is only the TOP Channel, so we free the remaining pointers we
+     * have and then ourselves. Since this is the last of the channels in the
+     * stack, make sure to free the ChannelState structure associated with it.
+     * We use Tcl_EventuallyFree to allow for any last references.
      */
+
     chanPtr->typePtr = NULL;
 
-    Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
-    Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 
     return errorCode;
 }
@@ -2430,10 +2672,10 @@ CloseChannel(interp, chanPtr, errorCode)
  *----------------------------------------------------------------------
  *
  * Tcl_CutChannel --
+ * CutChannel --
  *
- *	Removes a channel from the (thread-)global list of all channels
- *	(in that thread).  This is actually the statePtr for the stack
- *	of channel.
+ *	Removes a channel from the (thread-)global list of all channels (in
+ *	that thread). This is actually the statePtr for the stack of channel.
  *
  * Results:
  *	Nothing.
@@ -2442,56 +2684,107 @@ CloseChannel(interp, chanPtr, errorCode)
  *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
  *
  * NOTE:
- *	The channel to cut out of the list must not be referenced
- *	in any interpreter. This is something this procedure cannot
- *	check (despite the refcount) because the caller usually wants
- *	fiddle with the channel (like transfering it to a different
- *	thread) and thus keeps the refcount artifically high to prevent
- *	its destruction.
+ *	The channel to cut out of the list must not be referenced in any
+ *	interpreter. This is something this procedure cannot check (despite
+ *	the refcount) because the caller usually wants fiddle with the channel
+ *	(like transfering it to a different thread) and thus keeps the
+ *	refcount artifically high to prevent its destruction.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_CutChannel(chan)
-    Tcl_Channel chan;			/* The channel being removed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
-{
-    ThreadSpecificData* tsdPtr  = TCL_TSD_INIT(&dataKey);
-    ChannelState *prevCSPtr;		/* Preceding channel state in list of
-                                         * all states - used to splice a
-                                         * channel out of the list on close. */
+static void
+CutChannel(
+    Tcl_Channel chan)		/* The channel being removed. Must not be
+				 * referenced in any interpreter. */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState *prevCSPtr;	/* Preceding channel state in list of all
+				 * states - used to splice a channel out of
+				 * the list on close. */
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* state of the channel stack. */
+				/* State of the channel stack. */
     Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
-     * Remove this channel from of the list of all channels
-     * (in the current thread).
+     * Remove this channel from of the list of all channels (in the current
+     * thread).
      */
 
     if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
-        tsdPtr->firstCSPtr = statePtr->nextCSPtr;
+	tsdPtr->firstCSPtr = statePtr->nextCSPtr;
     } else {
-        for (prevCSPtr = tsdPtr->firstCSPtr;
-	     prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
-	     prevCSPtr = prevCSPtr->nextCSPtr) {
-            /* Empty loop body. */
-        }
-        if (prevCSPtr == (ChannelState *) NULL) {
-            panic("FlushChannel: damaged channel list");
-        }
-        prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
+	for (prevCSPtr = tsdPtr->firstCSPtr;
+		prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
+		prevCSPtr = prevCSPtr->nextCSPtr) {
+	    /* Empty loop body. */
+	}
+	if (prevCSPtr == NULL) {
+	    Tcl_Panic("FlushChannel: damaged channel list");
+	}
+	prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
     }
 
-    statePtr->nextCSPtr = (ChannelState *) NULL;
+    statePtr->nextCSPtr = NULL;
 
-    /* TIP #218, Channel Thread Actions */
-    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    /*
+     * TIP #218, Channel Thread Actions
+     */
+
+    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
     if (threadActionProc != NULL) {
-        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
-			     TCL_CHANNEL_THREAD_REMOVE);
+	(*threadActionProc)(Tcl_GetChannelInstanceData(chan),
+		TCL_CHANNEL_THREAD_REMOVE);
+    }
+}
+
+void
+Tcl_CutChannel(
+    Tcl_Channel chan)		/* The channel being added. Must not be
+				 * referenced in any interpreter. */
+{
+    Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState *prevCSPtr;	/* Preceding channel state in list of all
+				 * states - used to splice a channel out of
+				 * the list on close. */
+    ChannelState *statePtr = chanPtr->state;
+				/* State of the channel stack. */
+    Tcl_DriverThreadActionProc *threadActionProc;
+
+    /*
+     * Remove this channel from of the list of all channels (in the current
+     * thread).
+     */
+
+    if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
+	tsdPtr->firstCSPtr = statePtr->nextCSPtr;
+    } else {
+	for (prevCSPtr = tsdPtr->firstCSPtr;
+		prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
+		prevCSPtr = prevCSPtr->nextCSPtr) {
+	    /* Empty loop body. */
+	}
+	if (prevCSPtr == NULL) {
+	    Tcl_Panic("FlushChannel: damaged channel list");
+	}
+	prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
+    }
+
+    statePtr->nextCSPtr = NULL;
+
+    /*
+     * TIP #218, Channel Thread Actions
+     * For all transformations and the base channel.
+     */
+
+    while (chanPtr) {
+	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+	if (threadActionProc != NULL) {
+	    (*threadActionProc)(chanPtr->instanceData,
+		    TCL_CHANNEL_THREAD_REMOVE);
+	}
+	chanPtr= chanPtr->upChanPtr;
     }
 }
 
@@ -2499,10 +2792,11 @@ Tcl_CutChannel(chan)
  *----------------------------------------------------------------------
  *
  * Tcl_SpliceChannel --
+ * SpliceChannel --
  *
- *	Adds a channel to the (thread-)global list of all channels
- *	(in that thread). Expects that the field 'nextChanPtr' in
- *	the channel is set to NULL.
+ *	Adds a channel to the (thread-)global list of all channels (in that
+ *	thread). Expects that the field 'nextChanPtr' in the channel is set to
+ *	NULL.
  *
  * Results:
  *	Nothing.
@@ -2512,45 +2806,86 @@ Tcl_CutChannel(chan)
  *
  * NOTE:
  *	The channel to splice into the list must not be referenced in any
- *	interpreter. This is something this procedure cannot check
- *	(despite the refcount) because the caller usually wants figgle
- *	with the channel (like transfering it to a different thread)
- *	and thus keeps the refcount artifically high to prevent its
- *	destruction.
+ *	interpreter. This is something this procedure cannot check (despite
+ *	the refcount) because the caller usually wants figgle with the channel
+ *	(like transfering it to a different thread) and thus keeps the
+ *	refcount artifically high to prevent its destruction.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_SpliceChannel(chan)
-    Tcl_Channel chan;			/* The channel being added. Must
-                                         * not be referenced in any
-                                         * interpreter. */
+static void
+SpliceChannel(
+    Tcl_Channel chan)		/* The channel being added. Must not be
+				 * referenced in any interpreter. */
 {
-    ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
-    ChannelState	*statePtr = ((Channel *) chan)->state;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState *statePtr = ((Channel *) chan)->state;
     Tcl_DriverThreadActionProc *threadActionProc;
 
-    if (statePtr->nextCSPtr != (ChannelState *) NULL) {
-        panic("Tcl_SpliceChannel: trying to add channel used in different list");
+    if (statePtr->nextCSPtr != NULL) {
+	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
     }
 
-    statePtr->nextCSPtr	= tsdPtr->firstCSPtr;
-    tsdPtr->firstCSPtr	= statePtr;
+    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+    tsdPtr->firstCSPtr = statePtr;
 
     /*
-     * TIP #10. Mark the current thread as the new one managing this
-     *          channel. Note: 'Tcl_GetCurrentThread' returns sensible
-     *          values even for a non-threaded core.
+     * TIP #10. Mark the current thread as the new one managing this channel.
+     *		Note: 'Tcl_GetCurrentThread' returns sensible values even for
+     *		a non-threaded core.
      */
 
-    statePtr->managingThread = Tcl_GetCurrentThread ();
+    statePtr->managingThread = Tcl_GetCurrentThread();
+
+    /*
+     * TIP #218, Channel Thread Actions
+     */
 
-    /* TIP #218, Channel Thread Actions */
-    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
     if (threadActionProc != NULL) {
-        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
-			     TCL_CHANNEL_THREAD_INSERT);
+	(*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+		TCL_CHANNEL_THREAD_INSERT);
+    }
+}
+
+void
+Tcl_SpliceChannel(
+    Tcl_Channel chan)		/* The channel being added. Must not be
+				 * referenced in any interpreter. */
+{
+    Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState *statePtr = chanPtr->state;
+    Tcl_DriverThreadActionProc *threadActionProc;
+
+    if (statePtr->nextCSPtr != NULL) {
+	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
+    }
+
+    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+    tsdPtr->firstCSPtr = statePtr;
+
+    /*
+     * TIP #10. Mark the current thread as the new one managing this channel.
+     *		Note: 'Tcl_GetCurrentThread' returns sensible values even for
+     *		a non-threaded core.
+     */
+
+    statePtr->managingThread = Tcl_GetCurrentThread();
+
+    /*
+     * TIP #218, Channel Thread Actions
+     * For all transformations and the base channel.
+     */
+
+    while (chanPtr) {
+	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
+	if (threadActionProc != NULL) {
+	    (*threadActionProc)(chanPtr->instanceData,
+		    TCL_CHANNEL_THREAD_INSERT);
+	}
+	chanPtr= chanPtr->upChanPtr;
     }
 }
 
@@ -2569,29 +2904,30 @@ Tcl_SpliceChannel(chan)
  *
  * NOTE:
  *	Tcl_Close removes the channel as far as the user is concerned.
- *	However, it may continue to exist for a while longer if it has
- *	a background flush scheduled. The device itself is eventually
- *	closed and the channel record removed, in CloseChannel, above.
+ *	However, it may continue to exist for a while longer if it has a
+ *	background flush scheduled. The device itself is eventually closed and
+ *	the channel record removed, in CloseChannel, above.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 int
-Tcl_Close(interp, chan)
-    Tcl_Interp *interp;			/* Interpreter for errors. */
-    Tcl_Channel chan;			/* The channel being closed. Must
-                                         * not be referenced in any
-                                         * interpreter. */
-{
-    CloseCallback *cbPtr;		/* Iterate over close callbacks
-                                         * for this channel. */
-    Channel *chanPtr;			/* The real IO channel. */
-    ChannelState *statePtr;		/* State of real IO channel. */
-    int result;				/* Of calling FlushChannel. */
+Tcl_Close(
+    Tcl_Interp *interp,		/* Interpreter for errors. */
+    Tcl_Channel chan)		/* The channel being closed. Must not be
+				 * referenced in any interpreter. */
+{
+    CloseCallback *cbPtr;	/* Iterate over close callbacks for this
+				 * channel. */
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelState *statePtr;	/* State of real IO channel. */
+    int result;			/* Of calling FlushChannel. */
+    int flushcode;
+    int stickyError;
 
-    if (chan == (Tcl_Channel) NULL) {
-        return TCL_OK;
+    if (chan == NULL) {
+	return TCL_OK;
     }
 
     /*
@@ -2608,32 +2944,50 @@ Tcl_Close(interp, chan)
      * This operation should occur at the top of a channel stack.
      */
 
-    chanPtr	= (Channel *) chan;
-    statePtr	= chanPtr->state;
-    chanPtr	= statePtr->topChanPtr;
+    chanPtr = (Channel *) chan;
+    statePtr = chanPtr->state;
+    chanPtr = statePtr->topChanPtr;
 
     if (statePtr->refCount > 0) {
-        panic("called Tcl_Close on channel with refCount > 0");
+	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
     }
- 
+
     if (statePtr->flags & CHANNEL_INCLOSE) {
 	if (interp) {
-            Tcl_AppendResult(interp,
-	    "Illegal recursive call to close through close-handler of channel",
-	    (char *) NULL);
+	    Tcl_AppendResult(interp, "Illegal recursive call to close "
+		    "through close-handler of channel", NULL);
 	}
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    statePtr->flags |= CHANNEL_INCLOSE;
+    SetFlag(statePtr, CHANNEL_INCLOSE);
 
     /*
      * When the channel has an escape sequence driven encoding such as
      * iso2022, the terminated escape sequence must write to the buffer.
      */
+
+    stickyError = 0;
+
     if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
 	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
-        statePtr->outputEncodingFlags |= TCL_ENCODING_END;
-        WriteChars(chanPtr, "", 0);
+	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+	if (WriteChars(chanPtr, "", 0) < 0) {
+	    stickyError = Tcl_GetErrno();
+	}
+
+	/*
+	 * TIP #219, Tcl Channel Reflection API.
+	 * Move an error message found in the channel bypass into the
+	 * interpreter bypass. Just clear it if there is no interpreter.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    if (interp != NULL) {
+		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+	    }
+	    TclDecrRefCount(statePtr->chanMsg);
+	    statePtr->chanMsg = NULL;
+	}
     }
 
     Tcl_ClearChannelHandlers(chan);
@@ -2642,27 +2996,26 @@ Tcl_Close(interp, chan)
      * Invoke the registered close callbacks and delete their records.
      */
 
-    while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
-        cbPtr = statePtr->closeCbPtr;
-        statePtr->closeCbPtr = cbPtr->nextPtr;
-        (cbPtr->proc) (cbPtr->clientData);
-        ckfree((char *) cbPtr);
+    while (statePtr->closeCbPtr != NULL) {
+	cbPtr = statePtr->closeCbPtr;
+	statePtr->closeCbPtr = cbPtr->nextPtr;
+	(cbPtr->proc)(cbPtr->clientData);
+	ckfree((char *) cbPtr);
     }
 
-    statePtr->flags &= ~CHANNEL_INCLOSE;
+    ResetFlag(statePtr, CHANNEL_INCLOSE);
 
     /*
      * Ensure that the last output buffer will be flushed.
      */
-    
-    if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
-	    (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
-        statePtr->flags |= BUFFER_READY;
+
+    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+	SetFlag(statePtr, BUFFER_READY);
     }
 
     /*
-     * If this channel supports it, close the read side, since we don't need it
-     * anymore and this will help avoid deadlocks on some channel types.
+     * If this channel supports it, close the read side, since we don't need
+     * it anymore and this will help avoid deadlocks on some channel types.
      */
 
     if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
@@ -2673,14 +3026,42 @@ Tcl_Close(interp, chan)
     }
 
     /*
-     * The call to FlushChannel will flush any queued output and invoke
-     * the close function of the channel driver, or it will set up the
-     * channel to be flushed and closed asynchronously.
+     * The call to FlushChannel will flush any queued output and invoke the
+     * close function of the channel driver, or it will set up the channel to
+     * be flushed and closed asynchronously.
+     */
+
+    SetFlag(statePtr, CHANNEL_CLOSED);
+
+    flushcode = FlushChannel(interp, chanPtr, 0);
+
+    /*
+     * TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result.
+     *
+     * Notes: Due to the assertion of CHANNEL_CLOSED in the flags
+     * FlushChannel() has called CloseChannel() and thus freed all the channel
+     * structures. We must not try to access "chan" anymore, hence the NULL
+     * argument in the call below. The only place which may still contain a
+     * message is the interpreter itself, and "CloseChannel" made sure to lift
+     * any channel message it generated into it.
      */
 
-    statePtr->flags |= CHANNEL_CLOSED;
-    if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
-        return TCL_ERROR;
+    if (TclChanCaughtErrorBypass(interp, NULL)) {
+	result = EINVAL;
+    }
+
+    if (stickyError != 0) {
+	Tcl_SetErrno(stickyError);
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+	}
+	flushcode = -1;
+    }
+    if ((flushcode != 0) || (result != 0)) {
+	return TCL_ERROR;
     }
     return TCL_OK;
 }
@@ -2704,8 +3085,8 @@ Tcl_Close(interp, chan)
  */
 
 void
-Tcl_ClearChannelHandlers (channel)
-    Tcl_Channel channel;
+Tcl_ClearChannelHandlers(
+    Tcl_Channel channel)
 {
     ChannelHandler *chPtr, *chNext;	/* Iterate over channel handlers. */
     EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
@@ -2718,9 +3099,9 @@ Tcl_ClearChannelHandlers (channel)
      * This operation should occur at the top of a channel stack.
      */
 
-    chanPtr	= (Channel *) channel;
-    statePtr	= chanPtr->state;
-    chanPtr	= statePtr->topChanPtr;
+    chanPtr = (Channel *) channel;
+    statePtr = chanPtr->state;
+    chanPtr = statePtr->topChanPtr;
 
     /*
      * Cancel any outstanding timer.
@@ -2729,31 +3110,27 @@ Tcl_ClearChannelHandlers (channel)
     Tcl_DeleteTimerHandler(statePtr->timer);
 
     /*
-     * Remove any references to channel handlers for this channel that
-     * may be about to be invoked.
+     * Remove any references to channel handlers for this channel that may be
+     * about to be invoked.
      */
 
-    for (nhPtr = tsdPtr->nestedHandlerPtr;
-	 nhPtr != (NextChannelHandler *) NULL;
-	 nhPtr = nhPtr->nestedHandlerPtr) {
-        if (nhPtr->nextHandlerPtr &&
+    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
+	    nhPtr = nhPtr->nestedHandlerPtr) {
+	if (nhPtr->nextHandlerPtr &&
 		(nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
 	    nhPtr->nextHandlerPtr = NULL;
-        }
+	}
     }
 
     /*
-     * Remove all the channel handler records attached to the channel
-     * itself.
+     * Remove all the channel handler records attached to the channel itself.
      */
 
-    for (chPtr = statePtr->chPtr;
-	 chPtr != (ChannelHandler *) NULL;
-	 chPtr = chNext) {
-        chNext = chPtr->nextPtr;
-        ckfree((char *) chPtr);
+    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
+	chNext = chPtr->nextPtr;
+	ckfree((char *) chPtr);
     }
-    statePtr->chPtr = (ChannelHandler *) NULL;
+    statePtr->chPtr = NULL;
 
     /*
      * Cancel any pending copy operation.
@@ -2775,14 +3152,12 @@ Tcl_ClearChannelHandlers (channel)
      * Remove any EventScript records for this channel.
      */
 
-    for (ePtr = statePtr->scriptRecordPtr;
-	 ePtr != (EventScriptRecord *) NULL;
-	 ePtr = eNextPtr) {
-        eNextPtr = ePtr->nextPtr;
-	Tcl_DecrRefCount(ePtr->scriptPtr);
-        ckfree((char *) ePtr);
+    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
+	eNextPtr = ePtr->nextPtr;
+	TclDecrRefCount(ePtr->scriptPtr);
+	ckfree((char *) ePtr);
     }
-    statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+    statePtr->scriptRecordPtr = NULL;
 }
 
 /*
@@ -2790,11 +3165,11 @@ Tcl_ClearChannelHandlers (channel)
  *
  * Tcl_Write --
  *
- *	Puts a sequence of bytes into an output buffer, may queue the
- *	buffer for output if it gets full, and also remembers whether the
- *	current buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode. Compensates stacking, i.e. will redirect the
- *	data from the specified channel to the topmost channel in a stack.
+ *	Puts a sequence of bytes into an output buffer, may queue the buffer
+ *	for output if it gets full, and also remembers whether the current
+ *	buffer is ready e.g. if it contains a newline and we are in line
+ *	buffering mode. Compensates stacking, i.e. will redirect the data from
+ *	the specified channel to the topmost channel in a stack.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
@@ -2810,27 +3185,28 @@ Tcl_ClearChannelHandlers (channel)
  */
 
 int
-Tcl_Write(chan, src, srcLen)
-    Tcl_Channel chan;			/* The channel to buffer output for. */
-    CONST char *src;			/* Data to queue in output buffer. */
-    int srcLen;				/* Length of data in bytes, or < 0 for
-					 * strlen(). */
+Tcl_Write(
+    Tcl_Channel chan,		/* The channel to buffer output for. */
+    const char *src,		/* Data to queue in output buffer. */
+    int srcLen)			/* Length of data in bytes, or < 0 for
+				 * strlen(). */
 {
     /*
      * Always use the topmost channel of the stack
      */
+
     Channel *chanPtr;
-    ChannelState *statePtr;	/* state info for channel */
+    ChannelState *statePtr;	/* State info for channel */
 
     statePtr = ((Channel *) chan)->state;
-    chanPtr  = statePtr->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
 	return -1;
     }
 
     if (srcLen < 0) {
-        srcLen = strlen(src);
+	srcLen = strlen(src);
     }
     return DoWrite(chanPtr, src, srcLen);
 }
@@ -2840,11 +3216,11 @@ Tcl_Write(chan, src, srcLen)
  *
  * Tcl_WriteRaw --
  *
- *	Puts a sequence of bytes into an output buffer, may queue the
- *	buffer for output if it gets full, and also remembers whether the
- *	current buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode. Writes directly to the driver of the channel,
- *	does not compensate for stacking.
+ *	Puts a sequence of bytes into an output buffer, may queue the buffer
+ *	for output if it gets full, and also remembers whether the current
+ *	buffer is ready e.g. if it contains a newline and we are in line
+ *	buffering mode. Writes directly to the driver of the channel, does not
+ *	compensate for stacking.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
@@ -2860,14 +3236,15 @@ Tcl_Write(chan, src, srcLen)
  */
 
 int
-Tcl_WriteRaw(chan, src, srcLen)
-    Tcl_Channel chan;			/* The channel to buffer output for. */
-    CONST char *src;			/* Data to queue in output buffer. */
-    int srcLen;				/* Length of data in bytes, or < 0 for
-					 * strlen(). */
+Tcl_WriteRaw(
+    Tcl_Channel chan,		/* The channel to buffer output for. */
+    const char *src,		/* Data to queue in output buffer. */
+    int srcLen)			/* Length of data in bytes, or < 0 for
+				 * strlen(). */
 {
     Channel *chanPtr = ((Channel *) chan);
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     int errorCode, written;
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
@@ -2875,7 +3252,7 @@ Tcl_WriteRaw(chan, src, srcLen)
     }
 
     if (srcLen < 0) {
-        srcLen = strlen(src);
+	srcLen = strlen(src);
     }
 
     /*
@@ -2899,11 +3276,11 @@ Tcl_WriteRaw(chan, src, srcLen)
  * Tcl_WriteChars --
  *
  *	Takes a sequence of UTF-8 characters and converts them for output
- *	using the channel's current encoding, may queue the buffer for
- *	output if it gets full, and also remembers whether the current
- *	buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode. Compensates stacking, i.e. will redirect the
- *	data from the specified channel to the topmost channel in a stack.
+ *	using the channel's current encoding, may queue the buffer for output
+ *	if it gets full, and also remembers whether the current buffer is
+ *	ready e.g. if it contains a newline and we are in line buffering
+ *	mode. Compensates stacking, i.e. will redirect the data from the
+ *	specified channel to the topmost channel in a stack.
  *
  * Results:
  *	The number of bytes written or -1 in case of error. If -1,
@@ -2917,13 +3294,14 @@ Tcl_WriteRaw(chan, src, srcLen)
  */
 
 int
-Tcl_WriteChars(chan, src, len)
-    Tcl_Channel chan;		/* The channel to buffer output for. */
-    CONST char *src;		/* UTF-8 characters to queue in output buffer. */
-    int len;			/* Length of string in bytes, or < 0 for 
+Tcl_WriteChars(
+    Tcl_Channel chan,		/* The channel to buffer output for. */
+    const char *src,		/* UTF-8 characters to queue in output
+				 * buffer. */
+    int len)			/* Length of string in bytes, or < 0 for
 				 * strlen(). */
 {
-    ChannelState *statePtr;	/* state info for channel */
+    ChannelState *statePtr;	/* State info for channel */
 
     statePtr = ((Channel *) chan)->state;
 
@@ -2931,7 +3309,7 @@ Tcl_WriteChars(chan, src, len)
 	return -1;
     }
 
-    return DoWriteChars ((Channel*) chan, src, len);
+    return DoWriteChars((Channel *) chan, src, len);
 }
 
 /*
@@ -2940,11 +3318,11 @@ Tcl_WriteChars(chan, src, len)
  * DoWriteChars --
  *
  *	Takes a sequence of UTF-8 characters and converts them for output
- *	using the channel's current encoding, may queue the buffer for
- *	output if it gets full, and also remembers whether the current
- *	buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode. Compensates stacking, i.e. will redirect the
- *	data from the specified channel to the topmost channel in a stack.
+ *	using the channel's current encoding, may queue the buffer for output
+ *	if it gets full, and also remembers whether the current buffer is
+ *	ready e.g. if it contains a newline and we are in line buffering mode.
+ *	Compensates stacking, i.e. will redirect the data from the specified
+ *	channel to the topmost channel in a stack.
  *
  * Results:
  *	The number of bytes written or -1 in case of error. If -1,
@@ -2958,36 +3336,43 @@ Tcl_WriteChars(chan, src, len)
  */
 
 static int
-DoWriteChars(chanPtr, src, len)
-    Channel* chanPtr;		/* The channel to buffer output for. */
-    CONST char *src;		/* UTF-8 characters to queue in output buffer. */
-    int len;			/* Length of string in bytes, or < 0 for 
+DoWriteChars(
+    Channel *chanPtr,		/* The channel to buffer output for. */
+    const char *src,		/* UTF-8 characters to queue in output
+				 * buffer. */
+    int len)			/* Length of string in bytes, or < 0 for
 				 * strlen(). */
 {
     /*
      * Always use the topmost channel of the stack
      */
-    ChannelState *statePtr;	/* state info for channel */
+
+    ChannelState *statePtr;	/* State info for channel */
 
     statePtr = chanPtr->state;
-    chanPtr  = statePtr->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
 
     if (len < 0) {
-        len = strlen(src);
+	len = strlen(src);
     }
     if (statePtr->encoding == NULL) {
 	/*
-	 * Inefficient way to convert UTF-8 to byte-array, but the  
-	 * code parallels the way it is done for objects.
+	 * Inefficient way to convert UTF-8 to byte-array, but the code
+	 * parallels the way it is done for objects.
+	 * Special case for 1-byte (used by eg [puts] for the \n) could
+	 * be extended to more efficient translation of the src string.
 	 */
 
-	Tcl_Obj *objPtr;
-	int result;
+ 	int result;
 
-	objPtr = Tcl_NewStringObj(src, len);
-	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
-	result = WriteBytes(chanPtr, src, len);
-	Tcl_DecrRefCount(objPtr);
+	if ((len == 1) && (UCHAR(*src) < 0xC0)) {
+	    result = WriteBytes(chanPtr, src, len);
+	} else {
+	    Tcl_Obj *objPtr = Tcl_NewStringObj(src, len);
+	    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+	    result = WriteBytes(chanPtr, src, len);
+	    TclDecrRefCount(objPtr);
+	}
 	return result;
     }
     return WriteChars(chanPtr, src, len);
@@ -2998,17 +3383,17 @@ DoWriteChars(chanPtr, src, len)
  *
  * Tcl_WriteObj --
  *
- *	Takes the Tcl object and queues its contents for output.  If the 
- *	encoding of the channel is NULL, takes the byte-array representation 
- *	of the object and queues those bytes for output.  Otherwise, takes 
- *	the characters in the UTF-8 (string) representation of the object 
- *	and converts them for output using the channel's current encoding.  
- *	May flush internal buffers to output if one becomes full or is ready 
- *	for some other reason, e.g. if it contains a newline and the channel 
- *	is in line buffering mode.
+ *	Takes the Tcl object and queues its contents for output. If the
+ *	encoding of the channel is NULL, takes the byte-array representation
+ *	of the object and queues those bytes for output. Otherwise, takes the
+ *	characters in the UTF-8 (string) representation of the object and
+ *	converts them for output using the channel's current encoding. May
+ *	flush internal buffers to output if one becomes full or is ready for
+ *	some other reason, e.g. if it contains a newline and the channel is in
+ *	line buffering mode.
  *
  * Results:
- *	The number of bytes written or -1 in case of error. If -1, 
+ *	The number of bytes written or -1 in case of error. If -1,
  *	Tcl_GetErrno() will return the error code.
  *
  * Side effects:
@@ -3019,20 +3404,21 @@ DoWriteChars(chanPtr, src, len)
  */
 
 int
-Tcl_WriteObj(chan, objPtr)
-    Tcl_Channel chan;		/* The channel to buffer output for. */
-    Tcl_Obj *objPtr;		/* The object to write. */
+Tcl_WriteObj(
+    Tcl_Channel chan,		/* The channel to buffer output for. */
+    Tcl_Obj *objPtr)		/* The object to write. */
 {
     /*
      * Always use the topmost channel of the stack
      */
+
     Channel *chanPtr;
-    ChannelState *statePtr;	/* state info for channel */
+    ChannelState *statePtr;	/* State info for channel */
     char *src;
     int srcLen;
 
     statePtr = ((Channel *) chan)->state;
-    chanPtr  = statePtr->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
 	return -1;
@@ -3041,7 +3427,7 @@ Tcl_WriteObj(chan, objPtr)
 	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
 	return WriteBytes(chanPtr, src, srcLen);
     } else {
-	src = Tcl_GetStringFromObj(objPtr, &srcLen);
+	src = TclGetStringFromObj(objPtr, &srcLen);
 	return WriteChars(chanPtr, src, srcLen);
     }
 }
@@ -3051,10 +3437,10 @@ Tcl_WriteObj(chan, objPtr)
  *
  * WriteBytes --
  *
- *	Write a sequence of bytes into an output buffer, may queue the
- *	buffer for output if it gets full, and also remembers whether the
- *	current buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode.
+ *	Write a sequence of bytes into an output buffer, may queue the buffer
+ *	for output if it gets full, and also remembers whether the current
+ *	buffer is ready e.g. if it contains a newline and we are in line
+ *	buffering mode.
  *
  * Results:
  *	The number of bytes written or -1 in case of error. If -1,
@@ -3068,33 +3454,36 @@ Tcl_WriteObj(chan, objPtr)
  */
 
 static int
-WriteBytes(chanPtr, src, srcLen)
-    Channel *chanPtr;		/* The channel to buffer output for. */
-    CONST char *src;		/* Bytes to write. */
-    int srcLen;			/* Number of bytes to write. */
+WriteBytes(
+    Channel *chanPtr,		/* The channel to buffer output for. */
+    const char *src,		/* Bytes to write. */
+    int srcLen)			/* Number of bytes to write. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
     char *dst;
-    int dstMax, sawLF, savedLF, total, dstLen, toWrite;
-    
+    int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;
+
     total = 0;
     sawLF = 0;
     savedLF = 0;
+    translate = (statePtr->flags & CHANNEL_LINEBUFFERED)
+	|| (statePtr->outputTranslation != TCL_TRANSLATE_LF);
 
     /*
-     * Loop over all bytes in src, storing them in output buffer with
-     * proper EOL translation.
+     * Loop over all bytes in src, storing them in output buffer with proper
+     * EOL translation.
      */
 
     while (srcLen + savedLF > 0) {
 	bufPtr = statePtr->curOutPtr;
 	if (bufPtr == NULL) {
 	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
-	    statePtr->curOutPtr	= bufPtr;
+	    statePtr->curOutPtr = bufPtr;
 	}
-	dst = bufPtr->buf + bufPtr->nextAdded;
-	dstMax = bufPtr->bufLength - bufPtr->nextAdded;
+	dst = InsertPoint(bufPtr);
+	dstMax = SpaceLeft(bufPtr);
 	dstLen = dstMax;
 
 	toWrite = dstLen;
@@ -3102,25 +3491,32 @@ WriteBytes(chanPtr, src, srcLen)
 	    toWrite = srcLen;
 	}
 
-	if (savedLF) {
-	    /*
-	     * A '\n' was left over from last call to TranslateOutputEOL()
-	     * and we need to store it in this buffer.  If the channel is
-	     * line-based, we will need to flush it.
-	     */
+	if (translate) {
+	    if (savedLF) {
+		/*
+		 * A '\n' was left over from last call to TranslateOutputEOL()
+		 * and we need to store it in this buffer. If the channel is
+		 * line-based, we will need to flush it.
+		 */
 
-	    *dst++ = '\n';
-	    dstLen--;
-	    sawLF++;
+		*dst++ = '\n';
+		dstLen--;
+		sawLF++;
+	    }
+	    if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
+		sawLF++;
+	    }
+	    dstLen += savedLF;
+	    savedLF = 0;
+	    if (dstLen > dstMax) {
+		savedLF = 1;
+		dstLen = dstMax;
+	    }
+	} else {
+	    memcpy(dst, src, toWrite);
+	    dstLen = toWrite;
 	}
-	sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
-	dstLen += savedLF;
-	savedLF = 0;
 
-	if (dstLen > dstMax) {
-	    savedLF = 1;
-	    dstLen = dstMax;
-	}
 	bufPtr->nextAdded += dstLen;
 	if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
 	    return -1;
@@ -3138,11 +3534,10 @@ WriteBytes(chanPtr, src, srcLen)
  *
  * WriteChars --
  *
- *	Convert UTF-8 bytes to the channel's external encoding and
- *	write the produced bytes into an output buffer, may queue the 
- *	buffer for output if it gets full, and also remembers whether the
- *	current buffer is ready e.g. if it contains a newline and we are in
- *	line buffering mode.
+ *	Convert UTF-8 bytes to the channel's external encoding and write the
+ *	produced bytes into an output buffer, may queue the buffer for output
+ *	if it gets full, and also remembers whether the current buffer is
+ *	ready e.g. if it contains a newline and we are in line buffering mode.
  *
  * Results:
  *	The number of bytes written or -1 in case of error. If -1,
@@ -3156,20 +3551,21 @@ WriteBytes(chanPtr, src, srcLen)
  */
 
 static int
-WriteChars(chanPtr, src, srcLen)
-    Channel *chanPtr;		/* The channel to buffer output for. */
-    CONST char *src;		/* UTF-8 string to write. */
-    int srcLen;			/* Length of UTF-8 string in bytes. */
+WriteChars(
+    Channel *chanPtr,		/* The channel to buffer output for. */
+    const char *src,		/* UTF-8 string to write. */
+    int srcLen)			/* Length of UTF-8 string in bytes. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
     char *dst, *stage;
     int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
     int stageLen, toWrite, stageRead, endEncoding, result;
-    int consumedSomething;
+    int consumedSomething, translate;
     Tcl_Encoding encoding;
     char safe[BUFFER_PADDING];
-    
+
     total = 0;
     sawLF = 0;
     savedLF = 0;
@@ -3182,6 +3578,9 @@ WriteChars(chanPtr, src, srcLen)
 
     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
 
+    translate = (statePtr->flags & CHANNEL_LINEBUFFERED)
+	|| (statePtr->outputTranslation != TCL_TRANSLATE_LF);
+
     /*
      * Loop over all UTF-8 characters in src, storing them in staging buffer
      * with proper EOL translation.
@@ -3189,7 +3588,7 @@ WriteChars(chanPtr, src, srcLen)
 
     consumedSomething = 1;
     while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
-        consumedSomething = 0;
+	consumedSomething = 0;
 	stage = statePtr->outputStage;
 	stageMax = statePtr->bufSize;
 	stageLen = stageMax;
@@ -3199,27 +3598,34 @@ WriteChars(chanPtr, src, srcLen)
 	    toWrite = srcLen;
 	}
 
-	if (savedLF) {
-	    /*
-	     * A '\n' was left over from last call to TranslateOutputEOL()
-	     * and we need to store it in the staging buffer.  If the
-	     * channel is line-based, we will need to flush the output
-	     * buffer (after translating the staging buffer).
-	     */
-	    
-	    *stage++ = '\n';
-	    stageLen--;
-	    sawLF++;
-	}
-	sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite);
+	if (translate) {
+	    if (savedLF) {
+		/*
+		 * A '\n' was left over from last call to TranslateOutputEOL()
+		 * and we need to store it in the staging buffer. If the channel
+		 * is line-based, we will need to flush the output buffer (after
+		 * translating the staging buffer).
+		 */
+
+		*stage++ = '\n';
+		stageLen--;
+		sawLF++;
+	    }
+	    if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) {
+		sawLF++;
+	    }
 
-	stage -= savedLF;
-	stageLen += savedLF;
-	savedLF = 0;
+	    stage -= savedLF;
+	    stageLen += savedLF;
+	    savedLF = 0;
 
-	if (stageLen > stageMax) {
-	    savedLF = 1;
-	    stageLen = stageMax;
+	    if (stageLen > stageMax) {
+		savedLF = 1;
+		stageLen = stageMax;
+	    }
+	} else {
+	    memcpy(stage, src, toWrite);
+	    stageLen = toWrite;
 	}
 	src += toWrite;
 	srcLen -= toWrite;
@@ -3235,17 +3641,16 @@ WriteChars(chanPtr, src, srcLen)
 		bufPtr = AllocChannelBuffer(statePtr->bufSize);
 		statePtr->curOutPtr = bufPtr;
 	    }
-	    dst = bufPtr->buf + bufPtr->nextAdded;
-	    dstLen = bufPtr->bufLength - bufPtr->nextAdded;
+	    dst = InsertPoint(bufPtr);
+	    dstLen = SpaceLeft(bufPtr);
 
 	    if (saved != 0) {
 		/*
-		 * Here's some translated bytes left over from the last
-		 * buffer that we need to stick at the beginning of this
-		 * buffer.
+		 * Here's some translated bytes left over from the last buffer
+		 * that we need to stick at the beginning of this buffer.
 		 */
-		 
-		memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
+
+		memcpy(dst, safe, (size_t) saved);
 		bufPtr->nextAdded += saved;
 		dst += saved;
 		dstLen -= saved;
@@ -3257,7 +3662,8 @@ WriteChars(chanPtr, src, srcLen)
 		    &statePtr->outputEncodingState, dst,
 		    dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
 
-	    /* Fix for SF #506297, reported by Martin Forssen
+	    /*
+	     * Fix for SF #506297, reported by Martin Forssen
 	     * <ruric@users.sourceforge.net>.
 	     *
 	     * The encoding chosen in the script exposing the bug writes out
@@ -3273,13 +3679,15 @@ WriteChars(chanPtr, src, srcLen)
 	     */
 
 	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
+
 	    /*
 	     * The following code must be executed only when result is not 0.
 	     */
-	    if (result && ((stageRead + dstWrote) == 0)) {
+
+	    if ((result != 0) && (stageRead + dstWrote == 0)) {
 		/*
 		 * We have an incomplete UTF-8 character at the end of the
-		 * staging buffer.  It will get moved to the beginning of the
+		 * staging buffer. It will get moved to the beginning of the
 		 * staging buffer followed by more bytes from src.
 		 */
 
@@ -3290,18 +3698,17 @@ WriteChars(chanPtr, src, srcLen)
 		break;
 	    }
 	    bufPtr->nextAdded += dstWrote;
-	    if (bufPtr->nextAdded > bufPtr->bufLength) {
+	    if (IsBufferOverflowing(bufPtr)) {
 		/*
 		 * When translating from UTF-8 to external encoding, we
-		 * allowed the translation to produce a character that
-		 * crossed the end of the output buffer, so that we would
-		 * get a completely full buffer before flushing it.  The
-		 * extra bytes will be moved to the beginning of the next
-		 * buffer.
+		 * allowed the translation to produce a character that crossed
+		 * the end of the output buffer, so that we would get a
+		 * completely full buffer before flushing it. The extra bytes
+		 * will be moved to the beginning of the next buffer.
 		 */
 
-		saved = bufPtr->nextAdded - bufPtr->bufLength;
-		memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
+		saved = -SpaceLeft(bufPtr);
+		memcpy(safe, dst + dstLen, (size_t) saved);
 		bufPtr->nextAdded = bufPtr->bufLength;
 	    }
 	    if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
@@ -3327,13 +3734,14 @@ WriteChars(chanPtr, src, srcLen)
 	}
     }
 
-    /* If nothing was written and it happened because there was no progress
-     * in the UTF conversion, we throw an error.
+    /*
+     * If nothing was written and it happened because there was no progress in
+     * the UTF conversion, we throw an error.
      */
 
     if (!consumedSomething && (total == 0)) {
-        Tcl_SetErrno (EINVAL);
-        return -1;
+	Tcl_SetErrno(EINVAL);
+	return -1;
     }
     return total;
 }
@@ -3343,125 +3751,120 @@ WriteChars(chanPtr, src, srcLen)
  *
  * TranslateOutputEOL --
  *
- *	Helper function for WriteBytes() and WriteChars().  Converts the
- *	'\n' characters in the source buffer into the appropriate EOL
- *	form specified by the output translation mode.
+ *	Helper function for WriteBytes() and WriteChars(). Converts the '\n'
+ *	characters in the source buffer into the appropriate EOL form
+ *	specified by the output translation mode.
  *
- *	EOL translation stops either when the source buffer is empty
- *	or the output buffer is full.
+ *	EOL translation stops either when the source buffer is empty or the
+ *	output buffer is full.
  *
- *	When converting to CRLF mode and there is only 1 byte left in
- *	the output buffer, this routine stores the '\r' in the last
- *	byte and then stores the '\n' in the byte just past the end of the 
- *	buffer.  The caller is responsible for passing in a buffer that
- *	is large enough to hold the extra byte.
+ *	When converting to CRLF mode and there is only 1 byte left in the
+ *	output buffer, this routine stores the '\r' in the last byte and then
+ *	stores the '\n' in the byte just past the end of the buffer. The
+ *	caller is responsible for passing in a buffer that is large enough to
+ *	hold the extra byte.
  *
  * Results:
- *	The return value is 1 if a '\n' was translated from the source
- *	buffer, or 0 otherwise -- this can be used by the caller to
- *	decide to flush a line-based channel even though the channel
- *	buffer is not full.
+ *	The return value is 1 if a '\n' was translated from the source buffer,
+ *	or 0 otherwise -- this can be used by the caller to decide to flush a
+ *	line-based channel even though the channel buffer is not full.
  *
- *	*dstLenPtr is filled with how many bytes of the output buffer
- *	were used.  As mentioned above, this can be one more that
- *	the output buffer's specified length if a CRLF was stored.
+ *	*dstLenPtr is filled with how many bytes of the output buffer were
+ *	used. As mentioned above, this can be one more that the output
+ *	buffer's specified length if a CRLF was stored.
  *
- *	*srcLenPtr is filled with how many bytes of the source buffer
- *	were consumed.  
+ *	*srcLenPtr is filled with how many bytes of the source buffer were
+ *	consumed.
  *
  * Side effects:
- *	It may be obvious, but bears mentioning that when converting
- *	in CRLF mode (which requires two bytes of storage in the output
- *	buffer), the number of bytes consumed from the source buffer
- *	will be less than the number of bytes stored in the output buffer.
+ *	It may be obvious, but bears mentioning that when converting in CRLF
+ *	mode (which requires two bytes of storage in the output buffer), the
+ *	number of bytes consumed from the source buffer will be less than the
+ *	number of bytes stored in the output buffer.
  *
  *---------------------------------------------------------------------------
  */
 
 static int
-TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
-    ChannelState *statePtr;	/* Channel being read, for translation and
+TranslateOutputEOL(
+    ChannelState *statePtr,	/* Channel being read, for translation and
 				 * buffering modes. */
-    char *dst;			/* Output buffer filled with UTF-8 chars by
+    char *dst,			/* Output buffer filled with UTF-8 chars by
 				 * applying appropriate EOL translation to
 				 * source characters. */
-    CONST char *src;		/* Source UTF-8 characters. */
-    int *dstLenPtr;		/* On entry, the maximum length of output
-				 * buffer in bytes.  On exit, the number of
+    const char *src,		/* Source UTF-8 characters. */
+    int *dstLenPtr,		/* On entry, the maximum length of output
+				 * buffer in bytes. On exit, the number of
 				 * bytes actually used in output buffer. */
-    int *srcLenPtr;		/* On entry, the length of source buffer.
-				 * On exit, the number of bytes read from
-				 * the source buffer. */
+    int *srcLenPtr)		/* On entry, the length of source buffer. On
+				 * exit, the number of bytes read from the
+				 * source buffer. */
 {
     char *dstEnd;
     int srcLen, newlineFound;
-    
+
     newlineFound = 0;
     srcLen = *srcLenPtr;
 
     switch (statePtr->outputTranslation) {
-	case TCL_TRANSLATE_LF: {
-	    for (dstEnd = dst + srcLen; dst < dstEnd; ) {
-		if (*src == '\n') {
-		    newlineFound = 1;
-		}
-		*dst++ = *src++;
+    case TCL_TRANSLATE_LF:
+	for (dstEnd = dst + srcLen; dst < dstEnd; ) {
+	    if (*src == '\n') {
+		newlineFound = 1;
 	    }
-	    *dstLenPtr = srcLen;
-	    break;
-	}
-	case TCL_TRANSLATE_CR: {
-	    for (dstEnd = dst + srcLen; dst < dstEnd;) {
-		if (*src == '\n') {
-		    *dst++ = '\r';
-		    newlineFound = 1;
-		    src++;
-		} else {
-		    *dst++ = *src++;
-		}
+	    *dst++ = *src++;
+	}
+	*dstLenPtr = srcLen;
+	break;
+    case TCL_TRANSLATE_CR:
+	for (dstEnd = dst + srcLen; dst < dstEnd;) {
+	    if (*src == '\n') {
+		*dst++ = '\r';
+		newlineFound = 1;
+		src++;
+	    } else {
+		*dst++ = *src++;
 	    }
-	    *dstLenPtr = srcLen;
-	    break;
 	}
-	case TCL_TRANSLATE_CRLF: {
-	    /*
-	     * Since this causes the number of bytes to grow, we
-	     * start off trying to put 'srcLen' bytes into the
-	     * output buffer, but allow it to store more bytes, as
-	     * long as there's still source bytes and room in the
-	     * output buffer.
-	     */
+	*dstLenPtr = srcLen;
+	break;
+    case TCL_TRANSLATE_CRLF: {
+	/*
+	 * Since this causes the number of bytes to grow, we start off trying
+	 * to put 'srcLen' bytes into the output buffer, but allow it to store
+	 * more bytes, as long as there's still source bytes and room in the
+	 * output buffer.
+	 */
 
-	    char *dstStart, *dstMax;
-	    CONST char *srcStart;
-	    
-	    dstStart = dst;
-	    dstMax = dst + *dstLenPtr;
+	char *dstStart, *dstMax;
+	const char *srcStart;
 
-	    srcStart = src;
-	    
-	    if (srcLen < *dstLenPtr) {
-		dstEnd = dst + srcLen;
-	    } else {
-		dstEnd = dst + *dstLenPtr;
-	    }
-	    while (dst < dstEnd) {
-		if (*src == '\n') {
-		    if (dstEnd < dstMax) {
-			dstEnd++;
-		    }
-		    *dst++ = '\r';
-		    newlineFound = 1;
+	dstStart = dst;
+	dstMax = dst + *dstLenPtr;
+
+	srcStart = src;
+
+	if (srcLen < *dstLenPtr) {
+	    dstEnd = dst + srcLen;
+	} else {
+	    dstEnd = dst + *dstLenPtr;
+	}
+	while (dst < dstEnd) {
+	    if (*src == '\n') {
+		if (dstEnd < dstMax) {
+		    dstEnd++;
 		}
-		*dst++ = *src++;
+		*dst++ = '\r';
+		newlineFound = 1;
 	    }
-	    *srcLenPtr = src - srcStart;
-	    *dstLenPtr = dst - dstStart;
-	    break;
-	}
-	default: {
-	    break;
+	    *dst++ = *src++;
 	}
+	*srcLenPtr = src - srcStart;
+	*dstLenPtr = dst - dstStart;
+	break;
+    }
+    default:
+	break;
     }
     return newlineFound;
 }
@@ -3471,12 +3874,12 @@ TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
  *
  * CheckFlush --
  *
- *	Helper function for WriteBytes() and WriteChars().  If the
- *	channel buffer is ready to be flushed, flush it.
+ *	Helper function for WriteBytes() and WriteChars(). If the channel
+ *	buffer is ready to be flushed, flush it.
  *
  * Results:
- *	The return value is -1 if there was a problem flushing the
- *	channel buffer, or 0 otherwise.
+ *	The return value is -1 if there was a problem flushing the channel
+ *	buffer, or 0 otherwise.
  *
  * Side effects:
  *	The buffer will be recycled if it is flushed.
@@ -3485,13 +3888,15 @@ TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
  */
 
 static int
-CheckFlush(chanPtr, bufPtr, newlineFlag)
-    Channel *chanPtr;		/* Channel being read, for buffering mode. */
-    ChannelBuffer *bufPtr;	/* Channel buffer to possibly flush. */
-    int newlineFlag;		/* Non-zero if a the channel buffer
-				 * contains a newline. */
+CheckFlush(
+    Channel *chanPtr,		/* Channel being read, for buffering mode. */
+    ChannelBuffer *bufPtr,	/* Channel buffer to possibly flush. */
+    int newlineFlag)		/* Non-zero if a the channel buffer contains a
+				 * newline. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+
     /*
      * The current buffer is ready for output:
      * 1. if it is full.
@@ -3500,14 +3905,14 @@ CheckFlush(chanPtr, bufPtr, newlineFlag)
      */
 
     if ((statePtr->flags & BUFFER_READY) == 0) {
-	if (bufPtr->nextAdded == bufPtr->bufLength) {
-	    statePtr->flags |= BUFFER_READY;
+	if (IsBufferFull(bufPtr)) {
+	    SetFlag(statePtr, BUFFER_READY);
 	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
 	    if (newlineFlag != 0) {
-		statePtr->flags |= BUFFER_READY;
+		SetFlag(statePtr, BUFFER_READY);
 	    }
 	} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
-	    statePtr->flags |= BUFFER_READY;
+	    SetFlag(statePtr, BUFFER_READY);
 	}
     }
     if (statePtr->flags & BUFFER_READY) {
@@ -3531,17 +3936,17 @@ CheckFlush(chanPtr, bufPtr, newlineFlag)
  *	error or condition that occurred.
  *
  * Side effects:
- *	May flush output on the channel.  May cause input to be consumed
- *	from the channel.
+ *	May flush output on the channel. May cause input to be consumed from
+ *	the channel.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_Gets(chan, lineRead)
-    Tcl_Channel chan;		/* Channel from which to read. */
-    Tcl_DString *lineRead;	/* The line read will be appended to this
-				 * DString as UTF-8 characters.  The caller
+Tcl_Gets(
+    Tcl_Channel chan,		/* Channel from which to read. */
+    Tcl_DString *lineRead)	/* The line read will be appended to this
+				 * DString as UTF-8 characters. The caller
 				 * must have initialized it and is responsible
 				 * for managing the storage. */
 {
@@ -3549,13 +3954,13 @@ Tcl_Gets(chan, lineRead)
     int charsStored, length;
     char *string;
 
-    objPtr = Tcl_NewObj();
+    TclNewObj(objPtr);
     charsStored = Tcl_GetsObj(chan, objPtr);
     if (charsStored > 0) {
-	string = Tcl_GetStringFromObj(objPtr, &length);
+	string = TclGetStringFromObj(objPtr, &length);
 	Tcl_DStringAppend(lineRead, string, length);
     }
-    Tcl_DecrRefCount(objPtr);
+    TclDecrRefCount(objPtr);
     return charsStored;
 }
 
@@ -3565,60 +3970,71 @@ Tcl_Gets(chan, lineRead)
  * Tcl_GetsObj --
  *
  *	Accumulate input from the input channel until end-of-line or
- *	end-of-file has been seen.  Bytes read from the input channel
- *	are converted to UTF-8 using the encoding specified by the
- *	channel.
+ *	end-of-file has been seen. Bytes read from the input channel are
+ *	converted to UTF-8 using the encoding specified by the channel.
  *
  * Results:
  *	Number of characters accumulated in the object or -1 if error,
- *	blocked, or EOF.  If -1, use Tcl_GetErrno() to retrieve the
- *	POSIX error code for the error or condition that occurred.
+ *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
+ *	code for the error or condition that occurred.
  *
  * Side effects:
  *	Consumes input from the channel.
  *
- *	On reading EOF, leave channel pointing at EOF char.
- *	On reading EOL, leave channel pointing after EOL, but don't
- *	return EOL in dst buffer.
+ *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
+ *	leave channel pointing after EOL, but don't return EOL in dst buffer.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_GetsObj(chan, objPtr)
-    Tcl_Channel chan;		/* Channel from which to read. */
-    Tcl_Obj *objPtr;		/* The line read will be appended to this
+Tcl_GetsObj(
+    Tcl_Channel chan,		/* Channel from which to read. */
+    Tcl_Obj *objPtr)		/* The line read will be appended to this
 				 * object as UTF-8 characters. */
 {
     GetsState gs;
     Channel *chanPtr = (Channel *) chan;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
     int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
     Tcl_Encoding encoding;
     char *dst, *dstEnd, *eol, *eof;
     Tcl_EncodingState oldState;
 
+    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
+	copiedTotal = -1;
+	goto done;
+    }
+
+    /*
+     * A binary version of Tcl_GetsObj. This could also handle encodings that
+     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
+     * done on objPtr.
+     */
+
+    if ((statePtr->encoding == NULL)
+	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
+		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) {
+	return TclGetsObjBinary(chan, objPtr);
+    }
+
     /*
      * This operation should occur at the top of a channel stack.
      */
 
     chanPtr = statePtr->topChanPtr;
 
-    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
-	copiedTotal = -1;
-	goto done;
-    }
-
     bufPtr = statePtr->inQueueHead;
     encoding = statePtr->encoding;
 
     /*
-     * Preserved so we can restore the channel's state in case we don't
-     * find a newline in the available input.
+     * Preserved so we can restore the channel's state in case we don't find a
+     * newline in the available input.
      */
 
-    Tcl_GetStringFromObj(objPtr, &oldLength);
+    TclGetStringFromObj(objPtr, &oldLength);
     oldFlags = statePtr->inputEncodingFlags;
     oldState = statePtr->inputEncodingState;
     oldRemoved = BUFFER_PADDING;
@@ -3628,17 +4044,25 @@ Tcl_GetsObj(chan, objPtr)
 
     /*
      * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
-     * produce ByteArray objects.  To avoid circularity problems,
-     * "iso8859-1" is builtin to Tcl.
+     * produce ByteArray objects.
      */
 
     if (encoding == NULL) {
-	encoding = Tcl_GetEncoding(NULL, "iso8859-1");
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+	if (tsdPtr->binaryEncoding == NULL) {
+	    tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+	    Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
+	}
+	encoding = tsdPtr->binaryEncoding;
+	if (encoding == NULL) {
+	    Tcl_Panic("attempted gets on binary channel where no iso8859-1 encoding available");
+	}
     }
 
     /*
-     * Object used by FilterInputBytes to keep track of how much data has
-     * been consumed from the channel buffers.
+     * Object used by FilterInputBytes to keep track of how much data has been
+     * consumed from the channel buffers.
      */
 
     gs.objPtr		= objPtr;
@@ -3665,10 +4089,10 @@ Tcl_GetsObj(chan, objPtr)
 	    }
 	    dstEnd = dst + gs.bytesWrote;
 	}
-	
+
 	/*
-	 * Remember if EOF char is seen, then look for EOL anyhow, because
-	 * the EOL might be before the EOF char.
+	 * Remember if EOF char is seen, then look for EOL anyhow, because the
+	 * EOL might be before the EOF char.
 	 */
 
 	if (inEofChar != '\0') {
@@ -3687,31 +4111,37 @@ Tcl_GetsObj(chan, objPtr)
 	 */
 
 	switch (statePtr->inputTranslation) {
-	    case TCL_TRANSLATE_LF: {
-		for (eol = dst; eol < dstEnd; eol++) {
-		    if (*eol == '\n') {
-			skip = 1;
-			goto goteol;
-		    }
+	case TCL_TRANSLATE_LF:
+	    for (eol = dst; eol < dstEnd; eol++) {
+		if (*eol == '\n') {
+		    skip = 1;
+		    goto gotEOL;
 		}
-		break;
 	    }
-	    case TCL_TRANSLATE_CR: {
-		for (eol = dst; eol < dstEnd; eol++) {
-		    if (*eol == '\r') {
-			skip = 1;
-			goto goteol;
-		    }
+	    break;
+	case TCL_TRANSLATE_CR:
+	    for (eol = dst; eol < dstEnd; eol++) {
+		if (*eol == '\r') {
+		    skip = 1;
+		    goto gotEOL;
 		}
-		break;
 	    }
-	    case TCL_TRANSLATE_CRLF: {
-		for (eol = dst; eol < dstEnd; eol++) {
-		    if (*eol == '\r') {
-			eol++;
-			if (eol >= dstEnd) {
-			    int offset;
-			    
+	    break;
+	case TCL_TRANSLATE_CRLF:
+	    for (eol = dst; eol < dstEnd; eol++) {
+		if (*eol == '\r') {
+		    eol++;
+
+		    /*
+		     * If a CR is at the end of the buffer, then check for a
+		     * LF at the begining of the next buffer, unless EOF char
+		     * was found already.
+		     */
+
+		    if (eol >= dstEnd) {
+			int offset;
+
+			if (eol != eof) {
 			    offset = eol - objPtr->bytes;
 			    dst = dstEnd;
 			    if (FilterInputBytes(chanPtr, &gs) != 0) {
@@ -3719,88 +4149,89 @@ Tcl_GetsObj(chan, objPtr)
 			    }
 			    dstEnd = dst + gs.bytesWrote;
 			    eol = objPtr->bytes + offset;
-			    if (eol >= dstEnd) {
-				skip = 0;
-				goto goteol;
-			    }
 			}
-			if (*eol == '\n') {
-			    eol--;
-			    skip = 2;
-			    goto goteol;
+			if (eol >= dstEnd) {
+			    skip = 0;
+			    goto gotEOL;
 			}
 		    }
+		    if (*eol == '\n') {
+			eol--;
+			skip = 2;
+			goto gotEOL;
+		    }
 		}
-		break;
 	    }
-	    case TCL_TRANSLATE_AUTO: {
-		eol = dst;
-		skip = 1;
-		if (statePtr->flags & INPUT_SAW_CR) {
-		    statePtr->flags &= ~INPUT_SAW_CR;
-		    if (*eol == '\n') {
-			/*
-			 * Skip the raw bytes that make up the '\n'.
-			 */
+	    break;
+	case TCL_TRANSLATE_AUTO:
+	    eol = dst;
+	    skip = 1;
+	    if (statePtr->flags & INPUT_SAW_CR) {
+		ResetFlag(statePtr, INPUT_SAW_CR);
+		if ((eol < dstEnd) && (*eol == '\n')) {
+		    /*
+		     * Skip the raw bytes that make up the '\n'.
+		     */
 
-			char tmp[1 + TCL_UTF_MAX];
-			int rawRead;
-
-			bufPtr = gs.bufPtr;
-			Tcl_ExternalToUtf(NULL, gs.encoding,
-				bufPtr->buf + bufPtr->nextRemoved,
-				gs.rawRead, statePtr->inputEncodingFlags,
-				&gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
-				NULL, NULL);
-			bufPtr->nextRemoved += rawRead;
-			gs.rawRead -= rawRead;
-			gs.bytesWrote--;
-			gs.charsWrote--;
-			memmove(dst, dst + 1, (size_t) (dstEnd - dst));
-			dstEnd--;
-		    }
+		    char tmp[1 + TCL_UTF_MAX];
+		    int rawRead;
+
+		    bufPtr = gs.bufPtr;
+		    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
+			    gs.rawRead, statePtr->inputEncodingFlags,
+			    &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
+			    NULL);
+		    bufPtr->nextRemoved += rawRead;
+		    gs.rawRead -= rawRead;
+		    gs.bytesWrote--;
+		    gs.charsWrote--;
+		    memmove(dst, dst + 1, (size_t) (dstEnd - dst));
+		    dstEnd--;
 		}
-		for (eol = dst; eol < dstEnd; eol++) {
-		    if (*eol == '\r') {
-			eol++;
-			if (eol == dstEnd) {
-			    /*
-			     * If buffer ended on \r, peek ahead to see if a
-			     * \n is available.
-			     */
+	    }
+	    for (eol = dst; eol < dstEnd; eol++) {
+		if (*eol == '\r') {
+		    eol++;
+		    if (eol == dstEnd) {
+			/*
+			 * If buffer ended on \r, peek ahead to see if a \n is
+			 * available, unless EOF char was found already.
+			 */
 
+			if (eol != eof) {
 			    int offset;
-			    
+
 			    offset = eol - objPtr->bytes;
 			    dst = dstEnd;
 			    PeekAhead(chanPtr, &dstEnd, &gs);
 			    eol = objPtr->bytes + offset;
-			    if (eol >= dstEnd) {
-				eol--;
-				statePtr->flags |= INPUT_SAW_CR;
-				goto goteol;
-			    }
 			}
-			if (*eol == '\n') {
-			    skip++;
+
+			if (eol >= dstEnd) {
+			    eol--;
+			    SetFlag(statePtr, INPUT_SAW_CR);
+			    goto gotEOL;
 			}
-			eol--;
-			goto goteol;
-		    } else if (*eol == '\n') {
-			goto goteol;
 		    }
+		    if (*eol == '\n') {
+			skip++;
+		    }
+		    eol--;
+		    goto gotEOL;
+		} else if (*eol == '\n') {
+		    goto gotEOL;
 		}
 	    }
 	}
 	if (eof != NULL) {
 	    /*
-	     * EOF character was seen.  On EOF, leave current file position
+	     * EOF character was seen. On EOF, leave current file position
 	     * pointing at the EOF character, but don't store the EOF
 	     * character in the output string.
 	     */
 
 	    dstEnd = eof;
-	    statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
 	if (statePtr->flags & CHANNEL_EOF) {
@@ -3813,29 +4244,31 @@ Tcl_GetsObj(chan, objPtr)
 		 */
 
 		Tcl_SetObjLength(objPtr, oldLength);
-		CommonGetsCleanup(chanPtr, encoding);
+		CommonGetsCleanup(chanPtr);
 		copiedTotal = -1;
 		goto done;
 	    }
-	    goto goteol;
+	    goto gotEOL;
 	}
 	dst = dstEnd;
     }
 
     /*
-     * Found EOL or EOF, but the output buffer may now contain too many
-     * UTF-8 characters.  We need to know how many raw bytes correspond to
-     * the number of UTF-8 characters we want, plus how many raw bytes
-     * correspond to the character(s) making up EOL (if any), so we can
-     * remove the correct number of bytes from the channel buffer.
+     * Found EOL or EOF, but the output buffer may now contain too many UTF-8
+     * characters. We need to know how many raw bytes correspond to the number
+     * of UTF-8 characters we want, plus how many raw bytes correspond to the
+     * character(s) making up EOL (if any), so we can remove the correct
+     * number of bytes from the channel buffer.
      */
-     
-    goteol:
+
+  gotEOL:
     bufPtr = gs.bufPtr;
+    if (bufPtr == NULL) {
+	Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
+    }
     statePtr->inputEncodingState = gs.state;
-    Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
-	    gs.rawRead, statePtr->inputEncodingFlags,
-	    &statePtr->inputEncodingState, dst,
+    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
+	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
 	    eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
 	    &gs.charsWrote);
     bufPtr->nextRemoved += gs.rawRead;
@@ -3845,25 +4278,28 @@ Tcl_GetsObj(chan, objPtr)
      */
 
     Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
-    CommonGetsCleanup(chanPtr, encoding);
-    statePtr->flags &= ~CHANNEL_BLOCKED;
+    CommonGetsCleanup(chanPtr);
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
     copiedTotal = gs.totalChars + gs.charsWrote - skip;
     goto done;
 
     /*
-     * Couldn't get a complete line.  This only happens if we get a error
-     * reading from the channel or we are non-blocking and there wasn't
-     * an EOL or EOF in the data available.
+     * Couldn't get a complete line. This only happens if we get a error
+     * reading from the channel or we are non-blocking and there wasn't an EOL
+     * or EOF in the data available.
      */
 
-    restore:
+  restore:
     bufPtr = statePtr->inQueueHead;
+    if (bufPtr == NULL) {
+	Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+    }
     bufPtr->nextRemoved = oldRemoved;
 
     for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
 	bufPtr->nextRemoved = BUFFER_PADDING;
     }
-    CommonGetsCleanup(chanPtr, encoding);
+    CommonGetsCleanup(chanPtr);
 
     statePtr->inputEncodingState = oldState;
     statePtr->inputEncodingFlags = oldFlags;
@@ -3871,66 +4307,336 @@ Tcl_GetsObj(chan, objPtr)
 
     /*
      * We didn't get a complete line so we need to indicate to UpdateInterest
-     * that the gets blocked.  It will wait for more data instead of firing
-     * a timer, avoiding a busy wait.  This is where we are assuming that the
-     * next operation is a gets.  No more file events will be delivered on 
-     * this channel until new data arrives or some operation is performed
-     * on the channel (e.g. gets, read, fconfigure) that changes the blocking
-     * state.  Note that this means a file event will not be delivered even
-     * though a read would be able to consume the buffered data.
+     * that the gets blocked. It will wait for more data instead of firing a
+     * timer, avoiding a busy wait. This is where we are assuming that the
+     * next operation is a gets. No more file events will be delivered on this
+     * channel until new data arrives or some operation is performed on the
+     * channel (e.g. gets, read, fconfigure) that changes the blocking state.
+     * Note that this means a file event will not be delivered even though a
+     * read would be able to consume the buffered data.
+     */
+
+    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+    copiedTotal = -1;
+
+    /*
+     * Update the notifier state so we don't block while there is still data
+     * in the buffers.
+     */
+
+  done:
+    UpdateInterest(chanPtr);
+    return copiedTotal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetsObjBinary --
+ *
+ *	A variation of Tcl_GetsObj that works directly on the buffers until
+ *	end-of-line or end-of-file has been seen. Bytes read from the input
+ *	channel return as a ByteArray obj.
+ *
+ * Results:
+ *	Number of characters accumulated in the object or -1 if error,
+ *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
+ *	code for the error or condition that occurred.
+ *
+ * Side effects:
+ *	Consumes input from the channel.
+ *
+ *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
+ *	leave channel pointing after EOL, but don't return EOL in dst buffer.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TclGetsObjBinary(
+    Tcl_Channel chan,		/* Channel from which to read. */
+    Tcl_Obj *objPtr)		/* The line read will be appended to this
+				 * object as UTF-8 characters. */
+{
+    Channel *chanPtr = (Channel *) chan;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+    ChannelBuffer *bufPtr;
+    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
+    int rawLen, byteLen, eolChar;
+    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;
+
+    /*
+     * This operation should occur at the top of a channel stack.
+     */
+
+    chanPtr = statePtr->topChanPtr;
+
+    bufPtr = statePtr->inQueueHead;
+
+    /*
+     * Preserved so we can restore the channel's state in case we don't find a
+     * newline in the available input.
+     */
+
+    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
+    oldFlags = statePtr->inputEncodingFlags;
+    oldRemoved = BUFFER_PADDING;
+    oldLength = byteLen;
+    if (bufPtr != NULL) {
+	oldRemoved = bufPtr->nextRemoved;
+    }
+
+    rawLen = 0;
+    skip = 0;
+    eof = NULL;
+    inEofChar = statePtr->inEofChar;
+    /* Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR */
+    eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
+
+    while (1) {
+	/*
+	 * Subtract the number of bytes that were removed from channel
+	 * buffer during last call.
+	 */
+
+	if (bufPtr != NULL) {
+	    bufPtr->nextRemoved += rawLen;
+	    if (!IsBufferReady(bufPtr)) {
+		bufPtr = bufPtr->nextPtr;
+	    }
+	}
+
+	if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
+	    /*
+	     * All channel buffers were exhausted and the caller still
+	     * hasn't seen EOL. Need to read more bytes from the channel
+	     * device. Side effect is to allocate another channel buffer.
+	     */
+
+	    if (statePtr->flags & CHANNEL_BLOCKED) {
+		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+		    goto restore;
+		}
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
+	    }
+	    if (GetInput(chanPtr) != 0) {
+		goto restore;
+	    }
+	    bufPtr = statePtr->inQueueTail;
+	}
+
+	dst = (unsigned char *) RemovePoint(bufPtr);
+	dstEnd = dst + BytesLeft(bufPtr);
+
+	/*
+	 * Remember if EOF char is seen, then look for EOL anyhow, because the
+	 * EOL might be before the EOF char.
+	 * XXX - in the binary case, consider coincident search for eol/eof.
+	 */
+
+	if (inEofChar != '\0') {
+	    for (eol = dst; eol < dstEnd; eol++) {
+		if (*eol == inEofChar) {
+		    dstEnd = eol;
+		    eof = eol;
+		    break;
+		}
+	    }
+	}
+
+	/*
+	 * On EOL, leave current file position pointing after the EOL, but
+	 * don't store the EOL in the output string.
+	 */
+
+	for (eol = dst; eol < dstEnd; eol++) {
+	    if (*eol == eolChar) {
+		skip = 1;
+		goto gotEOL;
+	    }
+	}
+	if (eof != NULL) {
+	    /*
+	     * EOF character was seen. On EOF, leave current file position
+	     * pointing at the EOF character, but don't store the EOF
+	     * character in the output string.
+	     */
+
+	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
+	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+	}
+	if (statePtr->flags & CHANNEL_EOF) {
+	    skip = 0;
+	    eol = dstEnd;
+	    if ((dst == dstEnd) && (byteLen == oldLength)) {
+		/*
+		 * If we didn't append any bytes before encountering EOF,
+		 * caller needs to see -1.
+		 */
+
+		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
+		CommonGetsCleanup(chanPtr);
+		copiedTotal = -1;
+		goto done;
+	    }
+	    goto gotEOL;
+	}
+
+	/*
+	 * Copy bytes from the channel buffer to the ByteArray.
+	 * This may realloc space, so keep track of result.
+	 */
+
+	rawLen = dstEnd - dst;
+	byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
+	memcpy(byteArray + byteLen, dst, (size_t) rawLen);
+	byteLen += rawLen;
+    }
+
+    /*
+     * Found EOL or EOF, but the output buffer may now contain too many bytes.
+     * We need to know how many bytes correspond to the number we want, so we
+     * can remove the correct number of bytes from the channel buffer.
+     */
+
+  gotEOL:
+    if (bufPtr == NULL) {
+	Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL");
+    }
+
+    rawLen = eol - dst;
+    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
+    memcpy(byteArray + byteLen, dst, (size_t) rawLen);
+    byteLen += rawLen;
+    bufPtr->nextRemoved += rawLen + skip;
+
+    /*
+     * Convert the buffer if there was an encoding.
+     * XXX - unimplemented.
+     */
+
+    if (statePtr->encoding != NULL) {
+    }
+
+    /*
+     * Recycle all the emptied buffers.
+     */
+
+    CommonGetsCleanup(chanPtr);
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
+    copiedTotal = byteLen;
+    goto done;
+
+    /*
+     * Couldn't get a complete line. This only happens if we get a error
+     * reading from the channel or we are non-blocking and there wasn't an EOL
+     * or EOF in the data available.
+     */
+
+  restore:
+    bufPtr = statePtr->inQueueHead;
+    if (bufPtr == NULL) {
+	Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+    }
+    bufPtr->nextRemoved = oldRemoved;
+
+    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+	bufPtr->nextRemoved = BUFFER_PADDING;
+    }
+    CommonGetsCleanup(chanPtr);
+
+    statePtr->inputEncodingFlags = oldFlags;
+    byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
+
+    /*
+     * We didn't get a complete line so we need to indicate to UpdateInterest
+     * that the gets blocked. It will wait for more data instead of firing a
+     * timer, avoiding a busy wait. This is where we are assuming that the
+     * next operation is a gets. No more file events will be delivered on this
+     * channel until new data arrives or some operation is performed on the
+     * channel (e.g. gets, read, fconfigure) that changes the blocking state.
+     * Note that this means a file event will not be delivered even though a
+     * read would be able to consume the buffered data.
      */
 
-    statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
     copiedTotal = -1;
 
-    done:
     /*
-     * Update the notifier state so we don't block while there is still
-     * data in the buffers.
+     * Update the notifier state so we don't block while there is still data
+     * in the buffers.
      */
 
+  done:
     UpdateInterest(chanPtr);
     return copiedTotal;
 }
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FreeBinaryEncoding --
+ *
+ *	Frees any "iso8859-1" Tcl_Encoding created by [gets] on a binary
+ *	channel in a thread as part of that thread's finalization.
+ *
+ * Results:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
 
+static void
+FreeBinaryEncoding(
+    ClientData dummy)	/* Not used */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (tsdPtr->binaryEncoding != NULL) {
+	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
+	tsdPtr->binaryEncoding = NULL;
+    }
+}
+
 /*
  *---------------------------------------------------------------------------
  *
  * FilterInputBytes --
  *
- *	Helper function for Tcl_GetsObj.  Produces UTF-8 characters from
- *	raw bytes read from the channel.  
+ *	Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw
+ *	bytes read from the channel.
  *
- *	Consumes available bytes from channel buffers.  When channel
- *	buffers are exhausted, reads more bytes from channel device into
- *	a new channel buffer.  It is the caller's responsibility to
- *	free the channel buffers that have been exhausted.
+ *	Consumes available bytes from channel buffers. When channel buffers
+ *	are exhausted, reads more bytes from channel device into a new channel
+ *	buffer. It is the caller's responsibility to free the channel buffers
+ *	that have been exhausted.
  *
  * Results:
- *	The return value is -1 if there was an error reading from the
- *	channel, 0 otherwise.
+ *	The return value is -1 if there was an error reading from the channel,
+ *	0 otherwise.
  *
  * Side effects:
- *	Status object keeps track of how much data from channel buffers
- *	has been consumed and where UTF-8 bytes should be stored.
+ *	Status object keeps track of how much data from channel buffers has
+ *	been consumed and where UTF-8 bytes should be stored.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 static int
-FilterInputBytes(chanPtr, gsPtr)
-    Channel *chanPtr;		/* Channel to read. */
-    GetsState *gsPtr;		/* Current state of gets operation. */
+FilterInputBytes(
+    Channel *chanPtr,		/* Channel to read. */
+    GetsState *gsPtr)		/* Current state of gets operation. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
-    char *raw, *rawStart, *rawEnd;
-    char *dst;
-    int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
+    char *raw, *rawStart, *dst;
+    int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
     Tcl_Obj *objPtr;
-#define ENCODING_LINESIZE   20	/* Lower bound on how many bytes to convert
-				 * at a time.  Since we don't know a priori
-				 * how many bytes of storage this many source
+#define ENCODING_LINESIZE 20	/* Lower bound on how many bytes to convert at
+				 * a time. Since we don't know a priori how
+				 * many bytes of storage this many source
 				 * bytes will use, we actually need at least
 				 * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
 				 * room. */
@@ -3945,7 +4651,7 @@ FilterInputBytes(chanPtr, gsPtr)
     bufPtr = gsPtr->bufPtr;
     if (bufPtr != NULL) {
 	bufPtr->nextRemoved += gsPtr->rawRead;
-	if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
+	if (!IsBufferReady(bufPtr)) {
 	    bufPtr = bufPtr->nextPtr;
 	}
     }
@@ -3953,20 +4659,20 @@ FilterInputBytes(chanPtr, gsPtr)
 
     if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
 	/*
-	 * All channel buffers were exhausted and the caller still hasn't
-	 * seen EOL.  Need to read more bytes from the channel device.
-	 * Side effect is to allocate another channel buffer.
+	 * All channel buffers were exhausted and the caller still hasn't seen
+	 * EOL. Need to read more bytes from the channel device. Side effect
+	 * is to allocate another channel buffer.
 	 */
 
-	read:
-        if (statePtr->flags & CHANNEL_BLOCKED) {
-            if (statePtr->flags & CHANNEL_NONBLOCKING) {
+    read:
+	if (statePtr->flags & CHANNEL_BLOCKED) {
+	    if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		gsPtr->charsWrote = 0;
 		gsPtr->rawRead = 0;
 		return -1;
 	    }
-            statePtr->flags &= ~CHANNEL_BLOCKED;
-        }
+	    ResetFlag(statePtr, CHANNEL_BLOCKED);
+	}
 	if (GetInput(chanPtr) != 0) {
 	    gsPtr->charsWrote = 0;
 	    gsPtr->rawRead = 0;
@@ -3977,15 +4683,14 @@ FilterInputBytes(chanPtr, gsPtr)
     }
 
     /*
-     * Convert some of the bytes from the channel buffer to UTF-8.  Space in
-     * objPtr's string rep is used to hold the UTF-8 characters.  Grow the
+     * Convert some of the bytes from the channel buffer to UTF-8. Space in
+     * objPtr's string rep is used to hold the UTF-8 characters. Grow the
      * string rep if we need more space.
      */
 
-    rawStart = bufPtr->buf + bufPtr->nextRemoved;
+    rawStart = RemovePoint(bufPtr);
     raw = rawStart;
-    rawEnd = bufPtr->buf + bufPtr->nextAdded;
-    rawLen = rawEnd - rawStart;
+    rawLen = BytesLeft(bufPtr);
 
     dst = *gsPtr->dstPtr;
     offset = dst - objPtr->bytes;
@@ -3993,15 +4698,19 @@ FilterInputBytes(chanPtr, gsPtr)
     if (toRead > rawLen) {
 	toRead = rawLen;
     }
-    dstNeeded = toRead * TCL_UTF_MAX + 1;
-    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+    dstNeeded = toRead * TCL_UTF_MAX;
+    spaceLeft = objPtr->length - offset;
     if (dstNeeded > spaceLeft) {
-	length = offset * 2;
-	if (offset < dstNeeded) {
+	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+
+	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
 	    length = offset + dstNeeded;
+	    if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+		dstNeeded = TCL_UTF_MAX - 1 + toRead;
+		length = offset + dstNeeded;
+		Tcl_SetObjLength(objPtr, length);
+	    }
 	}
-	length += TCL_UTF_MAX + 1;
-	Tcl_SetObjLength(objPtr, length);
 	spaceLeft = length - offset;
 	dst = objPtr->bytes + offset;
 	*gsPtr->dstPtr = dst;
@@ -4009,44 +4718,45 @@ FilterInputBytes(chanPtr, gsPtr)
     gsPtr->state = statePtr->inputEncodingState;
     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
 	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-	    dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
+	    dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
 	    &gsPtr->charsWrote);
 
     /*
      * Make sure that if we go through 'gets', that we reset the
-     * TCL_ENCODING_START flag still.  [Bug #523988]
+     * TCL_ENCODING_START flag still. [Bug #523988]
      */
+
     statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
 
     if (result == TCL_CONVERT_MULTIBYTE) {
 	/*
 	 * The last few bytes in this channel buffer were the start of a
-	 * multibyte sequence.  If this buffer was full, then move them to
-	 * the next buffer so the bytes will be contiguous.  
+	 * multibyte sequence. If this buffer was full, then move them to the
+	 * next buffer so the bytes will be contiguous.
 	 */
 
 	ChannelBuffer *nextPtr;
 	int extra;
-	
+
 	nextPtr = bufPtr->nextPtr;
-	if (bufPtr->nextAdded < bufPtr->bufLength) {
+	if (!IsBufferFull(bufPtr)) {
 	    if (gsPtr->rawRead > 0) {
 		/*
-		 * Some raw bytes were converted to UTF-8.  Fall through,
+		 * Some raw bytes were converted to UTF-8. Fall through,
 		 * returning those UTF-8 characters because a EOL might be
 		 * present in them.
 		 */
 	    } else if (statePtr->flags & CHANNEL_EOF) {
 		/*
 		 * There was a partial character followed by EOF on the
-		 * device.  Fall through, returning that nothing was found.
+		 * device. Fall through, returning that nothing was found.
 		 */
 
 		bufPtr->nextRemoved = bufPtr->nextAdded;
 	    } else {
 		/*
-		 * There are no more cached raw bytes left.  See if we can
-		 * get some more.
+		 * There are no more cached raw bytes left. See if we can get
+		 * some more.
 		 */
 
 		goto read;
@@ -4058,8 +4768,8 @@ FilterInputBytes(chanPtr, gsPtr)
 		statePtr->inQueueTail = nextPtr;
 	    }
 	    extra = rawLen - gsPtr->rawRead;
-	    memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
-		    (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
+	    memcpy(nextPtr->buf + BUFFER_PADDING - extra,
+		    raw + gsPtr->rawRead, (size_t) extra);
 	    nextPtr->nextRemoved -= extra;
 	    bufPtr->nextAdded -= extra;
 	}
@@ -4074,9 +4784,9 @@ FilterInputBytes(chanPtr, gsPtr)
  *
  * PeekAhead --
  *
- *	Helper function used by Tcl_GetsObj().  Called when we've seen a
- *	\r at the end of the UTF-8 string and want to look ahead one
- *	character to see if it is a \n.
+ *	Helper function used by Tcl_GetsObj(). Called when we've seen a \r at
+ *	the end of the UTF-8 string and want to look ahead one character to
+ *	see if it is a \n.
  *
  * Results:
  *	*gsPtr->dstPtr is filled with a pointer to the start of the range of
@@ -4092,13 +4802,14 @@ FilterInputBytes(chanPtr, gsPtr)
  */
 
 static void
-PeekAhead(chanPtr, dstEndPtr, gsPtr)
-    Channel *chanPtr;		/* The channel to read. */
-    char **dstEndPtr;		/* Filled with pointer to end of new range
-				 * of UTF-8 characters. */
-    GetsState *gsPtr;		/* Current state of gets operation. */
+PeekAhead(
+    Channel *chanPtr,		/* The channel to read. */
+    char **dstEndPtr,		/* Filled with pointer to end of new range of
+				 * UTF-8 characters. */
+    GetsState *gsPtr)		/* Current state of gets operation. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
     Tcl_DriverBlockModeProc *blockModeProc;
     int bytesLeft;
@@ -4107,21 +4818,21 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
 
     /*
      * If there's any more raw input that's still buffered, we'll peek into
-     * that.  Otherwise, only get more data from the channel driver if it
-     * looks like there might actually be more data.  The assumption is that
-     * if the channel buffer is filled right up to the end, then there
-     * might be more data to read.
+     * that. Otherwise, only get more data from the channel driver if it looks
+     * like there might actually be more data. The assumption is that if the
+     * channel buffer is filled right up to the end, then there might be more
+     * data to read.
      */
 
     blockModeProc = NULL;
     if (bufPtr->nextPtr == NULL) {
-	bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
+	bytesLeft = BytesLeft(bufPtr) - gsPtr->rawRead;
 	if (bytesLeft == 0) {
-	    if (bufPtr->nextAdded < bufPtr->bufLength) {
+	    if (!IsBufferFull(bufPtr)) {
 		/*
 		 * Don't peek ahead if last read was short read.
 		 */
-		 
+
 		goto cleanup;
 	    }
 	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
@@ -4145,7 +4856,7 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
     }
     return;
 
-    cleanup:
+  cleanup:
     bufPtr->nextRemoved += gsPtr->rawRead;
     gsPtr->rawRead = 0;
     gsPtr->totalChars += gsPtr->charsWrote;
@@ -4158,8 +4869,8 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
  *
  * CommonGetsCleanup --
  *
- *	Helper function for Tcl_GetsObj() to restore the channel after
- *	a "gets" operation.
+ *	Helper function for Tcl_GetsObj() to restore the channel after a
+ *	"gets" operation.
  *
  * Results:
  *	None.
@@ -4169,19 +4880,19 @@ PeekAhead(chanPtr, dstEndPtr, gsPtr)
  *
  *---------------------------------------------------------------------------
  */
- 
+
 static void
-CommonGetsCleanup(chanPtr, encoding)
-    Channel *chanPtr;
-    Tcl_Encoding encoding;
+CommonGetsCleanup(
+    Channel *chanPtr)
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr, *nextPtr;
-    
+
     bufPtr = statePtr->inQueueHead;
     for ( ; bufPtr != NULL; bufPtr = nextPtr) {
 	nextPtr = bufPtr->nextPtr;
-	if (bufPtr->nextRemoved < bufPtr->nextAdded) {
+	if (IsBufferReady(bufPtr)) {
 	    break;
 	}
 	RecycleBuffer(statePtr, bufPtr, 0);
@@ -4193,20 +4904,20 @@ CommonGetsCleanup(chanPtr, encoding)
 	/*
 	 * If any multi-byte characters were split across channel buffer
 	 * boundaries, the split-up bytes were moved to the next channel
-	 * buffer by FilterInputBytes().  Move the bytes back to their
-	 * original buffer because the caller could change the channel's
-	 * encoding which could change the interpretation of whether those
-	 * bytes really made up multi-byte characters after all.
+	 * buffer by FilterInputBytes(). Move the bytes back to their original
+	 * buffer because the caller could change the channel's encoding which
+	 * could change the interpretation of whether those bytes really made
+	 * up multi-byte characters after all.
 	 */
-	 
+
 	nextPtr = bufPtr->nextPtr;
 	for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
 	    int extra;
 
-	    extra = bufPtr->bufLength - bufPtr->nextAdded;
+	    extra = SpaceLeft(bufPtr);
 	    if (extra > 0) {
-		memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
-			(VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
+		memcpy(InsertPoint(bufPtr),
+			nextPtr->buf + BUFFER_PADDING - extra,
 			(size_t) extra);
 		bufPtr->nextAdded += extra;
 		nextPtr->nextRemoved = BUFFER_PADDING;
@@ -4214,9 +4925,6 @@ CommonGetsCleanup(chanPtr, encoding)
 	    bufPtr = nextPtr;
 	}
     }
-    if (statePtr->encoding == NULL) {
-	Tcl_FreeEncoding(encoding);
-    }
 }
 
 /*
@@ -4224,16 +4932,16 @@ CommonGetsCleanup(chanPtr, encoding)
  *
  * Tcl_Read --
  *
- *	Reads a given number of bytes from a channel.  EOL and EOF
- *	translation is done on the bytes being read, so the the number
- *	of bytes consumed from the channel may not be equal to the
- *	number of bytes stored in the destination buffer.
+ *	Reads a given number of bytes from a channel. EOL and EOF translation
+ *	is done on the bytes being read, so the number of bytes consumed from
+ *	the channel may not be equal to the number of bytes stored in the
+ *	destination buffer.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
  * Results:
- *	The number of bytes read, or -1 on error. Use Tcl_GetErrno()
- *	to retrieve the error code for the error that occurred.
+ *	The number of bytes read, or -1 on error. Use Tcl_GetErrno() to
+ *	retrieve the error code for the error that occurred.
  *
  * Side effects:
  *	May cause input to be buffered.
@@ -4242,13 +4950,14 @@ CommonGetsCleanup(chanPtr, encoding)
  */
 
 int
-Tcl_Read(chan, dst, bytesToRead)
-    Tcl_Channel chan;		/* The channel from which to read. */
-    char *dst;			/* Where to store input read. */
-    int bytesToRead;		/* Maximum number of bytes to read. */
+Tcl_Read(
+    Tcl_Channel chan,		/* The channel from which to read. */
+    char *dst,			/* Where to store input read. */
+    int bytesToRead)		/* Maximum number of bytes to read. */
 {
-    Channel *chanPtr = (Channel *) chan;		
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    Channel *chanPtr = (Channel *) chan;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
 
     /*
      * This operation should occur at the top of a channel stack.
@@ -4268,16 +4977,16 @@ Tcl_Read(chan, dst, bytesToRead)
  *
  * Tcl_ReadRaw --
  *
- *	Reads a given number of bytes from a channel.  EOL and EOF
- *	translation is done on the bytes being read, so the the number
- *	of bytes consumed from the channel may not be equal to the
- *	number of bytes stored in the destination buffer.
+ *	Reads a given number of bytes from a channel. EOL and EOF translation
+ *	is done on the bytes being read, so the number of bytes consumed from
+ *	the channel may not be equal to the number of bytes stored in the
+ *	destination buffer.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
  * Results:
- *	The number of bytes read, or -1 on error. Use Tcl_GetErrno()
- *	to retrieve the error code for the error that occurred.
+ *	The number of bytes read, or -1 on error. Use Tcl_GetErrno() to
+ *	retrieve the error code for the error that occurred.
  *
  * Side effects:
  *	May cause input to be buffered.
@@ -4286,22 +4995,22 @@ Tcl_Read(chan, dst, bytesToRead)
  */
 
 int
-Tcl_ReadRaw(chan, bufPtr, bytesToRead)
-    Tcl_Channel chan;		/* The channel from which to read. */
-    char *bufPtr;		/* Where to store input read. */
-    int bytesToRead;		/* Maximum number of bytes to read. */
+Tcl_ReadRaw(
+    Tcl_Channel chan,		/* The channel from which to read. */
+    char *bufPtr,		/* Where to store input read. */
+    int bytesToRead)		/* Maximum number of bytes to read. */
 {
-    Channel *chanPtr = (Channel *) chan;		
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
-    int nread, result;
-    int copied, copiedNow;
+    Channel *chanPtr = (Channel *) chan;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+    int nread, result, copied, copiedNow;
 
     /*
      * The check below does too much because it will reject a call to this
      * function with a channel which is part of an 'fcopy'. But we have to
-     * allow this here or else the chaining in the transformation drivers
-     * will fail with 'file busy' error instead of retrieving and
-     * transforming the data to copy.
+     * allow this here or else the chaining in the transformation drivers will
+     * fail with 'file busy' error instead of retrieving and transforming the
+     * data to copy.
      *
      * We let the check procedure now believe that there is no fcopy in
      * progress. A better solution than this might be an additional flag
@@ -4313,102 +5022,113 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
     }
 
     /*
-     * Check for information in the push-back buffers. If there is
-     * some, use it. Go to the driver only if there is none (anymore)
-     * and the caller requests more bytes.
+     * Check for information in the push-back buffers. If there is some, use
+     * it. Go to the driver only if there is none (anymore) and the caller
+     * requests more bytes.
      */
 
     for (copied = 0; copied < bytesToRead; copied += copiedNow) {
-        copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
-                bytesToRead - copied);
-        if (copiedNow == 0) {
-            if (statePtr->flags & CHANNEL_EOF) {
+	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
+		bytesToRead - copied);
+	if (copiedNow == 0) {
+	    if (statePtr->flags & CHANNEL_EOF) {
 		goto done;
-            }
-            if (statePtr->flags & CHANNEL_BLOCKED) {
-                if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    }
+	    if (statePtr->flags & CHANNEL_BLOCKED) {
+		if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    goto done;
-                }
-                statePtr->flags &= (~(CHANNEL_BLOCKED));
-            }
+		}
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
+	    }
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	    /* [SF Tcl Bug 943274]. Better emulation of non-blocking
-	     * channels for channels without BlockModeProc, by keeping
-	     * track of true fileevents generated by the OS == Data
-	     * waiting and reading if and only if we are sure to have
-	     * data.
+	    /*
+	     * [Bug 943274]. Better emulation of non-blocking channels for
+	     * channels without BlockModeProc, by keeping track of true
+	     * fileevents generated by the OS == Data waiting and reading if
+	     * and only if we are sure to have data.
 	     */
 
 	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+		/*
+		 * We bypass the driver; it would block as no data is
+		 * available.
+		 */
 
-	        /* We bypass the driver, it would block, as no data is available */
-	        nread  = -1;
-	        result = EWOULDBLOCK;
+		nread = -1;
+		result = EWOULDBLOCK;
 	    } else {
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-	      /*
-	       * Now go to the driver to get as much as is possible to
-	       * fill the remaining request. Do all the error handling
-	       * by ourselves.  The code was stolen from 'GetInput' and
-	       * slightly adapted (different return value here).
-	       *
-	       * The case of 'bytesToRead == 0' at this point cannot happen.
-	       */
-
-	      nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
-			  bufPtr + copied, bytesToRead - copied, &result);
+
+		/*
+		 * Now go to the driver to get as much as is possible to fill
+		 * the remaining request. Do all the error handling by
+		 * ourselves. The code was stolen from 'GetInput' and slightly
+		 * adapted (different return value here).
+		 *
+		 * The case of 'bytesToRead == 0' at this point cannot happen.
+		 */
+
+		nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+			bufPtr + copied, bytesToRead - copied, &result);
+
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	    }
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
+
 	    if (nread > 0) {
-	        /*
-		 * If we get a short read, signal up that we may be
-		 * BLOCKED. We should avoid calling the driver because
-		 * on some platforms we will block in the low level
-		 * reading code even though the channel is set into
-		 * nonblocking mode.
+		/*
+		 * If we get a short read, signal up that we may be BLOCKED.
+		 * We should avoid calling the driver because on some
+		 * platforms we will block in the low level reading code even
+		 * though the channel is set into nonblocking mode.
 		 */
-            
-	        if (nread < (bytesToRead - copied)) {
-		    statePtr->flags |= CHANNEL_BLOCKED;
+
+		if (nread < (bytesToRead - copied)) {
+		    SetFlag(statePtr, CHANNEL_BLOCKED);
 		}
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	        if (nread <= (bytesToRead - copied)) {
-		    /* [SF Tcl Bug 943274] We have read the available
-		     * data, clear flag */
-		    statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+		if (nread <= (bytesToRead - copied)) {
+		    /*
+		     * [Bug 943274] We have read the available data, clear
+		     * flag.
+		     */
+
+		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
 		}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
+
 	    } else if (nread == 0) {
-	        statePtr->flags |= CHANNEL_EOF;
+		SetFlag(statePtr, CHANNEL_EOF);
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+
 	    } else if (nread < 0) {
-	        if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+		if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
 		    if (copied > 0) {
-		      /*
-		       * Information that was copied earlier has precedence
-		       * over EAGAIN/WOULDBLOCK handling.
-		       */
-		      return copied;
+			/*
+			 * Information that was copied earlier has precedence
+			 * over EAGAIN/WOULDBLOCK handling.
+			 */
+
+			return copied;
 		    }
 
-		    statePtr->flags |= CHANNEL_BLOCKED;
+		    SetFlag(statePtr, CHANNEL_BLOCKED);
 		    result = EAGAIN;
 		}
 
 		Tcl_SetErrno(result);
 		return -1;
-	    } 
+	    }
 
 	    return copied + nread;
-        }
+	}
     }
 
-done:
+  done:
     return copied;
 }
 
@@ -4417,39 +5137,39 @@ done:
  *
  * Tcl_ReadChars --
  *
- *	Reads from the channel until the requested number of characters
- *	have been seen, EOF is seen, or the channel would block.  EOL
- *	and EOF translation is done.  If reading binary data, the raw
- *	bytes are wrapped in a Tcl byte array object.  Otherwise, the raw
- *	bytes are converted to UTF-8 using the channel's current encoding
- *	and stored in a Tcl string object.
+ *	Reads from the channel until the requested number of characters have
+ *	been seen, EOF is seen, or the channel would block. EOL and EOF
+ *	translation is done. If reading binary data, the raw bytes are wrapped
+ *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
+ *	UTF-8 using the channel's current encoding and stored in a Tcl string
+ *	object.
  *
  * Results:
- *	The number of characters read, or -1 on error. Use Tcl_GetErrno()
- *	to retrieve the error code for the error that occurred.
+ *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
+ *	retrieve the error code for the error that occurred.
  *
  * Side effects:
  *	May cause input to be buffered.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 int
-Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
-    Tcl_Channel chan;		/* The channel to read. */
-    Tcl_Obj *objPtr;		/* Input data is stored in this object. */
-    int toRead;			/* Maximum number of characters to store,
-				 * or -1 to read all available data (up to EOF
-				 * or when channel blocks). */
-    int appendFlag;		/* If non-zero, data read from the channel
-				 * will be appended to the object.  Otherwise,
+Tcl_ReadChars(
+    Tcl_Channel chan,		/* The channel to read. */
+    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
+    int toRead,			/* Maximum number of characters to store, or
+				 * -1 to read all available data (up to EOF or
+				 * when channel blocks). */
+    int appendFlag)		/* If non-zero, data read from the channel
+				 * will be appended to the object. Otherwise,
 				 * the data will replace the existing contents
 				 * of the object. */
-
 {
-    Channel*      chanPtr  = (Channel *) chan;
-    ChannelState* statePtr = chanPtr->state;	/* state info for channel */
-    
+    Channel *chanPtr = (Channel *) chan;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+
     /*
      * This operation should occur at the top of a channel stack.
      */
@@ -4457,52 +5177,53 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
     chanPtr = statePtr->topChanPtr;
 
     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
-        /*
+	/*
 	 * Update the notifier state so we don't block while there is still
 	 * data in the buffers.
 	 */
-        UpdateInterest(chanPtr);
+
+	UpdateInterest(chanPtr);
 	return -1;
     }
 
-    return DoReadChars (chanPtr, objPtr, toRead, appendFlag);
+    return DoReadChars(chanPtr, objPtr, toRead, appendFlag);
 }
 /*
  *---------------------------------------------------------------------------
  *
  * DoReadChars --
  *
- *	Reads from the channel until the requested number of characters
- *	have been seen, EOF is seen, or the channel would block.  EOL
- *	and EOF translation is done.  If reading binary data, the raw
- *	bytes are wrapped in a Tcl byte array object.  Otherwise, the raw
- *	bytes are converted to UTF-8 using the channel's current encoding
- *	and stored in a Tcl string object.
+ *	Reads from the channel until the requested number of characters have
+ *	been seen, EOF is seen, or the channel would block. EOL and EOF
+ *	translation is done. If reading binary data, the raw bytes are wrapped
+ *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
+ *	UTF-8 using the channel's current encoding and stored in a Tcl string
+ *	object.
  *
  * Results:
- *	The number of characters read, or -1 on error. Use Tcl_GetErrno()
- *	to retrieve the error code for the error that occurred.
+ *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
+ *	retrieve the error code for the error that occurred.
  *
  * Side effects:
  *	May cause input to be buffered.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 static int
-DoReadChars(chanPtr, objPtr, toRead, appendFlag)
-    Channel* chanPtr;		/* The channel to read. */
-    Tcl_Obj *objPtr;		/* Input data is stored in this object. */
-    int toRead;			/* Maximum number of characters to store,
-				 * or -1 to read all available data (up to EOF
-				 * or when channel blocks). */
-    int appendFlag;		/* If non-zero, data read from the channel
-				 * will be appended to the object.  Otherwise,
+DoReadChars(
+    Channel *chanPtr,		/* The channel to read. */
+    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
+    int toRead,			/* Maximum number of characters to store, or
+				 * -1 to read all available data (up to EOF or
+				 * when channel blocks). */
+    int appendFlag)		/* If non-zero, data read from the channel
+				 * will be appended to the object. Otherwise,
 				 * the data will replace the existing contents
 				 * of the object. */
-
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelBuffer *bufPtr;
     int offset, factor, copied, copiedNow, result;
     Tcl_Encoding encoding;
@@ -4512,28 +5233,30 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
      * This operation should occur at the top of a channel stack.
      */
 
-    chanPtr  = statePtr->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
     encoding = statePtr->encoding;
-    factor   = UTF_EXPANSION_FACTOR;
+    factor = UTF_EXPANSION_FACTOR;
 
     if (appendFlag == 0) {
 	if (encoding == NULL) {
 	    Tcl_SetByteArrayLength(objPtr, 0);
 	} else {
 	    Tcl_SetObjLength(objPtr, 0);
-	    /* 
-	     * We're going to access objPtr->bytes directly, so
-	     * we must ensure that this is actually a string
-	     * object (otherwise it might have been pure Unicode).
+
+	    /*
+	     * We're going to access objPtr->bytes directly, so we must ensure
+	     * that this is actually a string object (otherwise it might have
+	     * been pure Unicode).
 	     */
-	    Tcl_GetString(objPtr);
+
+	    TclGetString(objPtr);
 	}
 	offset = 0;
     } else {
 	if (encoding == NULL) {
 	    Tcl_GetByteArrayFromObj(objPtr, &offset);
 	} else {
-	    Tcl_GetStringFromObj(objPtr, &offset);
+	    TclGetStringFromObj(objPtr, &offset);
 	}
     }
 
@@ -4552,7 +5275,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
 	     */
 
 	    bufPtr = statePtr->inQueueHead;
-	    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+	    if (IsBufferEmpty(bufPtr)) {
 		ChannelBuffer *nextPtr;
 
 		nextPtr = bufPtr->nextPtr;
@@ -4563,6 +5286,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
 		}
 	    }
 	}
+
 	if (copiedNow < 0) {
 	    if (statePtr->flags & CHANNEL_EOF) {
 		break;
@@ -4571,7 +5295,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
 		if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    break;
 		}
-		statePtr->flags &= ~CHANNEL_BLOCKED;
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
 	    if (result != 0) {
@@ -4586,41 +5310,42 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
 	    toRead -= copiedNow;
 	}
     }
-    statePtr->flags &= ~CHANNEL_BLOCKED;
+
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
     if (encoding == NULL) {
 	Tcl_SetByteArrayLength(objPtr, offset);
     } else {
 	Tcl_SetObjLength(objPtr, offset);
     }
 
-    done:
     /*
-     * Update the notifier state so we don't block while there is still
-     * data in the buffers.
+     * Update the notifier state so we don't block while there is still data
+     * in the buffers.
      */
 
+  done:
     UpdateInterest(chanPtr);
     return copied;
 }
+
 /*
  *---------------------------------------------------------------------------
  *
  * ReadBytes --
  *
- *	Reads from the channel until the requested number of bytes have
- *	been seen, EOF is seen, or the channel would block.  Bytes from
- *	the channel are stored in objPtr as a ByteArray object.  EOL
- *	and EOF translation are done.
+ *	Reads from the channel until the requested number of bytes have been
+ *	seen, EOF is seen, or the channel would block. Bytes from the channel
+ *	are stored in objPtr as a ByteArray object. EOL and EOF translation
+ *	are done.
  *
- *	'bytesToRead' can safely be a very large number because
- *	space is only allocated to hold data read from the channel
- *	as needed.
+ *	'bytesToRead' can safely be a very large number because space is only
+ *	allocated to hold data read from the channel as needed.
  *
  * Results:
- *	The return value is the number of bytes appended to the object
- *	and *offsetPtr is filled with the total number of bytes in the
- *	object (greater than the return value if there were already bytes
- *	in the object).
+ *	The return value is the number of bytes appended to the object and
+ *	*offsetPtr is filled with the total number of bytes in the object
+ *	(greater than the return value if there were already bytes in the
+ *	object).
  *
  * Side effects:
  *	None.
@@ -4629,25 +5354,24 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
  */
 
 static int
-ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
-    ChannelState *statePtr;	/* State of the channel to read. */
-    Tcl_Obj *objPtr;		/* Input data is appended to this ByteArray
-				 * object.  Its length is how much space
-				 * has been allocated to hold data, not how
-				 * many bytes of data have been stored in the
+ReadBytes(
+    ChannelState *statePtr,	/* State of the channel to read. */
+    Tcl_Obj *objPtr,		/* Input data is appended to this ByteArray
+				 * object. Its length is how much space has
+				 * been allocated to hold data, not how many
+				 * bytes of data have been stored in the
 				 * object. */
-    int bytesToRead;		/* Maximum number of bytes to store,
-				 * or < 0 to get all available bytes.
-				 * Bytes are obtained from the first
-				 * buffer in the queue -- even if this number
-				 * is larger than the number of bytes
-				 * available in the first buffer, only the
-				 * bytes from the first buffer are
+    int bytesToRead,		/* Maximum number of bytes to store, or < 0 to
+				 * get all available bytes. Bytes are obtained
+				 * from the first buffer in the queue - even
+				 * if this number is larger than the number of
+				 * bytes available in the first buffer, only
+				 * the bytes from the first buffer are
 				 * returned. */
-    int *offsetPtr;		/* On input, contains how many bytes of
-				 * objPtr have been used to hold data.  On
-				 * output, filled with how many bytes are now
-				 * being used. */
+    int *offsetPtr)		/* On input, contains how many bytes of objPtr
+				 * have been used to hold data. On output,
+				 * filled with how many bytes are now being
+				 * used. */
 {
     int toRead, srcLen, offset, length, srcRead, dstWrote;
     ChannelBuffer *bufPtr;
@@ -4655,9 +5379,9 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
 
     offset = *offsetPtr;
 
-    bufPtr = statePtr->inQueueHead; 
-    src = bufPtr->buf + bufPtr->nextRemoved;
-    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+    bufPtr = statePtr->inQueueHead;
+    src = RemovePoint(bufPtr);
+    srcLen = BytesLeft(bufPtr);
 
     toRead = bytesToRead;
     if ((unsigned) toRead > (unsigned) srcLen) {
@@ -4667,9 +5391,9 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
     dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
     if (toRead > length - offset - 1) {
 	/*
-	 * Double the existing size of the object or make enough room to
-	 * hold all the characters we may get from the source buffer,
-	 * whichever is larger.
+	 * Double the existing size of the object or make enough room to hold
+	 * all the characters we may get from the source buffer, whichever is
+	 * larger.
 	 */
 
 	length = offset * 2;
@@ -4681,7 +5405,7 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
     dst += offset;
 
     if (statePtr->flags & INPUT_NEED_NL) {
-	statePtr->flags &= ~INPUT_NEED_NL;
+	ResetFlag(statePtr, INPUT_NEED_NL);
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
 	    *offsetPtr += 1;
@@ -4710,21 +5434,21 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
  *
  * ReadChars --
  *
- *	Reads from the channel until the requested number of UTF-8
- *	characters have been seen, EOF is seen, or the channel would
- *	block.  Raw bytes from the channel are converted to UTF-8
- *	and stored in objPtr.  EOL and EOF translation is done.
+ *	Reads from the channel until the requested number of UTF-8 characters
+ *	have been seen, EOF is seen, or the channel would block. Raw bytes
+ *	from the channel are converted to UTF-8 and stored in objPtr. EOL and
+ *	EOF translation is done.
  *
- *	'charsToRead' can safely be a very large number because
- *	space is only allocated to hold data read from the channel
- *	as needed.
+ *	'charsToRead' can safely be a very large number because space is only
+ *	allocated to hold data read from the channel as needed.
+ *
+ *	'charsToRead' may *not* be 0.
  *
  * Results:
- *	The return value is the number of characters appended to
- *	the object, *offsetPtr is filled with the number of bytes that
- *	were appended, and *factorPtr is filled with the expansion
- *	factor used to guess how many bytes of UTF-8 to allocate to
- *	hold N source bytes.
+ *	The return value is the number of characters appended to the object,
+ *	*offsetPtr is filled with the number of bytes that were appended, and
+ *	*factorPtr is filled with the expansion factor used to guess how many
+ *	bytes of UTF-8 to allocate to hold N source bytes.
  *
  * Side effects:
  *	None.
@@ -4733,31 +5457,31 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
  */
 
 static int
-ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
-    ChannelState *statePtr;	/* State of channel to read. */
-    Tcl_Obj *objPtr;		/* Input data is appended to this object.
+ReadChars(
+    ChannelState *statePtr,	/* State of channel to read. */
+    Tcl_Obj *objPtr,		/* Input data is appended to this object.
 				 * objPtr->length is how much space has been
 				 * allocated to hold data, not how many bytes
 				 * of data have been stored in the object. */
-    int charsToRead;		/* Maximum number of characters to store,
-				 * or -1 to get all available characters.
+    int charsToRead,		/* Maximum number of characters to store, or
+				 * -1 to get all available characters.
 				 * Characters are obtained from the first
 				 * buffer in the queue -- even if this number
 				 * is larger than the number of characters
 				 * available in the first buffer, only the
 				 * characters from the first buffer are
 				 * returned. */
-    int *offsetPtr;		/* On input, contains how many bytes of
-				 * objPtr have been used to hold data.  On
-				 * output, filled with how many bytes are now
-				 * being used. */
-    int *factorPtr;		/* On input, contains a guess of how many
+    int *offsetPtr,		/* On input, contains how many bytes of objPtr
+				 * have been used to hold data. On output,
+				 * filled with how many bytes are now being
+				 * used. */
+    int *factorPtr)		/* On input, contains a guess of how many
 				 * bytes need to be allocated to hold the
 				 * result of converting N source bytes to
-				 * UTF-8.  On output, contains another guess
+				 * UTF-8. On output, contains another guess
 				 * based on the data seen so far. */
 {
-    int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
+    int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
     int srcRead, dstWrote, numChars, dstRead;
     ChannelBuffer *bufPtr;
     char *src, *dst;
@@ -4767,9 +5491,9 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
     factor = *factorPtr;
     offset = *offsetPtr;
 
-    bufPtr = statePtr->inQueueHead; 
-    src    = bufPtr->buf + bufPtr->nextRemoved;
-    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+    bufPtr = statePtr->inQueueHead;
+    src = RemovePoint(bufPtr);
+    srcLen = BytesLeft(bufPtr);
 
     toRead = charsToRead;
     if ((unsigned)toRead > (unsigned)srcLen) {
@@ -4777,35 +5501,38 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
     }
 
     /*
-     * 'factor' is how much we guess that the bytes in the source buffer
-     * will expand when converted to UTF-8 chars.  This guess comes from
-     * analyzing how many characters were produced by the previous
-     * pass.
+     * 'factor' is how much we guess that the bytes in the source buffer will
+     * expand when converted to UTF-8 chars. This guess comes from analyzing
+     * how many characters were produced by the previous pass.
      */
 
-    dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
-    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+    dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
+    spaceLeft = objPtr->length - offset;
 
     if (dstNeeded > spaceLeft) {
 	/*
-	 * Double the existing size of the object or make enough room to
-	 * hold all the characters we want from the source buffer,
-	 * whichever is larger.
+	 * Double the existing size of the object or make enough room to hold
+	 * all the characters we want from the source buffer, whichever is
+	 * larger.
 	 */
 
-	length = offset * 2;
-	if (offset < dstNeeded) {
+	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+
+	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
 	    length = offset + dstNeeded;
+	    if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+		dstNeeded = TCL_UTF_MAX - 1 + toRead;
+		length = offset + dstNeeded;
+		Tcl_SetObjLength(objPtr, length);
+	    }
 	}
 	spaceLeft = length - offset;
-	length += TCL_UTF_MAX + 1;
-	Tcl_SetObjLength(objPtr, length);
     }
     if (toRead == srcLen) {
 	/*
-	 * Want to convert the whole buffer in one pass.  If we have
-	 * enough space, convert it using all available space in object
-	 * rather than using the factor.
+	 * Want to convert the whole buffer in one pass. If we have enough
+	 * space, convert it using all available space in object rather than
+	 * using the factor.
 	 */
 
 	dstNeeded = spaceLeft;
@@ -4813,51 +5540,48 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
     dst = objPtr->bytes + offset;
 
     /*
-     * SF Tcl Bug 1462248
-     * The cause of the crash reported in the referenced bug is this:
+     * [Bug 1462248]: The cause of the crash reported in this bug is this:
      *
      * - ReadChars, called with a single buffer, with a incomplete
-     *   multi-byte character at the end (only the first byte of it).
+     *	 multi-byte character at the end (only the first byte of it).
      * - Encoding translation fails, asks for more data
      * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
-     * - ReadChar is called again, converts the first buffer, but due
-     *   to TEE it does not check for incomplete multi-byte data, and the
-     *   character just after the end of the first buffer is a valid
-     *   completion of the multi-byte header in the actual buffer. The
-     *   conversion reads more characters from the buffer then present.
-     *   This causes nextRemoved to overshoot nextAdded and the next
-     *   reads compute a negative srcLen, cause further translations to
-     *   fail, causing copying of data into the next buffer using bad
-     *   arguments, causing the mecpy for to eventually fail.
+     * - ReadChar is called again, converts the first buffer, but due to TEE
+     *	 it does not check for incomplete multi-byte data, and the character
+     *	 just after the end of the first buffer is a valid completion of the
+     *	 multi-byte header in the actual buffer. The conversion reads more
+     *	 characters from the buffer then present. This causes nextRemoved to
+     *	 overshoot nextAdded and the next reads compute a negative srcLen,
+     *	 cause further translations to fail, causing copying of data into the
+     *	 next buffer using bad arguments, causing the mecpy for to eventually
+     *	 fail.
      *
-     * In the end it is a memory access bug spiraling out of control
-     * if the conditions are _just so_. And ultimate cause is that TEE
-     * is given to a conversion where it should not. TEE signals that
-     * this is the last buffer. Except in our case it is not.
+     * In the end it is a memory access bug spiraling out of control if the
+     * conditions are _just so_. And ultimate cause is that TEE is given to a
+     * conversion where it should not. TEE signals that this is the last
+     * buffer. Except in our case it is not.
      *
-     * My solution is to suppress TEE if the first buffer is not the
-     * last. We will eventually need it given that EOF has been
-     * reached, but not right now. This is what the new flag
-     * "endEncSuppressFlag" is for.
+     * My solution is to suppress TEE if the first buffer is not the last. We
+     * will eventually need it given that EOF has been reached, but not right
+     * now. This is what the new flag "endEncSuppressFlag" is for.
      *
-     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind
-     * the actual buffer has been fixed as well, and fixes the problem
-     * with the crash too, but this would still allow the generic
-     * layer to accidentially break a multi-byte sequence if the
-     * conditions are just right, because again the ExternalToUtf
-     * would be successful where it should not.
+     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
+     * actual buffer has been fixed as well, and fixes the problem with the
+     * crash too, but this would still allow the generic layer to
+     * accidentially break a multi-byte sequence if the conditions are just
+     * right, because again the ExternalToUtf would be successful where it
+     * should not.
      */
 
     if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
-	(bufPtr->nextPtr != NULL)) {
-
-        /* TEE is set for a buffer which is not the last. Squash it
-	 * for now, and restore it later, before yielding control to
-	 * our caller.
+	    (bufPtr->nextPtr != NULL)) {
+	/*
+	 * TEE is set for a buffer which is not the last. Squash it for now,
+	 * and restore it later, before yielding control to our caller.
 	 */
 
-        statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-        encEndFlagSuppressed = 1;
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+	encEndFlagSuppressed = 1;
     }
 
     oldState = statePtr->inputEncodingState;
@@ -4866,19 +5590,19 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
 	 * We want a '\n' because the last character we saw was '\r'.
 	 */
 
-	statePtr->flags &= ~INPUT_NEED_NL;
+	ResetFlag(statePtr, INPUT_NEED_NL);
 	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
 		dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
 	if ((dstWrote > 0) && (*dst == '\n')) {
 	    /*
-	     * The next char was a '\n'.  Consume it and produce a '\n'.
+	     * The next char was a '\n'. Consume it and produce a '\n'.
 	     */
 
 	    bufPtr->nextRemoved += srcRead;
 	} else {
 	    /*
-	     * The next char was not a '\n'.  Produce a '\r'.
+	     * The next char was not a '\n'. Produce a '\r'.
 	     */
 
 	    *dst = '\r';
@@ -4889,67 +5613,64 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
 	if (encEndFlagSuppressed) {
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-        return 1;
+	return 1;
     }
 
     Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
 	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
-	    dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
+	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);
 
     if (encEndFlagSuppressed) {
-        statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
     }
 
     if (srcRead == 0) {
 	/*
-	 * Not enough bytes in src buffer to make a complete char.  Copy
-	 * the bytes to the next buffer to make a new contiguous string,
-	 * then tell the caller to fill the buffer with more bytes.
+	 * Not enough bytes in src buffer to make a complete char. Copy the
+	 * bytes to the next buffer to make a new contiguous string, then tell
+	 * the caller to fill the buffer with more bytes.
 	 */
 
 	ChannelBuffer *nextPtr;
-	
+
 	nextPtr = bufPtr->nextPtr;
 	if (nextPtr == NULL) {
 	    if (srcLen > 0) {
-	        /*
+		/*
 		 * There isn't enough data in the buffers to complete the next
 		 * character, so we need to wait for more data before the next
-		 * file event can be delivered.
-		 *
-		 * SF #478856.
+		 * file event can be delivered. [Bug 478856]
 		 *
-		 * The exception to this is if the input buffer was
-		 * completely empty before we tried to convert its
-		 * contents. Nothing in, nothing out, and no incomplete
-		 * character data. The conversion before the current one
-		 * was complete.
+		 * The exception to this is if the input buffer was completely
+		 * empty before we tried to convert its contents. Nothing in,
+		 * nothing out, and no incomplete character data. The
+		 * conversion before the current one was complete.
 		 */
 
-	        statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 	    }
 	    return -1;
 	}
 
-	/* Space is made at the beginning of the buffer to copy the
-	 * previous unused bytes there. Check first if the buffer we
-	 * are using actually has enough space at its beginning for
-	 * the data we are copying. Because if not we will write over the
-	 * buffer management information, especially the 'nextPtr'.
+	/*
+	 * Space is made at the beginning of the buffer to copy the previous
+	 * unused bytes there. Check first if the buffer we are using actually
+	 * has enough space at its beginning for the data we are copying.
+	 * Because if not we will write over the buffer management
+	 * information, especially the 'nextPtr'.
 	 *
-	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
-	 * used to prevent exactly this situation. I.e. it should
-	 * never happen. Therefore it is ok to panic should it happen
-	 * despite the precautions.
+	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
+	 * prevent exactly this situation. I.e. it should never happen.
+	 * Therefore it is ok to panic should it happen despite the
+	 * precautions.
 	 */
 
 	if (nextPtr->nextRemoved - srcLen < 0) {
-	    Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough");
+	    Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
 	}
 
 	nextPtr->nextRemoved -= srcLen;
-	memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
-		(size_t) srcLen);
+	memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
 	RecycleBuffer(statePtr, bufPtr, 0);
 	statePtr->inQueueHead = nextPtr;
 	return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
@@ -4958,12 +5679,12 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
     dstRead = dstWrote;
     if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
 	/*
-	 * Hit EOF char.  How many bytes of src correspond to where the
-	 * EOF was located in dst? Run the conversion again with an
-	 * output buffer just big enough to hold the data so we can
-	 * get the correct value for srcRead.
+	 * Hit EOF char. How many bytes of src correspond to where the EOF was
+	 * located in dst? Run the conversion again with an output buffer just
+	 * big enough to hold the data so we can get the correct value for
+	 * srcRead.
 	 */
-	 
+
 	if (dstWrote == 0) {
 	    return -1;
 	}
@@ -4972,12 +5693,12 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
 		dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
 	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
-    } 
+    }
 
     /*
-     * The number of characters that we got may be less than the number
-     * that we started with because "\r\n" sequences may have been
-     * turned into just '\n' in dst.
+     * The number of characters that we got may be less than the number that
+     * we started with because "\r\n" sequences may have been turned into just
+     * '\n' in dst.
      */
 
     numChars -= (dstRead - dstWrote);
@@ -4987,7 +5708,7 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
 	 * Got too many chars.
 	 */
 
-	CONST char *eof;
+	const char *eof;
 
 	eof = Tcl_UtfAtIndex(dst, toRead);
 	statePtr->inputEncodingState = oldState;
@@ -5013,12 +5734,12 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
  *
  * TranslateInputEOL --
  *
- *	Perform input EOL and EOF translation on the source buffer,
- *	leaving the translated result in the destination buffer.  
+ *	Perform input EOL and EOF translation on the source buffer, leaving
+ *	the translated result in the destination buffer.
  *
  * Results:
  *	The return value is 1 if the EOF character was found when copying
- *	bytes to the destination buffer, 0 otherwise.  
+ *	bytes to the destination buffer, 0 otherwise.
  *
  * Side effects:
  *	None.
@@ -5027,23 +5748,23 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
  */
 
 static int
-TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
-    ChannelState *statePtr;	/* Channel being read, for EOL translation
-				 * and EOF character. */
-    char *dstStart;		/* Output buffer filled with chars by
-				 * applying appropriate EOL translation to
-				 * source characters. */
-    CONST char *srcStart;	/* Source characters. */
-    int *dstLenPtr;		/* On entry, the maximum length of output
-				 * buffer in bytes; must be <= *srcLenPtr.  On
+TranslateInputEOL(
+    ChannelState *statePtr,	/* Channel being read, for EOL translation and
+				 * EOF character. */
+    char *dstStart,		/* Output buffer filled with chars by applying
+				 * appropriate EOL translation to source
+				 * characters. */
+    const char *srcStart,	/* Source characters. */
+    int *dstLenPtr,		/* On entry, the maximum length of output
+				 * buffer in bytes; must be <= *srcLenPtr. On
 				 * exit, the number of bytes actually used in
 				 * output buffer. */
-    int *srcLenPtr;		/* On entry, the length of source buffer.
-				 * On exit, the number of bytes read from
-				 * the source buffer. */
+    int *srcLenPtr)		/* On entry, the length of source buffer. On
+				 * exit, the number of bytes read from the
+				 * source buffer. */
 {
     int dstLen, srcLen, inEofChar;
-    CONST char *eof;
+    const char *eof;
 
     dstLen = *dstLenPtr;
 
@@ -5051,13 +5772,13 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
     inEofChar = statePtr->inEofChar;
     if (inEofChar != '\0') {
 	/*
-	 * Find EOF in translated buffer then compress out the EOL.  The
-	 * source buffer may be much longer than the destination buffer --
-	 * we only want to return EOF if the EOF has been copied to the
-	 * destination buffer.
+	 * Find EOF in translated buffer then compress out the EOL. The source
+	 * buffer may be much longer than the destination buffer - we only
+	 * want to return EOF if the EOF has been copied to the destination
+	 * buffer.
 	 */
 
-	CONST char *src, *srcMax;
+	const char *src, *srcMax;
 
 	srcMax = srcStart + *srcLenPtr;
 	for (src = srcStart; src < srcMax; src++) {
@@ -5073,106 +5794,104 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
 	}
     }
     switch (statePtr->inputTranslation) {
-	case TCL_TRANSLATE_LF: {
-	    if (dstStart != srcStart) {
-		memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
-	    }
-	    srcLen = dstLen;
-	    break;
-	}
-	case TCL_TRANSLATE_CR: {
-	    char *dst, *dstEnd;
-	    
-	    if (dstStart != srcStart) {
-		memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
-	    }
-	    dstEnd = dstStart + dstLen;
-	    for (dst = dstStart; dst < dstEnd; dst++) {
-		if (*dst == '\r') {
-		    *dst = '\n';
-		}
+    case TCL_TRANSLATE_LF:
+	if (dstStart != srcStart) {
+	    memcpy(dstStart, srcStart, (size_t) dstLen);
+	}
+	srcLen = dstLen;
+	break;
+    case TCL_TRANSLATE_CR: {
+	char *dst, *dstEnd;
+
+	if (dstStart != srcStart) {
+	    memcpy(dstStart, srcStart, (size_t) dstLen);
+	}
+	dstEnd = dstStart + dstLen;
+	for (dst = dstStart; dst < dstEnd; dst++) {
+	    if (*dst == '\r') {
+		*dst = '\n';
 	    }
-	    srcLen = dstLen;
-	    break;
 	}
-	case TCL_TRANSLATE_CRLF: {
-	    char *dst;
-	    CONST char *src, *srcEnd, *srcMax;
-	    
-	    dst = dstStart;
-	    src = srcStart;
-	    srcEnd = srcStart + dstLen;
-	    srcMax = srcStart + *srcLenPtr;
-
-	    for ( ; src < srcEnd; ) {
-		if (*src == '\r') {
-		    src++;
-		    if (src >= srcMax) {
-			statePtr->flags |= INPUT_NEED_NL;
-		    } else if (*src == '\n') {
-			*dst++ = *src++;
-		    } else {
-			*dst++ = '\r';
-		    }
-		} else {
+	srcLen = dstLen;
+	break;
+    }
+    case TCL_TRANSLATE_CRLF: {
+	char *dst;
+	const char *src, *srcEnd, *srcMax;
+
+	dst = dstStart;
+	src = srcStart;
+	srcEnd = srcStart + dstLen;
+	srcMax = srcStart + *srcLenPtr;
+
+	for ( ; src < srcEnd; ) {
+	    if (*src == '\r') {
+		src++;
+		if (src >= srcMax) {
+		    SetFlag(statePtr, INPUT_NEED_NL);
+		} else if (*src == '\n') {
 		    *dst++ = *src++;
+		} else {
+		    *dst++ = '\r';
 		}
+	    } else {
+		*dst++ = *src++;
 	    }
-	    srcLen = src - srcStart;
-	    dstLen = dst - dstStart;
-	    break;
 	}
-	case TCL_TRANSLATE_AUTO: {
-	    char *dst;
-	    CONST char *src, *srcEnd, *srcMax;
+	srcLen = src - srcStart;
+	dstLen = dst - dstStart;
+	break;
+    }
+    case TCL_TRANSLATE_AUTO: {
+	char *dst;
+	const char *src, *srcEnd, *srcMax;
 
-	    dst = dstStart;
-	    src = srcStart;
-	    srcEnd = srcStart + dstLen;
-	    srcMax = srcStart + *srcLenPtr;
+	dst = dstStart;
+	src = srcStart;
+	srcEnd = srcStart + dstLen;
+	srcMax = srcStart + *srcLenPtr;
 
-	    if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
-		if (*src == '\n') {
-		    src++;
-		}
-		statePtr->flags &= ~INPUT_SAW_CR;
+	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+	    if (*src == '\n') {
+		src++;
 	    }
-	    for ( ; src < srcEnd; ) {
-		if (*src == '\r') {
-		    src++;
-		    if (src >= srcMax) {
-			statePtr->flags |= INPUT_SAW_CR;
-		    } else if (*src == '\n') {
-			if (srcEnd < srcMax) {
-			    srcEnd++;
-			}
-			src++;
+	    ResetFlag(statePtr, INPUT_SAW_CR);
+	}
+	for ( ; src < srcEnd; ) {
+	    if (*src == '\r') {
+		src++;
+		if (src >= srcMax) {
+		    SetFlag(statePtr, INPUT_SAW_CR);
+		} else if (*src == '\n') {
+		    if (srcEnd < srcMax) {
+			srcEnd++;
 		    }
-		    *dst++ = '\n';
-		} else {
-		    *dst++ = *src++;
+		    src++;
 		}
+		*dst++ = '\n';
+	    } else {
+		*dst++ = *src++;
 	    }
-	    srcLen = src - srcStart;
-	    dstLen = dst - dstStart;
-	    break;
-	}
-	default: {		/* lint. */
-	    return 0;
 	}
+	srcLen = src - srcStart;
+	dstLen = dst - dstStart;
+	break;
+    }
+    default:
+	return 0;
     }
     *dstLenPtr = dstLen;
 
     if ((eof != NULL) && (srcStart + srcLen >= eof)) {
 	/*
-	 * EOF character was seen in EOL translated range.  Leave current
-	 * file position pointing at the EOF character, but don't store the
-	 * EOF character in the output string.
+	 * EOF character was seen in EOL translated range. Leave current file
+	 * position pointing at the EOF character, but don't store the EOF
+	 * character in the output string.
 	 */
 
-	statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
+	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
 	return 1;
     }
 
@@ -5185,8 +5904,8 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
  *
  * Tcl_Ungets --
  *
- *	Causes the supplied string to be added to the input queue of
- *	the channel, at either the head or tail of the queue.
+ *	Causes the supplied string to be added to the input queue of the
+ *	channel, at either the head or tail of the queue.
  *
  * Results:
  *	The number of bytes stored in the channel, or -1 on error.
@@ -5198,17 +5917,17 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
  */
 
 int
-Tcl_Ungets(chan, str, len, atEnd)
-    Tcl_Channel chan;		/* The channel for which to add the input. */
-    CONST char *str;		/* The input itself. */
-    int len;			/* The length of the input. */
-    int atEnd;			/* If non-zero, add at end of queue; otherwise
-                                 * add at head of queue. */    
+Tcl_Ungets(
+    Tcl_Channel chan,		/* The channel for which to add the input. */
+    const char *str,		/* The input itself. */
+    int len,			/* The length of the input. */
+    int atEnd)			/* If non-zero, add at end of queue; otherwise
+				 * add at head of queue. */
 {
     Channel *chanPtr;		/* The real IO channel. */
     ChannelState *statePtr;	/* State of actual channel. */
     ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
-    int i, flags;
+    int flags;
 
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
@@ -5222,7 +5941,7 @@ Tcl_Ungets(chan, str, len, atEnd)
     /*
      * CheckChannelErrors clears too many flag bits in this one case.
      */
-     
+
     flags = statePtr->flags;
     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
 	len = -1;
@@ -5231,42 +5950,40 @@ Tcl_Ungets(chan, str, len, atEnd)
     statePtr->flags = flags;
 
     /*
-     * If we have encountered a sticky EOF, just punt without storing.
-     * (sticky EOF is set if we have seen the input eofChar, to prevent
-     * reading beyond the eofChar). Otherwise, clear the EOF flags, and
-     * clear the BLOCKED bit. We want to discover these conditions anew
-     * in each operation.
+     * If we have encountered a sticky EOF, just punt without storing (sticky
+     * EOF is set if we have seen the input eofChar, to prevent reading beyond
+     * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
+     * bit. We want to discover these conditions anew in each operation.
      */
 
     if (statePtr->flags & CHANNEL_STICKY_EOF) {
 	goto done;
     }
-    statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
+    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
 
     bufPtr = AllocChannelBuffer(len);
-    for (i = 0; i < len; i++) {
-        bufPtr->buf[bufPtr->nextAdded++] = str[i];
-    }
+    memcpy(InsertPoint(bufPtr), str, (size_t) len);
+    bufPtr->nextAdded += len;
 
-    if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
-        bufPtr->nextPtr = (ChannelBuffer *) NULL;
-        statePtr->inQueueHead = bufPtr;
-        statePtr->inQueueTail = bufPtr;
+    if (statePtr->inQueueHead == NULL) {
+	bufPtr->nextPtr = NULL;
+	statePtr->inQueueHead = bufPtr;
+	statePtr->inQueueTail = bufPtr;
     } else if (atEnd) {
-        bufPtr->nextPtr = (ChannelBuffer *) NULL;
-        statePtr->inQueueTail->nextPtr = bufPtr;
-        statePtr->inQueueTail = bufPtr;
+	bufPtr->nextPtr = NULL;
+	statePtr->inQueueTail->nextPtr = bufPtr;
+	statePtr->inQueueTail = bufPtr;
     } else {
-        bufPtr->nextPtr = statePtr->inQueueHead;
-        statePtr->inQueueHead = bufPtr;
+	bufPtr->nextPtr = statePtr->inQueueHead;
+	statePtr->inQueueHead = bufPtr;
     }
 
-    done:
     /*
-     * Update the notifier state so we don't block while there is still
-     * data in the buffers.
+     * Update the notifier state so we don't block while there is still data
+     * in the buffers.
      */
 
+  done:
     UpdateInterest(chanPtr);
     return len;
 }
@@ -5288,12 +6005,14 @@ Tcl_Ungets(chan, str, len, atEnd)
  */
 
 int
-Tcl_Flush(chan)
-    Tcl_Channel chan;			/* The Channel to flush. */
+Tcl_Flush(
+    Tcl_Channel chan)		/* The Channel to flush. */
 {
-    int result;				/* Of calling FlushChannel. */
-    Channel *chanPtr  = (Channel *) chan;	/* The actual channel. */
-    ChannelState *statePtr = chanPtr->state;	/* State of actual channel. */
+    int result;			/* Of calling FlushChannel. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The actual channel. */
+    ChannelState *statePtr = chanPtr->state;
+				/* State of actual channel. */
 
     /*
      * This operation should occur at the top of a channel stack.
@@ -5309,14 +6028,13 @@ Tcl_Flush(chan)
      * Force current output buffer to be output also.
      */
 
-    if ((statePtr->curOutPtr != NULL)
-	    && (statePtr->curOutPtr->nextAdded > 0)) {
-        statePtr->flags |= BUFFER_READY;
+    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+	SetFlag(statePtr, BUFFER_READY);
     }
-    
+
     result = FlushChannel(NULL, chanPtr, 0);
     if (result != 0) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     return TCL_OK;
@@ -5327,8 +6045,8 @@ Tcl_Flush(chan)
  *
  * DiscardInputQueued --
  *
- *	Discards any input read from the channel but not yet consumed
- *	by Tcl reading commands.
+ *	Discards any input read from the channel but not yet consumed by Tcl
+ *	reading commands.
  *
  * Results:
  *	None.
@@ -5341,32 +6059,31 @@ Tcl_Flush(chan)
  */
 
 static void
-DiscardInputQueued(statePtr, discardSavedBuffers)
-    ChannelState *statePtr;	/* Channel on which to discard
-                                 * the queued input. */
-    int discardSavedBuffers;	/* If non-zero, discard all buffers including
-                                 * last one. */
+DiscardInputQueued(
+    ChannelState *statePtr,	/* Channel on which to discard the queued
+				 * input. */
+    int discardSavedBuffers)	/* If non-zero, discard all buffers including
+				 * last one. */
 {
-    ChannelBuffer *bufPtr, *nxtPtr;	/* Loop variables. */
+    ChannelBuffer *bufPtr, *nxtPtr;
+				/* Loop variables. */
 
     bufPtr = statePtr->inQueueHead;
-    statePtr->inQueueHead = (ChannelBuffer *) NULL;
-    statePtr->inQueueTail = (ChannelBuffer *) NULL;
-    for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
-        nxtPtr = bufPtr->nextPtr;
-        RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
+    statePtr->inQueueHead = NULL;
+    statePtr->inQueueTail = NULL;
+    for (; bufPtr != NULL; bufPtr = nxtPtr) {
+	nxtPtr = bufPtr->nextPtr;
+	RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
     }
 
     /*
      * If discardSavedBuffers is nonzero, must also discard any previously
      * saved buffer in the saveInBufPtr field.
      */
-    
-    if (discardSavedBuffers) {
-        if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
-            ckfree((char *) statePtr->saveInBufPtr);
-            statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
-        }
+
+    if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
+	ckfree((char *) statePtr->saveInBufPtr);
+	statePtr->saveInBufPtr = NULL;
     }
 }
 
@@ -5375,11 +6092,11 @@ DiscardInputQueued(statePtr, discardSavedBuffers)
  *
  * GetInput --
  *
- *	Reads input data from a device into a channel buffer.  
+ *	Reads input data from a device into a channel buffer.
  *
  * Results:
  *	The return value is the Posix error code if an error occurred while
- *	reading from the file, or 0 otherwise.  
+ *	reading from the file, or 0 otherwise.
  *
  * Side effects:
  *	Reads from the underlying device.
@@ -5388,14 +6105,15 @@ DiscardInputQueued(statePtr, discardSavedBuffers)
  */
 
 static int
-GetInput(chanPtr)
-    Channel *chanPtr;		/* Channel to read input from. */
+GetInput(
+    Channel *chanPtr)		/* Channel to read input from. */
 {
     int toRead;			/* How much to read? */
     int result;			/* Of calling driver. */
     int nread;			/* How much was read from channel? */
     ChannelBuffer *bufPtr;	/* New buffer to add to input queue. */
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
 
     /*
      * Prevent reading from a dead channel -- a channel that has been closed
@@ -5403,90 +6121,91 @@ GetInput(chanPtr)
      * channel cleanup has run but the channel is still registered in some
      * interpreter.
      */
-    
+
     if (CheckForDeadChannel(NULL, statePtr)) {
 	return EINVAL;
     }
 
     /*
-     * First check for more buffers in the pushback area of the
-     * topmost channel in the stack and use them. They can be the
-     * result of a transformation which went away without reading all
-     * the information placed in the area when it was stacked.
+     * First check for more buffers in the pushback area of the topmost
+     * channel in the stack and use them. They can be the result of a
+     * transformation which went away without reading all the information
+     * placed in the area when it was stacked.
      *
-     * Two possibilities for the state: No buffers in it, or a single
-     * empty buffer. In the latter case we can recycle it now.
+     * Two possibilities for the state: No buffers in it, or a single empty
+     * buffer. In the latter case we can recycle it now.
      */
 
-    if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
-        if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
+    if (chanPtr->inQueueHead != NULL) {
+	if (statePtr->inQueueHead != NULL) {
 	    RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
-	    statePtr->inQueueHead = (ChannelBuffer*) NULL;
+	    statePtr->inQueueHead = NULL;
 	}
 
 	statePtr->inQueueHead = chanPtr->inQueueHead;
 	statePtr->inQueueTail = chanPtr->inQueueTail;
-	chanPtr->inQueueHead  = (ChannelBuffer*) NULL;
-	chanPtr->inQueueTail  = (ChannelBuffer*) NULL;
+	chanPtr->inQueueHead = NULL;
+	chanPtr->inQueueTail = NULL;
 	return 0;
     }
 
     /*
-     * Nothing in the pushback area, fall back to the usual handling
-     * (driver, etc.)
+     * Nothing in the pushback area, fall back to the usual handling (driver,
+     * etc.)
      */
 
     /*
-     * See if we can fill an existing buffer. If we can, read only
-     * as much as will fit in it. Otherwise allocate a new buffer,
-     * add it to the input queue and attempt to fill it to the max.
+     * See if we can fill an existing buffer. If we can, read only as much as
+     * will fit in it. Otherwise allocate a new buffer, add it to the input
+     * queue and attempt to fill it to the max.
      */
 
     bufPtr = statePtr->inQueueTail;
-    if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
-        toRead = bufPtr->bufLength - bufPtr->nextAdded;
+    if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
+	toRead = SpaceLeft(bufPtr);
     } else {
 	bufPtr = statePtr->saveInBufPtr;
 	statePtr->saveInBufPtr = NULL;
 
 	/*
-	 * Check the actual buffersize against the requested
-	 * buffersize. Buffers which are smaller than requested are
-	 * squashed. This is done to honor dynamic changes of the
-	 * buffersize made by the user.
+	 * Check the actual buffersize against the requested buffersize.
+	 * Buffers which are smaller than requested are squashed. This is done
+	 * to honor dynamic changes of the buffersize made by the user.
 	 */
 
-	if ((bufPtr != NULL) && ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize)) {
-	  ckfree((char *) bufPtr);
-	  bufPtr = NULL;
+	if ((bufPtr != NULL)
+		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
+	    ckfree((char *) bufPtr);
+	    bufPtr = NULL;
 	}
 
 	if (bufPtr == NULL) {
 	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
 	}
-        bufPtr->nextPtr = (ChannelBuffer *) NULL;
+	bufPtr->nextPtr = NULL;
 
-	/* SF #427196: Use the actual size of the buffer to determine
-	 * the number of bytes to read from the channel and not the
-	 * size for new buffers. They can be different if the
-	 * buffersize was changed between reads.
+	/*
+	 * SF #427196: Use the actual size of the buffer to determine the
+	 * number of bytes to read from the channel and not the size for new
+	 * buffers. They can be different if the buffersize was changed
+	 * between reads.
 	 *
-	 * Note: This affects performance negatively if the buffersize
-	 * was extended but this small buffer is reused for all
-	 * subsequent reads. The system never uses buffers with the
-	 * requested bigger size in that case. An adjunct patch could
-	 * try and delete all unused buffers it encounters and which
-	 * are smaller than the formally requested buffersize.
+	 * Note: This affects performance negatively if the buffersize was
+	 * extended but this small buffer is reused for all subsequent reads.
+	 * The system never uses buffers with the requested bigger size in
+	 * that case. An adjunct patch could try and delete all unused buffers
+	 * it encounters and which are smaller than the formally requested
+	 * buffersize.
 	 */
 
-	toRead = bufPtr->bufLength - bufPtr->nextAdded;
+	toRead = SpaceLeft(bufPtr);
 
-        if (statePtr->inQueueTail == NULL) {
-            statePtr->inQueueHead = bufPtr;
-        } else {
-            statePtr->inQueueTail->nextPtr = bufPtr;
-        }
-        statePtr->inQueueTail = bufPtr;
+	if (statePtr->inQueueTail == NULL) {
+	    statePtr->inQueueHead = bufPtr;
+	} else {
+	    statePtr->inQueueTail->nextPtr = bufPtr;
+	}
+	statePtr->inQueueTail = bufPtr;
     }
 
     /*
@@ -5499,24 +6218,27 @@ GetInput(chanPtr)
     }
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /* [SF Tcl Bug 943274]. Better emulation of non-blocking channels
-     * for channels without BlockModeProc, by keeping track of true
-     * fileevents generated by the OS == Data waiting and reading if
-     * and only if we are sure to have data.
+    /*
+     * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
+     * channels without BlockModeProc, by keeping track of true fileevents
+     * generated by the OS == Data waiting and reading if and only if we are
+     * sure to have data.
      */
 
     if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+	/*
+	 * Bypass the driver, it would block, as no data is available
+	 */
 
-        /* Bypass the driver, it would block, as no data is available */
-        nread = -1;
-        result = EWOULDBLOCK;
+	nread = -1;
+	result = EWOULDBLOCK;
     } else {
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-        nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
-		    bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+	nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+		InsertPoint(bufPtr), toRead, &result);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
     }
@@ -5526,30 +6248,33 @@ GetInput(chanPtr)
 	bufPtr->nextAdded += nread;
 
 	/*
-	 * If we get a short read, signal up that we may be BLOCKED. We
-	 * should avoid calling the driver because on some platforms we
-	 * will block in the low level reading code even though the
-	 * channel is set into nonblocking mode.
+	 * If we get a short read, signal up that we may be BLOCKED. We should
+	 * avoid calling the driver because on some platforms we will block in
+	 * the low level reading code even though the channel is set into
+	 * nonblocking mode.
 	 */
-            
+
 	if (nread < toRead) {
-	    statePtr->flags |= CHANNEL_BLOCKED;
+	    SetFlag(statePtr, CHANNEL_BLOCKED);
 	}
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	if (nread <= toRead) {
-	  /* [SF Tcl Bug 943274] We have read the available data,
-	   * clear flag */
-	  statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+	    /*
+	     * [SF Tcl Bug 943274] We have read the available data, clear
+	     * flag.
+	     */
+
+	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     } else if (nread == 0) {
-	statePtr->flags |= CHANNEL_EOF;
+	SetFlag(statePtr, CHANNEL_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
     } else if (nread < 0) {
 	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
-	    statePtr->flags |= CHANNEL_BLOCKED;
+	    SetFlag(statePtr, CHANNEL_BLOCKED);
 	    result = EAGAIN;
 	}
 	Tcl_SetErrno(result);
@@ -5563,12 +6288,12 @@ GetInput(chanPtr)
  *
  * Tcl_Seek --
  *
- *	Implements seeking on Tcl Channels. This is a public function
- *	so that other C facilities may be implemented on top of it.
+ *	Implements seeking on Tcl Channels. This is a public function so that
+ *	other C facilities may be implemented on top of it.
  *
  * Results:
- *	The new access point or -1 on error. If error, use Tcl_GetErrno()
- *	to retrieve the POSIX error code for the error that occurred.
+ *	The new access point or -1 on error. If error, use Tcl_GetErrno() to
+ *	retrieve the POSIX error code for the error that occurred.
  *
  * Side effects:
  *	May flush output on the channel. May discard queued input.
@@ -5577,30 +6302,32 @@ GetInput(chanPtr)
  */
 
 Tcl_WideInt
-Tcl_Seek(chan, offset, mode)
-    Tcl_Channel chan;		/* The channel on which to seek. */
-    Tcl_WideInt offset;		/* Offset to seek to. */
-    int mode;			/* Relative to which location to seek? */
+Tcl_Seek(
+    Tcl_Channel chan,		/* The channel on which to seek. */
+    Tcl_WideInt offset,		/* Offset to seek to. */
+    int mode)			/* Relative to which location to seek? */
 {
-    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    Channel *chanPtr = (Channel *) chan;
+				/* The real IO channel. */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     int inputBuffered, outputBuffered;
 				/* # bytes held in buffers. */
     int result;			/* Of device driver operations. */
     Tcl_WideInt curPos;		/* Position on the device. */
-    int wasAsync;		/* Was the channel nonblocking before the
-                                 * seek operation? If so, must restore to
-                                 * nonblocking mode after the seek. */
+    int wasAsync;		/* Was the channel nonblocking before the seek
+				 * operation? If so, must restore to
+				 * non-blocking mode after the seek. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
 	return Tcl_LongAsWide(-1);
     }
 
     /*
-     * Disallow seek on dead channels -- channels that have been closed but
-     * not yet been deallocated. Such channels can be found if the exit
-     * handler for channel cleanup has run but the channel is still
-     * registered in an interpreter.
+     * Disallow seek on dead channels - channels that have been closed but not
+     * yet been deallocated. Such channels can be found if the exit handler
+     * for channel cleanup has run but the channel is still registered in an
+     * interpreter.
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
@@ -5618,22 +6345,22 @@ Tcl_Seek(chan, offset, mode)
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
-        Tcl_SetErrno(EINVAL);
-        return Tcl_LongAsWide(-1);
+    if (chanPtr->typePtr->seekProc == NULL) {
+	Tcl_SetErrno(EINVAL);
+	return Tcl_LongAsWide(-1);
     }
 
     /*
-     * Compute how much input and output is buffered. If both input and
-     * output is buffered, cannot compute the current position.
+     * Compute how much input and output is buffered. If both input and output
+     * is buffered, cannot compute the current position.
      */
 
     inputBuffered = Tcl_InputBuffered(chan);
     outputBuffered = Tcl_OutputBuffered(chan);
 
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
-        Tcl_SetErrno(EFAULT);
-        return Tcl_LongAsWide(-1);
+	Tcl_SetErrno(EFAULT);
+	return Tcl_LongAsWide(-1);
     }
 
     /*
@@ -5642,61 +6369,69 @@ Tcl_Seek(chan, offset, mode)
      */
 
     if (mode == SEEK_CUR) {
-        offset -= inputBuffered;
+	offset -= inputBuffered;
     }
 
     /*
-     * Discard any queued input - this input should not be read after
-     * the seek.
+     * Discard any queued input - this input should not be read after the
+     * seek.
      */
 
     DiscardInputQueued(statePtr, 0);
 
     /*
-     * Reset EOF and BLOCKED flags. We invalidate them by moving the
-     * access point. Also clear CR related flags.
+     * Reset EOF and BLOCKED flags. We invalidate them by moving the access
+     * point. Also clear CR related flags.
      */
 
     statePtr->flags &=
-        (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
-    
+	~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR);
+
     /*
-     * If the channel is in asynchronous output mode, switch it back
-     * to synchronous mode and cancel any async flush that may be
-     * scheduled. After the flush, the channel will be put back into
-     * asynchronous output mode.
+     * If the channel is in asynchronous output mode, switch it back to
+     * synchronous mode and cancel any async flush that may be scheduled.
+     * After the flush, the channel will be put back into asynchronous output
+     * mode.
      */
 
     wasAsync = 0;
     if (statePtr->flags & CHANNEL_NONBLOCKING) {
-        wasAsync = 1;
-        result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
+	wasAsync = 1;
+	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
-        statePtr->flags &= (~(CHANNEL_NONBLOCKING));
-        if (statePtr->flags & BG_FLUSH_SCHEDULED) {
-            statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
-        }
+	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
+	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
+	}
     }
-    
+
     /*
-     * If the flush fails we cannot recover the original position. In
-     * that case the seek is not attempted because we do not know where
-     * the access position is - instead we return the error. FlushChannel
-     * has already called Tcl_SetErrno() to report the error upwards.
-     * If the flush succeeds we do the seek also.
+     * If there is data buffered in statePtr->curOutPtr then mark the channel
+     * as ready to flush before invoking FlushChannel.
      */
-    
+
+    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
+	SetFlag(statePtr, BUFFER_READY);
+    }
+
+    /*
+     * If the flush fails we cannot recover the original position. In that
+     * case the seek is not attempted because we do not know where the access
+     * position is - instead we return the error. FlushChannel has already
+     * called Tcl_SetErrno() to report the error upwards. If the flush
+     * succeeds we do the seek also.
+     */
+
     if (FlushChannel(NULL, chanPtr, 0) != 0) {
-        curPos = -1;
+	curPos = -1;
     } else {
-
-        /*
-         * Now seek to the new position in the channel as requested by the
-         * caller.  Note that we prefer the wideSeekProc if that is
-	 * available and non-NULL...
-         */
+	/*
+	 * Now seek to the new position in the channel as requested by the
+	 * caller. Note that we prefer the wideSeekProc if that is available
+	 * and non-NULL...
+	 */
 
 	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
 		chanPtr->typePtr->wideSeekProc != NULL) {
@@ -5715,17 +6450,17 @@ Tcl_Seek(chan, offset, mode)
 	    Tcl_SetErrno(result);
 	}
     }
-    
+
     /*
      * Restore to nonblocking mode if that was the previous behavior.
      *
-     * NOTE: Even if there was an async flush active we do not restore
-     * it now because we already flushed all the queued output, above.
+     * NOTE: Even if there was an async flush active we do not restore it now
+     * because we already flushed all the queued output, above.
      */
-    
+
     if (wasAsync) {
-        statePtr->flags |= CHANNEL_NONBLOCKING;
-        result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
+	SetFlag(statePtr, CHANNEL_NONBLOCKING);
+	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
@@ -5739,13 +6474,13 @@ Tcl_Seek(chan, offset, mode)
  *
  * Tcl_Tell --
  *
- *	Returns the position of the next character to be read/written on
- *	this channel.
+ *	Returns the position of the next character to be read/written on this
+ *	channel.
  *
  * Results:
- *	A nonnegative integer on success, -1 on failure. If failed,
- *	use Tcl_GetErrno() to retrieve the POSIX error code for the
- *	error that occurred.
+ *	A nonnegative integer on success, -1 on failure. If failed, use
+ *	Tcl_GetErrno() to retrieve the POSIX error code for the error that
+ *	occurred.
  *
  * Side effects:
  *	None.
@@ -5754,14 +6489,17 @@ Tcl_Seek(chan, offset, mode)
  */
 
 Tcl_WideInt
-Tcl_Tell(chan)
-    Tcl_Channel chan;			/* The channel to return pos for. */
+Tcl_Tell(
+    Tcl_Channel chan)		/* The channel to return pos for. */
 {
-    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
-    int inputBuffered, outputBuffered;	/* # bytes held in buffers. */
-    int result;				/* Of calling device driver. */
-    Tcl_WideInt curPos;			/* Position on device. */
+    Channel *chanPtr = (Channel *) chan;
+				/* The real IO channel. */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+    int inputBuffered, outputBuffered;
+				/* # bytes held in buffers. */
+    int result;			/* Of calling device driver. */
+    Tcl_WideInt curPos;		/* Position on device. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
 	return Tcl_LongAsWide(-1);
@@ -5770,8 +6508,8 @@ Tcl_Tell(chan)
     /*
      * Disallow tell on dead channels -- channels that have been closed but
      * not yet been deallocated. Such channels can be found if the exit
-     * handler for channel cleanup has run but the channel is still
-     * registered in an interpreter.
+     * handler for channel cleanup has run but the channel is still registered
+     * in an interpreter.
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
@@ -5789,28 +6527,28 @@ Tcl_Tell(chan)
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
-        Tcl_SetErrno(EINVAL);
-        return Tcl_LongAsWide(-1);
+    if (chanPtr->typePtr->seekProc == NULL) {
+	Tcl_SetErrno(EINVAL);
+	return Tcl_LongAsWide(-1);
     }
 
     /*
-     * Compute how much input and output is buffered. If both input and
-     * output is buffered, cannot compute the current position.
+     * Compute how much input and output is buffered. If both input and output
+     * is buffered, cannot compute the current position.
      */
 
     inputBuffered = Tcl_InputBuffered(chan);
     outputBuffered = Tcl_OutputBuffered(chan);
 
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
-        Tcl_SetErrno(EFAULT);
-        return Tcl_LongAsWide(-1);
+	Tcl_SetErrno(EFAULT);
+	return Tcl_LongAsWide(-1);
     }
 
     /*
-     * Get the current position in the device and compute the position
-     * where the next character will be read or written.  Note that we
-     * prefer the wideSeekProc if that is available and non-NULL...
+     * Get the current position in the device and compute the position where
+     * the next character will be read or written. Note that we prefer the
+     * wideSeekProc if that is available and non-NULL...
      */
 
     if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
@@ -5822,11 +6560,11 @@ Tcl_Tell(chan)
 		chanPtr->instanceData, 0, SEEK_CUR, &result));
     }
     if (curPos == Tcl_LongAsWide(-1)) {
-        Tcl_SetErrno(result);
-        return Tcl_LongAsWide(-1);
+	Tcl_SetErrno(result);
+	return Tcl_LongAsWide(-1);
     }
     if (inputBuffered != 0) {
-        return curPos - inputBuffered;
+	return curPos - inputBuffered;
     }
     return curPos + outputBuffered;
 }
@@ -5836,9 +6574,9 @@ Tcl_Tell(chan)
  *
  * Tcl_SeekOld, Tcl_TellOld --
  *
- *	Backward-compatability versions of the seek/tell interface that
- *	do not support 64-bit offsets.  This interface is not documented
- *	or expected to be supported indefinitely.
+ *	Backward-compatability versions of the seek/tell interface that do not
+ *	support 64-bit offsets. This interface is not documented or expected
+ *	to be supported indefinitely.
  *
  * Results:
  *	As for Tcl_Seek and Tcl_Tell respectively, except truncated to
@@ -5851,10 +6589,10 @@ Tcl_Tell(chan)
  */
 
 int
-Tcl_SeekOld(chan, offset, mode)
-    Tcl_Channel chan;		/* The channel on which to seek. */
-    int offset;			/* Offset to seek to. */
-    int mode;			/* Relative to which location to seek? */
+Tcl_SeekOld(
+    Tcl_Channel chan,		/* The channel on which to seek. */
+    int offset,			/* Offset to seek to. */
+    int mode)			/* Relative to which location to seek? */
 {
     Tcl_WideInt wOffset, wResult;
 
@@ -5864,8 +6602,8 @@ Tcl_SeekOld(chan, offset, mode)
 }
 
 int
-Tcl_TellOld(chan)
-    Tcl_Channel chan;		/* The channel to return pos for. */
+Tcl_TellOld(
+    Tcl_Channel chan)		/* The channel to return pos for. */
 {
     Tcl_WideInt wResult;
 
@@ -5876,28 +6614,98 @@ Tcl_TellOld(chan)
 /*
  *---------------------------------------------------------------------------
  *
+ * Tcl_TruncateChannel --
+ *
+ *	Truncate a channel to the given length.
+ *
+ * Results:
+ *	TCL_OK on success, TCL_ERROR if the operation failed (e.g. is not
+ *	supported by the type of channel, or the underlying OS operation
+ *	failed in some way).
+ *
+ * Side effects:
+ *	Seeks the channel to the current location. Sets errno on OS error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_TruncateChannel(
+    Tcl_Channel chan,		/* Channel to truncate. */
+    Tcl_WideInt length)		/* Length to truncate it to. */
+{
+    Channel *chanPtr = (Channel *) chan;
+    Tcl_DriverTruncateProc *truncateProc =
+	    Tcl_ChannelTruncateProc(chanPtr->typePtr);
+    int result;
+
+    if (truncateProc == NULL) {
+	/*
+	 * Feature not supported and it's not emulatable. Pretend it's
+	 * returned an EINVAL, a very generic error!
+	 */
+
+	Tcl_SetErrno(EINVAL);
+	return TCL_ERROR;
+    }
+
+    if (!(chanPtr->state->flags & TCL_WRITABLE)) {
+	/*
+	 * We require that the file was opened of writing. Do that check now
+	 * so that we only flush if we think we're going to succeed.
+	 */
+
+	Tcl_SetErrno(EINVAL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Seek first to force a total flush of all pending buffers and ditch any
+     * pre-read input data.
+     */
+
+    if (Tcl_Seek(chan, (Tcl_WideInt)0, SEEK_CUR) == Tcl_LongAsWide(-1)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * We're all flushed to disk now and we also don't have any unfortunate
+     * input baggage around either; can truncate with impunity.
+     */
+
+    result = truncateProc(chanPtr->instanceData, length);
+    if (result != 0) {
+	Tcl_SetErrno(result);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * CheckChannelErrors --
  *
- *	See if the channel is in an ready state and can perform the
- *	desired operation.
+ *	See if the channel is in an ready state and can perform the desired
+ *	operation.
  *
  * Results:
- *	The return value is 0 if the channel is OK, otherwise the
- *	return value is -1 and errno is set to indicate the error.
+ *	The return value is 0 if the channel is OK, otherwise the return value
+ *	is -1 and errno is set to indicate the error.
  *
  * Side effects:
  *	May clear the EOF and/or BLOCKED bits if reading from channel.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 static int
-CheckChannelErrors(statePtr, flags)
-    ChannelState *statePtr;	/* Channel to check. */
-    int flags;			/* Test if channel supports desired operation:
-				 * TCL_READABLE, TCL_WRITABLE.  Also indicates
+CheckChannelErrors(
+    ChannelState *statePtr,	/* Channel to check. */
+    int flags)			/* Test if channel supports desired operation:
+				 * TCL_READABLE, TCL_WRITABLE. Also indicates
 				 * Raw read or write for special close
-				 * processing*/
+				 * processing */
 {
     int direction = flags & (TCL_READABLE|TCL_WRITABLE);
 
@@ -5906,20 +6714,31 @@ CheckChannelErrors(statePtr, flags)
      */
 
     if (statePtr->unreportedError != 0) {
-        Tcl_SetErrno(statePtr->unreportedError);
-        statePtr->unreportedError = 0;
-        return -1;
+	Tcl_SetErrno(statePtr->unreportedError);
+	statePtr->unreportedError = 0;
+
+	/*
+	 * TIP #219, Tcl Channel Reflection API.
+	 * Move a defered error message back into the channel bypass.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    TclDecrRefCount(statePtr->chanMsg);
+	}
+	statePtr->chanMsg = statePtr->unreportedMsg;
+	statePtr->unreportedMsg = NULL;
+	return -1;
     }
 
     /*
-     * Only the raw read and write operations are allowed during close
-     * in order to drain data from stacked channels.
+     * Only the raw read and write operations are allowed during close in
+     * order to drain data from stacked channels.
      */
 
     if ((statePtr->flags & CHANNEL_CLOSED) &&
 	    ((flags & CHANNEL_RAW_MODE) == 0)) {
-        Tcl_SetErrno(EACCES);
-        return -1;
+	Tcl_SetErrno(EACCES);
+	return -1;
     }
 
     /*
@@ -5927,8 +6746,8 @@ CheckChannelErrors(statePtr, flags)
      */
 
     if ((statePtr->flags & direction) == 0) {
-        Tcl_SetErrno(EACCES);
-        return -1;
+	Tcl_SetErrno(EACCES);
+	return -1;
     }
 
     /*
@@ -5946,16 +6765,16 @@ CheckChannelErrors(statePtr, flags)
 
     if (direction == TCL_READABLE) {
 	/*
-	 * If we have not encountered a sticky EOF, clear the EOF bit
-	 * (sticky EOF is set if we have seen the input eofChar, to prevent
-	 * reading beyond the eofChar). Also, always clear the BLOCKED bit.
-	 * We want to discover these conditions anew in each operation.
+	 * If we have not encountered a sticky EOF, clear the EOF bit (sticky
+	 * EOF is set if we have seen the input eofChar, to prevent reading
+	 * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
+	 * discover these conditions anew in each operation.
 	 */
 
 	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
-	    statePtr->flags &= ~CHANNEL_EOF;
+	    ResetFlag(statePtr, CHANNEL_EOF);
 	}
-	statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
     }
 
     return 0;
@@ -5978,15 +6797,15 @@ CheckChannelErrors(statePtr, flags)
  */
 
 int
-Tcl_Eof(chan)
-    Tcl_Channel chan;			/* Does this channel have EOF? */
+Tcl_Eof(
+    Tcl_Channel chan)		/* Does this channel have EOF? */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of real channel structure. */
+				/* State of real channel structure. */
 
     return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
-            ((statePtr->flags & CHANNEL_EOF) &&
-		    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
+	    ((statePtr->flags & CHANNEL_EOF) &&
+	    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
 }
 
 /*
@@ -6006,11 +6825,11 @@ Tcl_Eof(chan)
  */
 
 int
-Tcl_InputBlocked(chan)
-    Tcl_Channel chan;			/* Is this channel blocked? */
+Tcl_InputBlocked(
+    Tcl_Channel chan)		/* Is this channel blocked? */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of real channel structure. */
+				/* State of real channel structure. */
 
     return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
 }
@@ -6020,12 +6839,12 @@ Tcl_InputBlocked(chan)
  *
  * Tcl_InputBuffered --
  *
- *	Returns the number of bytes of input currently buffered in the
- *	common internal buffer of a channel.
+ *	Returns the number of bytes of input currently buffered in the common
+ *	internal buffer of a channel.
  *
  * Results:
- *	The number of input bytes buffered, or zero if the channel is not
- *	open for reading.
+ *	The number of input bytes buffered, or zero if the channel is not open
+ *	for reading.
  *
  * Side effects:
  *	None.
@@ -6034,28 +6853,26 @@ Tcl_InputBlocked(chan)
  */
 
 int
-Tcl_InputBuffered(chan)
-    Tcl_Channel chan;			/* The channel to query. */
+Tcl_InputBuffered(
+    Tcl_Channel chan)		/* The channel to query. */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of real channel structure. */
+				/* State of real channel structure. */
     ChannelBuffer *bufPtr;
     int bytesBuffered;
 
-    for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
-	 bufPtr != (ChannelBuffer *) NULL;
-	 bufPtr = bufPtr->nextPtr) {
-        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL;
+	    bufPtr = bufPtr->nextPtr) {
+	bytesBuffered += BytesLeft(bufPtr);
     }
 
     /*
      * Don't forget the bytes in the topmost pushback area.
      */
 
-    for (bufPtr = statePtr->topChanPtr->inQueueHead;
-	 bufPtr != (ChannelBuffer *) NULL;
-	 bufPtr = bufPtr->nextPtr) {
-        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;
+	    bufPtr = bufPtr->nextPtr) {
+	bytesBuffered += BytesLeft(bufPtr);
     }
 
     return bytesBuffered;
@@ -6066,12 +6883,12 @@ Tcl_InputBuffered(chan)
  *
  * Tcl_OutputBuffered --
  *
- *    Returns the number of bytes of output currently buffered in the
- *    common internal buffer of a channel.
+ *    Returns the number of bytes of output currently buffered in the common
+ *    internal buffer of a channel.
  *
  * Results:
- *    The number of output bytes buffered, or zero if the channel is not
- *    open for writing.
+ *    The number of output bytes buffered, or zero if the channel is not open
+ *    for writing.
  *
  * Side effects:
  *    None.
@@ -6080,24 +6897,24 @@ Tcl_InputBuffered(chan)
  */
 
 int
-Tcl_OutputBuffered(chan)
-    Tcl_Channel chan;                 /* The channel to query. */
+Tcl_OutputBuffered(
+    Tcl_Channel chan)		/* The channel to query. */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-                                      /* State of real channel structure. */
+				/* State of real channel structure. */
     ChannelBuffer *bufPtr;
     int bytesBuffered;
 
-    for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead;
-	bufPtr != (ChannelBuffer *) NULL;
-	bufPtr = bufPtr->nextPtr) {
-	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL;
+	    bufPtr = bufPtr->nextPtr) {
+	bytesBuffered += BytesLeft(bufPtr);
     }
-    if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
-	(statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
-	statePtr->flags |= BUFFER_READY;
-	bytesBuffered +=
-	    (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
+    if (statePtr->curOutPtr != NULL) {
+	register ChannelBuffer *curOutPtr = statePtr->curOutPtr;
+
+	if (IsBufferReady(curOutPtr)) {
+	    bytesBuffered += BytesLeft(curOutPtr);
+	}
     }
 
     return bytesBuffered;
@@ -6112,8 +6929,8 @@ Tcl_OutputBuffered(chan)
  *	internal buffer (push back area) of a channel.
  *
  * Results:
- *	The number of input bytes buffered, or zero if the channel is not
- *	open for reading.
+ *	The number of input bytes buffered, or zero if the channel is not open
+ *	for reading.
  *
  * Side effects:
  *	None.
@@ -6122,18 +6939,17 @@ Tcl_OutputBuffered(chan)
  */
 
 int
-Tcl_ChannelBuffered(chan)
-    Tcl_Channel chan;			/* The channel to query. */
+Tcl_ChannelBuffered(
+    Tcl_Channel chan)		/* The channel to query. */
 {
     Channel *chanPtr = (Channel *) chan;
-					/* real channel structure. */
+				/* Real channel structure. */
     ChannelBuffer *bufPtr;
-    int bytesBuffered;
+    int bytesBuffered = 0;
 
-    for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
-	 bufPtr != (ChannelBuffer *) NULL;
-	 bufPtr = bufPtr->nextPtr) {
-        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+    for (bufPtr = chanPtr->inQueueHead; bufPtr != NULL;
+	    bufPtr = bufPtr->nextPtr) {
+	bytesBuffered += BytesLeft(bufPtr);
     }
 
     return bytesBuffered;
@@ -6144,8 +6960,8 @@ Tcl_ChannelBuffered(chan)
  *
  * Tcl_SetChannelBufferSize --
  *
- *	Sets the size of buffers to allocate to store input or output
- *	in the channel. The size must be between 1 byte and 1 MByte.
+ *	Sets the size of buffers to allocate to store input or output in the
+ *	channel. The size must be between 1 byte and 1 MByte.
  *
  * Results:
  *	None.
@@ -6157,13 +6973,12 @@ Tcl_ChannelBuffered(chan)
  */
 
 void
-Tcl_SetChannelBufferSize(chan, sz)
-    Tcl_Channel chan;			/* The channel whose buffer size
-                                         * to set. */
-    int sz;				/* The size to set. */
+Tcl_SetChannelBufferSize(
+    Tcl_Channel chan,		/* The channel whose buffer size to set. */
+    int sz)			/* The size to set. */
 {
-    ChannelState *statePtr;		/* State of real channel structure. */
-    
+    ChannelState *statePtr;	/* State of real channel structure. */
+
     /*
      * Clip the buffer size to force it into the [1,1M] range
      */
@@ -6183,7 +6998,7 @@ Tcl_SetChannelBufferSize(chan, sz)
     }
     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
 	statePtr->outputStage = (char *)
-	    ckalloc((unsigned) (statePtr->bufSize + 2));
+		ckalloc((unsigned) (statePtr->bufSize + 2));
     }
 }
 
@@ -6204,12 +7019,12 @@ Tcl_SetChannelBufferSize(chan, sz)
  */
 
 int
-Tcl_GetChannelBufferSize(chan)
-    Tcl_Channel chan;		/* The channel for which to find the
-                                 * buffer size. */
+Tcl_GetChannelBufferSize(
+    Tcl_Channel chan)		/* The channel for which to find the buffer
+				 * size. */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of real channel structure. */
+				/* State of real channel structure. */
 
     return statePtr->bufSize;
 }
@@ -6219,44 +7034,43 @@ Tcl_GetChannelBufferSize(chan)
  *
  * Tcl_BadChannelOption --
  *
- *	This procedure generates a "bad option" error message in an
- *	(optional) interpreter.  It is used by channel drivers when 
- *      a invalid Set/Get option is requested. Its purpose is to concatenate
- *      the generic options list to the specific ones and factorize
- *      the generic options error message string.
+ *	This procedure generates a "bad option" error message in an (optional)
+ *	interpreter. It is used by channel drivers when a invalid Set/Get
+ *	option is requested. Its purpose is to concatenate the generic options
+ *	list to the specific ones and factorize the generic options error
+ *	message string.
  *
  * Results:
  *	TCL_ERROR.
  *
  * Side effects:
- *	An error message is generated in interp's result object to
- *	indicate that a command was invoked with the a bad option
- *	The message has the form
- *		bad option "blah": should be one of 
- *              <...generic options...>+<...specific options...>
- *	"blah" is the optionName argument and "<specific options>"
- *	is a space separated list of specific option words.
- *      The function takes good care of inserting minus signs before
- *      each option, commas after, and an "or" before the last option.
+
+ *	An error message is generated in interp's result object to indicate
+ *	that a command was invoked with the a bad option. The message has the
+ *	form:
+ *		bad option "blah": should be one of
+ *		<...generic options...>+<...specific options...>
+ *	"blah" is the optionName argument and "<specific options>" is a space
+ *	separated list of specific option words. The function takes good care
+ *	of inserting minus signs before each option, commas after, and an "or"
+ *	before the last option.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_BadChannelOption(interp, optionName, optionList)
-    Tcl_Interp *interp;			/* Current interpreter. (can be NULL)*/
-    CONST char *optionName;		/* 'bad option' name */
-    CONST char *optionList;		/* Specific options list to append 
-					 * to the standard generic options.
-					 * can be NULL for generic options 
-					 * only.
-					 */
-{
-    if (interp) {
-	CONST char *genericopt = 
-	    "blocking buffering buffersize encoding eofchar translation";
-	CONST char **argv;
-	int  argc, i;
+Tcl_BadChannelOption(
+    Tcl_Interp *interp,		/* Current interpreter (can be NULL).*/
+    const char *optionName,	/* 'bad option' name */
+    const char *optionList)	/* Specific options list to append to the
+				 * standard generic options. Can be NULL for
+				 * generic options only. */
+{
+    if (interp != NULL) {
+	const char *genericopt =
+		"blocking buffering buffersize encoding eofchar translation";
+	const char **argv;
+	int argc, i;
 	Tcl_DString ds;
 
 	Tcl_DStringInit(&ds);
@@ -6265,18 +7079,18 @@ Tcl_BadChannelOption(interp, optionName, optionList)
 	    Tcl_DStringAppend(&ds, " ", 1);
 	    Tcl_DStringAppend(&ds, optionList, -1);
 	}
-	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), 
+	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
 		&argc, &argv) != TCL_OK) {
-	    panic("malformed option list in channel driver");
+	    Tcl_Panic("malformed option list in channel driver");
 	}
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "bad option \"", optionName, 
-		"\": should be one of ", (char *) NULL);
+	Tcl_AppendResult(interp, "bad option \"", optionName,
+		"\": should be one of ", NULL);
 	argc--;
 	for (i = 0; i < argc; i++) {
-	    Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
+	    Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
 	}
-	Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
+	Tcl_AppendResult(interp, "or -", argv[i], NULL);
 	Tcl_DStringFree(&ds);
 	ckfree((char *) argv);
     }
@@ -6289,39 +7103,40 @@ Tcl_BadChannelOption(interp, optionName, optionList)
  *
  * Tcl_GetChannelOption --
  *
- *	Gets a mode associated with an IO channel. If the optionName arg
- *	is non NULL, retrieves the value of that option. If the optionName
- *	arg is NULL, retrieves a list of alternating option names and
- *	values for the given channel.
+ *	Gets a mode associated with an IO channel. If the optionName arg is
+ *	non NULL, retrieves the value of that option. If the optionName arg is
+ *	NULL, retrieves a list of alternating option names and values for the
+ *	given channel.
  *
  * Results:
- *	A standard Tcl result. Also sets the supplied DString to the
- *	string value of the option(s) returned.
+ *	A standard Tcl result. Also sets the supplied DString to the string
+ *	value of the option(s) returned.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
-    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
-    Tcl_Channel chan;		/* Channel on which to get option. */
-    CONST char *optionName;	/* Option to get. */
-    Tcl_DString *dsPtr;		/* Where to store value(s). */
+Tcl_GetChannelOption(
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    Tcl_Channel chan,		/* Channel on which to get option. */
+    const char *optionName,	/* Option to get. */
+    Tcl_DString *dsPtr)		/* Where to store value(s). */
 {
     size_t len;			/* Length of optionName string. */
     char optionVal[128];	/* Buffer for sprintf. */
     Channel *chanPtr = (Channel *) chan;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     int flags;
 
     /*
      * Disallow options on dead channels -- channels that have been closed but
      * not yet been deallocated. Such channels can be found if the exit
-     * handler for channel cleanup has run but the channel is still
-     * registered in an interpreter.
+     * handler for channel cleanup has run but the channel is still registered
+     * in an interpreter.
      */
 
     if (CheckForDeadChannel(interp, statePtr)) {
@@ -6347,57 +7162,52 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
     }
 
     /*
-     * If the optionName is NULL it means that we want a list of all
-     * options and values.
+     * If the optionName is NULL it means that we want a list of all options
+     * and values.
      */
-    
-    if (optionName == (char *) NULL) {
-        len = 0;
+
+    if (optionName == NULL) {
+	len = 0;
     } else {
-        len = strlen(optionName);
-    }
-    
-    if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-blocking", len) == 0))) {
-        if (len == 0) {
-            Tcl_DStringAppendElement(dsPtr, "-blocking");
-        }
-        Tcl_DStringAppendElement(dsPtr,
+	len = strlen(optionName);
+    }
+
+    if (len == 0 || HaveOpt(2, "-blocking")) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-blocking");
+	}
+	Tcl_DStringAppendElement(dsPtr,
 		(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
-        if (len > 0) {
-            return TCL_OK;
-        }
-    }
-    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-buffering", len) == 0))) {
-        if (len == 0) {
-            Tcl_DStringAppendElement(dsPtr, "-buffering");
-        }
-        if (flags & CHANNEL_LINEBUFFERED) {
-            Tcl_DStringAppendElement(dsPtr, "line");
-        } else if (flags & CHANNEL_UNBUFFERED) {
-            Tcl_DStringAppendElement(dsPtr, "none");
-        } else {
-            Tcl_DStringAppendElement(dsPtr, "full");
-        }
-        if (len > 0) {
-            return TCL_OK;
-        }
-    }
-    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-buffersize", len) == 0))) {
-        if (len == 0) {
-            Tcl_DStringAppendElement(dsPtr, "-buffersize");
-        }
-        TclFormatInt(optionVal, statePtr->bufSize);
-        Tcl_DStringAppendElement(dsPtr, optionVal);
-        if (len > 0) {
-            return TCL_OK;
-        }
-    }
-    if ((len == 0) ||
-	    ((len > 2) && (optionName[1] == 'e') &&
-		    (strncmp(optionName, "-encoding", len) == 0))) {
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+    if (len == 0 || HaveOpt(7, "-buffering")) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-buffering");
+	}
+	if (flags & CHANNEL_LINEBUFFERED) {
+	    Tcl_DStringAppendElement(dsPtr, "line");
+	} else if (flags & CHANNEL_UNBUFFERED) {
+	    Tcl_DStringAppendElement(dsPtr, "none");
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "full");
+	}
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+    if (len == 0 || HaveOpt(7, "-buffersize")) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-buffersize");
+	}
+	TclFormatInt(optionVal, statePtr->bufSize);
+	Tcl_DStringAppendElement(dsPtr, optionVal);
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+    if (len == 0 || HaveOpt(2, "-encoding")) {
 	if (len == 0) {
 	    Tcl_DStringAppendElement(dsPtr, "-encoding");
 	}
@@ -6411,108 +7221,111 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
 	    return TCL_OK;
 	}
     }
-    if ((len == 0) ||
-            ((len > 2) && (optionName[1] == 'e') &&
-                    (strncmp(optionName, "-eofchar", len) == 0))) {
-        if (len == 0) {
-            Tcl_DStringAppendElement(dsPtr, "-eofchar");
-        }
-        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
-                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
-            Tcl_DStringStartSublist(dsPtr);
-        }
-        if (flags & TCL_READABLE) {
-            if (statePtr->inEofChar == 0) {
-                Tcl_DStringAppendElement(dsPtr, "");
-            } else {
-                char buf[4];
-
-                sprintf(buf, "%c", statePtr->inEofChar);
-                Tcl_DStringAppendElement(dsPtr, buf);
-            }
-        }
-        if (flags & TCL_WRITABLE) {
-            if (statePtr->outEofChar == 0) {
-                Tcl_DStringAppendElement(dsPtr, "");
-            } else {
-                char buf[4];
-
-                sprintf(buf, "%c", statePtr->outEofChar);
-                Tcl_DStringAppendElement(dsPtr, buf);
-            }
-        }
-        if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
-            /* Not readable or writable (server socket) */
-            Tcl_DStringAppendElement(dsPtr, "");
-        }
-        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
-                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
-            Tcl_DStringEndSublist(dsPtr);
-        }
-        if (len > 0) {
-            return TCL_OK;
-        }
-    }
-    if ((len == 0) ||
-            ((len > 1) && (optionName[1] == 't') &&
-                    (strncmp(optionName, "-translation", len) == 0))) {
-        if (len == 0) {
-            Tcl_DStringAppendElement(dsPtr, "-translation");
-        }
-        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
-                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
-            Tcl_DStringStartSublist(dsPtr);
-        }
-        if (flags & TCL_READABLE) {
-            if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
-                Tcl_DStringAppendElement(dsPtr, "auto");
-            } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
-                Tcl_DStringAppendElement(dsPtr, "cr");
-            } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
-                Tcl_DStringAppendElement(dsPtr, "crlf");
-            } else {
-                Tcl_DStringAppendElement(dsPtr, "lf");
-            }
-        }
-        if (flags & TCL_WRITABLE) {
-            if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
-                Tcl_DStringAppendElement(dsPtr, "auto");
-            } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
-                Tcl_DStringAppendElement(dsPtr, "cr");
-            } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
-                Tcl_DStringAppendElement(dsPtr, "crlf");
-            } else {
-                Tcl_DStringAppendElement(dsPtr, "lf");
-            }
-        }
-        if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
-            /* Not readable or writable (server socket) */
-            Tcl_DStringAppendElement(dsPtr, "auto");
-        }
-        if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
-                (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
-            Tcl_DStringEndSublist(dsPtr);
-        }
-        if (len > 0) {
-            return TCL_OK;
-        }
-    }
-    if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
+    if (len == 0 || HaveOpt(2, "-eofchar")) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-eofchar");
+	}
+	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	if (flags & TCL_READABLE) {
+	    if (statePtr->inEofChar == 0) {
+		Tcl_DStringAppendElement(dsPtr, "");
+	    } else {
+		char buf[4];
+
+		sprintf(buf, "%c", statePtr->inEofChar);
+		Tcl_DStringAppendElement(dsPtr, buf);
+	    }
+	}
+	if (flags & TCL_WRITABLE) {
+	    if (statePtr->outEofChar == 0) {
+		Tcl_DStringAppendElement(dsPtr, "");
+	    } else {
+		char buf[4];
+
+		sprintf(buf, "%c", statePtr->outEofChar);
+		Tcl_DStringAppendElement(dsPtr, buf);
+	    }
+	}
+	if (!(flags & (TCL_READABLE|TCL_WRITABLE))) {
+	    /*
+	     * Not readable or writable (e.g. server socket)
+	     */
+
+	    Tcl_DStringAppendElement(dsPtr, "");
+	}
+	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+	    Tcl_DStringEndSublist(dsPtr);
+	}
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+    if (len == 0 || HaveOpt(1, "-translation")) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-translation");
+	}
+	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	if (flags & TCL_READABLE) {
+	    if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+		Tcl_DStringAppendElement(dsPtr, "auto");
+	    } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+		Tcl_DStringAppendElement(dsPtr, "cr");
+	    } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+		Tcl_DStringAppendElement(dsPtr, "crlf");
+	    } else {
+		Tcl_DStringAppendElement(dsPtr, "lf");
+	    }
+	}
+	if (flags & TCL_WRITABLE) {
+	    if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+		Tcl_DStringAppendElement(dsPtr, "auto");
+	    } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
+		Tcl_DStringAppendElement(dsPtr, "cr");
+	    } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+		Tcl_DStringAppendElement(dsPtr, "crlf");
+	    } else {
+		Tcl_DStringAppendElement(dsPtr, "lf");
+	    }
+	}
+	if (!(flags & (TCL_READABLE|TCL_WRITABLE))) {
+	    /*
+	     * Not readable or writable (e.g. server socket)
+	     */
+
+	    Tcl_DStringAppendElement(dsPtr, "auto");
+	}
+	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
+		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
+	    Tcl_DStringEndSublist(dsPtr);
+	}
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+
+    if (chanPtr->typePtr->getOptionProc != NULL) {
 	/*
-	 * let the driver specific handle additional options
-	 * and result code and message.
+	 * Let the driver specific handle additional options and result code
+	 * and message.
 	 */
 
-        return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
+	return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
 		interp, optionName, dsPtr);
     } else {
 	/*
-	 * no driver specific options case.
+	 * No driver specific options case.
 	 */
 
-        if (len == 0) {
-            return TCL_OK;
-        }
+	if (len == 0) {
+	    return TCL_OK;
+	}
 	return Tcl_BadChannelOption(interp, optionName, NULL);
     }
 }
@@ -6525,8 +7338,8 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
  *	Sets an option on a channel.
  *
  * Results:
- *	A standard Tcl result.  On error, sets interp's result object
- *	if interp is not NULL.
+ *	A standard Tcl result. On error, sets interp's result object if
+ *	interp is not NULL.
  *
  * Side effects:
  *	May modify an option on a device.
@@ -6535,17 +7348,19 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
  */
 
 int
-Tcl_SetChannelOption(interp, chan, optionName, newValue)
-    Tcl_Interp *interp;		/* For error reporting - can be NULL. */
-    Tcl_Channel chan;		/* Channel on which to set mode. */
-    CONST char *optionName;	/* Which option to set? */
-    CONST char *newValue;	/* New value for option. */
-{
-    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+Tcl_SetChannelOption(
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    Tcl_Channel chan,		/* Channel on which to set mode. */
+    const char *optionName,	/* Which option to set? */
+    const char *newValue)	/* New value for option. */
+{
+    Channel *chanPtr = (Channel *) chan;
+				/* The real IO channel. */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     size_t len;			/* Length of optionName string. */
     int argc;
-    CONST char **argv;
+    const char **argv;
 
     /*
      * If the channel is in the middle of a background copy, fail.
@@ -6553,18 +7368,17 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 
     if (statePtr->csPtrR || statePtr->csPtrW) {
 	if (interp) {
-	    Tcl_AppendResult(interp,
-		    "unable to set channel options: background copy in progress",
-		    (char *) NULL);
+	    Tcl_AppendResult(interp, "unable to set channel options: "
+		    "background copy in progress", NULL);
 	}
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Disallow options on dead channels -- channels that have been closed but
      * not yet been deallocated. Such channels can be found if the exit
-     * handler for channel cleanup has run but the channel is still
-     * registered in an interpreter.
+     * handler for channel cleanup has run but the channel is still registered
+     * in an interpreter.
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
@@ -6579,50 +7393,47 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 
     len = strlen(optionName);
 
-    if ((len > 2) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-blocking", len) == 0)) {
+    if (HaveOpt(2, "-blocking")) {
 	int newMode;
-        if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
-            return TCL_ERROR;
-        }
-        if (newMode) {
-            newMode = TCL_MODE_BLOCKING;
-        } else {
-            newMode = TCL_MODE_NONBLOCKING;
-        }
+
+	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (newMode) {
+	    newMode = TCL_MODE_BLOCKING;
+	} else {
+	    newMode = TCL_MODE_NONBLOCKING;
+	}
 	return SetBlockMode(interp, chanPtr, newMode);
-    } else if ((len > 7) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-buffering", len) == 0)) {
-        len = strlen(newValue);
-        if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
-            statePtr->flags &=
-                (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
-        } else if ((newValue[0] == 'l') &&
-                (strncmp(newValue, "line", len) == 0)) {
-            statePtr->flags &= (~(CHANNEL_UNBUFFERED));
-            statePtr->flags |= CHANNEL_LINEBUFFERED;
-        } else if ((newValue[0] == 'n') &&
-                (strncmp(newValue, "none", len) == 0)) {
-            statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
-            statePtr->flags |= CHANNEL_UNBUFFERED;
-        } else {
-            if (interp) {
-                Tcl_AppendResult(interp, "bad value for -buffering: ",
-                        "must be one of full, line, or none",
-                        (char *) NULL);
-                return TCL_ERROR;
-            }
-        }
+    } else if (HaveOpt(7, "-buffering")) {
+	len = strlen(newValue);
+	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
+	    statePtr->flags &=
+		    ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED);
+	} else if ((newValue[0] == 'l') &&
+		(strncmp(newValue, "line", len) == 0)) {
+	    ResetFlag(statePtr, CHANNEL_UNBUFFERED);
+	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);
+	} else if ((newValue[0] == 'n') &&
+		(strncmp(newValue, "none", len) == 0)) {
+	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
+	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
+	} else {
+	    if (interp) {
+		Tcl_AppendResult(interp, "bad value for -buffering: "
+			"must be one of full, line, or none", NULL);
+		return TCL_ERROR;
+	    }
+	}
 	return TCL_OK;
-    } else if ((len > 7) && (optionName[1] == 'b') &&
-            (strncmp(optionName, "-buffersize", len) == 0)) {
+    } else if (HaveOpt(7, "-buffersize")) {
 	int newBufferSize;
+
 	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetChannelBufferSize(chan, newBufferSize);
-    } else if ((len > 2) && (optionName[1] == 'e') &&
-	    (strncmp(optionName, "-encoding", len) == 0)) {
+    } else if (HaveOpt(2, "-encoding")) {
 	Tcl_Encoding encoding;
 
 	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
@@ -6633,10 +7444,12 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 		return TCL_ERROR;
 	    }
 	}
+
 	/*
 	 * When the channel has an escape sequence driven encoding such as
 	 * iso2022, the terminated escape sequence must write to the buffer.
 	 */
+
 	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
 		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
@@ -6648,74 +7461,77 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	statePtr->inputEncodingFlags = TCL_ENCODING_START;
 	statePtr->outputEncodingState = NULL;
 	statePtr->outputEncodingFlags = TCL_ENCODING_START;
-	statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
+	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 	UpdateInterest(chanPtr);
-    } else if ((len > 2) && (optionName[1] == 'e') &&
-            (strncmp(optionName, "-eofchar", len) == 0)) {
-        if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
-            return TCL_ERROR;
-        }
-        if (argc == 0) {
-            statePtr->inEofChar = 0;
-            statePtr->outEofChar = 0;
-        } else if (argc == 1) {
-            if (statePtr->flags & TCL_WRITABLE) {
-                statePtr->outEofChar = (int) argv[0][0];
-            }
-            if (statePtr->flags & TCL_READABLE) {
-                statePtr->inEofChar = (int) argv[0][0];
-            }
-        } else if (argc != 2) {
-            if (interp) {
-                Tcl_AppendResult(interp,
-                        "bad value for -eofchar: should be a list of zero,",
-                        " one, or two elements", (char *) NULL);
-            }
-            ckfree((char *) argv);
-            return TCL_ERROR;
-        } else {
-            if (statePtr->flags & TCL_READABLE) {
-                statePtr->inEofChar = (int) argv[0][0];
-            }
-            if (statePtr->flags & TCL_WRITABLE) {
-                statePtr->outEofChar = (int) argv[1][0];
-            }
-        }
-        if (argv != NULL) {
-            ckfree((char *) argv);
-        }
+    } else if (HaveOpt(2, "-eofchar")) {
+	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (argc == 0) {
+	    statePtr->inEofChar = 0;
+	    statePtr->outEofChar = 0;
+	} else if (argc == 1 || argc == 2) {
+	    int outIndex = (argc - 1);
+	    int inValue = (int) argv[0][0];
+	    int outValue = (int) argv[outIndex][0];
+	    if (inValue & 0x80 || outValue & 0x80) {
+		if (interp) {
+		    Tcl_AppendResult(interp, "bad value for -eofchar: ",
+			    "must be non-NUL ASCII character", NULL);
+		}
+		ckfree((char *) argv);
+		return TCL_ERROR;
+	    }
+	    if (statePtr->flags & TCL_READABLE) {
+		statePtr->inEofChar = inValue;
+	    }
+	    if (statePtr->flags & TCL_WRITABLE) {
+		statePtr->outEofChar = outValue;
+	    }
+	} else {
+	    if (interp) {
+		Tcl_AppendResult(interp,
+			"bad value for -eofchar: should be a list of zero,"
+			" one, or two elements", NULL);
+	    }
+	    ckfree((char *) argv);
+	    return TCL_ERROR;
+	}
+	if (argv != NULL) {
+	    ckfree((char *) argv);
+	}
 
 	/*
-	 * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing
-	 * the character which signals eof can transform a current eof
-	 * condition into a 'go ahead'. Ditto for blocked.
+	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
+	 * which signals eof can transform a current eof condition into a 'go
+	 * ahead'. Ditto for blocked.
 	 */
 
-	statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED));
+	statePtr->flags &=
+		~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED);
 
 	return TCL_OK;
-    } else if ((len > 1) && (optionName[1] == 't') &&
-            (strncmp(optionName, "-translation", len) == 0)) {
-	CONST char *readMode, *writeMode;
+    } else if (HaveOpt(1, "-translation")) {
+	const char *readMode, *writeMode;
 
-        if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
-            return TCL_ERROR;
-        }
+	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
 
-        if (argc == 1) {
+	if (argc == 1) {
 	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
 	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
 	} else if (argc == 2) {
 	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
 	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
 	} else {
-            if (interp) {
-                Tcl_AppendResult(interp,
-                        "bad value for -translation: must be a one or two",
-                        " element list", (char *) NULL);
-            }
-            ckfree((char *) argv);
-            return TCL_ERROR;
+	    if (interp) {
+		Tcl_AppendResult(interp,
+			"bad value for -translation: must be a one or two"
+			" element list", NULL);
+	    }
+	    ckfree((char *) argv);
+	    return TCL_ERROR;
 	}
 
 	if (readMode) {
@@ -6727,7 +7543,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	    } else if (strcmp(readMode, "binary") == 0) {
 		translation = TCL_TRANSLATE_LF;
 		statePtr->inEofChar = 0;
-		Tcl_FreeEncoding(statePtr->encoding);		    
+		Tcl_FreeEncoding(statePtr->encoding);
 		statePtr->encoding = NULL;
 	    } else if (strcmp(readMode, "lf") == 0) {
 		translation = TCL_TRANSLATE_LF;
@@ -6740,24 +7556,23 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	    } else {
 		if (interp) {
 		    Tcl_AppendResult(interp,
-			    "bad value for -translation: ",
-			    "must be one of auto, binary, cr, lf, crlf,",
-			    " or platform", (char *) NULL);
+			    "bad value for -translation: "
+			    "must be one of auto, binary, cr, lf, crlf,"
+			    " or platform", NULL);
 		}
 		ckfree((char *) argv);
 		return TCL_ERROR;
 	    }
 
 	    /*
-	     * Reset the EOL flags since we need to look at any buffered
-	     * data to see if the new translation mode allows us to
-	     * complete the line.
+	     * Reset the EOL flags since we need to look at any buffered data
+	     * to see if the new translation mode allows us to complete the
+	     * line.
 	     */
 
 	    if (translation != statePtr->inputTranslation) {
 		statePtr->inputTranslation = translation;
-		statePtr->flags &= ~(INPUT_SAW_CR);
-		statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
+		ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA);
 		UpdateInterest(chanPtr);
 	    }
 	}
@@ -6766,10 +7581,9 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 		/* Do nothing. */
 	    } else if (strcmp(writeMode, "auto") == 0) {
 		/*
-		 * This is a hack to get TCP sockets to produce output
-		 * in CRLF mode if they are being set into AUTO mode.
-		 * A better solution for achieving this effect will be
-		 * coded later.
+		 * This is a hack to get TCP sockets to produce output in CRLF
+		 * mode if they are being set into AUTO mode. A better
+		 * solution for achieving this effect will be coded later.
 		 */
 
 		if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
@@ -6780,7 +7594,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	    } else if (strcmp(writeMode, "binary") == 0) {
 		statePtr->outEofChar = 0;
 		statePtr->outputTranslation = TCL_TRANSLATE_LF;
-		Tcl_FreeEncoding(statePtr->encoding);		    
+		Tcl_FreeEncoding(statePtr->encoding);
 		statePtr->encoding = NULL;
 	    } else if (strcmp(writeMode, "lf") == 0) {
 		statePtr->outputTranslation = TCL_TRANSLATE_LF;
@@ -6793,21 +7607,21 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	    } else {
 		if (interp) {
 		    Tcl_AppendResult(interp,
-			    "bad value for -translation: ",
-			    "must be one of auto, binary, cr, lf, crlf,",
-			    " or platform", (char *) NULL);
+			    "bad value for -translation: "
+			    "must be one of auto, binary, cr, lf, crlf,"
+			    " or platform", NULL);
 		}
 		ckfree((char *) argv);
 		return TCL_ERROR;
 	    }
 	}
-        ckfree((char *) argv);            
-        return TCL_OK;
+	ckfree((char *) argv);
+	return TCL_OK;
     } else if (chanPtr->typePtr->setOptionProc != NULL) {
-        return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
-                interp, optionName, newValue);
+	return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
+		interp, optionName, newValue);
     } else {
-	return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
+	return Tcl_BadChannelOption(interp, optionName, NULL);
     }
 
     /*
@@ -6818,14 +7632,12 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
 	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
 	statePtr->saveInBufPtr = NULL;
     }
-    if (statePtr->inQueueHead != NULL) {
-	if ((statePtr->inQueueHead->nextPtr == NULL)
-		&& (statePtr->inQueueHead->nextAdded ==
-			statePtr->inQueueHead->nextRemoved)) {
-	    RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
-	    statePtr->inQueueHead = NULL;
-	    statePtr->inQueueTail = NULL;
-	}
+    if ((statePtr->inQueueHead != NULL)
+	    && (statePtr->inQueueHead->nextPtr == NULL)
+	    && IsBufferEmpty(statePtr->inQueueHead)) {
+	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+	statePtr->inQueueHead = NULL;
+	statePtr->inQueueTail = NULL;
     }
 
     /*
@@ -6833,12 +7645,11 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
      */
 
     if (statePtr->outputStage != NULL) {
-	ckfree((char *) statePtr->outputStage);
+	ckfree(statePtr->outputStage);
 	statePtr->outputStage = NULL;
     }
     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
-	statePtr->outputStage = (char *) 
-	    ckalloc((unsigned) (statePtr->bufSize + 2));
+	statePtr->outputStage = ckalloc((unsigned) (statePtr->bufSize + 2));
     }
     return TCL_OK;
 }
@@ -6848,11 +7659,10 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
  *
  * CleanupChannelHandlers --
  *
- *	Removes channel handlers that refer to the supplied interpreter,
- *	so that if the actual channel is not closed now, these handlers
- *	will not run on subsequent events on the channel. This would be
- *	erroneous, because the interpreter no longer has a reference to
- *	this channel.
+ *	Removes channel handlers that refer to the supplied interpreter, so
+ *	that if the actual channel is not closed now, these handlers will not
+ *	run on subsequent events on the channel. This would be erroneous,
+ *	because the interpreter no longer has a reference to this channel.
  *
  * Results:
  *	None.
@@ -6864,38 +7674,37 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
  */
 
 static void
-CleanupChannelHandlers(interp, chanPtr)
-    Tcl_Interp *interp;
-    Channel *chanPtr;
+CleanupChannelHandlers(
+    Tcl_Interp *interp,
+    Channel *chanPtr)
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
 
     /*
-     * Remove fileevent records on this channel that refer to the
-     * given interpreter.
+     * Remove fileevent records on this channel that refer to the given
+     * interpreter.
      */
-    
-    for (sPtr = statePtr->scriptRecordPtr,
-             prevPtr = (EventScriptRecord *) NULL;
-	 sPtr != (EventScriptRecord *) NULL;
-	 sPtr = nextPtr) {
-        nextPtr = sPtr->nextPtr;
-        if (sPtr->interp == interp) {
-            if (prevPtr == (EventScriptRecord *) NULL) {
-                statePtr->scriptRecordPtr = nextPtr;
-            } else {
-                prevPtr->nextPtr = nextPtr;
-            }
 
-            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-                    TclChannelEventScriptInvoker, (ClientData) sPtr);
+    for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
+	    sPtr != NULL; sPtr = nextPtr) {
+	nextPtr = sPtr->nextPtr;
+	if (sPtr->interp == interp) {
+	    if (prevPtr == NULL) {
+		statePtr->scriptRecordPtr = nextPtr;
+	    } else {
+		prevPtr->nextPtr = nextPtr;
+	    }
+
+	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+		    TclChannelEventScriptInvoker, sPtr);
 
-	    Tcl_DecrRefCount(sPtr->scriptPtr);
-            ckfree((char *) sPtr);
-        } else {
-            prevPtr = sPtr;
-        }
+	    TclDecrRefCount(sPtr->scriptPtr);
+	    ckfree((char *) sPtr);
+	} else {
+	    prevPtr = sPtr;
+	}
     }
 }
 
@@ -6904,10 +7713,9 @@ CleanupChannelHandlers(interp, chanPtr)
  *
  * Tcl_NotifyChannel --
  *
- *	This procedure is called by a channel driver when a driver
- *	detects an event on a channel.  This procedure is responsible
- *	for actually handling the event by invoking any channel
- *	handler callbacks.
+ *	This procedure is called by a channel driver when a driver detects an
+ *	event on a channel. This procedure is responsible for actually
+ *	handling the event by invoking any channel handler callbacks.
  *
  * Results:
  *	None.
@@ -6919,62 +7727,62 @@ CleanupChannelHandlers(interp, chanPtr)
  */
 
 void
-Tcl_NotifyChannel(channel, mask)
-    Tcl_Channel channel;	/* Channel that detected an event. */
-    int mask;			/* OR'ed combination of TCL_READABLE,
+Tcl_NotifyChannel(
+    Tcl_Channel channel,	/* Channel that detected an event. */
+    int mask)			/* OR'ed combination of TCL_READABLE,
 				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
 				 * which events were detected. */
 {
     Channel *chanPtr = (Channel *) channel;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     ChannelHandler *chPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     NextChannelHandler nh;
-    Channel* upChanPtr;
-    Tcl_ChannelType* upTypePtr;
+    Channel *upChanPtr;
+    const Tcl_ChannelType *upTypePtr;
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /* [SF Tcl Bug 943274]
-     * For a non-blocking channel without blockmodeproc we keep track
-     * of actual input coming from the OS so that we can do a credible
-     * imitation of non-blocking behaviour.
+    /*
+     * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
+     * keep track of actual input coming from the OS so that we can do a
+     * credible imitation of non-blocking behaviour.
      */
 
     if ((mask & TCL_READABLE) &&
-	(statePtr->flags & CHANNEL_NONBLOCKING) &&
-	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	!(statePtr->flags & CHANNEL_TIMER_FEV)) {
-
-        statePtr->flags |= CHANNEL_HAS_MORE_DATA;
+	    (statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	    !(statePtr->flags & CHANNEL_TIMER_FEV)) {
+	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
     }
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     /*
-     * In contrast to the other API functions this procedure walks towards
-     * the top of a stack and not down from it.
+     * In contrast to the other API functions this procedure walks towards the
+     * top of a stack and not down from it.
      *
      * The channel calling this procedure is the one who generated the event,
-     * and thus does not take part in handling it. IOW, its HandlerProc is
-     * not called, instead we begin with the channel above it.
+     * and thus does not take part in handling it. IOW, its HandlerProc is not
+     * called, instead we begin with the channel above it.
      *
-     * This behaviour also allows the transformation channels to
-     * generate their own events and pass them upward.
+     * This behaviour also allows the transformation channels to generate
+     * their own events and pass them upward.
      */
 
-    while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
-	Tcl_DriverHandlerProc* upHandlerProc;
+    while (mask && (chanPtr->upChanPtr != (NULL))) {
+	Tcl_DriverHandlerProc *upHandlerProc;
 
-        upChanPtr = chanPtr->upChanPtr;
+	upChanPtr = chanPtr->upChanPtr;
 	upTypePtr = upChanPtr->typePtr;
 	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
 	if (upHandlerProc != NULL) {
 	    mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
 	}
 
-	/* ELSE:
-	 * Ignore transformations which are unable to handle the event
-	 * coming from below. Assume that they don't change the mask and
-	 * pass it on.
+	/*
+	 * ELSE: Ignore transformations which are unable to handle the event
+	 * coming from below. Assume that they don't change the mask and pass
+	 * it on.
 	 */
 
 	chanPtr = upChanPtr;
@@ -6983,29 +7791,28 @@ Tcl_NotifyChannel(channel, mask)
     channel = (Tcl_Channel) chanPtr;
 
     /*
-     * Here we have either reached the top of the stack or the mask is
-     * empty.  We break out of the procedure if it is the latter.
+     * Here we have either reached the top of the stack or the mask is empty.
+     * We break out of the procedure if it is the latter.
      */
 
     if (!mask) {
-        return;
+	return;
     }
 
     /*
-     * We are now above the topmost channel in a stack and have events
-     * left. Now call the channel handlers as usual.
+     * We are now above the topmost channel in a stack and have events left.
+     * Now call the channel handlers as usual.
      *
      * Preserve the channel struct in case the script closes it.
      */
-     
-    Tcl_Preserve((ClientData) channel);
-    Tcl_Preserve((ClientData) statePtr);
+
+    Tcl_Preserve(channel);
+    Tcl_Preserve(statePtr);
 
     /*
-     * If we are flushing in the background, be sure to call FlushChannel
-     * for writable events.  Note that we have to discard the writable
-     * event so we don't call any write handlers before the flush is
-     * complete.
+     * If we are flushing in the background, be sure to call FlushChannel for
+     * writable events. Note that we have to discard the writable event so we
+     * don't call any write handlers before the flush is complete.
      */
 
     if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
@@ -7017,12 +7824,12 @@ Tcl_NotifyChannel(channel, mask)
      * Add this invocation to the list of recursive invocations of
      * ChannelHandlerEventProc.
      */
-    
-    nh.nextHandlerPtr = (ChannelHandler *) NULL;
+
+    nh.nextHandlerPtr = NULL;
     nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
     tsdPtr->nestedHandlerPtr = &nh;
 
-    for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+    for (chPtr = statePtr->chPtr; chPtr != NULL; ) {
 	/*
 	 * If this channel handler is interested in any of the events that
 	 * have occurred on the channel, invoke its procedure.
@@ -7038,17 +7845,17 @@ Tcl_NotifyChannel(channel, mask)
     }
 
     /*
-     * Update the notifier interest, since it may have changed after
-     * invoking event handlers. Skip that if the channel was deleted
-     * in the call to the channel handler.
+     * Update the notifier interest, since it may have changed after invoking
+     * event handlers. Skip that if the channel was deleted in the call to the
+     * channel handler.
      */
 
     if (chanPtr->typePtr != NULL) {
-        UpdateInterest(chanPtr);
+	UpdateInterest(chanPtr);
     }
 
-    Tcl_Release((ClientData) statePtr);
-    Tcl_Release((ClientData) channel);
+    Tcl_Release(statePtr);
+    Tcl_Release(channel);
 
     tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
 }
@@ -7058,8 +7865,8 @@ Tcl_NotifyChannel(channel, mask)
  *
  * UpdateInterest --
  *
- *	Arrange for the notifier to call us back at appropriate times
- *	based on the current state of the channel.
+ *	Arrange for the notifier to call us back at appropriate times based on
+ *	the current state of the channel.
  *
  * Results:
  *	None.
@@ -7071,15 +7878,16 @@ Tcl_NotifyChannel(channel, mask)
  */
 
 static void
-UpdateInterest(chanPtr)
-    Channel *chanPtr;		/* Channel to update. */
+UpdateInterest(
+    Channel *chanPtr)		/* Channel to update. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     int mask = statePtr->interestMask;
 
     /*
-     * If there are flushed buffers waiting to be written, then
-     * we need to watch for the channel to become writable.
+     * If there are flushed buffers waiting to be written, then we need to
+     * watch for the channel to become writable.
      */
 
     if (statePtr->flags & BG_FLUSH_SCHEDULED) {
@@ -7089,62 +7897,59 @@ UpdateInterest(chanPtr)
     /*
      * If there is data in the input queue, and we aren't waiting for more
      * data, then we need to schedule a timer so we don't block in the
-     * notifier.  Also, cancel the read interest so we don't get duplicate
+     * notifier. Also, cancel the read interest so we don't get duplicate
      * events.
      */
 
     if (mask & TCL_READABLE) {
 	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
-		&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
-		&& (statePtr->inQueueHead->nextRemoved <
-			statePtr->inQueueHead->nextAdded)) {
+		&& (statePtr->inQueueHead != NULL)
+		&& IsBufferReady(statePtr->inQueueHead)) {
 	    mask &= ~TCL_READABLE;
 
 	    /*
 	     * Andreas Kupries, April 11, 2003
 	     *
-	     * Some operating systems (Solaris 2.6 and higher (but not
-	     * Solaris 2.5, go figure)) generate READABLE and
-	     * EXCEPTION events when select()'ing [*] on a plain file,
-	     * even if EOF was not yet reached. This is a problem in
-	     * the following situation:
+	     * Some operating systems (Solaris 2.6 and higher (but not Solaris
+	     * 2.5, go figure)) generate READABLE and EXCEPTION events when
+	     * select()'ing [*] on a plain file, even if EOF was not yet
+	     * reached. This is a problem in the following situation:
 	     *
-	     * - An extension asks to get both READABLE and EXCEPTION
-	     *   events.
-	     * - It reads data into a buffer smaller than the buffer
-	     *   used by Tcl itself.
-	     * - It does not process all events in the event queue, but
-	     *   only only one, at least in some situations.
+	     * - An extension asks to get both READABLE and EXCEPTION events.
+	     * - It reads data into a buffer smaller than the buffer used by
+	     *	 Tcl itself.
+	     * - It does not process all events in the event queue, but only
+	     *	 one, at least in some situations.
 	     *
 	     * In that case we can get into a situation where
 	     *
 	     * - Tcl drops READABLE here, because it has data in its own
-	     *   buffers waiting to be read by the extension.
+	     *	 buffers waiting to be read by the extension.
 	     * - A READABLE event is syntesized via timer.
 	     * - The OS still reports the EXCEPTION condition on the file.
-	     * - And the extension gets the EXCPTION event first, and
-	     *   handles this as EOF.
+	     * - And the extension gets the EXCPTION event first, and handles
+	     *	 this as EOF.
 	     *
 	     * End result ==> Premature end of reading from a file.
 	     *
-	     * The concrete example is 'Expect', and its [expect]
-	     * command (and at the C-level, deep in the bowels of
-	     * Expect, 'exp_get_next_event'. See marker 'SunOS' for
-	     * commentary in that function too).
+	     * The concrete example is 'Expect', and its [expect] command
+	     * (and at the C-level, deep in the bowels of Expect,
+	     * 'exp_get_next_event'. See marker 'SunOS' for commentary in
+	     * that function too).
 	     *
-	     * [*] As the Tcl notifier does. See also for marker
-	     * 'SunOS' in file 'exp_event.c' of Expect.
+	     * [*] As the Tcl notifier does. See also for marker 'SunOS' in
+	     * file 'exp_event.c' of Expect.
 	     *
-	     * Our solution here is to drop the interest in the
-	     * EXCEPTION events too. This compiles on all platforms,
-	     * and also passes the testsuite on all of them.
+	     * Our solution here is to drop the interest in the EXCEPTION
+	     * events too. This compiles on all platforms, and also passes the
+	     * testsuite on all of them.
 	     */
 
 	    mask &= ~TCL_EXCEPTION;
 
 	    if (!statePtr->timer) {
 		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
-			(ClientData) chanPtr);
+			chanPtr);
 	    }
 	}
     }
@@ -7156,8 +7961,8 @@ UpdateInterest(chanPtr)
  *
  * ChannelTimerProc --
  *
- *	Timer handler scheduled by UpdateInterest to monitor the
- *	channel buffers until they are empty.
+ *	Timer handler scheduled by UpdateInterest to monitor the channel
+ *	buffers until they are empty.
  *
  * Results:
  *	None.
@@ -7169,47 +7974,47 @@ UpdateInterest(chanPtr)
  */
 
 static void
-ChannelTimerProc(clientData)
-    ClientData clientData;
+ChannelTimerProc(
+    ClientData clientData)
 {
-    Channel *chanPtr = (Channel *) clientData;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    Channel *chanPtr = clientData;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
 
     if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
 	    && (statePtr->interestMask & TCL_READABLE)
-	    && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
-	    && (statePtr->inQueueHead->nextRemoved <
-		    statePtr->inQueueHead->nextAdded)) {
+	    && (statePtr->inQueueHead != NULL)
+	    && IsBufferReady(statePtr->inQueueHead)) {
 	/*
-	 * Restart the timer in case a channel handler reenters the
-	 * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
+	 * Restart the timer in case a channel handler reenters the event loop
+	 * before UpdateInterest gets called by Tcl_NotifyChannel.
 	 */
 
-	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
-		(ClientData) chanPtr);
+	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	/* Set the TIMER flag to notify the higher levels that the
-	 * driver might have no data for us. We do this only if we are
-	 * in non-blocking mode and the driver has no BlockModeProc
-	 * because only then we really don't know if the driver will
-	 * block or not. A similar test is done in "PeekAhead".
+	/*
+	 * Set the TIMER flag to notify the higher levels that the driver
+	 * might have no data for us. We do this only if we are in
+	 * non-blocking mode and the driver has no BlockModeProc because only
+	 * then we really don't know if the driver will block or not. A
+	 * similar test is done in "PeekAhead".
 	 */
 
 	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
 	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
-	    statePtr->flags |= CHANNEL_TIMER_FEV;
+	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-	Tcl_Preserve((ClientData) statePtr);
+	Tcl_Preserve(statePtr);
 	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	statePtr->flags &= ~CHANNEL_TIMER_FEV; 
+	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-	Tcl_Release((ClientData) statePtr);
+	Tcl_Release(statePtr);
     } else {
 	statePtr->timer = NULL;
 	UpdateInterest(chanPtr);
@@ -7221,80 +8026,75 @@ ChannelTimerProc(clientData)
  *
  * Tcl_CreateChannelHandler --
  *
- *	Arrange for a given procedure to be invoked whenever the
- *	channel indicated by the chanPtr arg becomes readable or
- *	writable.
+ *	Arrange for a given procedure to be invoked whenever the channel
+ *	indicated by the chanPtr arg becomes readable or writable.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	From now on, whenever the I/O channel given by chanPtr becomes
- *	ready in the way indicated by mask, proc will be invoked.
- *	See the manual entry for details on the calling sequence
- *	to proc.  If there is already an event handler for chan, proc
- *	and clientData, then the mask will be updated.
+ *	From now on, whenever the I/O channel given by chanPtr becomes ready
+ *	in the way indicated by mask, proc will be invoked. See the manual
+ *	entry for details on the calling sequence to proc. If there is already
+ *	an event handler for chan, proc and clientData, then the mask will be
+ *	updated.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CreateChannelHandler(chan, mask, proc, clientData)
-    Tcl_Channel chan;		/* The channel to create the handler for. */
-    int mask;			/* OR'ed combination of TCL_READABLE,
-				 * TCL_WRITABLE, and TCL_EXCEPTION:
-				 * indicates conditions under which
-				 * proc should be called. Use 0 to
-                                 * disable a registered handler. */
-    Tcl_ChannelProc *proc;	/* Procedure to call for each
-				 * selected event. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
+Tcl_CreateChannelHandler(
+    Tcl_Channel chan,		/* The channel to create the handler for. */
+    int mask,			/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
+				 * conditions under which proc should be
+				 * called. Use 0 to disable a registered
+				 * handler. */
+    Tcl_ChannelProc *proc,	/* Procedure to call for each selected
+				 * event. */
+    ClientData clientData)	/* Arbitrary data to pass to proc. */
 {
     ChannelHandler *chPtr;
     Channel *chanPtr = (Channel *) chan;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
 
     /*
-     * Check whether this channel handler is not already registered. If
-     * it is not, create a new record, else reuse existing record (smash
-     * current values).
+     * Check whether this channel handler is not already registered. If it is
+     * not, create a new record, else reuse existing record (smash current
+     * values).
      */
 
-    for (chPtr = statePtr->chPtr;
-	 chPtr != (ChannelHandler *) NULL;
-	 chPtr = chPtr->nextPtr) {
-        if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
-                (chPtr->clientData == clientData)) {
-            break;
-        }
+    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
+	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
+		(chPtr->clientData == clientData)) {
+	    break;
+	}
     }
-    if (chPtr == (ChannelHandler *) NULL) {
-        chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
-        chPtr->mask = 0;
-        chPtr->proc = proc;
-        chPtr->clientData = clientData;
-        chPtr->chanPtr = chanPtr;
-        chPtr->nextPtr = statePtr->chPtr;
-        statePtr->chPtr = chPtr;
+    if (chPtr == NULL) {
+	chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler));
+	chPtr->mask = 0;
+	chPtr->proc = proc;
+	chPtr->clientData = clientData;
+	chPtr->chanPtr = chanPtr;
+	chPtr->nextPtr = statePtr->chPtr;
+	statePtr->chPtr = chPtr;
     }
 
     /*
-     * The remainder of the initialization below is done regardless of
-     * whether or not this is a new record or a modification of an old
-     * one.
+     * The remainder of the initialization below is done regardless of whether
+     * or not this is a new record or a modification of an old one.
      */
 
     chPtr->mask = mask;
 
     /*
-     * Recompute the interest mask for the channel - this call may actually
-     * be disabling an existing handler.
+     * Recompute the interest mask for the channel - this call may actually be
+     * disabling an existing handler.
      */
-    
+
     statePtr->interestMask = 0;
-    for (chPtr = statePtr->chPtr;
-	 chPtr != (ChannelHandler *) NULL;
-	 chPtr = chPtr->nextPtr) {
+    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
 	statePtr->interestMask |= chPtr->mask;
     }
 
@@ -7306,55 +8106,53 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
  *
  * Tcl_DeleteChannelHandler --
  *
- *	Cancel a previously arranged callback arrangement for an IO
- *	channel.
+ *	Cancel a previously arranged callback arrangement for an IO channel.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	If a callback was previously registered for this chan, proc and
- *	 clientData , it is removed and the callback will no longer be called
+ *	clientData, it is removed and the callback will no longer be called
  *	when the channel becomes ready for IO.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteChannelHandler(chan, proc, clientData)
-    Tcl_Channel chan;		/* The channel for which to remove the
-                                 * callback. */
-    Tcl_ChannelProc *proc;	/* The procedure in the callback to delete. */
-    ClientData clientData;	/* The client data in the callback
-                                 * to delete. */
-    
+Tcl_DeleteChannelHandler(
+    Tcl_Channel chan,		/* The channel for which to remove the
+				 * callback. */
+    Tcl_ChannelProc *proc,	/* The procedure in the callback to delete. */
+    ClientData clientData)	/* The client data in the callback to
+				 * delete. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ChannelHandler *chPtr, *prevChPtr;
     Channel *chanPtr = (Channel *) chan;
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     NextChannelHandler *nhPtr;
 
     /*
      * Find the entry and the previous one in the list.
      */
 
-    for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
-	 chPtr != (ChannelHandler *) NULL;
-	 chPtr = chPtr->nextPtr) {
-        if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
-                && (chPtr->proc == proc)) {
-            break;
-        }
-        prevChPtr = chPtr;
+    for (prevChPtr = NULL, chPtr = statePtr->chPtr; chPtr != NULL;
+	    chPtr = chPtr->nextPtr) {
+	if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
+		&& (chPtr->proc == proc)) {
+	    break;
+	}
+	prevChPtr = chPtr;
     }
 
     /*
      * If not found, return without doing anything.
      */
 
-    if (chPtr == (ChannelHandler *) NULL) {
-        return;
+    if (chPtr == NULL) {
+	return;
     }
 
     /*
@@ -7362,36 +8160,32 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
      * process the next one instead - we are going to delete *this* one.
      */
 
-    for (nhPtr = tsdPtr->nestedHandlerPtr;
-	 nhPtr != (NextChannelHandler *) NULL;
-	 nhPtr = nhPtr->nestedHandlerPtr) {
-        if (nhPtr->nextHandlerPtr == chPtr) {
-            nhPtr->nextHandlerPtr = chPtr->nextPtr;
-        }
+    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
+	    nhPtr = nhPtr->nestedHandlerPtr) {
+	if (nhPtr->nextHandlerPtr == chPtr) {
+	    nhPtr->nextHandlerPtr = chPtr->nextPtr;
+	}
     }
 
     /*
      * Splice it out of the list of channel handlers.
      */
-    
-    if (prevChPtr == (ChannelHandler *) NULL) {
-        statePtr->chPtr = chPtr->nextPtr;
+
+    if (prevChPtr == NULL) {
+	statePtr->chPtr = chPtr->nextPtr;
     } else {
-        prevChPtr->nextPtr = chPtr->nextPtr;
+	prevChPtr->nextPtr = chPtr->nextPtr;
     }
     ckfree((char *) chPtr);
 
     /*
      * Recompute the interest list for the channel, so that infinite loops
-     * will not result if Tcl_DeleteChannelHandler is called inside an
-     * event.
+     * will not result if Tcl_DeleteChannelHandler is called inside an event.
      */
 
     statePtr->interestMask = 0;
-    for (chPtr = statePtr->chPtr;
-	 chPtr != (ChannelHandler *) NULL;
-	 chPtr = chPtr->nextPtr) {
-        statePtr->interestMask |= chPtr->mask;
+    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
+	statePtr->interestMask |= chPtr->mask;
     }
 
     UpdateInterest(statePtr->topChanPtr);
@@ -7402,8 +8196,8 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
  *
  * DeleteScriptRecord --
  *
- *	Delete a script record for this combination of channel, interp
- *	and mask.
+ *	Delete a script record for this combination of channel, interp and
+ *	mask.
  *
  * Results:
  *	None.
@@ -7415,36 +8209,35 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
  */
 
 static void
-DeleteScriptRecord(interp, chanPtr, mask)
-    Tcl_Interp *interp;		/* Interpreter in which script was to be
-                                 * executed. */
-    Channel *chanPtr;		/* The channel for which to delete the
-                                 * script record (if any). */
-    int mask;			/* Events in mask must exactly match mask
-                                 * of script to delete. */
-{
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+DeleteScriptRecord(
+    Tcl_Interp *interp,		/* Interpreter in which script was to be
+				 * executed. */
+    Channel *chanPtr,		/* The channel for which to delete the script
+				 * record (if any). */
+    int mask)			/* Events in mask must exactly match mask of
+				 * script to delete. */
+{
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     EventScriptRecord *esPtr, *prevEsPtr;
 
-    for (esPtr = statePtr->scriptRecordPtr,
-             prevEsPtr = (EventScriptRecord *) NULL;
-	 esPtr != (EventScriptRecord *) NULL;
-	 prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
-        if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
-            if (esPtr == statePtr->scriptRecordPtr) {
-                statePtr->scriptRecordPtr = esPtr->nextPtr;
-            } else {
-                prevEsPtr->nextPtr = esPtr->nextPtr;
-            }
+    for (esPtr = statePtr->scriptRecordPtr, prevEsPtr = NULL; esPtr != NULL;
+	    prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
+	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
+	    if (esPtr == statePtr->scriptRecordPtr) {
+		statePtr->scriptRecordPtr = esPtr->nextPtr;
+	    } else {
+		prevEsPtr->nextPtr = esPtr->nextPtr;
+	    }
+
+	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+		    TclChannelEventScriptInvoker, esPtr);
 
-            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-                    TclChannelEventScriptInvoker, (ClientData) esPtr);
-            
-	    Tcl_DecrRefCount(esPtr->scriptPtr);
-            ckfree((char *) esPtr);
+	    TclDecrRefCount(esPtr->scriptPtr);
+	    ckfree((char *) esPtr);
 
-            break;
-        }
+	    break;
+	}
     }
 }
 
@@ -7466,40 +8259,54 @@ DeleteScriptRecord(interp, chanPtr, mask)
  */
 
 static void
-CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
-    Tcl_Interp *interp;			/* Interpreter in which to execute
-                                         * the stored script. */
-    Channel *chanPtr;			/* Channel for which script is to
-                                         * be stored. */
-    int mask;				/* Set of events for which script
-                                         * will be invoked. */
-    Tcl_Obj *scriptPtr;			/* Pointer to script object. */
-{
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+CreateScriptRecord(
+    Tcl_Interp *interp,		/* Interpreter in which to execute the stored
+				 * script. */
+    Channel *chanPtr,		/* Channel for which script is to be stored */
+    int mask,			/* Set of events for which script will be
+				 * invoked. */
+    Tcl_Obj *scriptPtr)		/* Pointer to script object. */
+{
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
     EventScriptRecord *esPtr;
+    int makeCH;
 
-    for (esPtr = statePtr->scriptRecordPtr;
-	 esPtr != (EventScriptRecord *) NULL;
-	 esPtr = esPtr->nextPtr) {
-        if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
-	    Tcl_DecrRefCount(esPtr->scriptPtr);
-	    esPtr->scriptPtr = (Tcl_Obj *) NULL;
-            break;
-        }
-    }
-    if (esPtr == (EventScriptRecord *) NULL) {
-        esPtr = (EventScriptRecord *) ckalloc((unsigned)
-                sizeof(EventScriptRecord));
-        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
-                TclChannelEventScriptInvoker, (ClientData) esPtr);
-        esPtr->nextPtr = statePtr->scriptRecordPtr;
-        statePtr->scriptRecordPtr = esPtr;
+    for (esPtr=statePtr->scriptRecordPtr; esPtr!=NULL; esPtr=esPtr->nextPtr) {
+	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
+	    TclDecrRefCount(esPtr->scriptPtr);
+	    esPtr->scriptPtr = NULL;
+	    break;
+	}
     }
+
+    makeCH = (esPtr == NULL);
+
+    if (makeCH) {
+	esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord));
+    }
+
+    /*
+     * Initialize the structure before calling Tcl_CreateChannelHandler,
+     * because a reflected channel caling 'chan postevent' aka
+     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
+     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
+     * see uninitialized memory and crash. See [Bug 2918110].
+     */
+
     esPtr->chanPtr = chanPtr;
     esPtr->interp = interp;
     esPtr->mask = mask;
     Tcl_IncrRefCount(scriptPtr);
     esPtr->scriptPtr = scriptPtr;
+
+    if (makeCH) {
+	esPtr->nextPtr = statePtr->scriptRecordPtr;
+	statePtr->scriptRecordPtr = esPtr;
+
+	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+		TclChannelEventScriptInvoker, esPtr);
+    }
 }
 
 /*
@@ -7507,9 +8314,9 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
  *
  * TclChannelEventScriptInvoker --
  *
- *	Invokes a script scheduled by "fileevent" for when the channel
- *	becomes ready for IO. This function is invoked by the channel
- *	handler which was created by the Tcl "fileevent" command.
+ *	Invokes a script scheduled by "fileevent" for when the channel becomes
+ *	ready for IO. This function is invoked by the channel handler which
+ *	was created by the Tcl "fileevent" command.
  *
  * Results:
  *	None.
@@ -7521,48 +8328,48 @@ CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
  */
 
 void
-TclChannelEventScriptInvoker(clientData, mask)
-    ClientData clientData;	/* The script+interp record. */
-    int mask;			/* Not used. */
+TclChannelEventScriptInvoker(
+    ClientData clientData,	/* The script+interp record. */
+    int mask)			/* Not used. */
 {
     Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
     Channel *chanPtr;		/* The channel for which this handler is
-                                 * registered. */
+				 * registered. */
     EventScriptRecord *esPtr;	/* The event script + interpreter to eval it
-                                 * in. */
+				 * in. */
     int result;			/* Result of call to eval script. */
 
-    esPtr	= (EventScriptRecord *) clientData;
-    chanPtr	= esPtr->chanPtr;
-    mask	= esPtr->mask;
-    interp	= esPtr->interp;
+    esPtr = clientData;
+    chanPtr = esPtr->chanPtr;
+    mask = esPtr->mask;
+    interp = esPtr->interp;
 
     /*
-     * We must preserve the interpreter so we can report errors on it
-     * later.  Note that we do not need to preserve the channel because
-     * that is done by Tcl_NotifyChannel before calling channel handlers.
+     * We must preserve the interpreter so we can report errors on it later.
+     * Note that we do not need to preserve the channel because that is done
+     * by Tcl_NotifyChannel before calling channel handlers.
      */
-    
-    Tcl_Preserve((ClientData) interp);
-    Tcl_Preserve((ClientData) chanPtr);
+
+    Tcl_Preserve(interp);
+    Tcl_Preserve(chanPtr);
     result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
 
     /*
-     * On error, cause a background error and remove the channel handler
-     * and the script record.
+     * On error, cause a background error and remove the channel handler and
+     * the script record.
      *
      * NOTE: Must delete channel handler before causing the background error
      * because the background error may want to reinstall the handler.
      */
-    
+
     if (result != TCL_OK) {
 	if (chanPtr->typePtr != NULL) {
 	    DeleteScriptRecord(interp, chanPtr, mask);
 	}
-        Tcl_BackgroundError(interp);
+	TclBackgroundException(interp, result);
     }
-    Tcl_Release((ClientData) chanPtr);
-    Tcl_Release((ClientData) interp);
+    Tcl_Release(chanPtr);
+    Tcl_Release(interp);
 }
 
 /*
@@ -7570,10 +8377,10 @@ TclChannelEventScriptInvoker(clientData, mask)
  *
  * Tcl_FileEventObjCmd --
  *
- *	This procedure implements the "fileevent" Tcl command. See the
- *	user documentation for details on what it does. This command is
- *	based on the Tk command "fileevent" which in turn is based on work
- *	contributed by Mark Diekhans.
+ *	This procedure implements the "fileevent" Tcl command. See the user
+ *	documentation for details on what it does. This command is based on
+ *	the Tk command "fileevent" which in turn is based on work contributed
+ *	by Mark Diekhans.
  *
  * Results:
  *	A standard Tcl result.
@@ -7586,22 +8393,20 @@ TclChannelEventScriptInvoker(clientData, mask)
 
 	/* ARGSUSED */
 int
-Tcl_FileEventObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Interpreter in which the channel
-                                         * for which to create the handler
-                                         * is found. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
-{
-    Channel *chanPtr;			/* The channel to create
-                                         * the handler for. */
-    ChannelState *statePtr;		/* state info for channel */
-    Tcl_Channel chan;			/* The opaque type for the channel. */
+Tcl_FileEventObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Interpreter in which the channel for which
+				 * to create the handler is found. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Channel *chanPtr;		/* The channel to create the handler for. */
+    ChannelState *statePtr;	/* State info for channel */
+    Tcl_Channel chan;		/* The opaque type for the channel. */
     char *chanName;
-    int modeIndex;			/* Index of mode argument. */
+    int modeIndex;		/* Index of mode argument. */
     int mask;
-    static CONST char *modeOptions[] = {"readable", "writable", NULL};
+    static const char *modeOptions[] = {"readable", "writable", NULL};
     static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
 
     if ((objc != 3) && (objc != 4)) {
@@ -7614,85 +8419,110 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
     }
     mask = maskArray[modeIndex];
 
-    chanName = Tcl_GetString(objv[1]);
+    chanName = TclGetString(objv[1]);
     chan = Tcl_GetChannel(interp, chanName, NULL);
-    if (chan == (Tcl_Channel) NULL) {
+    if (chan == NULL) {
 	return TCL_ERROR;
     }
-    chanPtr  = (Channel *) chan;
+    chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
     if ((statePtr->flags & mask) == 0) {
-        Tcl_AppendResult(interp, "channel is not ",
-                (mask == TCL_READABLE) ? "readable" : "writable",
-                (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel is not ",
+		(mask == TCL_READABLE) ? "readable" : "writable", NULL);
+	return TCL_ERROR;
     }
-    
+
     /*
      * If we are supposed to return the script, do so.
      */
 
     if (objc == 3) {
 	EventScriptRecord *esPtr;
-	for (esPtr = statePtr->scriptRecordPtr;
-             esPtr != (EventScriptRecord *) NULL;
-             esPtr = esPtr->nextPtr) {
+	for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
+		esPtr = esPtr->nextPtr) {
 	    if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
 		Tcl_SetObjResult(interp, esPtr->scriptPtr);
 		break;
 	    }
 	}
-        return TCL_OK;
+	return TCL_OK;
     }
 
     /*
      * If we are supposed to delete a stored script, do so.
      */
 
-    if (*(Tcl_GetString(objv[3])) == '\0') {
-        DeleteScriptRecord(interp, chanPtr, mask);
-        return TCL_OK;
+    if (*(TclGetString(objv[3])) == '\0') {
+	DeleteScriptRecord(interp, chanPtr, mask);
+	return TCL_OK;
     }
 
     /*
-     * Make the script record that will link between the event and the
-     * script to invoke. This also creates a channel event handler which
-     * will evaluate the script in the supplied interpreter.
+     * Make the script record that will link between the event and the script
+     * to invoke. This also creates a channel event handler which will
+     * evaluate the script in the supplied interpreter.
      */
 
     CreateScriptRecord(interp, chanPtr, mask, objv[3]);
-    
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * ZeroTransferTimerProc --
+ *
+ *	Timer handler scheduled by TclCopyChannel so that -command is
+ *	called asynchronously even when -size is 0.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls CopyData for -command invocation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ZeroTransferTimerProc(
+    ClientData clientData)
+{
+    /* calling CopyData with mask==0 still implies immediate invocation of the
+     *  -command callback, and completion of the fcopy.
+     */
+    CopyData(clientData, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCopyChannel --
  *
  *	This routine copies data from one channel to another, either
- *	synchronously or asynchronously.  If a command script is
- *	supplied, the operation runs in the background.  The script
- *	is invoked when the copy completes.  Otherwise the function
- *	waits until the copy is completed before returning.
+ *	synchronously or asynchronously. If a command script is supplied, the
+ *	operation runs in the background. The script is invoked when the copy
+ *	completes. Otherwise the function waits until the copy is completed
+ *	before returning.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	May schedule a background copy operation that causes both
- *	channels to be marked busy.
+ *	May schedule a background copy operation that causes both channels to
+ *	be marked busy.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
-    Tcl_Interp *interp;		/* Current interpreter. */
-    Tcl_Channel inChan;		/* Channel to read from. */
-    Tcl_Channel outChan;	/* Channel to write to. */
-    int toRead;			/* Amount of data to copy, or -1 for all. */
-    Tcl_Obj *cmdPtr;		/* Pointer to script to execute or NULL. */
+TclCopyChannel(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Channel inChan,		/* Channel to read from. */
+    Tcl_Channel outChan,	/* Channel to write to. */
+    int toRead,			/* Amount of data to copy, or -1 for all. */
+    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
 {
     Channel *inPtr = (Channel *) inChan;
     Channel *outPtr = (Channel *) outChan;
@@ -7701,53 +8531,46 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
     CopyState *csPtr;
     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
 
-    inStatePtr	= inPtr->state;
-    outStatePtr	= outPtr->state;
+    inStatePtr = inPtr->state;
+    outStatePtr = outPtr->state;
 
     if (BUSY_STATE(inStatePtr,TCL_READABLE)) {
 	if (interp) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+	    Tcl_AppendResult(interp, "channel \"",
 		    Tcl_GetChannelName(inChan), "\" is busy", NULL);
 	}
 	return TCL_ERROR;
     }
     if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
 	if (interp) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+	    Tcl_AppendResult(interp, "channel \"",
 		    Tcl_GetChannelName(outChan), "\" is busy", NULL);
 	}
 	return TCL_ERROR;
     }
 
-    readFlags	= inStatePtr->flags;
-    writeFlags	= outStatePtr->flags;
+    readFlags = inStatePtr->flags;
+    writeFlags = outStatePtr->flags;
 
     /*
-     * Set up the blocking mode appropriately.  Background copies need
-     * non-blocking channels.  Foreground copies need blocking channels.
-     * If there is an error, restore the old blocking mode.
+     * Set up the blocking mode appropriately. Background copies need
+     * non-blocking channels. Foreground copies need blocking channels. If
+     * there is an error, restore the old blocking mode.
      */
 
     if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
-	if (SetBlockMode(interp, inPtr,
-		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
-		!= TCL_OK) {
+	if (SetBlockMode(interp, inPtr, nonBlocking ?
+		TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-    }	    
-    if (inPtr != outPtr) {
-	if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
-	    if (SetBlockMode(NULL, outPtr,
-		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
-		    != TCL_OK) {
-		if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
-		    SetBlockMode(NULL, inPtr,
-			    (readFlags & CHANNEL_NONBLOCKING)
-			    ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
-		    return TCL_ERROR;
-		}
-	    }
-	}
+    }
+    if ((inPtr!=outPtr) && (nonBlocking!=(writeFlags&CHANNEL_NONBLOCKING)) &&
+	    (SetBlockMode(NULL, outPtr, nonBlocking ?
+		    TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING) != TCL_OK) &&
+	    (nonBlocking != (readFlags & CHANNEL_NONBLOCKING))) {
+	SetBlockMode(NULL, inPtr, (readFlags & CHANNEL_NONBLOCKING)
+		? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
+	return TCL_ERROR;
     }
 
     /*
@@ -7759,19 +8582,19 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
 
     /*
      * Allocate a new CopyState to maintain info about the current copy in
-     * progress.  This structure will be deallocated when the copy is
+     * progress. This structure will be deallocated when the copy is
      * completed.
      */
 
-    csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
-    csPtr->bufSize    = inStatePtr->bufSize;
-    csPtr->readPtr    = inPtr;
-    csPtr->writePtr   = outPtr;
-    csPtr->readFlags  = readFlags;
+    csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
+    csPtr->bufSize = inStatePtr->bufSize;
+    csPtr->readPtr = inPtr;
+    csPtr->writePtr = outPtr;
+    csPtr->readFlags = readFlags;
     csPtr->writeFlags = writeFlags;
-    csPtr->toRead     = toRead;
-    csPtr->total      = 0;
-    csPtr->interp     = interp;
+    csPtr->toRead = toRead;
+    csPtr->total = 0;
+    csPtr->interp = interp;
     if (cmdPtr) {
 	Tcl_IncrRefCount(cmdPtr);
     }
@@ -7781,6 +8604,16 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
     outStatePtr->csPtrW = csPtr;
 
     /*
+     * Special handling of -size 0 async transfers, so that the -command is
+     * still called asynchronously.
+     */
+
+    if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) {
+        Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr);
+        return 0;
+    }
+
+    /*
      * Start copying data between the channels.
      */
 
@@ -7792,8 +8625,8 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
  *
  * CopyData --
  *
- *	This function implements the lowest level of the copying
- *	mechanism for TclCopyChannel.
+ *	This function implements the lowest level of the copying mechanism for
+ *	TclCopyChannel.
  *
  * Results:
  *	Returns TCL_OK on success, else TCL_ERROR.
@@ -7805,19 +8638,20 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
  */
 
 static int
-CopyData(csPtr, mask)
-    CopyState *csPtr;		/* State of copy operation. */
-    int mask;			/* Current channel event flags. */
+CopyData(
+    CopyState *csPtr,		/* State of copy operation. */
+    int mask)			/* Current channel event flags. */
 {
     Tcl_Interp *interp;
-    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
+    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
     Tcl_Channel inChan, outChan;
     ChannelState *inStatePtr, *outStatePtr;
-    int result = TCL_OK, size, total, sizeb;
-    char* buffer;
-
-    int inBinary, outBinary, sameEncoding; /* Encoding control */
-    int underflow;	/* input underflow */
+    int result = TCL_OK, size, sizeb;
+    Tcl_WideInt total;
+    char *buffer;
+    int inBinary, outBinary, sameEncoding;
+				/* Encoding control */
+    int underflow;		/* Input underflow */
 
     inChan	= (Tcl_Channel) csPtr->readPtr;
     outChan	= (Tcl_Channel) csPtr->writePtr;
@@ -7829,18 +8663,18 @@ CopyData(csPtr, mask)
     /*
      * Copy the data the slow way, using the translation mechanism.
      *
-     * Note: We have make sure that we use the topmost channel in a stack
-     * for the copying. The caller uses Tcl_GetChannel to access it, and
-     * thus gets the bottom of the stack.
+     * Note: We have make sure that we use the topmost channel in a stack for
+     * the copying. The caller uses Tcl_GetChannel to access it, and thus gets
+     * the bottom of the stack.
      */
 
-    inBinary     = (inStatePtr->encoding  == NULL);
-    outBinary    = (outStatePtr->encoding == NULL);
-    sameEncoding = (inStatePtr->encoding  == outStatePtr->encoding);
+    inBinary = (inStatePtr->encoding == NULL);
+    outBinary = (outStatePtr->encoding == NULL);
+    sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);
 
     if (!(inBinary || sameEncoding)) {
-        bufObj = Tcl_NewObj ();
-	Tcl_IncrRefCount (bufObj);
+	TclNewObj(bufObj);
+	Tcl_IncrRefCount(bufObj);
     }
 
     while (csPtr->toRead != 0) {
@@ -7848,17 +8682,19 @@ CopyData(csPtr, mask)
 	 * Check for unreported background errors.
 	 */
 
-	if (inStatePtr->unreportedError != 0) {
+	Tcl_GetChannelError(inChan, &msg);
+	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
 	    Tcl_SetErrno(inStatePtr->unreportedError);
 	    inStatePtr->unreportedError = 0;
 	    goto readError;
 	}
-	if (outStatePtr->unreportedError != 0) {
+	Tcl_GetChannelError(outChan, &msg);
+	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
 	    Tcl_SetErrno(outStatePtr->unreportedError);
 	    outStatePtr->unreportedError = 0;
 	    goto writeError;
 	}
-	
+
 	if (cmdPtr && (mask == 0)) {
 	    /*
 	     * In async mode, we skip reading synchronously and fake an
@@ -7873,51 +8709,60 @@ CopyData(csPtr, mask)
 	     */
 
 	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
-	        sizeb = csPtr->bufSize;
+		sizeb = csPtr->bufSize;
 	    } else {
-	        sizeb = csPtr->toRead;
+		sizeb = csPtr->toRead;
 	    }
 
 	    if (inBinary || sameEncoding) {
-	        size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
+		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
 	    } else {
-	        size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
+		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
+				   0 /* No append */);
 	    }
-	    underflow = (size >= 0) && (size < sizeb);	/* input underflow */
+	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
 	}
 
 	if (size < 0) {
-	    readError:
-	    errObj = Tcl_NewObj();
-	    Tcl_AppendStringsToObj(errObj, "error reading \"",
-		    Tcl_GetChannelName(inChan), "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+	readError:
+	    if (interp) {
+		TclNewObj(errObj);
+		Tcl_AppendStringsToObj(errObj, "error reading \"",
+			Tcl_GetChannelName(inChan), "\": ", NULL);
+		if (msg != NULL) {
+		    Tcl_AppendObjToObj(errObj, msg);
+		} else {
+		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
+			    NULL);
+		}
+	    }
+	    if (msg != NULL) {
+		Tcl_DecrRefCount(msg);
+	    }
 	    break;
 	} else if (underflow) {
 	    /*
-	     * We had an underflow on the read side.  If we are at
-	     * EOF, and not in the synchronous part of an asynchronous
-	     * fcopy, then the copying is done, otherwise set up a
-	     * channel handler to detect when the channel becomes
-	     * readable again.
+	     * We had an underflow on the read side. If we are at EOF, and not
+	     * in the synchronous part of an asynchronous fcopy, then the
+	     * copying is done, otherwise set up a channel handler to detect
+	     * when the channel becomes readable again.
 	     */
-	    
+
 	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
 		break;
 	    }
 	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
 		!(mask & TCL_READABLE)) {
 		if (mask & TCL_WRITABLE) {
-		    Tcl_DeleteChannelHandler(outChan, CopyEventProc,
-			    (ClientData) csPtr);
+		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 		}
-		Tcl_CreateChannelHandler(inChan, TCL_READABLE,
-			CopyEventProc, (ClientData) csPtr);
+		Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc,
+			csPtr);
 	    }
 	    if (size == 0) {
-	        if (bufObj != (Tcl_Obj*) NULL) {
-		    Tcl_DecrRefCount (bufObj);
-		    bufObj = (Tcl_Obj*) NULL;
+		if (bufObj != NULL) {
+		    TclDecrRefCount(bufObj);
+		    bufObj = NULL;
 		}
 		return TCL_OK;
 	    }
@@ -7931,7 +8776,7 @@ CopyData(csPtr, mask)
 	    buffer = csPtr->buffer;
 	    sizeb = size;
 	} else {
-	    buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
+	    buffer = TclGetStringFromObj(bufObj, &sizeb);
 	}
 
 	if (outBinary || sameEncoding) {
@@ -7953,19 +8798,29 @@ CopyData(csPtr, mask)
 	 */
 
 	if (sizeb < 0) {
-	    writeError:
-	    errObj = Tcl_NewObj();
-	    Tcl_AppendStringsToObj(errObj, "error writing \"",
-		    Tcl_GetChannelName(outChan), "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+	writeError:
+	    if (interp) {
+		TclNewObj(errObj);
+		Tcl_AppendStringsToObj(errObj, "error writing \"",
+			Tcl_GetChannelName(outChan), "\": ", NULL);
+		if (msg != NULL) {
+		    Tcl_AppendObjToObj(errObj, msg);
+		} else {
+		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
+			    NULL);
+		}
+	    }
+	    if (msg != NULL) {
+		Tcl_DecrRefCount(msg);
+	    }
 	    break;
 	}
 
 	/*
-	 * Update the current byte count.  Do it now so the count is
-	 * valid before a return or break takes us out of the loop.
-	 * The invariant at the top of the loop should be that 
-	 * csPtr->toRead holds the number of bytes left to copy.
+	 * (UP) Update the current byte count. Do it now so the count is valid
+	 * before a return or break takes us out of the loop. The invariant at
+	 * the top of the loop should be that csPtr->toRead holds the number
+	 * of bytes left to copy.
 	 */
 
 	if (csPtr->toRead != -1) {
@@ -7977,89 +8832,90 @@ CopyData(csPtr, mask)
 	 * Break loop if EOF && (size>0)
 	 */
 
-        if (Tcl_Eof(inChan)) {
-            break;
-        }
+	if (Tcl_Eof(inChan)) {
+	    break;
+	}
 
 	/*
-	 * Check to see if the write is happening in the background.  If so,
+	 * Check to see if the write is happening in the background. If so,
 	 * stop copying and wait for the channel to become writable again.
 	 * After input underflow we already installed a readable handler
 	 * therefore we don't need a writable handler.
 	 */
 
-	if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
+	if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) {
 	    if (!(mask & TCL_WRITABLE)) {
 		if (mask & TCL_READABLE) {
-		    Tcl_DeleteChannelHandler(inChan, CopyEventProc,
-			    (ClientData) csPtr);
+		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
 		}
 		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
-			CopyEventProc, (ClientData) csPtr);
+			CopyEventProc, csPtr);
 	    }
-	    if (bufObj != (Tcl_Obj*) NULL) {
-	        Tcl_DecrRefCount (bufObj);
-		bufObj = (Tcl_Obj*) NULL;
+	    if (bufObj != NULL) {
+		TclDecrRefCount(bufObj);
+		bufObj = NULL;
 	    }
 	    return TCL_OK;
 	}
 
 	/*
-	 * For background copies, we only do one buffer per invocation so
-	 * we don't starve the rest of the system.
+	 * For background copies, we only do one buffer per invocation so we
+	 * don't starve the rest of the system.
 	 */
 
 	if (cmdPtr && (csPtr->toRead != 0)) {
 	    /*
-	     * The first time we enter this code, there won't be a
-	     * channel handler established yet, so do it here.
+	     * The first time we enter this code, there won't be a channel
+	     * handler established yet, so do it here.
 	     */
 
 	    if (mask == 0) {
-		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
-			CopyEventProc, (ClientData) csPtr);
+		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc,
+			csPtr);
 	    }
-	    if (bufObj != (Tcl_Obj*) NULL) {
-	        Tcl_DecrRefCount (bufObj);
-		bufObj = (Tcl_Obj*) NULL;
+	    if (bufObj != NULL) {
+		TclDecrRefCount(bufObj);
+		bufObj = NULL;
 	    }
 	    return TCL_OK;
 	}
     } /* while */
 
-    if (bufObj != (Tcl_Obj*) NULL) {
-        Tcl_DecrRefCount (bufObj);
-	bufObj = (Tcl_Obj*) NULL;
+    if (bufObj != NULL) {
+	TclDecrRefCount(bufObj);
+	bufObj = NULL;
     }
 
     /*
-     * Make the callback or return the number of bytes transferred.
-     * The local total is used because StopCopy frees csPtr.
+     * Make the callback or return the number of bytes transferred. The local
+     * total is used because StopCopy frees csPtr.
      */
 
     total = csPtr->total;
     if (cmdPtr && interp) {
+	int code;
 	/*
-	 * Get a private copy of the command so we can mutate it
-	 * by adding arguments.  Note that StopCopy frees our saved
-	 * reference to the original command obj.
+	 * Get a private copy of the command so we can mutate it by adding
+	 * arguments. Note that StopCopy frees our saved reference to the
+	 * original command obj.
 	 */
 
 	cmdPtr = Tcl_DuplicateObj(cmdPtr);
 	Tcl_IncrRefCount(cmdPtr);
 	StopCopy(csPtr);
-	Tcl_Preserve((ClientData) interp);
+	Tcl_Preserve(interp);
 
-	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
+	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
 	if (errObj) {
 	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
 	}
-	if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
-	    Tcl_BackgroundError(interp);
+	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+	if (code != TCL_OK) {
+	    TclBackgroundException(interp, code);
 	    result = TCL_ERROR;
 	}
-	Tcl_DecrRefCount(cmdPtr);
-	Tcl_Release((ClientData) interp);
+	TclDecrRefCount(cmdPtr);
+	Tcl_Release(interp);
     } else {
 	StopCopy(csPtr);
 	if (interp) {
@@ -8068,7 +8924,7 @@ CopyData(csPtr, mask)
 		result = TCL_ERROR;
 	    } else {
 		Tcl_ResetResult(interp);
-		Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
+		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
 	    }
 	}
     }
@@ -8085,8 +8941,8 @@ CopyData(csPtr, mask)
  *	No encoding conversions are applied to the bytes being read.
  *
  * Results:
- *	The number of characters read, or -1 on error. Use Tcl_GetErrno()
- *	to retrieve the error code for the error that occurred.
+ *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
+ *	retrieve the error code for the error that occurred.
  *
  * Side effects:
  *	May cause input to be buffered.
@@ -8095,60 +8951,61 @@ CopyData(csPtr, mask)
  */
 
 static int
-DoRead(chanPtr, bufPtr, toRead)
-    Channel *chanPtr;		/* The channel from which to read. */
-    char *bufPtr;		/* Where to store input read. */
-    int toRead;			/* Maximum number of bytes to read. */
-{
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
-    int copied;			/* How many characters were copied into
-                                 * the result string? */
-    int copiedNow;		/* How many characters were copied from
-                                 * the current input buffer? */
+DoRead(
+    Channel *chanPtr,		/* The channel from which to read. */
+    char *bufPtr,		/* Where to store input read. */
+    int toRead)			/* Maximum number of bytes to read. */
+{
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+    int copied;			/* How many characters were copied into the
+				 * result string? */
+    int copiedNow;		/* How many characters were copied from the
+				 * current input buffer? */
     int result;			/* Of calling GetInput. */
 
     /*
-     * If we have not encountered a sticky EOF, clear the EOF bit. Either
-     * way clear the BLOCKED bit. We want to discover these anew during
-     * each operation.
+     * If we have not encountered a sticky EOF, clear the EOF bit. Either way
+     * clear the BLOCKED bit. We want to discover these anew during each
+     * operation.
      */
 
     if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
-        statePtr->flags &= ~CHANNEL_EOF;
+	ResetFlag(statePtr, CHANNEL_EOF);
     }
-    statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
-    
+    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+
     for (copied = 0; copied < toRead; copied += copiedNow) {
-        copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
-                toRead - copied);
-        if (copiedNow == 0) {
-            if (statePtr->flags & CHANNEL_EOF) {
+	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
+		toRead - copied);
+	if (copiedNow == 0) {
+	    if (statePtr->flags & CHANNEL_EOF) {
 		goto done;
-            }
-            if (statePtr->flags & CHANNEL_BLOCKED) {
-                if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    }
+	    if (statePtr->flags & CHANNEL_BLOCKED) {
+		if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    goto done;
-                }
-                statePtr->flags &= (~(CHANNEL_BLOCKED));
-            }
-            result = GetInput(chanPtr);
-            if (result != 0) {
-                if (result != EAGAIN) {
-                    copied = -1;
-                }
+		}
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
+	    }
+	    result = GetInput(chanPtr);
+	    if (result != 0) {
+		if (result != EAGAIN) {
+		    copied = -1;
+		}
 		goto done;
-            }
-        }
+	    }
+	}
     }
 
-    statePtr->flags &= (~(CHANNEL_BLOCKED));
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
 
-    done:
     /*
-     * Update the notifier state so we don't block while there is still
-     * data in the buffers.
+     * Update the notifier state so we don't block while there is still data
+     * in the buffers.
      */
 
+  done:
     UpdateInterest(chanPtr);
     return copied;
 }
@@ -8158,13 +9015,13 @@ DoRead(chanPtr, bufPtr, toRead)
  *
  * CopyAndTranslateBuffer --
  *
- *	Copy at most one buffer of input to the result space, doing
- *	eol translations according to mode in effect currently.
+ *	Copy at most one buffer of input to the result space, doing eol
+ *	translations according to mode in effect currently.
  *
  * Results:
- *	Number of bytes stored in the result buffer (as opposed to the
- *	number of bytes read from the channel).  May return
- *	zero if no input is available to be translated.
+ *	Number of bytes stored in the result buffer (as opposed to the number
+ *	of bytes read from the channel). May return zero if no input is
+ *	available to be translated.
  *
  * Side effects:
  *	Consumes buffered input. May deallocate one buffer.
@@ -8173,220 +9030,208 @@ DoRead(chanPtr, bufPtr, toRead)
  */
 
 static int
-CopyAndTranslateBuffer(statePtr, result, space)
-    ChannelState *statePtr;	/* Channel state from which to read input. */
-    char *result;		/* Where to store the copied input. */
-    int space;			/* How many bytes are available in result
-                                 * to store the copied input? */
+CopyAndTranslateBuffer(
+    ChannelState *statePtr,	/* Channel state from which to read input. */
+    char *result,		/* Where to store the copied input. */
+    int space)			/* How many bytes are available in result to
+				 * store the copied input? */
 {
     ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
-    int bytesInBuffer;		/* How many bytes are available to be
-                                 * copied in the current input buffer? */
+    int bytesInBuffer;		/* How many bytes are available to be copied
+				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
-                                 * into the destination space? */
-    int i;			/* Iterates over the copied input looking
-                                 * for the input eofChar. */
-    
+				 * into the destination space? */
+    int i;			/* Iterates over the copied input looking for
+				 * the input eofChar. */
+
     /*
      * If there is no input at all, return zero. The invariant is that either
-     * there is no buffer in the queue, or if the first buffer is empty, it
-     * is also the last buffer (and thus there is no input in the queue).
-     * Note also that if the buffer is empty, we leave it in the queue.
+     * there is no buffer in the queue, or if the first buffer is empty, it is
+     * also the last buffer (and thus there is no input in the queue). Note
+     * also that if the buffer is empty, we leave it in the queue.
      */
-    
-    if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
-        return 0;
+
+    if (statePtr->inQueueHead == NULL) {
+	return 0;
     }
     bufPtr = statePtr->inQueueHead;
-    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+    bytesInBuffer = BytesLeft(bufPtr);
 
     copied = 0;
     switch (statePtr->inputTranslation) {
-        case TCL_TRANSLATE_LF: {
-            if (bytesInBuffer == 0) {
-                return 0;
-            }
+    case TCL_TRANSLATE_LF:
+	if (bytesInBuffer == 0) {
+	    return 0;
+	}
 
-	    /*
-             * Copy the current chunk into the result buffer.
-             */
-
-	    if (bytesInBuffer < space) {
-		space = bytesInBuffer;
-	    }
-	    memcpy((VOID *) result,
-		    (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
-		    (size_t) space);
-	    bufPtr->nextRemoved += space;
-	    copied = space;
-            break;
-	}
-        case TCL_TRANSLATE_CR: {
-	    char *end;
-	    
-            if (bytesInBuffer == 0) {
-                return 0;
-            }
+	/*
+	 * Copy the current chunk into the result buffer.
+	 */
 
-	    /*
-             * Copy the current chunk into the result buffer, then
-             * replace all \r with \n.
-             */
-
-	    if (bytesInBuffer < space) {
-		space = bytesInBuffer;
-	    }
-	    memcpy((VOID *) result,
-		    (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
-		    (size_t) space);
-	    bufPtr->nextRemoved += space;
-	    copied = space;
-
-	    for (end = result + copied; result < end; result++) {
-		if (*result == '\r') {
-		    *result = '\n';
-		}
-            }
-            break;
-	}
-        case TCL_TRANSLATE_CRLF: {
-	    char *src, *end, *dst;
-	    int curByte;
-	    
-            /*
-             * If there is a held-back "\r" at EOF, produce it now.
-             */
-            
-	    if (bytesInBuffer == 0) {
-                if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
-                        (INPUT_SAW_CR | CHANNEL_EOF)) {
-                    result[0] = '\r';
-                    statePtr->flags &= ~INPUT_SAW_CR;
-                    return 1;
-                }
-                return 0;
-            }
-
-            /*
-             * Copy the current chunk and replace "\r\n" with "\n"
-             * (but not standalone "\r"!).
-             */
-
-	    if (bytesInBuffer < space) {
-		space = bytesInBuffer;
-	    }
-	    memcpy((VOID *) result,
-		    (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
-		    (size_t) space);
-	    bufPtr->nextRemoved += space;
-	    copied = space;
-
-	    end = result + copied;
-	    dst = result;
-	    for (src = result; src < end; src++) {
-		curByte = *src;
-		if (curByte == '\n') {
-                    statePtr->flags &= ~INPUT_SAW_CR;
-		} else if (statePtr->flags & INPUT_SAW_CR) {
-		    statePtr->flags &= ~INPUT_SAW_CR;
-		    *dst = '\r';
-		    dst++;
-		}
-		if (curByte == '\r') {
-		    statePtr->flags |= INPUT_SAW_CR;
-		} else {
-		    *dst = (char) curByte;
-		    dst++;
-		}
+	if (bytesInBuffer < space) {
+	    space = bytesInBuffer;
+	}
+	memcpy(result, RemovePoint(bufPtr), (size_t) space);
+	bufPtr->nextRemoved += space;
+	copied = space;
+	break;
+    case TCL_TRANSLATE_CR: {
+	char *end;
+
+	if (bytesInBuffer == 0) {
+	    return 0;
+	}
+
+	/*
+	 * Copy the current chunk into the result buffer, then replace all \r
+	 * with \n.
+	 */
+
+	if (bytesInBuffer < space) {
+	    space = bytesInBuffer;
+	}
+	memcpy(result, RemovePoint(bufPtr), (size_t) space);
+	bufPtr->nextRemoved += space;
+	copied = space;
+
+	for (end = result + copied; result < end; result++) {
+	    if (*result == '\r') {
+		*result = '\n';
 	    }
-	    copied = dst - result;
-	    break;
 	}
-        case TCL_TRANSLATE_AUTO: {
-	    char *src, *end, *dst;
-	    int curByte;
-	
-            if (bytesInBuffer == 0) {
-                return 0;
-            }
-
-            /*
-             * Loop over the current buffer, converting "\r" and "\r\n"
-             * to "\n".
-             */
-
-	    if (bytesInBuffer < space) {
-		space = bytesInBuffer;
-	    }
-	    memcpy((VOID *) result,
-		    (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
-		    (size_t) space);
-	    bufPtr->nextRemoved += space;
-	    copied = space;
-
-	    end = result + copied;
-	    dst = result;
-	    for (src = result; src < end; src++) {
-		curByte = *src;
-		if (curByte == '\r') {
-		    statePtr->flags |= INPUT_SAW_CR;
-		    *dst = '\n';
+	break;
+    }
+    case TCL_TRANSLATE_CRLF: {
+	char *src, *end, *dst;
+	int curByte;
+
+	/*
+	 * If there is a held-back "\r" at EOF, produce it now.
+	 */
+
+	if (bytesInBuffer == 0) {
+	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
+		    (INPUT_SAW_CR | CHANNEL_EOF)) {
+		result[0] = '\r';
+		ResetFlag(statePtr, INPUT_SAW_CR);
+		return 1;
+	    }
+	    return 0;
+	}
+
+	/*
+	 * Copy the current chunk and replace "\r\n" with "\n" (but not
+	 * standalone "\r"!).
+	 */
+
+	if (bytesInBuffer < space) {
+	    space = bytesInBuffer;
+	}
+	memcpy(result, RemovePoint(bufPtr), (size_t) space);
+	bufPtr->nextRemoved += space;
+	copied = space;
+
+	end = result + copied;
+	dst = result;
+	for (src = result; src < end; src++) {
+	    curByte = *src;
+	    if (curByte == '\n') {
+		ResetFlag(statePtr, INPUT_SAW_CR);
+	    } else if (statePtr->flags & INPUT_SAW_CR) {
+		ResetFlag(statePtr, INPUT_SAW_CR);
+		*dst = '\r';
+		dst++;
+	    }
+	    if (curByte == '\r') {
+		SetFlag(statePtr, INPUT_SAW_CR);
+	    } else {
+		*dst = (char) curByte;
+		dst++;
+	    }
+	}
+	copied = dst - result;
+	break;
+    }
+    case TCL_TRANSLATE_AUTO: {
+	char *src, *end, *dst;
+	int curByte;
+
+	if (bytesInBuffer == 0) {
+	    return 0;
+	}
+
+	/*
+	 * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
+	 */
+
+	if (bytesInBuffer < space) {
+	    space = bytesInBuffer;
+	}
+	memcpy(result, RemovePoint(bufPtr), (size_t) space);
+	bufPtr->nextRemoved += space;
+	copied = space;
+
+	end = result + copied;
+	dst = result;
+	for (src = result; src < end; src++) {
+	    curByte = *src;
+	    if (curByte == '\r') {
+		SetFlag(statePtr, INPUT_SAW_CR);
+		*dst = '\n';
+		dst++;
+	    } else {
+		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
+		    *dst = (char) curByte;
 		    dst++;
-		} else {
-		    if ((curByte != '\n') || 
-			    !(statePtr->flags & INPUT_SAW_CR)) {
-			*dst = (char) curByte;
-			dst++;
-		    }
-		    statePtr->flags &= ~INPUT_SAW_CR;
 		}
+		ResetFlag(statePtr, INPUT_SAW_CR);
 	    }
-	    copied = dst - result;
-            break;
-	}
-        default: {
-            panic("unknown eol translation mode");
 	}
+	copied = dst - result;
+	break;
+    }
+    default:
+	Tcl_Panic("unknown eol translation mode");
     }
 
     /*
-     * If an in-stream EOF character is set for this channel, check that
-     * the input we copied so far does not contain the EOF char.  If it does,
-     * copy only up to and excluding that character.
+     * If an in-stream EOF character is set for this channel, check that the
+     * input we copied so far does not contain the EOF char. If it does, copy
+     * only up to and excluding that character.
      */
-    
+
     if (statePtr->inEofChar != 0) {
-        for (i = 0; i < copied; i++) {
-            if (result[i] == (char) statePtr->inEofChar) {
+	for (i = 0; i < copied; i++) {
+	    if (result[i] == (char) statePtr->inEofChar) {
 		/*
-		 * Set sticky EOF so that no further input is presented
-		 * to the caller.
+		 * Set sticky EOF so that no further input is presented to the
+		 * caller.
 		 */
-		
-		statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+
+		SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 		copied = i;
-                break;
-            }
-        }
+		break;
+	    }
+	}
     }
 
     /*
      * If the current buffer is empty recycle it.
      */
 
-    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
-        statePtr->inQueueHead = bufPtr->nextPtr;
-        if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
-            statePtr->inQueueTail = (ChannelBuffer *) NULL;
-        }
-        RecycleBuffer(statePtr, bufPtr, 0);
+    if (IsBufferEmpty(bufPtr)) {
+	statePtr->inQueueHead = bufPtr->nextPtr;
+	if (statePtr->inQueueHead == NULL) {
+	    statePtr->inQueueTail = NULL;
+	}
+	RecycleBuffer(statePtr, bufPtr, 0);
     }
 
     /*
-     * Return the number of characters copied into the result buffer.
-     * This may be different from the number of bytes consumed, because
-     * of EOL translations.
+     * Return the number of characters copied into the result buffer. This may
+     * be different from the number of bytes consumed, because of EOL
+     * translations.
      */
 
     return copied;
@@ -8400,8 +9245,8 @@ CopyAndTranslateBuffer(statePtr, result, space)
  *	Copy at most one buffer of input to the result space.
  *
  * Results:
- *	Number of bytes stored in the result buffer.  May return
- *	zero if no input is available.
+ *	Number of bytes stored in the result buffer. May return zero if no
+ *	input is available.
  *
  * Side effects:
  *	Consumes buffered input. May deallocate one buffer.
@@ -8410,39 +9255,39 @@ CopyAndTranslateBuffer(statePtr, result, space)
  */
 
 static int
-CopyBuffer(chanPtr, result, space)
-    Channel *chanPtr;		/* Channel from which to read input. */
-    char *result;		/* Where to store the copied input. */
-    int space;			/* How many bytes are available in result
-                                 * to store the copied input? */
+CopyBuffer(
+    Channel *chanPtr,		/* Channel from which to read input. */
+    char *result,		/* Where to store the copied input. */
+    int space)			/* How many bytes are available in result to
+				 * store the copied input? */
 {
     ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
-    int bytesInBuffer;		/* How many bytes are available to be
-                                 * copied in the current input buffer? */
+    int bytesInBuffer;		/* How many bytes are available to be copied
+				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
-                                 * into the destination space? */
-    
+				 * into the destination space? */
+
     /*
-     * If there is no input at all, return zero. The invariant is that
-     * either there is no buffer in the queue, or if the first buffer
-     * is empty, it is also the last buffer (and thus there is no
-     * input in the queue).  Note also that if the buffer is empty, we
-     * don't leave it in the queue, but recycle it.
+     * If there is no input at all, return zero. The invariant is that either
+     * there is no buffer in the queue, or if the first buffer is empty, it is
+     * also the last buffer (and thus there is no input in the queue). Note
+     * also that if the buffer is empty, we don't leave it in the queue, but
+     * recycle it.
      */
-    
-    if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
-        return 0;
+
+    if (chanPtr->inQueueHead == NULL) {
+	return 0;
     }
     bufPtr = chanPtr->inQueueHead;
-    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+    bytesInBuffer = BytesLeft(bufPtr);
 
     copied = 0;
 
     if (bytesInBuffer == 0) {
-        RecycleBuffer(chanPtr->state, bufPtr, 0);
-	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
-	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
-        return 0;
+	RecycleBuffer(chanPtr->state, bufPtr, 0);
+	chanPtr->inQueueHead = NULL;
+	chanPtr->inQueueTail = NULL;
+	return 0;
     }
 
     /*
@@ -8450,31 +9295,29 @@ CopyBuffer(chanPtr, result, space)
      */
 
     if (bytesInBuffer < space) {
-        space = bytesInBuffer;
+	space = bytesInBuffer;
     }
 
-    memcpy((VOID *) result,
-	   (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
-	   (size_t) space);
+    memcpy(result, RemovePoint(bufPtr), (size_t) space);
     bufPtr->nextRemoved += space;
     copied = space;
 
     /*
-     * We don't care about in-stream EOF characters here as the data
-     * read here may still flow through one or more transformations,
-     * i.e. is not in its final state yet.
+     * We don't care about in-stream EOF characters here as the data read here
+     * may still flow through one or more transformations, i.e. is not in its
+     * final state yet.
      */
 
     /*
      * If the current buffer is empty recycle it.
      */
 
-    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
-        chanPtr->inQueueHead = bufPtr->nextPtr;
-        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
-            chanPtr->inQueueTail = (ChannelBuffer *) NULL;
-        }
-        RecycleBuffer(chanPtr->state, bufPtr, 0);
+    if (IsBufferEmpty(bufPtr)) {
+	chanPtr->inQueueHead = bufPtr->nextPtr;
+	if (chanPtr->inQueueHead == NULL) {
+	    chanPtr->inQueueTail = NULL;
+	}
+	RecycleBuffer(chanPtr->state, bufPtr, 0);
     }
 
     /*
@@ -8506,29 +9349,28 @@ CopyBuffer(chanPtr, result, space)
  */
 
 static int
-DoWrite(chanPtr, src, srcLen)
-    Channel *chanPtr;			/* The channel to buffer output for. */
-    CONST char *src;			/* Data to write. */
-    int srcLen;				/* Number of bytes to write. */
-{
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
-    ChannelBuffer *outBufPtr;		/* Current output buffer. */
-    int foundNewline;			/* Did we find a newline in output? */
+DoWrite(
+    Channel *chanPtr,		/* The channel to buffer output for. */
+    const char *src,		/* Data to write. */
+    int srcLen)			/* Number of bytes to write. */
+{
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
+    ChannelBuffer *outBufPtr;	/* Current output buffer. */
+    int foundNewline;		/* Did we find a newline in output? */
     char *dPtr;
-    CONST char *sPtr;			/* Search variables for newline. */
-    int crsent;				/* In CRLF eol translation mode,
-                                         * remember the fact that a CR was
-                                         * output to the channel without
-                                         * its following NL. */
-    int i;				/* Loop index for newline search. */
-    int destCopied;			/* How many bytes were used in this
-                                         * destination buffer to hold the
-                                         * output? */
-    int totalDestCopied;		/* How many bytes total were
-                                         * copied to the channel buffer? */
-    int srcCopied;			/* How many bytes were copied from
-                                         * the source string? */
-    char *destPtr;			/* Where in line to copy to? */
+    const char *sPtr;		/* Search variables for newline. */
+    int crsent;			/* In CRLF eol translation mode, remember the
+				 * fact that a CR was output to the channel
+				 * without its following NL. */
+    int i;			/* Loop index for newline search. */
+    int destCopied;		/* How many bytes were used in this
+				 * destination buffer to hold the output? */
+    int totalDestCopied;	/* How many bytes total were copied to the
+				 * channel buffer? */
+    int srcCopied;		/* How many bytes were copied from the source
+				 * string? */
+    char *destPtr;		/* Where in line to copy to? */
 
     /*
      * If we are in network (or windows) translation mode, record the fact
@@ -8536,7 +9378,7 @@ DoWrite(chanPtr, src, srcLen)
      */
 
     crsent = 0;
-    
+
     /*
      * Loop filling buffers and flushing them until all output has been
      * consumed.
@@ -8546,97 +9388,96 @@ DoWrite(chanPtr, src, srcLen)
     totalDestCopied = 0;
 
     while (srcLen > 0) {
-        
-        /*
-         * Make sure there is a current output buffer to accept output.
-         */
-
-        if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
-            statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
-        }
-
-        outBufPtr = statePtr->curOutPtr;
-
-        destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
-        if (destCopied > srcLen) {
-            destCopied = srcLen;
-        }
-        
-        destPtr = outBufPtr->buf + outBufPtr->nextAdded;
-        switch (statePtr->outputTranslation) {
-            case TCL_TRANSLATE_LF:
-                srcCopied = destCopied;
-                memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
-                break;
-            case TCL_TRANSLATE_CR:
-                srcCopied = destCopied;
-                memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
-                for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
-                    if (*dPtr == '\n') {
-                        *dPtr = '\r';
-                    }
-                }
-                break;
-            case TCL_TRANSLATE_CRLF:
-                for (srcCopied = 0, dPtr = destPtr, sPtr = src;
-                     dPtr < destPtr + destCopied;
-                     dPtr++, sPtr++, srcCopied++) {
-                    if (*sPtr == '\n') {
-                        if (crsent) {
-                            *dPtr = '\n';
-                            crsent = 0;
-                        } else {
-                            *dPtr = '\r';
-                            crsent = 1;
-                            sPtr--, srcCopied--;
-                        }
-                    } else {
-                        *dPtr = *sPtr;
-                    }
-                }
-                break;
-            case TCL_TRANSLATE_AUTO:
-                panic("Tcl_Write: AUTO output translation mode not supported");
-            default:
-                panic("Tcl_Write: unknown output translation mode");
-        }
-
-        /*
-         * The current buffer is ready for output if it is full, or if it
-         * contains a newline and this channel is line-buffered, or if it
-         * contains any output and this channel is unbuffered.
-         */
-
-        outBufPtr->nextAdded += destCopied;
-        if (!(statePtr->flags & BUFFER_READY)) {
-            if (outBufPtr->nextAdded == outBufPtr->bufLength) {
-                statePtr->flags |= BUFFER_READY;
-            } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
-                for (sPtr = src, i = 0, foundNewline = 0;
-		     (i < srcCopied) && (!foundNewline);
-		     i++, sPtr++) {
-                    if (*sPtr == '\n') {
-                        foundNewline = 1;
-                        break;
-                    }
-                }
-                if (foundNewline) {
-                    statePtr->flags |= BUFFER_READY;
-                }
-            } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
-                statePtr->flags |= BUFFER_READY;
-            }
-        }
-        
-        totalDestCopied += srcCopied;
-        src += srcCopied;
-        srcLen -= srcCopied;
-
-        if (statePtr->flags & BUFFER_READY) {
-            if (FlushChannel(NULL, chanPtr, 0) != 0) {
-                return -1;
-            }
-        }
+	/*
+	 * Make sure there is a current output buffer to accept output.
+	 */
+
+	if (statePtr->curOutPtr == NULL) {
+	    statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
+	}
+
+	outBufPtr = statePtr->curOutPtr;
+
+	destCopied = SpaceLeft(outBufPtr);
+	if (destCopied > srcLen) {
+	    destCopied = srcLen;
+	}
+
+	destPtr = InsertPoint(outBufPtr);
+	switch (statePtr->outputTranslation) {
+	case TCL_TRANSLATE_LF:
+	    srcCopied = destCopied;
+	    memcpy(destPtr, src, (size_t) destCopied);
+	    break;
+	case TCL_TRANSLATE_CR:
+	    srcCopied = destCopied;
+	    memcpy(destPtr, src, (size_t) destCopied);
+	    for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
+		if (*dPtr == '\n') {
+		    *dPtr = '\r';
+		}
+	    }
+	    break;
+	case TCL_TRANSLATE_CRLF:
+	    for (srcCopied = 0, dPtr = destPtr, sPtr = src;
+		    dPtr < destPtr + destCopied;
+		    dPtr++, sPtr++, srcCopied++) {
+		if (*sPtr == '\n') {
+		    if (crsent) {
+			*dPtr = '\n';
+			crsent = 0;
+		    } else {
+			*dPtr = '\r';
+			crsent = 1;
+			sPtr--, srcCopied--;
+		    }
+		} else {
+		    *dPtr = *sPtr;
+		}
+	    }
+	    break;
+	case TCL_TRANSLATE_AUTO:
+	    Tcl_Panic("Tcl_Write: AUTO output translation mode not supported");
+	default:
+	    Tcl_Panic("Tcl_Write: unknown output translation mode");
+	}
+
+	/*
+	 * The current buffer is ready for output if it is full, or if it
+	 * contains a newline and this channel is line-buffered, or if it
+	 * contains any output and this channel is unbuffered.
+	 */
+
+	outBufPtr->nextAdded += destCopied;
+	if (!(statePtr->flags & BUFFER_READY)) {
+	    if (IsBufferFull(outBufPtr)) {
+		SetFlag(statePtr, BUFFER_READY);
+	    } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+		for (sPtr = src, i = 0, foundNewline = 0;
+			(i < srcCopied) && (!foundNewline);
+			i++, sPtr++) {
+		    if (*sPtr == '\n') {
+			foundNewline = 1;
+			break;
+		    }
+		}
+		if (foundNewline) {
+		    SetFlag(statePtr, BUFFER_READY);
+		}
+	    } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+		SetFlag(statePtr, BUFFER_READY);
+	    }
+	}
+
+	totalDestCopied += srcCopied;
+	src += srcCopied;
+	srcLen -= srcCopied;
+
+	if (statePtr->flags & BUFFER_READY) {
+	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
+		return -1;
+	    }
+	}
     } /* Closes "while" */
 
     return totalDestCopied;
@@ -8647,9 +9488,9 @@ DoWrite(chanPtr, src, srcLen)
  *
  * CopyEventProc --
  *
- *	This routine is invoked as a channel event handler for
- *	the background copy operation.  It is just a trivial wrapper
- *	around the CopyData routine.
+ *	This routine is invoked as a channel event handler for the background
+ *	copy operation. It is just a trivial wrapper around the CopyData
+ *	routine.
  *
  * Results:
  *	None.
@@ -8661,11 +9502,11 @@ DoWrite(chanPtr, src, srcLen)
  */
 
 static void
-CopyEventProc(clientData, mask)
-    ClientData clientData;
-    int mask;
+CopyEventProc(
+    ClientData clientData,
+    int mask)
 {
-    (void) CopyData((CopyState *)clientData, mask);
+    (void) CopyData((CopyState *) clientData, mask);
 }
 
 /*
@@ -8679,15 +9520,15 @@ CopyEventProc(clientData, mask)
  *	None.
  *
  * Side effects:
- *	Removes any pending channel handlers and restores the blocking
- *	and buffering modes of the channels.  The CopyState is freed.
+ *	Removes any pending channel handlers and restores the blocking and
+ *	buffering modes of the channels. The CopyState is freed.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-StopCopy(csPtr)
-    CopyState *csPtr;		/* State for bg copy to stop . */
+StopCopy(
+    CopyState *csPtr)		/* State for bg copy to stop . */
 {
     ChannelState *inStatePtr, *outStatePtr;
     int nonBlocking;
@@ -8696,8 +9537,8 @@ StopCopy(csPtr)
 	return;
     }
 
-    inStatePtr	= csPtr->readPtr->state;
-    outStatePtr	= csPtr->writePtr->state;
+    inStatePtr = csPtr->readPtr->state;
+    outStatePtr = csPtr->writePtr->state;
 
     /*
      * Restore the old blocking mode and output buffering mode.
@@ -8717,20 +9558,20 @@ StopCopy(csPtr)
     }
     outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
     outStatePtr->flags |=
-	csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+	    csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
 
     if (csPtr->cmdPtr) {
-	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
-		(ClientData)csPtr);
+	Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
+		csPtr);
 	if (csPtr->readPtr != csPtr->writePtr) {
-	    Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
-		    CopyEventProc, (ClientData)csPtr);
+	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
+		    CopyEventProc, csPtr);
 	}
-        Tcl_DecrRefCount(csPtr->cmdPtr);
+	TclDecrRefCount(csPtr->cmdPtr);
     }
-    inStatePtr->csPtrR  = NULL;
+    inStatePtr->csPtrR = NULL;
     outStatePtr->csPtrW = NULL;
-    ckfree((char*) csPtr);
+    ckfree((char *) csPtr);
 }
 
 /*
@@ -8738,23 +9579,23 @@ StopCopy(csPtr)
  *
  * StackSetBlockMode --
  *
- *	This function sets the blocking mode for a channel, iterating
- *	through each channel in a stack and updates the state flags.
+ *	This function sets the blocking mode for a channel, iterating through
+ *	each channel in a stack and updates the state flags.
  *
  * Results:
  *	0 if OK, result code from failed blockModeProc otherwise.
  *
  * Side effects:
- *	Modifies the blocking mode of the channel and possibly generates
- *	an error.
+ *	Modifies the blocking mode of the channel and possibly generates an
+ *	error.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-StackSetBlockMode(chanPtr, mode)
-    Channel *chanPtr;		/* Channel to modify. */
-    int mode;			/* One of TCL_MODE_BLOCKING or
+StackSetBlockMode(
+    Channel *chanPtr,		/* Channel to modify. */
+    int mode)			/* One of TCL_MODE_BLOCKING or
 				 * TCL_MODE_NONBLOCKING. */
 {
     int result = 0;
@@ -8765,7 +9606,7 @@ StackSetBlockMode(chanPtr, mode)
      */
 
     chanPtr = chanPtr->state->topChanPtr;
-    while (chanPtr != (Channel *) NULL) {
+    while (chanPtr != NULL) {
 	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 	if (blockModeProc != NULL) {
 	    result = (*blockModeProc) (chanPtr->instanceData, mode);
@@ -8784,41 +9625,64 @@ StackSetBlockMode(chanPtr, mode)
  *
  * SetBlockMode --
  *
- *	This function sets the blocking mode for a channel and updates
- *	the state flags.
+ *	This function sets the blocking mode for a channel and updates the
+ *	state flags.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Modifies the blocking mode of the channel and possibly generates
- *	an error.
+ *	Modifies the blocking mode of the channel and possibly generates an
+ *	error.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetBlockMode(interp, chanPtr, mode)
-    Tcl_Interp *interp;		/* Interp for error reporting. */
-    Channel *chanPtr;		/* Channel to modify. */
-    int mode;			/* One of TCL_MODE_BLOCKING or
+SetBlockMode(
+    Tcl_Interp *interp,		/* Interp for error reporting. */
+    Channel *chanPtr,		/* Channel to modify. */
+    int mode)			/* One of TCL_MODE_BLOCKING or
 				 * TCL_MODE_NONBLOCKING. */
 {
-    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
     int result = 0;
+    ChannelState *statePtr = chanPtr->state;
+				/* State info for channel */
 
     result = StackSetBlockMode(chanPtr, mode);
     if (result != 0) {
-	if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_AppendResult(interp, "error setting blocking mode: ",
-		    Tcl_PosixError(interp), (char *) NULL);
+	if (interp != NULL) {
+	    /*
+	     * TIP #219.
+	     * Move error messages put by the driver into the bypass area and
+	     * put them into the regular interpreter result. Fall back to the
+	     * regular message if nothing was found in the bypass.
+	     *
+	     * Note that we cannot have a message in the interpreter bypass
+	     * area, StackSetBlockMode is restricted to the channel bypass.
+	     * We still need the interp as the destination of the move.
+	     */
+
+	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
+		Tcl_AppendResult(interp, "error setting blocking mode: ",
+			Tcl_PosixError(interp), NULL);
+	    }
+	} else {
+	    /*
+	     * TIP #219.
+	     * If we have no interpreter to put a bypass message into we have
+	     * to clear it, to prevent its propagation and use in other places
+	     * unrelated to the actual occurence of the problem.
+	     */
+
+	    Tcl_SetChannelError((Tcl_Channel) chanPtr, NULL);
 	}
 	return TCL_ERROR;
     }
     if (mode == TCL_MODE_BLOCKING) {
-	statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+	ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED);
     } else {
-	statePtr->flags |= CHANNEL_NONBLOCKING;
+	SetFlag(statePtr, CHANNEL_NONBLOCKING);
     }
     return TCL_OK;
 }
@@ -8840,10 +9704,10 @@ SetBlockMode(interp, chanPtr, mode)
  */
 
 int
-Tcl_GetChannelNames(interp)
-    Tcl_Interp *interp;		/* Interp for error reporting. */
+Tcl_GetChannelNames(
+    Tcl_Interp *interp)		/* Interp for error reporting. */
 {
-    return Tcl_GetChannelNamesEx(interp, (char *) NULL);
+    return Tcl_GetChannelNamesEx(interp, NULL);
 }
 
 /*
@@ -8851,9 +9715,9 @@ Tcl_GetChannelNames(interp)
  *
  * Tcl_GetChannelNamesEx --
  *
- *	Return the names of open channels in the interp filtered
- *	filtered through a pattern.  If pattern is NULL, it returns
- *	all the open channels.
+ *	Return the names of open channels in the interp filtered filtered
+ *	through a pattern. If pattern is NULL, it returns all the open
+ *	channels.
  *
  * Results:
  *	TCL_OK or TCL_ERROR.
@@ -8865,35 +9729,44 @@ Tcl_GetChannelNames(interp)
  */
 
 int
-Tcl_GetChannelNamesEx(interp, pattern)
-    Tcl_Interp *interp;		/* Interp for error reporting. */
-    CONST char *pattern;	/* pattern to filter on. */
+Tcl_GetChannelNamesEx(
+    Tcl_Interp *interp,		/* Interp for error reporting. */
+    const char *pattern)	/* Pattern to filter on. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ChannelState *statePtr;
-    CONST char *name;		/* name for channel */
-    Tcl_Obj *resultPtr;		/* pointer to result object */
+    const char *name;		/* Name for channel */
+    Tcl_Obj *resultPtr;		/* Pointer to result object */
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
     Tcl_HashSearch hSearch;	/* Search variable. */
 
-    if (interp == (Tcl_Interp *) NULL) {
+    if (interp == NULL) {
 	return TCL_OK;
     }
 
     /*
-     * Get the channel table that stores the channels registered
-     * for this interpreter.
+     * Get the channel table that stores the channels registered for this
+     * interpreter.
      */
-    hTblPtr	= GetChannelTable(interp);
-    resultPtr	= Tcl_GetObjResult(interp);
 
-    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	 hPtr != (Tcl_HashEntry *) NULL;
-	 hPtr = Tcl_NextHashEntry(&hSearch)) {
+    hTblPtr = GetChannelTable(interp);
+    TclNewObj(resultPtr);
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)
+	    && !((pattern[0] == 's') && (pattern[1] == 't')
+	    && (pattern[2] == 'd'))) {
+	if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL)
+		&& (Tcl_ListObjAppendElement(interp, resultPtr,
+		Tcl_NewStringObj(pattern, -1)) != TCL_OK)) {
+	    goto error;
+	}
+	goto done;
+    }
+    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&hSearch)) {
 
 	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
-        if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
+	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
 	    name = "stdin";
 	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
 	    name = "stdout";
@@ -8901,18 +9774,24 @@ Tcl_GetChannelNamesEx(interp, pattern)
 	    name = "stderr";
 	} else {
 	    /*
-	     * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr),
-	     * but it's simpler to just grab the name from the statePtr.
+	     * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr), but it's
+	     * simpler to just grab the name from the statePtr.
 	     */
+
 	    name = statePtr->channelName;
 	}
 
 	if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
 		(Tcl_ListObjAppendElement(interp, resultPtr,
 			Tcl_NewStringObj(name, -1)) != TCL_OK)) {
+	error:
+	    TclDecrRefCount(resultPtr);
 	    return TCL_ERROR;
 	}
     }
+
+  done:
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -8921,8 +9800,8 @@ Tcl_GetChannelNamesEx(interp, pattern)
  *
  * Tcl_IsChannelRegistered --
  *
- *	Checks whether the channel is associated with the interp.
- *	See also Tcl_RegisterChannel and Tcl_UnregisterChannel.
+ *	Checks whether the channel is associated with the interp. See also
+ *	Tcl_RegisterChannel and Tcl_UnregisterChannel.
  *
  * Results:
  *	0 if the channel is not registered in the interpreter, 1 else.
@@ -8934,32 +9813,33 @@ Tcl_GetChannelNamesEx(interp, pattern)
  */
 
 int
-Tcl_IsChannelRegistered (interp, chan)
-     Tcl_Interp* interp;	/* The interp to query of the channel */
-     Tcl_Channel chan;		/* The channel to check */
+Tcl_IsChannelRegistered(
+    Tcl_Interp *interp,		/* The interp to query of the channel */
+    Tcl_Channel chan)		/* The channel to check */
 {
-    Tcl_HashTable	*hTblPtr;	/* Hash table of channels. */
-    Tcl_HashEntry	*hPtr;		/* Search variable. */
-    Channel		*chanPtr;	/* The real IO channel. */
-    ChannelState	*statePtr;	/* State of the real channel. */
+    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
+    Tcl_HashEntry *hPtr;	/* Search variable. */
+    Channel *chanPtr;		/* The real IO channel. */
+    ChannelState *statePtr;	/* State of the real channel. */
 
     /*
-     * Always check bottom-most channel in the stack.  This is the one
-     * that gets registered.
+     * Always check bottom-most channel in the stack. This is the one that
+     * gets registered.
      */
+
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
     statePtr = chanPtr->state;
 
-    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-    if (hTblPtr == (Tcl_HashTable *) NULL) {
-        return 0;
+    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
+    if (hTblPtr == NULL) {
+	return 0;
     }
     hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        return 0;
+    if (hPtr == NULL) {
+	return 0;
     }
     if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
-        return 0;
+	return 0;
     }
 
     return 1;
@@ -8982,11 +9862,11 @@ Tcl_IsChannelRegistered (interp, chan)
  */
 
 int
-Tcl_IsChannelShared (chan)
-    Tcl_Channel chan;	/* The channel to query */
+Tcl_IsChannelShared(
+    Tcl_Channel chan)		/* The channel to query */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-					/* State of real channel structure. */
+				/* State of real channel structure. */
 
     return ((statePtr->refCount > 1) ? 1 : 0);
 }
@@ -8997,8 +9877,8 @@ Tcl_IsChannelShared (chan)
  * Tcl_IsChannelExisting --
  *
  *	Checks whether a channel of the given name exists in the
- *	(thread)-global list of all channels.
- *	See Tcl_GetChannelNamesEx for function exposed at the Tcl level.
+ *	(thread)-global list of all channels. See Tcl_GetChannelNamesEx for
+ *	function exposed at the Tcl level.
  *
  * Results:
  *	A boolean value (0 = Does not exist, 1 = Does exist).
@@ -9010,19 +9890,18 @@ Tcl_IsChannelShared (chan)
  */
 
 int
-Tcl_IsChannelExisting(chanName)
-    CONST char* chanName;	/* The name of the channel to look for. */
+Tcl_IsChannelExisting(
+    const char *chanName)	/* The name of the channel to look for. */
 {
     ChannelState *statePtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    CONST char *name;
+    const char *name;
     int chanNameLen;
 
     chanNameLen = strlen(chanName);
-    for (statePtr = tsdPtr->firstCSPtr;
-	 statePtr != NULL;
-	 statePtr = statePtr->nextCSPtr) {
-        if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
+    for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL;
+	    statePtr = statePtr->nextCSPtr) {
+	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
 	    name = "stdin";
 	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
 	    name = "stdout";
@@ -9032,7 +9911,8 @@ Tcl_IsChannelExisting(chanName)
 	    name = statePtr->channelName;
 	}
 
-	/* Bug 2333466. Include \0 in the compare to prevent partial matching on prefixes.
+	/* Bug 2333466. Include \0 in the compare to prevent partial matching
+	 * on prefixes.
 	 */
 	if ((*chanName == *name) &&
 		(memcmp(name, chanName, (size_t) chanNameLen+1) == 0)) {
@@ -9059,9 +9939,9 @@ Tcl_IsChannelExisting(chanName)
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_ChannelName(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+const char *
+Tcl_ChannelName(
+    const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */
 {
     return chanTypePtr->typeName;
 }
@@ -9083,8 +9963,9 @@ Tcl_ChannelName(chanTypePtr)
  */
 
 Tcl_ChannelTypeVersion
-Tcl_ChannelVersion(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelVersion(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
 	return TCL_CHANNEL_VERSION_2;
@@ -9092,11 +9973,14 @@ Tcl_ChannelVersion(chanTypePtr)
 	return TCL_CHANNEL_VERSION_3;
     } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
 	return TCL_CHANNEL_VERSION_4;
+    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_5) {
+	return TCL_CHANNEL_VERSION_5;
     } else {
 	/*
-	 * In <v2 channel versions, the version field is occupied
-	 * by the Tcl_DriverBlockModeProc
+	 * In <v2 channel versions, the version field is occupied by the
+	 * Tcl_DriverBlockModeProc
 	 */
+
 	return TCL_CHANNEL_VERSION_1;
     }
 }
@@ -9119,13 +10003,13 @@ Tcl_ChannelVersion(chanTypePtr)
  */
 
 static int
-HaveVersion(chanTypePtr, minimumVersion)
-    Tcl_ChannelType *chanTypePtr;
-    Tcl_ChannelTypeVersion minimumVersion;
+HaveVersion(
+    const Tcl_ChannelType *chanTypePtr,
+    Tcl_ChannelTypeVersion minimumVersion)
 {
     Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
 
-    return ((int)actualVersion) >= ((int)minimumVersion);
+    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
 }
 
 /*
@@ -9144,8 +10028,9 @@ HaveVersion(chanTypePtr, minimumVersion)
  *---------------------------------------------------------------------- */
 
 Tcl_DriverBlockModeProc *
-Tcl_ChannelBlockModeProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelBlockModeProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->blockModeProc;
@@ -9153,6 +10038,7 @@ Tcl_ChannelBlockModeProc(chanTypePtr)
 	/*
 	 * The v1 structure had the blockModeProc in a different place.
 	 */
+
 	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
     }
 }
@@ -9174,8 +10060,9 @@ Tcl_ChannelBlockModeProc(chanTypePtr)
  */
 
 Tcl_DriverCloseProc *
-Tcl_ChannelCloseProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelCloseProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->closeProc;
 }
@@ -9197,8 +10084,9 @@ Tcl_ChannelCloseProc(chanTypePtr)
  */
 
 Tcl_DriverClose2Proc *
-Tcl_ChannelClose2Proc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelClose2Proc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->close2Proc;
 }
@@ -9220,8 +10108,9 @@ Tcl_ChannelClose2Proc(chanTypePtr)
  */
 
 Tcl_DriverInputProc *
-Tcl_ChannelInputProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelInputProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->inputProc;
 }
@@ -9243,8 +10132,9 @@ Tcl_ChannelInputProc(chanTypePtr)
  */
 
 Tcl_DriverOutputProc *
-Tcl_ChannelOutputProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelOutputProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->outputProc;
 }
@@ -9266,8 +10156,9 @@ Tcl_ChannelOutputProc(chanTypePtr)
  */
 
 Tcl_DriverSeekProc *
-Tcl_ChannelSeekProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelSeekProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->seekProc;
 }
@@ -9289,8 +10180,9 @@ Tcl_ChannelSeekProc(chanTypePtr)
  */
 
 Tcl_DriverSetOptionProc *
-Tcl_ChannelSetOptionProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelSetOptionProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->setOptionProc;
 }
@@ -9312,8 +10204,9 @@ Tcl_ChannelSetOptionProc(chanTypePtr)
  */
 
 Tcl_DriverGetOptionProc *
-Tcl_ChannelGetOptionProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelGetOptionProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->getOptionProc;
 }
@@ -9335,8 +10228,9 @@ Tcl_ChannelGetOptionProc(chanTypePtr)
  */
 
 Tcl_DriverWatchProc *
-Tcl_ChannelWatchProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelWatchProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->watchProc;
 }
@@ -9358,8 +10252,9 @@ Tcl_ChannelWatchProc(chanTypePtr)
  */
 
 Tcl_DriverGetHandleProc *
-Tcl_ChannelGetHandleProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelGetHandleProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     return chanTypePtr->getHandleProc;
 }
@@ -9381,8 +10276,9 @@ Tcl_ChannelGetHandleProc(chanTypePtr)
  */
 
 Tcl_DriverFlushProc *
-Tcl_ChannelFlushProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelFlushProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->flushProc;
@@ -9408,8 +10304,9 @@ Tcl_ChannelFlushProc(chanTypePtr)
  */
 
 Tcl_DriverHandlerProc *
-Tcl_ChannelHandlerProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelHandlerProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->handlerProc;
@@ -9435,8 +10332,9 @@ Tcl_ChannelHandlerProc(chanTypePtr)
  */
 
 Tcl_DriverWideSeekProc *
-Tcl_ChannelWideSeekProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelWideSeekProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
 	return chanTypePtr->wideSeekProc;
@@ -9450,7 +10348,8 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
  *
  * Tcl_ChannelThreadActionProc --
  *
- *	Return the Tcl_DriverThreadActionProc of the channel type.
+ *	TIP #218, Channel Thread Actions. Return the
+ *	Tcl_DriverThreadActionProc of the channel type.
  *
  * Results:
  *	A pointer to the proc.
@@ -9462,8 +10361,9 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
  */
 
 Tcl_DriverThreadActionProc *
-Tcl_ChannelThreadActionProc(chanTypePtr)
-    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
+Tcl_ChannelThreadActionProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
 	return chanTypePtr->threadActionProc;
@@ -9471,43 +10371,537 @@ Tcl_ChannelThreadActionProc(chanTypePtr)
 	return NULL;
     }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetChannelErrorInterp --
+ *
+ *	TIP #219, Tcl Channel Reflection API.
+ *	Store an error message for the I/O system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Discards a previously stored message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetChannelErrorInterp(
+    Tcl_Interp *interp,		/* Interp to store the data into. */
+    Tcl_Obj *msg)		/* Error message to store. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->chanMsg != NULL) {
+	TclDecrRefCount(iPtr->chanMsg);
+	iPtr->chanMsg = NULL;
+    }
+
+    if (msg != NULL) {
+	iPtr->chanMsg = FixLevelCode(msg);
+	Tcl_IncrRefCount(iPtr->chanMsg);
+    }
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetChannelError --
+ *
+ *	TIP #219, Tcl Channel Reflection API.
+ *	Store an error message for the I/O system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Discards a previously stored message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetChannelError(
+    Tcl_Channel chan,		/* Channel to store the data into. */
+    Tcl_Obj *msg)		/* Error message to store. */
+{
+    ChannelState *statePtr = ((Channel *) chan)->state;
+
+    if (statePtr->chanMsg != NULL) {
+	TclDecrRefCount(statePtr->chanMsg);
+	statePtr->chanMsg = NULL;
+    }
+
+    if (msg != NULL) {
+	statePtr->chanMsg = FixLevelCode(msg);
+	Tcl_IncrRefCount(statePtr->chanMsg);
+    }
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FixLevelCode --
+ *
+ *	TIP #219, Tcl Channel Reflection API.
+ *	Scans an error message for bad -code / -level directives. Returns a
+ *	modified copy with such directives corrected, and the input if it had
+ *	no problems.
+ *
+ * Results:
+ *	A Tcl_Obj*
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+FixLevelCode(
+    Tcl_Obj *msg)
+{
+    int explicitResult, numOptions, lc, lcn;
+    Tcl_Obj **lv, **lvn;
+    int res, i, j, val, lignore, cignore;
+    int newlevel = -1, newcode = -1;
+
+    /* ASSERT msg != NULL */
+
+    /*
+     * Process the caught message.
+     *
+     * Syntax = (option value)... ?message?
+     *
+     * Bad message syntax causes a panic, because the other side uses
+     * Tcl_GetReturnOptions and list construction functions to marshall the
+     * information. Hence an error means that we've got serious breakage.
+     */
+
+    res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
+    if (res != TCL_OK) {
+	Tcl_Panic("Tcl_SetChannelError(Interp): Bad syntax of message");
+    }
+
+    explicitResult = (1 == (lc % 2));
+    numOptions = lc - explicitResult;
+
+    /*
+     * No options, nothing to do.
+     */
+
+    if (numOptions == 0) {
+	return msg;
+    }
+
+    /*
+     * Check for -code x, x != 1|error, and -level x, x != 0
+     */
+
+    for (i = 0; i < numOptions; i += 2) {
+	if (0 == strcmp(TclGetString(lv[i]), "-code")) {
+	    /*
+	     * !"error", !integer, integer != 1 (numeric code for error)
+	     */
+
+	    res = TclGetIntFromObj(NULL, lv[i+1], &val);
+	    if (((res == TCL_OK) && (val != 1)) || ((res != TCL_OK) &&
+		    (0 != strcmp(TclGetString(lv[i+1]), "error")))) {
+		newcode = 1;
+	    }
+	} else if (0 == strcmp(TclGetString(lv[i]), "-level")) {
+	    /*
+	     * !integer, integer != 0
+	     */
+
+	    res = TclGetIntFromObj(NULL, lv [i+1], &val);
+	    if ((res != TCL_OK) || (val != 0)) {
+		newlevel = 0;
+	    }
+	}
+    }
+
+    /*
+     * -code, -level are either not present or ok. Nothing to do.
+     */
+
+    if ((newlevel < 0) && (newcode < 0)) {
+	return msg;
+    }
+
+    lcn = numOptions;
+    if (explicitResult) {
+	lcn ++;
+    }
+    if (newlevel >= 0) {
+	lcn += 2;
+    }
+    if (newcode >= 0) {
+	lcn += 2;
+    }
+
+    lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *));
+
+    /*
+     * New level/code information is spliced into the first occurence of
+     * -level, -code, further occurences are ignored. The options cannot be
+     * not present, we would not come here. Options which are ok are simply
+     * copied over.
+     */
+
+    lignore = cignore = 0;
+    for (i=0, j=0; i<numOptions; i+=2) {
+	if (0 == strcmp(TclGetString(lv[i]), "-level")) {
+	    if (newlevel >= 0) {
+		lvn[j++] = lv[i];
+		lvn[j++] = Tcl_NewIntObj(newlevel);
+		newlevel = -1;
+		lignore = 1;
+		continue;
+	    } else if (lignore) {
+		continue;
+	    }
+	} else if (0 == strcmp(TclGetString(lv[i]), "-code")) {
+	    if (newcode >= 0) {
+		lvn[j++] = lv[i];
+		lvn[j++] = Tcl_NewIntObj(newcode);
+		newcode = -1;
+		cignore = 1;
+		continue;
+	    } else if (cignore) {
+		continue;
+	    }
+	}
+
+	/*
+	 * Keep everything else, possibly copied down.
+	 */
+
+	lvn[j++] = lv[i];
+	lvn[j++] = lv[i+1];
+    }
+    if (newlevel >= 0) {
+	Tcl_Panic("Defined newlevel not used in rewrite");
+    }
+    if (newcode >= 0) {
+	Tcl_Panic("Defined newcode not used in rewrite");
+    }
+
+    if (explicitResult) {
+	lvn[j++] = lv[i];
+    }
+
+    msg = Tcl_NewListObj(j, lvn);
+
+    ckfree((char *) lvn);
+    return msg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelErrorInterp --
+ *
+ *	TIP #219, Tcl Channel Reflection API.
+ *	Return the message stored by the channel driver.
+ *
+ * Results:
+ *	Tcl error message object.
+ *
+ * Side effects:
+ *	Resets the stored data to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetChannelErrorInterp(
+    Tcl_Interp *interp,		/* Interp to query. */
+    Tcl_Obj **msg)		/* Place for error message. */
+{
+    Interp *iPtr = (Interp *) interp;
+
+    *msg = iPtr->chanMsg;
+    iPtr->chanMsg = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelError --
+ *
+ *	TIP #219, Tcl Channel Reflection API.
+ *	Return the message stored by the channel driver.
+ *
+ * Results:
+ *	Tcl error message object.
+ *
+ * Side effects:
+ *	Resets the stored data to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetChannelError(
+    Tcl_Channel chan,		/* Channel to query. */
+    Tcl_Obj **msg)		/* Place for error message. */
+{
+    ChannelState *statePtr = ((Channel *) chan)->state;
+
+    *msg = statePtr->chanMsg;
+    statePtr->chanMsg = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelTruncateProc --
+ *
+ *	TIP #208 (subsection relating to truncation, based on TIP #206).
+ *	Return the Tcl_DriverTruncateProc of the channel type.
+ *
+ * Results:
+ *	A pointer to the proc.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverTruncateProc *
+Tcl_ChannelTruncateProc(
+    const Tcl_ChannelType *chanTypePtr)
+				/* Pointer to channel type. */
+{
+    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
+	return chanTypePtr->truncateProc;
+    } else {
+	return NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupChannelIntRep --
+ *
+ *	Initialize the internal representation of a new Tcl_Obj to a copy of
+ *	the internal representation of an existing string object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to a copy of srcPtr's internal
+ *	representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupChannelIntRep(
+    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
+				 * an internal rep of type "Channel". */
+    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
+				 * currently have an internal rep.*/
+{
+    ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr);
+    Interp       *interpPtr = GET_CHANNELINTERP(srcPtr);
+
+    SET_CHANNELSTATE(copyPtr, statePtr);
+    SET_CHANNELINTERP(copyPtr, interpPtr);
+    Tcl_Preserve((ClientData) statePtr);
+    copyPtr->typePtr = &tclChannelType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetChannelFromAny --
+ *
+ *	Create an internal representation of type "Channel" for an object.
+ *
+ * Results:
+ *	This operation always succeeds and returns TCL_OK.
+ *
+ * Side effects:
+ *	Any old internal reputation for objPtr is freed and the internal
+ *	representation is set to "Channel".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetChannelFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
+{
+    ChannelState *statePtr;
+    Interp       *interpPtr;
+
+    if (interp == NULL) {
+	return TCL_ERROR;
+    }
+    if (objPtr->typePtr == &tclChannelType) {
+	/*
+	 * The channel is valid until any call to DetachChannel occurs.
+	 * Ensure consistency checks are done.
+	 */
+	statePtr  = GET_CHANNELSTATE(objPtr);
+	interpPtr = GET_CHANNELINTERP(objPtr);
+	if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+	    ResetFlag(statePtr, CHANNEL_TAINTED);
+	    Tcl_Release((ClientData) statePtr);
+	    UpdateStringOfChannel(objPtr);
+	    objPtr->typePtr = NULL;
+	} else if (interpPtr != (Interp*) interp) {
+	    Tcl_Release((ClientData) statePtr);
+	    UpdateStringOfChannel(objPtr);
+	    objPtr->typePtr = NULL;
+	}
+    }
+    if (objPtr->typePtr != &tclChannelType) {
+	Tcl_Channel chan;
+
+	/*
+	 * We need a valid string with which to check for a valid channel, but
+	 * make sure not to free internal rep until validated. [Bug 1847044]
+	 */
+	if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) {
+	    objPtr->typePtr->updateStringProc(objPtr);
+	}
+
+	chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
+	if (chan == NULL) {
+	    return TCL_ERROR;
+	}
+
+	TclFreeIntRep(objPtr);
+	statePtr = ((Channel *)chan)->state;
+	Tcl_Preserve((ClientData) statePtr);
+	SET_CHANNELSTATE(objPtr, statePtr);
+	SET_CHANNELINTERP(objPtr, interp);
+	objPtr->typePtr = &tclChannelType;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfChannel --
+ *
+ *	Update the string representation for an object whose internal
+ *	representation is "Channel".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string may be set by converting its Unicode represention
+ *	to UTF format.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfChannel(
+    Tcl_Obj *objPtr)		/* Object with string rep to update. */
+{
+    if (objPtr->bytes == NULL) {
+	ChannelState *statePtr = GET_CHANNELSTATE(objPtr);
+	const char *name = statePtr->channelName;
+	if (name) {
+	    size_t len = strlen(name);
+	    objPtr->bytes = (char *) ckalloc(len + 1);
+	    objPtr->length = len;
+	    memcpy(objPtr->bytes, name, len);
+	} else {
+	    objPtr->bytes = tclEmptyStringRep;
+	    objPtr->length = 0;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeChannelIntRep --
+ *
+ *	Release statePtr storage.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May cause state to be freed.
+ *
+ *----------------------------------------------------------------------
+ */
 
+static void
+FreeChannelIntRep(
+    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
+{
+    Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr));
+}
+
 #if 0
-/* For future debugging work, a simple function to print the flags of
- * a channel in semi-readable form.
+/*
+ * For future debugging work, a simple function to print the flags of a
+ * channel in semi-readable form.
  */
 
 static int
-DumpFlags (str, flags)
-     char* str;
-     int flags;
-{
-  char buf [20];
-  int i = 0;
-
-  if (flags & TCL_READABLE)           {buf[i] = 'r';} else {buf [i]='_';}; i++;
-  if (flags & TCL_WRITABLE)           {buf[i] = 'w';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_NONBLOCKING)    {buf[i] = 'n';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_LINEBUFFERED)   {buf[i] = 'l';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_UNBUFFERED)     {buf[i] = 'u';} else {buf [i]='_';}; i++;
-  if (flags & BUFFER_READY)           {buf[i] = 'R';} else {buf [i]='_';}; i++;
-  if (flags & BG_FLUSH_SCHEDULED)     {buf[i] = 'F';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_CLOSED)         {buf[i] = 'c';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_EOF)            {buf[i] = 'E';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_STICKY_EOF)     {buf[i] = 'S';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_BLOCKED)        {buf[i] = 'B';} else {buf [i]='_';}; i++;
-  if (flags & INPUT_SAW_CR)           {buf[i] = '/';} else {buf [i]='_';}; i++;
-  if (flags & INPUT_NEED_NL)          {buf[i] = '*';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_DEAD)           {buf[i] = 'D';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_RAW_MODE)       {buf[i] = 'R';} else {buf [i]='_';}; i++;
+DumpFlags(
+    char *str,
+    int flags)
+{
+    char buf[20];
+    int i = 0;
+
+#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
+
+    ChanFlag('r', TCL_READABLE);
+    ChanFlag('w', TCL_WRITABLE);
+    ChanFlag('n', CHANNEL_NONBLOCKING);
+    ChanFlag('l', CHANNEL_LINEBUFFERED);
+    ChanFlag('u', CHANNEL_UNBUFFERED);
+    ChanFlag('R', BUFFER_READY);
+    ChanFlag('F', BG_FLUSH_SCHEDULED);
+    ChanFlag('c', CHANNEL_CLOSED);
+    ChanFlag('E', CHANNEL_EOF);
+    ChanFlag('S', CHANNEL_STICKY_EOF);
+    ChanFlag('B', CHANNEL_BLOCKED);
+    ChanFlag('/', INPUT_SAW_CR);
+    ChanFlag('*', INPUT_NEED_NL);
+    ChanFlag('D', CHANNEL_DEAD);
+    ChanFlag('R', CHANNEL_RAW_MODE);
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-  if (flags & CHANNEL_TIMER_FEV)      {buf[i] = 'T';} else {buf [i]='_';}; i++;
-  if (flags & CHANNEL_HAS_MORE_DATA)  {buf[i] = 'H';} else {buf [i]='_';}; i++;
+    ChanFlag('T', CHANNEL_TIMER_FEV);
+    ChanFlag('H', CHANNEL_HAS_MORE_DATA);
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-  if (flags & CHANNEL_INCLOSE)        {buf[i] = 'x';} else {buf [i]='_';}; i++;
-  buf [i] ='\0';
+    ChanFlag('x', CHANNEL_INCLOSE);
+
+    buf[i] ='\0';
 
-  fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr);
-  return 0;
+    fprintf(stderr, "%s: %s\n", str, buf);
+    return 0;
 }
 #endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIO.h b/generic/tclIO.h
index e9f6151..8746a09 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclIO.h --
  *
  *	This file provides the generic portions (those that are the same on
@@ -7,16 +7,16 @@
  * Copyright (c) 1998-2000 Ajuba Solutions
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 /*
  * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
- * compile on systems where neither is defined. We want both defined so
- * that we can test safely for both. In the code we still have to test for
- * both because there may be systems on which both are defined and have
- * different values.
+ * compile on systems where neither is defined. We want both defined so that
+ * we can test safely for both. In the code we still have to test for both
+ * because there may be systems on which both are defined and have different
+ * values.
  */
 
 #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
@@ -26,12 +26,12 @@
 #   define EAGAIN EWOULDBLOCK
 #endif
 #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
-error one of EWOULDBLOCK or EAGAIN must be defined
+#error one of EWOULDBLOCK or EAGAIN must be defined
 #endif
 
 /*
  * The following structure encapsulates the state for a background channel
- * copy.  Note that the data buffer for the copy will be appended to this
+ * copy. Note that the data buffer for the copy will be appended to this
  * structure.
  */
 
@@ -41,7 +41,7 @@ typedef struct CopyState {
     int readFlags;		/* Original read channel flags. */
     int writeFlags;		/* Original write channel flags. */
     int toRead;			/* Number of bytes to copy, or -1. */
-    int total;			/* Total bytes transferred (written). */
+    Tcl_WideInt total;		/* Total bytes transferred (written). */
     Tcl_Interp *interp;		/* Interp that started the copy. */
     Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
     int bufSize;		/* Size of appended buffer. */
@@ -57,28 +57,28 @@ typedef struct CopyState {
 
 typedef struct ChannelBuffer {
     int nextAdded;		/* The next position into which a character
-                                 * will be put in the buffer. */
-    int nextRemoved;		/* Position of next byte to be removed
-                                 * from the buffer. */
+				 * will be put in the buffer. */
+    int nextRemoved;		/* Position of next byte to be removed from
+				 * the buffer. */
     int bufLength;		/* How big is the buffer? */
     struct ChannelBuffer *nextPtr;
     				/* Next buffer in chain. */
     char buf[4];		/* Placeholder for real buffer. The real
-                                 * buffer occuppies this space + bufSize-4
-                                 * bytes. This must be the last field in
-                                 * the structure. */
+				 * buffer occuppies this space + bufSize-4
+				 * bytes. This must be the last field in the
+				 * structure. */
 } ChannelBuffer;
 
 #define CHANNELBUFFER_HEADER_SIZE	(sizeof(ChannelBuffer) - 4)
 
 /*
  * How much extra space to allocate in buffer to hold bytes from previous
- * buffer (when converting to UTF-8) or to hold bytes that will go to
- * next buffer (when converting from UTF-8).
+ * buffer (when converting to UTF-8) or to hold bytes that will go to next
+ * buffer (when converting from UTF-8).
  */
- 
-#define BUFFER_PADDING	    16
- 
+
+#define BUFFER_PADDING		16
+
 /*
  * The following defines the *default* buffer size for channels.
  */
@@ -86,28 +86,29 @@ typedef struct ChannelBuffer {
 #define CHANNELBUFFER_DEFAULT_SIZE	(1024 * 4)
 
 /*
- * Structure to record a close callback. One such record exists for
- * each close callback registered for a channel.
+ * Structure to record a close callback. One such record exists for each close
+ * callback registered for a channel.
  */
 
 typedef struct CloseCallback {
-    Tcl_CloseProc *proc;		/* The procedure to call. */
-    ClientData clientData;		/* Arbitrary one-word data to pass
-					 * to the callback. */
-    struct CloseCallback *nextPtr;	/* For chaining close callbacks. */
+    Tcl_CloseProc *proc;	/* The procedure to call. */
+    ClientData clientData;	/* Arbitrary one-word data to pass to the
+				 * callback. */
+    struct CloseCallback *nextPtr;
+				/* For chaining close callbacks. */
 } CloseCallback;
 
 /*
  * The following structure describes the information saved from a call to
- * "fileevent". This is used later when the event being waited for to
- * invoke the saved script in the interpreter designed in this record.
+ * "fileevent". This is used later when the event being waited for to invoke
+ * the saved script in the interpreter designed in this record.
  */
 
 typedef struct EventScriptRecord {
     struct Channel *chanPtr;	/* The channel for which this script is
-				 * registered. This is used only when an
-				 * error occurs during evaluation of the
-				 * script, to delete the handler. */
+				 * registered. This is used only when an error
+				 * occurs during evaluation of the script, to
+				 * delete the handler. */
     Tcl_Obj *scriptPtr;		/* Script to invoke. */
     Tcl_Interp *interp;		/* In what interpreter to invoke script? */
     int mask;			/* Events must overlap current mask for the
@@ -119,29 +120,28 @@ typedef struct EventScriptRecord {
 /*
  * struct Channel:
  *
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
+ * One of these structures is allocated for each open channel. It contains
+ * data specific to the channel but which belongs to the generic part of the
+ * Tcl channel mechanism, and it points at an instance specific (and type
+ * specific) instance data, and at a channel type structure.
  */
 
 typedef struct Channel {
     struct ChannelState *state; /* Split out state information */
-
-    ClientData instanceData;	/* Instance-specific data provided by
-				 * creator of channel. */
+    ClientData instanceData;	/* Instance-specific data provided by creator
+				 * of channel. */
     Tcl_ChannelType *typePtr;	/* Pointer to channel type structure. */
-
     struct Channel *downChanPtr;/* Refers to channel this one was stacked
-				 * upon.  This reference is NULL for normal
-				 * channels.  See Tcl_StackChannel. */
+				 * upon. This reference is NULL for normal
+				 * channels. See Tcl_StackChannel. */
     struct Channel *upChanPtr;	/* Refers to the channel above stacked this
 				 * one. NULL for the top most channel. */
 
     /*
-     * Intermediate buffers to hold pre-read data for consumption by a
-     * newly stacked transformation. See 'Tcl_StackChannel'.
+     * Intermediate buffers to hold pre-read data for consumption by a newly
+     * stacked transformation. See 'Tcl_StackChannel'.
      */
+
     ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
     ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */
 } Channel;
@@ -149,54 +149,52 @@ typedef struct Channel {
 /*
  * struct ChannelState:
  *
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
+ * One of these structures is allocated for each open channel. It contains
+ * data specific to the channel but which belongs to the generic part of the
+ * Tcl channel mechanism, and it points at an instance specific (and type
+ * specific) instance data, and at a channel type structure.
  */
 
 typedef struct ChannelState {
     CONST char *channelName;	/* The name of the channel instance in Tcl
-				 * commands. Storage is owned by the generic IO
-				 * code, is dynamically allocated. */
+				 * commands. Storage is owned by the generic
+				 * IO code, is dynamically allocated. */
     int	flags;			/* ORed combination of the flags defined
 				 * below. */
     Tcl_Encoding encoding;	/* Encoding to apply when reading or writing
-				 * data on this channel.  NULL means no
+				 * data on this channel. NULL means no
 				 * encoding is applied to data. */
     Tcl_EncodingState inputEncodingState;
-				/* Current encoding state, used when converting
-				 * input data bytes to UTF-8. */
+				/* Current encoding state, used when
+				 * converting input data bytes to UTF-8. */
     int inputEncodingFlags;	/* Encoding flags to pass to conversion
 				 * routine when converting input data bytes to
-				 * UTF-8.  May be TCL_ENCODING_START before
+				 * UTF-8. May be TCL_ENCODING_START before
 				 * converting first byte and TCL_ENCODING_END
 				 * when EOF is seen. */
     Tcl_EncodingState outputEncodingState;
-				/* Current encoding state, used when converting
-				 * UTF-8 to output data bytes. */
+				/* Current encoding state, used when
+				 * converting UTF-8 to output data bytes. */
     int outputEncodingFlags;	/* Encoding flags to pass to conversion
 				 * routine when converting UTF-8 to output
-				 * data bytes.  May be TCL_ENCODING_START
+				 * data bytes. May be TCL_ENCODING_START
 				 * before converting first byte and
 				 * TCL_ENCODING_END when EOF is seen. */
     TclEolTranslation inputTranslation;
 				/* What translation to apply for end of line
-				 * sequences on input? */    
+				 * sequences on input? */
     TclEolTranslation outputTranslation;
-				/* What translation to use for generating
-				 * end of line sequences in output? */
-    int inEofChar;		/* If nonzero, use this as a signal of EOF
-				 * on input. */
-    int outEofChar;             /* If nonzero, append this to the channel
-				 * when it is closed if it is open for
-				 * writing. */
+				/* What translation to use for generating end
+				 * of line sequences in output? */
+    int inEofChar;		/* If nonzero, use this as a signal of EOF on
+				 * input. */
+    int outEofChar;		/* If nonzero, append this to the channel when
+				 * it is closed if it is open for writing. */
     int unreportedError;	/* Non-zero if an error report was deferred
 				 * because it happened in the background. The
 				 * value is the POSIX error code. */
     int refCount;		/* How many interpreters hold references to
 				 * this IO channel? */
-
     CloseCallback *closeCbPtr;	/* Callbacks registered to be called when the
 				 * channel is closed. */
     char *outputStage;		/* Temporary staging buffer used when
@@ -205,37 +203,46 @@ typedef struct ChannelState {
     ChannelBuffer *curOutPtr;	/* Current output buffer being filled. */
     ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
     ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
-
     ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
 				 * need to allocate a new buffer for "gets"
 				 * that crosses buffer boundaries. */
     ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
     ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */
-
-    struct ChannelHandler *chPtr;/* List of channel handlers registered
-				  * for this channel. */
+    struct ChannelHandler *chPtr;/* List of channel handlers registered for
+				  * this channel. */
     int interestMask;		/* Mask of all events this channel has
 				 * handlers for. */
     EventScriptRecord *scriptRecordPtr;
-				/* Chain of all scripts registered for
-				 * event handlers ("fileevent") on this
-				 * channel. */
-
+				/* Chain of all scripts registered for event
+				 * handlers ("fileevent") on this channel. */
     int bufSize;		/* What size buffers to allocate? */
     Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
     CopyState *csPtrR;		/* State of background copy for which channel is input, or NULL. */
     CopyState *csPtrW;		/* State of background copy for which channel is output, or NULL. */
-    Channel *topChanPtr;	/* Refers to topmost channel in a stack.
-				 * Never NULL. */
+    Channel *topChanPtr;	/* Refers to topmost channel in a stack. Never
+				 * NULL. */
     Channel *bottomChanPtr;	/* Refers to bottommost channel in a stack.
 				 * This channel can be relied on to live as
 				 * long as the channel state. Never NULL. */
     struct ChannelState *nextCSPtr;
 				/* Next in list of channels currently open. */
-    Tcl_ThreadId managingThread; /* TIP #10: Id of the thread managing
-				  * this stack of channels. */
+    Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this
+				 * stack of channels. */
+
+    /*
+     * TIP #219 ... Info for the I/O system ...
+     * Error message set by channel drivers, for the propagation of arbitrary
+     * Tcl errors. This information, if present (chanMsg not NULL), takes
+     * precedence over a posix error code returned by a channel operation.
+     */
+
+    Tcl_Obj* chanMsg;
+    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
+				 * because it happened in the background. The
+				 * value is the chanMg, if any. #219's
+				 * companion to 'unreportedError'. */
 } ChannelState;
-    
+
 /*
  * Values for the flags field in Channel. Any ORed combination of the
  * following flags can be stored in the field. These flags record various
@@ -243,107 +250,106 @@ typedef struct ChannelState {
  * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
  */
 
-#define CHANNEL_NONBLOCKING	(1<<3)	/* Channel is currently in
-					 * nonblocking mode. */
+#define CHANNEL_NONBLOCKING	(1<<3)	/* Channel is currently in nonblocking
+					 * mode. */
 #define CHANNEL_LINEBUFFERED	(1<<4)	/* Output to the channel must be
 					 * flushed after every newline. */
 #define CHANNEL_UNBUFFERED	(1<<5)	/* Output to the channel must always
 					 * be flushed immediately. */
 #define BUFFER_READY		(1<<6)	/* Current output buffer (the
-					 * curOutPtr field in the
-                                         * channel structure) should be
-                                         * output as soon as possible even
-                                         * though it may not be full. */
-#define BG_FLUSH_SCHEDULED	(1<<7)	/* A background flush of the
-					 * queued output buffers has been
-                                         * scheduled. */
-#define CHANNEL_CLOSED		(1<<8)	/* Channel has been closed. No
-					 * further Tcl-level IO on the
-                                         * channel is allowed. */
-#define CHANNEL_EOF		(1<<9)	/* EOF occurred on this channel.
-					 * This bit is cleared before every
-                                         * input operation. */
-#define CHANNEL_STICKY_EOF	(1<<10)	/* EOF occurred on this channel because
-					 * we saw the input eofChar. This bit
-                                         * prevents clearing of the EOF bit
-                                         * before every input operation. */
-#define CHANNEL_BLOCKED		(1<<11)	/* EWOULDBLOCK or EAGAIN occurred
-					 * on this channel. This bit is
-					 * cleared before every input or
-					 * output operation. */
+					 * curOutPtr field in the channel
+					 * structure) should be output as soon
+					 * as possible even though it may not
+					 * be full. */
+#define BG_FLUSH_SCHEDULED	(1<<7)	/* A background flush of the queued
+					 * output buffers has been
+					 * scheduled. */
+#define CHANNEL_CLOSED		(1<<8)	/* Channel has been closed. No further
+					 * Tcl-level IO on the channel is
+					 * allowed. */
+#define CHANNEL_EOF		(1<<9)	/* EOF occurred on this channel. This
+					 * bit is cleared before every input
+					 * operation. */
+#define CHANNEL_STICKY_EOF	(1<<10)	/* EOF occurred on this channel
+					 * because we saw the input
+					 * eofChar. This bit prevents clearing
+					 * of the EOF bit before every input
+					 * operation. */
+#define CHANNEL_BLOCKED		(1<<11)	/* EWOULDBLOCK or EAGAIN occurred on
+					 * this channel. This bit is cleared
+					 * before every input or output
+					 * operation. */
 #define INPUT_SAW_CR		(1<<12)	/* Channel is in CRLF eol input
-					 * translation mode and the last
-                                         * byte seen was a "\r". */
+					 * translation mode and the last byte
+					 * seen was a "\r". */
 #define INPUT_NEED_NL		(1<<15)	/* Saw a '\r' at end of last buffer,
 					 * and there should be a '\n' at
 					 * beginning of next buffer. */
-#define CHANNEL_DEAD		(1<<13)	/* The channel has been closed by
-					 * the exit handler (on exit) but
-                                         * not deallocated. When any IO
-                                         * operation sees this flag on a
-                                         * channel, it does not call driver
-                                         * level functions to avoid referring
-                                         * to deallocated data. */
+#define CHANNEL_DEAD		(1<<13)	/* The channel has been closed by the
+					 * exit handler (on exit) but not
+					 * deallocated. When any IO operation
+					 * sees this flag on a channel, it
+					 * does not call driver level
+					 * functions to avoid referring to
+					 * deallocated data. */
 #define CHANNEL_NEED_MORE_DATA	(1<<14)	/* The last input operation failed
 					 * because there was not enough data
-					 * to complete the operation.  This
-					 * flag is set when gets fails to
-					 * get a complete line or when read
-					 * fails to get a complete character.
-					 * When set, file events will not be
+					 * to complete the operation. This
+					 * flag is set when gets fails to get
+					 * a complete line or when read fails
+					 * to get a complete character. When
+					 * set, file events will not be
 					 * delivered for buffered data until
-					 * the state of the channel changes. */
+					 * the state of the channel
+					 * changes. */
 #define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
 					 * being used. */
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV       (1<<17) /* When set the event we are
-					 * notified by is a fileevent
-					 * generated by a timer. We
-					 * don't know if the driver
-					 * has more data and should
-					 * not try to read from it. If
-					 * the system needs more than
-					 * is in the buffers out read
-					 * routines will simulate a
-					 * short read (0 characters
-					 * read) */
-#define CHANNEL_HAS_MORE_DATA   (1<<18) /* Set by NotifyChannel for a
-					 * channel if and only if the
-					 * channel is configured
-					 * non-blocking, the driver
+#define CHANNEL_TIMER_FEV	(1<<17)	/* When set the event we are notified
+					 * by is a fileevent generated by a
+					 * timer. We don't know if the driver
+					 * has more data and should not try to
+					 * read from it. If the system needs
+					 * more than is in the buffers out
+					 * read routines will simulate a short
+					 * read (0 characters read) */
+#define CHANNEL_HAS_MORE_DATA   (1<<18) /* Set by NotifyChannel for a channel
+					 * if and only if the channel is
+					 * configured non-blocking, the driver
 					 * for said channel has no
-					 * blockmodeproc, and data has
-					 * arrived for reading at the
-					 * OS level). A GetInput will
-					 * pass reading from the
+					 * blockmodeproc, and data has arrived
+					 * for reading at the OS level). A
+					 * GetInput will pass reading from the
 					 * driver if the channel is
-					 * non-blocking, without
-					 * blockmode proc and the flag
-					 * has not been set. A read
-					 * will be performed if the
-					 * flag is set. This will
-					 * reset the flag as well. */
+					 * non-blocking, without blockmode
+					 * proc and the flag has not been set.
+					 * A read will be performed if the
+					 * flag is set. This will reset the
+					 * flag as well. */
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being
-					 * closed. Its structures are
-					 * still live and usable, but
-					 * it may not be closed again
-					 * from within the close handler.
-					 */
+#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
+					 * Its structures are still live and
+					 * usable, but it may not be closed
+					 * again from within the close
+					 * handler. */
+#define CHANNEL_TAINTED		(1<<20)	/* Channel stack structure has changed.
+					 * Used by Channel Tcl_Obj type to
+					 * determine if we have to revalidate
+					 * the channel. */
 
 /*
  * For each channel handler registered in a call to Tcl_CreateChannelHandler,
  * there is one record of the following type. All of records for a specific
- * channel are chained together in a singly linked list which is stored in
- * the channel structure.
+ * channel are chained together in a singly linked list which is stored in the
+ * channel structure.
  */
 
 typedef struct ChannelHandler {
     Channel *chanPtr;		/* The channel structure for this channel. */
     int mask;			/* Mask of desired events. */
     Tcl_ChannelProc *proc;	/* Procedure to call in the type of
-                                 * Tcl_CreateChannelHandler. */
+				 * Tcl_CreateChannelHandler. */
     ClientData clientData;	/* Argument to pass to procedure. */
     struct ChannelHandler *nextPtr;
     				/* Next one in list of registered handlers. */
@@ -366,17 +372,17 @@ typedef struct ChannelHandler {
  */
 
 typedef struct NextChannelHandler {
-    ChannelHandler *nextHandlerPtr;	/* The next handler to be invoked in
-                                         * this invocation. */
+    ChannelHandler *nextHandlerPtr;
+				/* The next handler to be invoked in this
+				 * invocation. */
     struct NextChannelHandler *nestedHandlerPtr;
-    /* Next nested invocation of
-     * ChannelHandlerEventProc. */
+				/* Next nested invocation of
+				 * ChannelHandlerEventProc. */
 } NextChannelHandler;
 
-
 /*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
+ * The following structure describes the event that is added to the Tcl event
+ * queue by the channel handler check procedure.
  */
 
 typedef struct ChannelHandlerEvent {
@@ -386,26 +392,26 @@ typedef struct ChannelHandlerEvent {
 } ChannelHandlerEvent;
 
 /*
- * The following structure is used by Tcl_GetsObj() to encapsulates the
- * state for a "gets" operation.
+ * The following structure is used by Tcl_GetsObj() to encapsulates the state
+ * for a "gets" operation.
  */
- 
+
 typedef struct GetsState {
-    Tcl_Obj *objPtr;		/* The object to which UTF-8 characters
-				 * will be appended. */
-    char **dstPtr;		/* Pointer into objPtr's string rep where
-				 * next character should be stored. */
-    Tcl_Encoding encoding;	/* The encoding to use to convert raw bytes
-				 * to UTF-8.  */
+    Tcl_Obj *objPtr;		/* The object to which UTF-8 characters will
+				 * be appended. */
+    char **dstPtr;		/* Pointer into objPtr's string rep where next
+				 * character should be stored. */
+    Tcl_Encoding encoding;	/* The encoding to use to convert raw bytes to
+				 * UTF-8. */
     ChannelBuffer *bufPtr;	/* The current buffer of raw bytes being
 				 * emptied. */
     Tcl_EncodingState state;	/* The encoding state just before the last
 				 * external to UTF-8 conversion in
 				 * FilterInputBytes(). */
-    int rawRead;		/* The number of bytes removed from bufPtr
-				 * in the last call to FilterInputBytes(). */
-    int bytesWrote;		/* The number of bytes of UTF-8 data
-				 * appended to objPtr during the last call to
+    int rawRead;		/* The number of bytes removed from bufPtr in
+				 * the last call to FilterInputBytes(). */
+    int bytesWrote;		/* The number of bytes of UTF-8 data appended
+				 * to objPtr during the last call to
 				 * FilterInputBytes(). */
     int charsWrote;		/* The corresponding number of UTF-8
 				 * characters appended to objPtr during the
@@ -414,3 +420,11 @@ typedef struct GetsState {
 				 * appended to objPtr so far, just before the
 				 * last call to FilterInputBytes(). */
 } GetsState;
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 635490c..21dcd71 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1,16 +1,15 @@
-/* 
+/*
  * tclIOCmd.c --
  *
  *	Contains the definitions of most of the Tcl commands relating to IO.
  *
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
  * Callback structure for accept callback in a TCP server.
@@ -22,26 +21,75 @@ typedef struct AcceptCallback {
 } AcceptCallback;
 
 /*
+ * Thread local storage used to maintain a per-thread stdout channel obj.
+ * It must be per-thread because of std channel limitations.
+ */
+
+typedef struct ThreadSpecificData {
+    int initialized;		/* Set to 1 when the module is initialized. */
+    Tcl_Obj *stdoutObjPtr;	/* Cached stdout channel Tcl_Obj */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
  * Static functions for this file:
  */
 
-static void	AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
-	            Tcl_Channel chan, char *address, int port));
-static void	RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
-	            AcceptCallback *acceptCallbackPtr));
-static void	TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
-		    ClientData clientData, Tcl_Interp *interp));
-static void	TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
-static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
-		    Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
+static void		FinalizeIOCmdTSD(ClientData clientData);
+static void		AcceptCallbackProc(ClientData callbackData,
+			    Tcl_Channel chan, char *address, int port);
+static int		ChanPendingObjCmd(ClientData unused,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		ChanTruncateObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static void		RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
+			    AcceptCallback *acceptCallbackPtr);
+static void		TcpAcceptCallbacksDeleteProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		TcpServerCloseProc(ClientData callbackData);
+static void		UnregisterTcpServerInterpCleanupProc(
+			    Tcl_Interp *interp,
+			    AcceptCallback *acceptCallbackPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeIOCmdTSD --
+ *
+ *	Release the storage associated with the per-thread cache.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeIOCmdTSD(
+    ClientData clientData)	/* Not used. */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (tsdPtr->stdoutObjPtr != NULL) {
+	Tcl_DecrRefCount(tsdPtr->stdoutObjPtr);
+	tsdPtr->stdoutObjPtr = NULL;
+    }
+    tsdPtr->initialized = 0;
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_PutsObjCmd --
  *
- *	This procedure is invoked to process the "puts" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "puts" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -54,94 +102,106 @@ static void	UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
 
 	/* ARGSUSED */
 int
-Tcl_PutsObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_PutsObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to puts on. */
-    Tcl_Obj *string;			/* String to write. */
-    int newline;			/* Add a newline at end? */
-    char *channelId;			/* Name of channel for puts. */
-    int result;				/* Result of puts operation. */
-    int mode;				/* Mode in which channel is opened. */
+    Tcl_Channel chan;		/* The channel to puts on. */
+    Tcl_Obj *string;		/* String to write. */
+    Tcl_Obj *chanObjPtr = NULL;	/* channel object. */
+    int newline;		/* Add a newline at end? */
+    int result;			/* Result of puts operation. */
+    int mode;			/* Mode in which channel is opened. */
+    ThreadSpecificData *tsdPtr;
 
     switch (objc) {
-    case 2: /* puts $x */
+    case 2: /* [puts $x] */
 	string = objv[1];
 	newline = 1;
-	channelId = "stdout";
 	break;
 
-    case 3: /* puts -nonewline $x  or  puts $chan $x */ 
-	if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+    case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
 	    newline = 0;
-	    channelId = "stdout";
 	} else {
 	    newline = 1;
-	    channelId = Tcl_GetString(objv[1]);
+	    chanObjPtr = objv[1];
 	}
 	string = objv[2];
 	break;
 
-    case 4: /* puts -nonewline $chan $x  or  puts $chan $x nonewline */
-	if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
-	    channelId = Tcl_GetString(objv[2]);
+    case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
+	newline = 0;
+	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
+	    chanObjPtr = objv[2];
 	    string = objv[3];
-	} else {
+	    break;
+	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
 	    /*
-	     * The code below provides backwards compatibility with an
-	     * old form of the command that is no longer recommended
-	     * or documented.
+	     * The code below provides backwards compatibility with an old
+	     * form of the command that is no longer recommended or
+	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
+	     * maybe even earlier.
 	     */
 
-	    char *arg;
-	    int length;
-
-	    arg = Tcl_GetStringFromObj(objv[3], &length);
-	    if ((length != 9) || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
-		Tcl_AppendResult(interp, "bad argument \"", arg,
-				 "\": should be \"nonewline\"",
-				 (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    channelId = Tcl_GetString(objv[1]);
+	    chanObjPtr = objv[1];
 	    string = objv[2];
+	    break;
 	}
-	newline = 0;
-	break;
-
-    default: /* puts  or  puts some bad number of arguments... */
+	/* Fall through */
+    default:
+	/* [puts] or [puts some bad number of arguments...] */
 	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
 	return TCL_ERROR;
     }
 
-    chan = Tcl_GetChannel(interp, channelId, &mode);
-    if (chan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
+    if (chanObjPtr == NULL) {
+	tsdPtr = TCL_TSD_INIT(&dataKey);
+
+	if (!tsdPtr->initialized) {
+	    tsdPtr->initialized = 1;
+	    TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout");
+	    Tcl_IncrRefCount(tsdPtr->stdoutObjPtr);
+	    Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL);
+	}
+	chanObjPtr = tsdPtr->stdoutObjPtr;
+    }
+    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
+	return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", channelId,
-                "\" wasn't opened for writing", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
+		"\" wasn't opened for writing", NULL);
+	return TCL_ERROR;
     }
 
     result = Tcl_WriteObj(chan, string);
     if (result < 0) {
-        goto error;
+	goto error;
     }
     if (newline != 0) {
-        result = Tcl_WriteChars(chan, "\n", 1);
-        if (result < 0) {
-            goto error;
-        }
+	result = Tcl_WriteChars(chan, "\n", 1);
+	if (result < 0) {
+	    goto error;
+	}
     }
     return TCL_OK;
 
-    error:
-    Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
-	    Tcl_PosixError(interp), (char *) NULL);
+    /*
+     * TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result. Fall back to the regular
+     * message if nothing was found in the bypass.
+     */
+
+  error:
+    if (!TclChanCaughtErrorBypass(interp, chan)) {
+	Tcl_AppendResult(interp, "error writing \"",
+		TclGetString(chanObjPtr), "\": ",
+		Tcl_PosixError(interp), NULL);
+    }
     return TCL_ERROR;
 }
 
@@ -150,8 +210,8 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_FlushObjCmd --
  *
- *	This procedure is called to process the Tcl "flush" command.
- *	See the user documentation for details on what it does.
+ *	This function is called to process the Tcl "flush" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -164,34 +224,43 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_FlushObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_FlushObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to flush on. */
-    char *channelId;
+    Tcl_Obj *chanObjPtr;
+    Tcl_Channel chan;		/* The channel to flush on. */
     int mode;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
-    channelId = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, channelId, &mode);
-    if (chan == (Tcl_Channel) NULL) {
+    chanObjPtr = objv[1];
+    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", channelId,
-		"\" wasn't opened for writing", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
+		"\" wasn't opened for writing", NULL);
+	return TCL_ERROR;
     }
-    
+
     if (Tcl_Flush(chan) != TCL_OK) {
-	Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
+	/*
+	 * TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+
+	if (!TclChanCaughtErrorBypass(interp, chan)) {
+	    Tcl_AppendResult(interp, "error flushing \"",
+		    TclGetString(chanObjPtr), "\": ",
+		    Tcl_PosixError(interp), NULL);
+	}
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -202,8 +271,8 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_GetsObjCmd --
  *
- *	This procedure is called to process the Tcl "gets" command.
- *	See the user documentation for details on what it does.
+ *	This function is called to process the Tcl "gets" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -216,54 +285,61 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_GetsObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_GetsObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to read from. */
-    int lineLen;			/* Length of line just read. */
-    int mode;				/* Mode in which channel is opened. */
-    char *name;
-    Tcl_Obj *linePtr;
+    Tcl_Channel chan;		/* The channel to read from. */
+    int lineLen;		/* Length of line just read. */
+    int mode;			/* Mode in which channel is opened. */
+    Tcl_Obj *linePtr, *chanObjPtr;
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
 	return TCL_ERROR;
     }
-    name = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, name, &mode);
-    if (chan == (Tcl_Channel) NULL) {
+    chanObjPtr = objv[1];
+    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", name,
-		"\" wasn't opened for reading", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
+		"\" wasn't opened for reading", NULL);
+	return TCL_ERROR;
     }
 
     linePtr = Tcl_NewObj();
-
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen < 0) {
-        if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
+	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
 	    Tcl_DecrRefCount(linePtr);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "error reading \"", name, "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
-            return TCL_ERROR;
-        }
-        lineLen = -1;
+
+	    /*
+	     * TIP #219. Capture error messages put by the driver into the
+	     * bypass area and put them into the regular interpreter result.
+	     * Fall back to the regular message if nothing was found in the
+	     * bypass.
+	     */
+
+	    if (!TclChanCaughtErrorBypass(interp, chan)) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "error reading \"",
+			TclGetString(chanObjPtr), "\": ",
+			Tcl_PosixError(interp), NULL);
+	    }
+	    return TCL_ERROR;
+	}
+	lineLen = -1;
     }
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
 		TCL_LEAVE_ERR_MSG) == NULL) {
-	    Tcl_DecrRefCount(linePtr);
-            return TCL_ERROR;
-        }
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
-        return TCL_OK;
+	return TCL_OK;
     } else {
 	Tcl_SetObjResult(interp, linePtr);
     }
@@ -275,8 +351,8 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_ReadObjCmd --
  *
- *	This procedure is invoked to process the Tcl "read" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "read" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -289,94 +365,116 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ReadObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ReadObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel chan;		/* The channel to read from. */
     int newline, i;		/* Discard newline at end? */
     int toRead;			/* How many bytes to read? */
     int charactersRead;		/* How many characters were read? */
     int mode;			/* Mode in which channel is opened. */
-    char *name;
-    Tcl_Obj *resultPtr;
+    Tcl_Obj *resultPtr, *chanObjPtr;
 
     if ((objc != 2) && (objc != 3)) {
-	argerror:
+	Interp *iPtr;
+
+    argerror:
+	iPtr = (Interp *) interp;
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
-	Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
-		" ?-nonewline? channelId\"", (char *) NULL);
+
+	/*
+	 * Do not append directly; that makes ensembles using this command as
+	 * a subcommand produce the wrong message.
+	 */
+
+	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
+	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId");
+	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
 	return TCL_ERROR;
     }
 
     i = 1;
     newline = 0;
-    if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+    if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
 	newline = 1;
 	i++;
     }
 
     if (i == objc) {
-        goto argerror;
+	goto argerror;
     }
 
-    name = Tcl_GetString(objv[i]);
-    chan = Tcl_GetChannel(interp, name, &mode);
-    if (chan == (Tcl_Channel) NULL) {
+    chanObjPtr = objv[i];
+    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", name, 
-                "\" wasn't opened for reading", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
+		"\" wasn't opened for reading", NULL);
+	return TCL_ERROR;
     }
     i++;	/* Consumed channel name. */
 
     /*
-     * Compute how many bytes to read, and see whether the final
-     * newline should be dropped.
+     * Compute how many bytes to read.
      */
 
     toRead = -1;
     if (i < objc) {
-	char *arg;
-	
-	arg = Tcl_GetString(objv[i]);
-	if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */
-	    if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
-                return TCL_ERROR;
+	if (TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
+	    /*
+	     * The code below provides backwards compatibility with an old
+	     * form of the command that is no longer recommended or
+	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
+	     * maybe even earlier.
+	     */
+
+	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
+	    return TCL_ERROR;
 	    }
-	} else if (strcmp(arg, "nonewline") == 0) {
 	    newline = 1;
-	} else {
-	    Tcl_AppendResult(interp, "bad argument \"", arg,
-		    "\": should be \"nonewline\"", (char *) NULL);
+	} else if (toRead < 0) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "expected non-negative integer but got \"",
+		    TclGetString(objv[i]), "\"", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
 	    return TCL_ERROR;
-        }
+	}
     }
 
     resultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(resultPtr);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "error reading \"", name, "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
+	/*
+	 * TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+
+	if (!TclChanCaughtErrorBypass(interp, chan)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "error reading \"",
+		    TclGetString(chanObjPtr), "\": ",
+		    Tcl_PosixError(interp), NULL);
+	}
 	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
     }
-    
+
     /*
      * If requested, remove the last newline in the channel if at EOF.
      */
-    
+
     if ((charactersRead > 0) && (newline != 0)) {
 	char *result;
 	int length;
 
-	result = Tcl_GetStringFromObj(resultPtr, &length);
+	result = TclGetStringFromObj(resultPtr, &length);
 	if (result[length - 1] == '\n') {
 	    Tcl_SetObjLength(resultPtr, length - 1);
 	}
@@ -391,35 +489,34 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_SeekObjCmd --
  *
- *	This procedure is invoked to process the Tcl "seek" command. See
- *	the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "seek" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Moves the position of the access point on the specified channel.
- *	May flush queued output.
+ *	Moves the position of the access point on the specified channel.  May
+ *	flush queued output.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 int
-Tcl_SeekObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_SeekObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to tell on. */
-    Tcl_WideInt offset;			/* Where to seek? */
-    int mode;				/* How to seek? */
-    Tcl_WideInt result;			/* Of calling Tcl_Seek. */
-    char *chanName;
+    Tcl_Channel chan;		/* The channel to tell on. */
+    Tcl_WideInt offset;		/* Where to seek? */
+    int mode;			/* How to seek? */
+    Tcl_WideInt result;		/* Of calling Tcl_Seek. */
     int optionIndex;
-    static CONST char *originOptions[] = {
-	"start", "current", "end", (char *) NULL
+    static const char *originOptions[] = {
+	"start", "current", "end", NULL
     };
     static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
 
@@ -427,9 +524,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
 	return TCL_ERROR;
     }
-    chanName = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, chanName, NULL);
-    if (chan == (Tcl_Channel) NULL) {
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
@@ -446,9 +541,18 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
 
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
-        Tcl_AppendResult(interp, "error during seek on \"", 
-		chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
-        return TCL_ERROR;
+	/*
+	 * TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+	if (!TclChanCaughtErrorBypass(interp, chan)) {
+	    Tcl_AppendResult(interp, "error during seek on \"",
+		    TclGetString(objv[1]), "\": ",
+		    Tcl_PosixError(interp), NULL);
+	}
+	return TCL_ERROR;
     }
     return TCL_OK;
 }
@@ -458,8 +562,8 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
  *
  * Tcl_TellObjCmd --
  *
- *	This procedure is invoked to process the Tcl "tell" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "tell" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -472,30 +576,42 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_TellObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_TellObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to tell on. */
-    char *chanName;
+    Tcl_Channel chan;		/* The channel to tell on. */
+    Tcl_WideInt newLoc;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
+
+    /*
+     * Try to find a channel with the right name and permissions in the IO
+     * channel table of this interpreter.
+     */
+
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    newLoc = Tcl_Tell(chan);
+
     /*
-     * Try to find a channel with the right name and permissions in
-     * the IO channel table of this interpreter.
+     * TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result.
      */
-    
-    chanName = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, chanName, NULL);
-    if (chan == (Tcl_Channel) NULL) {
+
+    if (TclChanCaughtErrorBypass(interp, chan)) {
 	return TCL_ERROR;
     }
-    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
+
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc));
     return TCL_OK;
 }
 
@@ -504,8 +620,8 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
  *
  * Tcl_CloseObjCmd --
  *
- *	This procedure is invoked to process the Tcl "close" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "close" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -518,48 +634,48 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_CloseObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_CloseObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Channel chan;			/* The channel to close. */
-    char *arg;
+    Tcl_Channel chan;		/* The channel to close. */
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
 
-    arg = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, arg, NULL);
-    if (chan == (Tcl_Channel) NULL) {
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
-        /*
-         * If there is an error message and it ends with a newline, remove
-         * the newline. This is done for command pipeline channels where the
-         * error output from the subprocesses is stored in interp's result.
-         *
-         * NOTE: This is likely to not have any effect on regular error
-         * messages produced by drivers during the closing of a channel,
-         * because the Tcl convention is that such error messages do not
-         * have a terminating newline.
-         */
-
-	Tcl_Obj *resultPtr;
+	/*
+	 * If there is an error message and it ends with a newline, remove the
+	 * newline. This is done for command pipeline channels where the error
+	 * output from the subprocesses is stored in interp's result.
+	 *
+	 * NOTE: This is likely to not have any effect on regular error
+	 * messages produced by drivers during the closing of a channel,
+	 * because the Tcl convention is that such error messages do not have
+	 * a terminating newline.
+	 */
+
+	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
 	char *string;
 	int len;
-	
-	resultPtr = Tcl_GetObjResult(interp);
-	string = Tcl_GetStringFromObj(resultPtr, &len);
-        if ((len > 0) && (string[len - 1] == '\n')) {
+
+	if (Tcl_IsShared(resultPtr)) {
+	    resultPtr = Tcl_DuplicateObj(resultPtr);
+	    Tcl_SetObjResult(interp, resultPtr);
+	}
+	string = TclGetStringFromObj(resultPtr, &len);
+	if ((len > 0) && (string[len - 1] == '\n')) {
 	    Tcl_SetObjLength(resultPtr, len - 1);
-        }
-        return TCL_ERROR;
+	}
+	return TCL_ERROR;
     }
 
     return TCL_OK;
@@ -570,8 +686,8 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
  *
  * Tcl_FconfigureObjCmd --
  *
- *	This procedure is invoked to process the Tcl "fconfigure" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "fconfigure" command. See
+ *	the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -584,55 +700,60 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_FconfigureObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *chanName, *optionName, *valueName;
-    Tcl_Channel chan;			/* The channel to set a mode on. */
-    int i;				/* Iterate over arg-value pairs. */
-    Tcl_DString ds;			/* DString to hold result of
-                                         * calling Tcl_GetChannelOption. */
+    char *optionName, *valueName;
+    Tcl_Channel chan;		/* The channel to set a mode on. */
+    int i;			/* Iterate over arg-value pairs. */
 
     if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"channelId ?optionName? ?value? ?optionName value?...");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    chanName = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, chanName, NULL);
-    if (chan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
+
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+	return TCL_ERROR;
     }
+
     if (objc == 2) {
-        Tcl_DStringInit(&ds);
-        if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
+	Tcl_DString ds;		/* DString to hold result of calling
+				 * Tcl_GetChannelOption. */
+
+	Tcl_DStringInit(&ds);
+	if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) {
 	    Tcl_DStringFree(&ds);
 	    return TCL_ERROR;
-        }
-        Tcl_DStringResult(interp, &ds);
-        return TCL_OK;
-    }
-    if (objc == 3) {
-        Tcl_DStringInit(&ds);
-	optionName = Tcl_GetString(objv[2]);
-        if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
-            Tcl_DStringFree(&ds);
-            return TCL_ERROR;
-        }
-        Tcl_DStringResult(interp, &ds);
-        return TCL_OK;
+	}
+	Tcl_DStringResult(interp, &ds);
+	return TCL_OK;
+    } else if (objc == 3) {
+	Tcl_DString ds;		/* DString to hold result of calling
+				 * Tcl_GetChannelOption. */
+
+	Tcl_DStringInit(&ds);
+	optionName = TclGetString(objv[2]);
+	if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
+	    Tcl_DStringFree(&ds);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringResult(interp, &ds);
+	return TCL_OK;
     }
+
     for (i = 3; i < objc; i += 2) {
-	optionName = Tcl_GetString(objv[i-1]);
-	valueName = Tcl_GetString(objv[i]);
-        if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
+	optionName = TclGetString(objv[i-1]);
+	valueName = TclGetString(objv[i]);
+	if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
 		!= TCL_OK) {
-            return TCL_ERROR;
-        }
+	    return TCL_ERROR;
+	}
     }
+
     return TCL_OK;
 }
 
@@ -641,43 +762,39 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
  *
  * Tcl_EofObjCmd --
  *
- *	This procedure is invoked to process the Tcl "eof" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "eof" command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Sets interp's result to boolean true or false depending on whether
- *	the specified channel has an EOF condition.
+ *	Sets interp's result to boolean true or false depending on whether the
+ *	specified channel has an EOF condition.
  *
  *---------------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 int
-Tcl_EofObjCmd(unused, interp, objc, objv)
-    ClientData unused;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_EofObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel chan;
-    int dummy;
-    char *arg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
-    arg = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, arg, &dummy);
-    if (chan == NULL) {
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan)));
     return TCL_OK;
 }
 
@@ -686,8 +803,8 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
  *
  * Tcl_ExecObjCmd --
  *
- *	This procedure is invoked to process the "exec" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "exec" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -700,39 +817,39 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ExecObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_ExecObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     /*
-     * This procedure generates an argv array for the string arguments. It
+     * This function generates an argv array for the string arguments. It
      * starts out with stack-allocated space but uses dynamically-allocated
      * storage if needed.
      */
 
-#define NUM_ARGS 20
     Tcl_Obj *resultPtr;
-    CONST char **argv;
+    const char **argv;
     char *string;
     Tcl_Channel chan;
-    CONST char *argStorage[NUM_ARGS];
     int argc, background, i, index, keepNewline, result, skip, length;
-    static CONST char *options[] = {
-	"-keepnewline",	"--",		NULL
+    int ignoreStderr;
+    static const char *options[] = {
+	"-ignorestderr", "-keepnewline", "--", NULL
     };
     enum options {
-	EXEC_KEEPNEWLINE, EXEC_LAST
+	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
     };
 
     /*
-     * Check for a leading "-keepnewline" argument.
+     * Check for any leading option arguments.
      */
 
     keepNewline = 0;
+    ignoreStderr = 0;
     for (skip = 1; skip < objc; skip++) {
-	string = Tcl_GetString(objv[skip]);
+	string = TclGetString(objv[skip]);
 	if (string[0] != '-') {
 	    break;
 	}
@@ -742,6 +859,8 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
 	}
 	if (index == EXEC_KEEPNEWLINE) {
 	    keepNewline = 1;
+	} else if (index == EXEC_IGNORESTDERR) {
+	    ignoreStderr = 1;
 	} else {
 	    skip++;
 	    break;
@@ -757,23 +876,20 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
      */
 
     background = 0;
-    string = Tcl_GetString(objv[objc - 1]);
+    string = TclGetString(objv[objc - 1]);
     if ((string[0] == '&') && (string[1] == '\0')) {
 	objc--;
-        background = 1;
+	background = 1;
     }
 
     /*
-     * Create the string argument array "argv". Make sure argv is large
-     * enough to hold the argc arguments plus 1 extra for the zero
-     * end-of-argv word.
+     * Create the string argument array "argv". Make sure argv is large enough
+     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
      */
 
-    argv = argStorage;
     argc = objc - skip;
-    if ((argc + 1) > (int)(sizeof(argv) / sizeof(argv[0]))) {
-	argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
-    }
+    argv = (const char **)
+	    TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
 
     /*
      * Copy the string conversions of each (post option) object into the
@@ -781,64 +897,71 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
      */
 
     for (i = 0; i < argc; i++) {
-	argv[i] = Tcl_GetString(objv[i + skip]);
+	argv[i] = TclGetString(objv[i + skip]);
     }
     argv[argc] = NULL;
-    chan = Tcl_OpenCommandChannel(interp, argc, argv,
-            (background ? 0 : TCL_STDOUT | TCL_STDERR));
+    chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
+	    (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
 
     /*
-     * Free the argv array if malloc'ed storage was used.
+     * Free the argv array.
      */
 
-    if (argv != argStorage) {
-	ckfree((char *)argv);
-    }
+    TclStackFree(interp, (void *)argv);
 
-    if (chan == (Tcl_Channel) NULL) {
+    if (chan == NULL) {
 	return TCL_ERROR;
     }
 
     if (background) {
-        /*
+	/*
 	 * Store the list of PIDs from the pipeline in interp's result and
 	 * detach the PIDs (instead of waiting for them).
 	 */
 
-        TclGetAndDetachPids(interp, chan);
-        if (Tcl_Close(interp, chan) != TCL_OK) {
+	TclGetAndDetachPids(interp, chan);
+	if (Tcl_Close(interp, chan) != TCL_OK) {
 	    return TCL_ERROR;
-        }
+	}
 	return TCL_OK;
     }
 
     resultPtr = Tcl_NewObj();
     if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
 	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "error reading output from command: ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    Tcl_DecrRefCount(resultPtr);
+	    /*
+	     * TIP #219.
+	     * Capture error messages put by the driver into the bypass area
+	     * and put them into the regular interpreter result. Fall back to
+	     * the regular message if nothing was found in the bypass.
+	     */
+
+	    if (!TclChanCaughtErrorBypass(interp, chan)) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "error reading output from command: ",
+			Tcl_PosixError(interp), NULL);
+		Tcl_DecrRefCount(resultPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
+
     /*
-     * If the process produced anything on stderr, it will have been
-     * returned in the interpreter result.  It needs to be appended to
-     * the result string.
+     * If the process produced anything on stderr, it will have been returned
+     * in the interpreter result. It needs to be appended to the result
+     * string.
      */
 
     result = Tcl_Close(interp, chan);
-    string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
-    Tcl_AppendToObj(resultPtr, string, length);
+    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
 
     /*
-     * If the last character of the result is a newline, then remove
-     * the newline character.
+     * If the last character of the result is a newline, then remove the
+     * newline character.
      */
-    
+
     if (keepNewline == 0) {
-	string = Tcl_GetStringFromObj(resultPtr, &length);
+	string = TclGetStringFromObj(resultPtr, &length);
 	if ((length > 0) && (string[length - 1] == '\n')) {
 	    Tcl_SetObjLength(resultPtr, length - 1);
 	}
@@ -853,48 +976,45 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_FblockedObjCmd --
  *
- *	This procedure is invoked to process the Tcl "fblocked" command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the Tcl "fblocked" command. See
+ *	the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Sets interp's result to boolean true or false depending on whether
- *	the preceeding input operation on the channel would have blocked.
+ *	Sets interp's result to boolean true or false depending on whether the
+ *	preceeding input operation on the channel would have blocked.
  *
  *---------------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 int
-Tcl_FblockedObjCmd(unused, interp, objc, objv)
-    ClientData unused;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_FblockedObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel chan;
     int mode;
-    char *arg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
-    arg = Tcl_GetString(objv[1]);
-    chan = Tcl_GetChannel(interp, arg, &mode);
-    if (chan == NULL) {
-        return TCL_ERROR;
+    if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
+	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
-		arg, "\" wasn't opened for reading", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
+		"\" wasn't opened for reading", NULL);
+	return TCL_ERROR;
     }
-        
-    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
+
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan)));
     return TCL_OK;
 }
 
@@ -903,8 +1023,8 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
  *
  * Tcl_OpenObjCmd --
  *
- *	This procedure is invoked to process the "open" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "open" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -917,14 +1037,14 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_OpenObjCmd(notUsed, interp, objc, objv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_OpenObjCmd(
+    ClientData notUsed,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int pipeline, prot;
-    char *modeString, *what;
+    const char *modeString, *what;
     Tcl_Channel chan;
 
     if ((objc < 2) || (objc > 4)) {
@@ -935,16 +1055,34 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
     if (objc == 2) {
 	modeString = "r";
     } else {
-	modeString = Tcl_GetString(objv[2]);
+	modeString = TclGetString(objv[2]);
 	if (objc == 4) {
-	    if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
+	    char *permString = TclGetString(objv[3]);
+	    int code = TCL_ERROR;
+	    int scanned = TclParseAllWhiteSpace(permString, -1);
+
+	    /* Support legacy octal numbers */
+	    if ((permString[scanned] == '0')
+		    && (permString[scanned+1] >= '0')
+		    && (permString[scanned+1] <= '7')) {
+
+		Tcl_Obj *permObj;
+
+		TclNewLiteralStringObj(permObj, "0o");
+		Tcl_AppendToObj(permObj, permString+scanned+1, -1);
+		code = TclGetIntFromObj(NULL, permObj, &prot);
+		Tcl_DecrRefCount(permObj);
+	    }
+
+	    if ((code == TCL_ERROR)
+		    && TclGetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	}
     }
 
     pipeline = 0;
-    what = Tcl_GetString(objv[1]);
+    what = TclGetString(objv[1]);
     if (what[0] == '|') {
 	pipeline = 1;
     }
@@ -954,43 +1092,47 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
      */
 
     if (!pipeline) {
-        chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
+	chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
     } else {
-	int mode, seekFlag, cmdObjc;
-	CONST char **cmdArgv;
+	int mode, seekFlag, cmdObjc, binary;
+	const char **cmdArgv;
 
-        if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
-            return TCL_ERROR;
-        }
+	if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
+	    return TCL_ERROR;
+	}
 
-        mode = TclGetOpenMode(interp, modeString, &seekFlag);
-        if (mode == -1) {
+	mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
+	if (mode == -1) {
 	    chan = NULL;
-        } else {
+	} else {
 	    int flags = TCL_STDERR | TCL_ENFORCE_MODE;
+
 	    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
-		case O_RDONLY:
-		    flags |= TCL_STDOUT;
-		    break;
-		case O_WRONLY:
-		    flags |= TCL_STDIN;
-		    break;
-		case O_RDWR:
-		    flags |= (TCL_STDIN | TCL_STDOUT);
-		    break;
-		default:
-		    panic("Tcl_OpenCmd: invalid mode value");
-		    break;
+	    case O_RDONLY:
+		flags |= TCL_STDOUT;
+		break;
+	    case O_WRONLY:
+		flags |= TCL_STDIN;
+		break;
+	    case O_RDWR:
+		flags |= (TCL_STDIN | TCL_STDOUT);
+		break;
+	    default:
+		Tcl_Panic("Tcl_OpenCmd: invalid mode value");
+		break;
 	    }
 	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
+	    if (binary && chan) {
+		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+	    }
 	}
-        ckfree((char *) cmdArgv);
+	ckfree((char *) cmdArgv);
     }
-    if (chan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
+    if (chan == NULL) {
+	return TCL_ERROR;
     }
     Tcl_RegisterChannel(interp, chan);
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
     return TCL_OK;
 }
 
@@ -999,40 +1141,38 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
  *
  * TcpAcceptCallbacksDeleteProc --
  *
- *	Assocdata cleanup routine called when an interpreter is being
- *	deleted to set the interp field of all the accept callback records
- *	registered with	the interpreter to NULL. This will prevent the
- *	interpreter from being used in the future to eval accept scripts.
+ *	Assocdata cleanup routine called when an interpreter is being deleted
+ *	to set the interp field of all the accept callback records registered
+ *	with the interpreter to NULL. This will prevent the interpreter from
+ *	being used in the future to eval accept scripts.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	Deallocates memory and sets the interp field of all the accept
- *	callback records to NULL to prevent this interpreter from being
- *	used subsequently to eval accept scripts.
+ *	callback records to NULL to prevent this interpreter from being used
+ *	subsequently to eval accept scripts.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 static void
-TcpAcceptCallbacksDeleteProc(clientData, interp)
-    ClientData clientData;	/* Data which was passed when the assocdata
-                                 * was registered. */
-    Tcl_Interp *interp;		/* Interpreter being deleted - not used. */
+TcpAcceptCallbacksDeleteProc(
+    ClientData clientData,	/* Data which was passed when the assocdata
+				 * was registered. */
+    Tcl_Interp *interp)		/* Interpreter being deleted - not used. */
 {
-    Tcl_HashTable *hTblPtr;
+    Tcl_HashTable *hTblPtr = clientData;
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch hSearch;
-    AcceptCallback *acceptCallbackPtr;
 
-    hTblPtr = (Tcl_HashTable *) clientData;
     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-             hPtr != (Tcl_HashEntry *) NULL;
-             hPtr = Tcl_NextHashEntry(&hSearch)) {
-        acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
-        acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
+
+	acceptCallbackPtr->interp = NULL;
     }
     Tcl_DeleteHashTable(hTblPtr);
     ckfree((char *) hTblPtr);
@@ -1043,50 +1183,50 @@ TcpAcceptCallbacksDeleteProc(clientData, interp)
  *
  * RegisterTcpServerInterpCleanup --
  *
- *	Registers an accept callback record to have its interp
- *	field set to NULL when the interpreter is deleted.
+ *	Registers an accept callback record to have its interp field set to
+ *	NULL when the interpreter is deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	When, in the future, the interpreter is deleted, the interp
- *	field of the accept callback data structure will be set to
- *	NULL. This will prevent attempts to eval the accept script
- *	in a deleted interpreter.
+ *	When, in the future, the interpreter is deleted, the interp field of
+ *	the accept callback data structure will be set to NULL. This will
+ *	prevent attempts to eval the accept script in a deleted interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
-    Tcl_Interp *interp;		/* Interpreter for which we want to be
-                                 * informed of deletion. */
-    AcceptCallback *acceptCallbackPtr;
-    				/* The accept callback record whose
-                                 * interp field we want set to NULL when
-                                 * the interpreter is deleted. */
+RegisterTcpServerInterpCleanup(
+    Tcl_Interp *interp,		/* Interpreter for which we want to be
+				 * informed of deletion. */
+    AcceptCallback *acceptCallbackPtr)
+				/* The accept callback record whose interp
+				 * field we want set to NULL when the
+				 * interpreter is deleted. */
 {
-    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback
-                                 * records to smash when the interpreter
-                                 * will be deleted. */
+    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback records to
+				 * smash when the interpreter will be
+				 * deleted. */
     Tcl_HashEntry *hPtr;	/* Entry for this record. */
-    int new;			/* Is the entry new? */
+    int isNew;			/* Is the entry new? */
 
-    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
-            "tclTCPAcceptCallbacks",
-            NULL);
-    if (hTblPtr == (Tcl_HashTable *) NULL) {
-        hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
-        (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
-                TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
-    }
-    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
-    if (!new) {
-        panic("RegisterTcpServerCleanup: damaged accept record table");
-    }
-    Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
+    hTblPtr = (Tcl_HashTable *)
+	    Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+
+    if (hTblPtr == NULL) {
+	hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
+	(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+		TcpAcceptCallbacksDeleteProc, hTblPtr);
+    }
+
+    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew);
+    if (!isNew) {
+	Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
+    }
+    Tcl_SetHashValue(hPtr, acceptCallbackPtr);
 }
 
 /*
@@ -1094,41 +1234,41 @@ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
  *
  * UnregisterTcpServerInterpCleanupProc --
  *
- *	Unregister a previously registered accept callback record. The
- *	interp field of this record will no longer be set to NULL in
- *	the future when the interpreter is deleted.
+ *	Unregister a previously registered accept callback record. The interp
+ *	field of this record will no longer be set to NULL in the future when
+ *	the interpreter is deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Prevents the interp field of the accept callback record from
- *	being set to NULL in the future when the interpreter is deleted.
+ *	Prevents the interp field of the accept callback record from being set
+ *	to NULL in the future when the interpreter is deleted.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
-    Tcl_Interp *interp;		/* Interpreter in which the accept callback
-                                 * record was registered. */
-    AcceptCallback *acceptCallbackPtr;
-    				/* The record for which to delete the
-                                 * registration. */
+UnregisterTcpServerInterpCleanupProc(
+    Tcl_Interp *interp,		/* Interpreter in which the accept callback
+				 * record was registered. */
+    AcceptCallback *acceptCallbackPtr)
+				/* The record for which to delete the
+				 * registration. */
 {
     Tcl_HashTable *hTblPtr;
     Tcl_HashEntry *hPtr;
 
     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
-            "tclTCPAcceptCallbacks", NULL);
-    if (hTblPtr == (Tcl_HashTable *) NULL) {
-        return;
+	    "tclTCPAcceptCallbacks", NULL);
+    if (hTblPtr == NULL) {
+	return;
     }
+
     hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        return;
+    if (hPtr != NULL) {
+	Tcl_DeleteHashEntry(hPtr);
     }
-    Tcl_DeleteHashEntry(hPtr);
 }
 
 /*
@@ -1136,8 +1276,8 @@ UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
  *
  * AcceptCallbackProc --
  *
- *	This callback is invoked by the TCP channel driver when it
- *	accepts a new connection from a client on a server socket.
+ *	This callback is invoked by the TCP channel driver when it accepts a
+ *	new connection from a client on a server socket.
  *
  * Results:
  *	None.
@@ -1149,72 +1289,65 @@ UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
  */
 
 static void
-AcceptCallbackProc(callbackData, chan, address, port)
-    ClientData callbackData;		/* The data stored when the callback
-                                         * was created in the call to
-                                         * Tcl_OpenTcpServer. */
-    Tcl_Channel chan;			/* Channel for the newly accepted
-                                         * connection. */
-    char *address;			/* Address of client that was
-                                         * accepted. */
-    int port;				/* Port of client that was accepted. */
+AcceptCallbackProc(
+    ClientData callbackData,	/* The data stored when the callback was
+				 * created in the call to
+				 * Tcl_OpenTcpServer. */
+    Tcl_Channel chan,		/* Channel for the newly accepted
+				 * connection. */
+    char *address,		/* Address of client that was accepted. */
+    int port)			/* Port of client that was accepted. */
 {
-    AcceptCallback *acceptCallbackPtr;
-    Tcl_Interp *interp;
-    char *script;
-    char portBuf[TCL_INTEGER_SPACE];
-    int result;
-
-    acceptCallbackPtr = (AcceptCallback *) callbackData;
+    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
 
     /*
      * Check if the callback is still valid; the interpreter may have gone
      * away, this is signalled by setting the interp field of the callback
      * data to NULL.
      */
-    
-    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
 
-        script = acceptCallbackPtr->script;
-        interp = acceptCallbackPtr->interp;
-        
-        Tcl_Preserve((ClientData) script);
-        Tcl_Preserve((ClientData) interp);
+    if (acceptCallbackPtr->interp != NULL) {
+	char portBuf[TCL_INTEGER_SPACE];
+	char *script = acceptCallbackPtr->script;
+	Tcl_Interp *interp = acceptCallbackPtr->interp;
+	int result;
+
+	Tcl_Preserve(script);
+	Tcl_Preserve(interp);
 
 	TclFormatInt(portBuf, port);
-        Tcl_RegisterChannel(interp, chan);
-
-        /*
-         * Artificially bump the refcount to protect the channel from
-         * being deleted while the script is being evaluated.
-         */
-
-        Tcl_RegisterChannel((Tcl_Interp *) NULL,  chan);
-        
-        result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
-                " ", address, " ", portBuf, (char *) NULL);
-        if (result != TCL_OK) {
-            Tcl_BackgroundError(interp);
+	Tcl_RegisterChannel(interp, chan);
+
+	/*
+	 * Artificially bump the refcount to protect the channel from being
+	 * deleted while the script is being evaluated.
+	 */
+
+	Tcl_RegisterChannel(NULL, chan);
+
+	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
+		" ", address, " ", portBuf, NULL);
+	if (result != TCL_OK) {
+	    TclBackgroundException(interp, result);
 	    Tcl_UnregisterChannel(interp, chan);
-        }
+	}
 
-        /*
-         * Decrement the artificially bumped refcount. After this it is
-         * not safe anymore to use "chan", because it may now be deleted.
-         */
+	/*
+	 * Decrement the artificially bumped refcount. After this it is not
+	 * safe anymore to use "chan", because it may now be deleted.
+	 */
 
-        Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
-        
-        Tcl_Release((ClientData) interp);
-        Tcl_Release((ClientData) script);
-    } else {
+	Tcl_UnregisterChannel(NULL, chan);
 
-        /*
-         * The interpreter has been deleted, so there is no useful
-         * way to utilize the client socket - just close it.
-         */
+	Tcl_Release(interp);
+	Tcl_Release(script);
+    } else {
+	/*
+	 * The interpreter has been deleted, so there is no useful way to
+	 * utilize the client socket - just close it.
+	 */
 
-        Tcl_Close((Tcl_Interp *) NULL, chan);
+	Tcl_Close(NULL, chan);
     }
 }
 
@@ -1223,36 +1356,35 @@ AcceptCallbackProc(callbackData, chan, address, port)
  *
  * TcpServerCloseProc --
  *
- *	This callback is called when the TCP server channel for which it
- *	was registered is being closed. It informs the interpreter in
- *	which the accept script is evaluated (if that interpreter still
- *	exists) that this channel no longer needs to be informed if the
- *	interpreter is deleted.
+ *	This callback is called when the TCP server channel for which it was
+ *	registered is being closed. It informs the interpreter in which the
+ *	accept script is evaluated (if that interpreter still exists) that
+ *	this channel no longer needs to be informed if the interpreter is
+ *	deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	In the future, if the interpreter is deleted this channel will
- *	no longer be informed.
+ *	In the future, if the interpreter is deleted this channel will no
+ *	longer be informed.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-TcpServerCloseProc(callbackData)
-    ClientData callbackData;	/* The data passed in the call to
-                                 * Tcl_CreateCloseHandler. */
+TcpServerCloseProc(
+    ClientData callbackData)	/* The data passed in the call to
+				 * Tcl_CreateCloseHandler. */
 {
-    AcceptCallback *acceptCallbackPtr;
-    				/* The actual data. */
+    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+				/* The actual data. */
 
-    acceptCallbackPtr = (AcceptCallback *) callbackData;
-    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
-        UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
-                acceptCallbackPtr);
+    if (acceptCallbackPtr->interp != NULL) {
+	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
+		acceptCallbackPtr);
     }
-    Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
+    Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
     ckfree((char *) acceptCallbackPtr);
 }
 
@@ -1261,8 +1393,8 @@ TcpServerCloseProc(callbackData)
  *
  * Tcl_SocketObjCmd --
  *
- *	This procedure is invoked to process the "socket" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "socket" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1274,127 +1406,115 @@ TcpServerCloseProc(callbackData)
  */
 
 int
-Tcl_SocketObjCmd(notUsed, interp, objc, objv)
-    ClientData notUsed;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_SocketObjCmd(
+    ClientData notUsed,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static CONST char *socketOptions[] = {
-	"-async", "-myaddr", "-myport","-server", (char *) NULL
+    static const char *socketOptions[] = {
+	"-async", "-myaddr", "-myport","-server", NULL
     };
     enum socketOptions {
-	SKT_ASYNC,      SKT_MYADDR,      SKT_MYPORT,      SKT_SERVER  
+	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
     };
-    int optionIndex, a, server, port;
-    char *arg, *copyScript, *host, *script;
-    char *myaddr = NULL;
-    int myport = 0;
-    int async = 0;
+    int optionIndex, a, server = 0, port, myport = 0, async = 0;
+    char *host, *script = NULL, *myaddr = NULL;
     Tcl_Channel chan;
-    AcceptCallback *acceptCallbackPtr;
-    
-    server = 0;
-    script = NULL;
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     for (a = 1; a < objc; a++) {
-	arg = Tcl_GetString(objv[a]);
+	const char *arg = Tcl_GetString(objv[a]);
+
 	if (arg[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
-		"option", TCL_EXACT, &optionIndex) != TCL_OK) {
+	if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option",
+		TCL_EXACT, &optionIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	switch ((enum socketOptions) optionIndex) {
-	    case SKT_ASYNC: {
-                if (server == 1) {
-                    Tcl_AppendResult(interp,
-                            "cannot set -async option for server sockets",
-                            (char *) NULL);
-                    return TCL_ERROR;
-                }
-                async = 1;		
-		break;
+	case SKT_ASYNC:
+	    if (server == 1) {
+		Tcl_AppendResult(interp,
+			"cannot set -async option for server sockets", NULL);
+		return TCL_ERROR;
 	    }
-	    case SKT_MYADDR: {
-		a++;
-                if (a >= objc) {
-		    Tcl_AppendResult(interp,
-			    "no argument given for -myaddr option",
-                            (char *) NULL);
-		    return TCL_ERROR;
-		}
-                myaddr = Tcl_GetString(objv[a]);
-		break;
+	    async = 1;
+	    break;
+	case SKT_MYADDR:
+	    a++;
+	    if (a >= objc) {
+		Tcl_AppendResult(interp,
+			"no argument given for -myaddr option", NULL);
+		return TCL_ERROR;
 	    }
-	    case SKT_MYPORT: {
-		char *myPortName;
-		a++;
-                if (a >= objc) {
-		    Tcl_AppendResult(interp,
-			    "no argument given for -myport option",
-                            (char *) NULL);
-		    return TCL_ERROR;
-		}
-		myPortName = Tcl_GetString(objv[a]);
-		if (TclSockGetPort(interp, myPortName, "tcp", &myport)
-			!= TCL_OK) {
-		    return TCL_ERROR;
-		}
-		break;
+	    myaddr = TclGetString(objv[a]);
+	    break;
+	case SKT_MYPORT: {
+	    char *myPortName;
+
+	    a++;
+	    if (a >= objc) {
+		Tcl_AppendResult(interp,
+			"no argument given for -myport option", NULL);
+		return TCL_ERROR;
 	    }
-	    case SKT_SERVER: {
-                if (async == 1) {
-                    Tcl_AppendResult(interp,
-                            "cannot set -async option for server sockets",
-                            (char *) NULL);
-                    return TCL_ERROR;
-                }
-		server = 1;
-		a++;
-		if (a >= objc) {
-		    Tcl_AppendResult(interp,
-			    "no argument given for -server option",
-                            (char *) NULL);
-		    return TCL_ERROR;
-		}
-                script = Tcl_GetString(objv[a]);
-		break;
+	    myPortName = TclGetString(objv[a]);
+	    if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
+		return TCL_ERROR;
 	    }
-	    default: {
-		panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
+	    break;
+	}
+	case SKT_SERVER:
+	    if (async == 1) {
+		Tcl_AppendResult(interp,
+			"cannot set -async option for server sockets", NULL);
+		return TCL_ERROR;
+	    }
+	    server = 1;
+	    a++;
+	    if (a >= objc) {
+		Tcl_AppendResult(interp,
+			"no argument given for -server option", NULL);
+		return TCL_ERROR;
 	    }
+	    script = TclGetString(objv[a]);
+	    break;
+	default:
+	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
 	}
     }
     if (server) {
-        host = myaddr;		/* NULL implies INADDR_ANY */
+	host = myaddr;		/* NULL implies INADDR_ANY */
 	if (myport != 0) {
-	    Tcl_AppendResult(interp, "Option -myport is not valid for servers",
+	    Tcl_AppendResult(interp, "option -myport is not valid for servers",
 		    NULL);
 	    return TCL_ERROR;
 	}
     } else if (a < objc) {
-	host = Tcl_GetString(objv[a]);
+	host = TclGetString(objv[a]);
 	a++;
     } else {
-wrongNumArgs:
-	Tcl_AppendResult(interp, "wrong # args: should be either:\n",
-		Tcl_GetString(objv[0]),
-                " ?-myaddr addr? ?-myport myport? ?-async? host port\n",
-		Tcl_GetString(objv[0]),
-                " -server command ?-myaddr addr? port",
-                (char *) NULL);
-        return TCL_ERROR;
+	Interp *iPtr;
+
+    wrongNumArgs:
+	iPtr = (Interp *) interp;
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-myaddr addr? ?-myport myport? ?-async? host port");
+	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"-server command ?-myaddr addr? port");
+	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
+	return TCL_ERROR;
     }
 
     if (a == objc-1) {
-	if (TclSockGetPort(interp, Tcl_GetString(objv[a]),
-		"tcp", &port) != TCL_OK) {
+	if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
+		&port) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } else {
@@ -1402,46 +1522,47 @@ wrongNumArgs:
     }
 
     if (server) {
-        acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
-                sizeof(AcceptCallback));
-        copyScript = ckalloc((unsigned) strlen(script) + 1);
-        strcpy(copyScript, script);
-        acceptCallbackPtr->script = copyScript;
-        acceptCallbackPtr->interp = interp;
-        chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
-                (ClientData) acceptCallbackPtr);
-        if (chan == (Tcl_Channel) NULL) {
-            ckfree(copyScript);
-            ckfree((char *) acceptCallbackPtr);
-            return TCL_ERROR;
-        }
-
-        /*
-         * Register with the interpreter to let us know when the
-         * interpreter is deleted (by having the callback set the
-         * acceptCallbackPtr->interp field to NULL). This is to
-         * avoid trying to eval the script in a deleted interpreter.
-         */
-
-        RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
-        
-        /*
-         * Register a close callback. This callback will inform the
-         * interpreter (if it still exists) that this channel does not
-         * need to be informed when the interpreter is deleted.
-         */
-        
-        Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
-                (ClientData) acceptCallbackPtr);
+	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
+		ckalloc((unsigned) sizeof(AcceptCallback));
+	unsigned len = strlen(script) + 1;
+	char *copyScript = ckalloc(len);
+
+	memcpy(copyScript, script, len);
+	acceptCallbackPtr->script = copyScript;
+	acceptCallbackPtr->interp = interp;
+	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
+		acceptCallbackPtr);
+	if (chan == NULL) {
+	    ckfree(copyScript);
+	    ckfree((char *) acceptCallbackPtr);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Register with the interpreter to let us know when the interpreter
+	 * is deleted (by having the callback set the interp field of the
+	 * acceptCallbackPtr's structure to NULL). This is to avoid trying to
+	 * eval the script in a deleted interpreter.
+	 */
+
+	RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
+
+	/*
+	 * Register a close callback. This callback will inform the
+	 * interpreter (if it still exists) that this channel does not need to
+	 * be informed when the interpreter is deleted.
+	 */
+
+	Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
     } else {
-        chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
-        if (chan == (Tcl_Channel) NULL) {
-            return TCL_ERROR;
-        }
-    }
-    Tcl_RegisterChannel(interp, chan);            
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
-    
+	chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
+	if (chan == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_RegisterChannel(interp, chan);
+    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+
     return TCL_OK;
 }
 
@@ -1450,32 +1571,30 @@ wrongNumArgs:
  *
  * Tcl_FcopyObjCmd --
  *
- *	This procedure is invoked to process the "fcopy" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "fcopy" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Moves data between two channels and possibly sets up a
- *	background copy handler.
+ *	Moves data between two channels and possibly sets up a background copy
+ *	handler.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FcopyObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_FcopyObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel inChan, outChan;
-    char *arg;
-    int mode, i;
-    int toRead, index;
+    int mode, i, toRead, index;
     Tcl_Obj *cmdPtr;
-    static CONST char* switches[] = { "-size", "-command", NULL };
+    static const char* switches[] = { "-size", "-command", NULL };
     enum { FcopySize, FcopyCommand };
 
     if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
@@ -1485,60 +1604,269 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Parse the channel arguments and verify that they are readable
-     * or writable, as appropriate.
+     * Parse the channel arguments and verify that they are readable or
+     * writable, as appropriate.
      */
 
-    arg = Tcl_GetString(objv[1]);
-    inChan = Tcl_GetChannel(interp, arg, &mode);
-    if (inChan == (Tcl_Channel) NULL) {
+    if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
-		arg, 
-                "\" wasn't opened for reading", (char *) NULL);
-        return TCL_ERROR;
-    }
-    arg = Tcl_GetString(objv[2]);
-    outChan = Tcl_GetChannel(interp, arg, &mode);
-    if (outChan == (Tcl_Channel) NULL) {
+	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
+		"\" wasn't opened for reading", NULL);
+	return TCL_ERROR;
+    }
+    if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
-		arg, 
-                "\" wasn't opened for writing", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
+		"\" wasn't opened for writing", NULL);
+	return TCL_ERROR;
     }
 
     toRead = -1;
     cmdPtr = NULL;
     for (i = 3; i < objc; i += 2) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
-		(int *) &index) != TCL_OK) {
+		&index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	switch (index) {
-	    case FcopySize:
-		if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (toRead<0) {
-		    /*
-		     * Handle all negative sizes like -1, meaning 'copy all'.
-		     * By resetting toRead we avoid changes in the
-		     * core copying functions (which explicitly check
-		     * for -1 and crash on any other negative value).
-		     */
-		    toRead = -1;
-		}
-		break;
-	    case FcopyCommand:
-		cmdPtr = objv[i+1];
-		break;
+	case FcopySize:
+	    if (TclGetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (toRead<0) {
+		/*
+		 * Handle all negative sizes like -1, meaning 'copy all'. By
+		 * resetting toRead we avoid changes in the core copying
+		 * functions (which explicitly check for -1 and crash on any
+		 * other negative value).
+		 */
+		toRead = -1;
+	    }
+	    break;
+	case FcopyCommand:
+	    cmdPtr = objv[i+1];
+	    break;
 	}
     }
 
     return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr);
 }
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanPendingObjCmd --
+ *
+ *	This function is invoked to process the Tcl "chan pending" command
+ *	(TIP #287). See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp's result to the number of bytes of buffered input or
+ *	output (depending on whether the first argument is "input" or
+ *	"output"), or -1 if the channel wasn't opened for that mode.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+ChanPendingObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+    int index, mode;
+    static const char *options[] = {"input", "output", NULL};
+    enum options {PENDING_INPUT, PENDING_OUTPUT};
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum options) index) {
+    case PENDING_INPUT:
+	if ((mode & TCL_READABLE) == 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
+	}
+	break;
+    case PENDING_OUTPUT:
+	if ((mode & TCL_WRITABLE) == 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
+	}
+	break;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChanTruncateObjCmd --
+ *
+ *	This function is invoked to process the "chan truncate" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Truncates a channel (or rather a file underlying a channel).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ChanTruncateObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+    Tcl_WideInt length;
+
+    if ((objc < 2) || (objc > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?");
+	return TCL_ERROR;
+    }
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (objc == 3) {
+	/*
+	 * User is supplying an explicit length.
+	 */
+
+	if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (length < 0) {
+	    Tcl_AppendResult(interp,
+		    "cannot truncate to negative length of file", NULL);
+	    return TCL_ERROR;
+	}
+    } else {
+	/*
+	 * User wants to truncate to the current file position.
+	 */
+
+	length = Tcl_Tell(chan);
+	if (length == Tcl_WideAsLong(-1)) {
+	    Tcl_AppendResult(interp,
+		    "could not determine current location in \"",
+		    TclGetString(objv[1]), "\": ",
+		    Tcl_PosixError(interp), NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
+	Tcl_AppendResult(interp, "error during truncate on \"",
+		TclGetString(objv[1]), "\": ",
+		Tcl_PosixError(interp), NULL);
+	return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitChanCmd --
+ *
+ *	This function is invoked to create the "chan" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A Tcl command handle.
+ *
+ * Side effects:
+ *	None (since nothing is byte-compiled).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitChanCmd(
+    Tcl_Interp *interp)
+{
+    /*
+     * Most commands are plugged directly together, but some are done via
+     * alias-like rewriting; [chan configure] is this way for security reasons
+     * (want overwriting of [fconfigure] to control that nicely), and [chan
+     * names] because the functionality isn't available as a separate command
+     * function at the moment.
+     */
+    static const EnsembleImplMap initMap[] = {
+	{"blocked",	Tcl_FblockedObjCmd},
+	{"close",	Tcl_CloseObjCmd},
+	{"copy",	Tcl_FcopyObjCmd},
+	{"create",	TclChanCreateObjCmd},		/* TIP #219 */
+	{"eof",		Tcl_EofObjCmd},
+	{"event",	Tcl_FileEventObjCmd},
+	{"flush",	Tcl_FlushObjCmd},
+	{"gets",	Tcl_GetsObjCmd},
+	{"pending",	ChanPendingObjCmd},		/* TIP #287 */
+	{"postevent",	TclChanPostEventObjCmd},	/* TIP #219 */
+	{"puts",	Tcl_PutsObjCmd},
+	{"read",	Tcl_ReadObjCmd},
+	{"seek",	Tcl_SeekObjCmd},
+	{"tell",	Tcl_TellObjCmd},
+	{"truncate",	ChanTruncateObjCmd},		/* TIP #208 */
+	{NULL}
+    };
+    static const char *extras[] = {
+	"configure",	"::fconfigure",
+	"names",	"::file channels",
+	NULL
+    };
+    Tcl_Command ensemble;
+    Tcl_Obj *mapObj;
+    int i;
+
+    ensemble = TclMakeEnsemble(interp, "chan", initMap);
+    Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
+    for (i=0 ; extras[i] ; i+=2) {
+	/*
+	 * Can assume that reference counts are all incremented.
+	 */
+
+	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1),
+		Tcl_NewStringObj(extras[i+1], -1));
+    }
+    Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
+    return ensemble;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 8699b39..eed21fb 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -1,112 +1,101 @@
 /*
  * tclIOGT.c --
  *
- *	Implements a generic transformation exposing the underlying API
- *	at the script level.  Contributed by Andreas Kupries.
+ *	Implements a generic transformation exposing the underlying API at the
+ *	script level. Contributed by Andreas Kupries.
  *
  * Copyright (c) 2000 Ajuba Solutions
  * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclIO.h"
-
 
 /*
- * Forward declarations of internal procedures.
- * First the driver procedures of the transformation.
+ * Forward declarations of internal procedures. First the driver procedures of
+ * the transformation.
  */
 
-static int		TransformBlockModeProc _ANSI_ARGS_ ((
-				ClientData instanceData, int mode));
-static int		TransformCloseProc _ANSI_ARGS_ ((
-				ClientData instanceData, Tcl_Interp* interp));
-static int		TransformInputProc _ANSI_ARGS_ ((
-				ClientData instanceData,
-				char* buf, int toRead, int* errorCodePtr));
-static int		TransformOutputProc _ANSI_ARGS_ ((
-				ClientData instanceData, CONST char *buf,
-				int toWrite, int* errorCodePtr));
-static int		TransformSeekProc _ANSI_ARGS_ ((
-				ClientData instanceData, long offset,
-				int mode, int* errorCodePtr));
-static int		TransformSetOptionProc _ANSI_ARGS_((
-				ClientData instanceData, Tcl_Interp *interp,
-				CONST char *optionName, CONST char *value));
-static int		TransformGetOptionProc _ANSI_ARGS_((
-				ClientData instanceData, Tcl_Interp *interp,
-				CONST char *optionName, Tcl_DString *dsPtr));
-static void		TransformWatchProc _ANSI_ARGS_ ((
-				ClientData instanceData, int mask));
-static int		TransformGetFileHandleProc _ANSI_ARGS_ ((
-				ClientData instanceData, int direction,
-				ClientData* handlePtr));
-static int		TransformNotifyProc _ANSI_ARGS_ ((
-				ClientData instanceData, int mask));
-static Tcl_WideInt	TransformWideSeekProc _ANSI_ARGS_ ((
-				ClientData instanceData, Tcl_WideInt offset,
-				int mode, int* errorCodePtr));
+static int		TransformBlockModeProc(ClientData instanceData,
+			    int mode);
+static int		TransformCloseProc(ClientData instanceData,
+			    Tcl_Interp *interp);
+static int		TransformInputProc(ClientData instanceData, char *buf,
+			    int toRead, int *errorCodePtr);
+static int		TransformOutputProc(ClientData instanceData,
+			    const char *buf, int toWrite, int *errorCodePtr);
+static int		TransformSeekProc(ClientData instanceData, long offset,
+			    int mode, int *errorCodePtr);
+static int		TransformSetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *value);
+static int		TransformGetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
+static void		TransformWatchProc(ClientData instanceData, int mask);
+static int		TransformGetFileHandleProc(ClientData instanceData,
+			    int direction, ClientData *handlePtr);
+static int		TransformNotifyProc(ClientData instanceData, int mask);
+static Tcl_WideInt	TransformWideSeekProc(ClientData instanceData,
+			    Tcl_WideInt offset, int mode, int *errorCodePtr);
 
 /*
- * Forward declarations of internal procedures.
- * Secondly the procedures for handling and generating fileeevents.
+ * Forward declarations of internal procedures. Secondly the procedures for
+ * handling and generating fileeevents.
  */
 
-static void		TransformChannelHandlerTimer _ANSI_ARGS_ ((
-				ClientData clientData));
+static void		TransformChannelHandlerTimer(ClientData clientData);
 
 /*
- * Forward declarations of internal procedures.
- * Third, helper procedures encapsulating essential tasks.
+ * Forward declarations of internal procedures. Third, helper procedures
+ * encapsulating essential tasks.
  */
 
 typedef struct TransformChannelData TransformChannelData;
 
-static int		ExecuteCallback _ANSI_ARGS_ ((
-				TransformChannelData* ctrl, Tcl_Interp* interp,
-				unsigned char* op, unsigned char* buf,
-				int bufLen, int transmit, int preserve));
+static int		ExecuteCallback(TransformChannelData *ctrl,
+			    Tcl_Interp *interp, unsigned char *op,
+			    unsigned char *buf, int bufLen, int transmit,
+			    int preserve);
 
 /*
- * Action codes to give to 'ExecuteCallback' (argument 'transmit')
- * confering to the procedure what to do with the result of the script
- * it calls.
+ * Action codes to give to 'ExecuteCallback' (argument 'transmit'), telling
+ * the procedure what to do with the result of the script it calls.
  */
 
-#define TRANSMIT_DONT  (0) /* No transfer to do */
-#define TRANSMIT_DOWN  (1) /* Transfer to the underlying channel */
-#define TRANSMIT_SELF  (2) /* Transfer into our channel. */
-#define TRANSMIT_IBUF  (3) /* Transfer to internal input buffer */
-#define TRANSMIT_NUM   (4) /* Transfer number to 'maxRead' */
+#define TRANSMIT_DONT	0	/* No transfer to do. */
+#define TRANSMIT_DOWN	1	/* Transfer to the underlying channel. */
+#define TRANSMIT_SELF	2	/* Transfer into our channel. */
+#define TRANSMIT_IBUF	3	/* Transfer to internal input buffer. */
+#define TRANSMIT_NUM	4	/* Transfer number to 'maxRead'. */
 
 /*
- * Codes for 'preserve' of 'ExecuteCallback'
+ * Codes for 'preserve' of 'ExecuteCallback'.
  */
 
-#define P_PRESERVE    (1)
-#define P_NO_PRESERVE (0)
+#define P_PRESERVE	1
+#define P_NO_PRESERVE	0
 
 /*
- * Strings for the action codes delivered to the script implementing
- * a transformation. Argument 'op' of 'ExecuteCallback'.
+ * Strings for the action codes delivered to the script implementing a
+ * transformation. Argument 'op' of 'ExecuteCallback'.
  */
 
-#define A_CREATE_WRITE	(UCHARP ("create/write"))
-#define A_DELETE_WRITE	(UCHARP ("delete/write"))
-#define A_FLUSH_WRITE	(UCHARP ("flush/write"))
-#define A_WRITE		(UCHARP ("write"))
+#define A_CREATE_WRITE	(UCHARP("create/write"))
+#define A_DELETE_WRITE	(UCHARP("delete/write"))
+#define A_FLUSH_WRITE	(UCHARP("flush/write"))
+#define A_WRITE		(UCHARP("write"))
 
-#define A_CREATE_READ	(UCHARP ("create/read"))
-#define A_DELETE_READ	(UCHARP ("delete/read"))
-#define A_FLUSH_READ	(UCHARP ("flush/read"))
-#define A_READ		(UCHARP ("read"))
+#define A_CREATE_READ	(UCHARP("create/read"))
+#define A_DELETE_READ	(UCHARP("delete/read"))
+#define A_FLUSH_READ	(UCHARP("flush/read"))
+#define A_READ		(UCHARP("read"))
 
-#define A_QUERY_MAXREAD (UCHARP ("query/maxRead"))
-#define A_CLEAR_READ	(UCHARP ("clear/read"))
+#define A_QUERY_MAXREAD	(UCHARP("query/maxRead"))
+#define A_CLEAR_READ	(UCHARP("clear/read"))
 
 /*
  * Management of a simple buffer.
@@ -114,74 +103,75 @@ static int		ExecuteCallback _ANSI_ARGS_ ((
 
 typedef struct ResultBuffer ResultBuffer;
 
-static void		ResultClear  _ANSI_ARGS_ ((ResultBuffer* r));
-static void		ResultInit   _ANSI_ARGS_ ((ResultBuffer* r));
-static int		ResultLength _ANSI_ARGS_ ((ResultBuffer* r));
-static int		ResultCopy   _ANSI_ARGS_ ((ResultBuffer* r,
-				unsigned char* buf, int toRead));
-static void		ResultAdd    _ANSI_ARGS_ ((ResultBuffer* r,
-				unsigned char* buf, int toWrite));
+static inline void	ResultClear(ResultBuffer *r);
+static inline void	ResultInit(ResultBuffer *r);
+static inline int	ResultEmpty(ResultBuffer *r);
+static inline int	ResultCopy(ResultBuffer *r, unsigned char *buf,
+			    size_t toRead);
+static inline void	ResultAdd(ResultBuffer *r, unsigned char *buf,
+			    size_t toWrite);
 
 /*
- * This structure describes the channel type structure for tcl based
+ * This structure describes the channel type structure for Tcl-based
  * transformations.
  */
 
 static Tcl_ChannelType transformChannelType = {
-    "transform",			/* Type name. */
-    TCL_CHANNEL_VERSION_3,
-    TransformCloseProc,			/* Close proc. */
-    TransformInputProc,			/* Input proc. */
-    TransformOutputProc,		/* Output proc. */
-    TransformSeekProc,			/* Seek proc. */
-    TransformSetOptionProc,		/* Set option proc. */
-    TransformGetOptionProc,		/* Get option proc. */
-    TransformWatchProc,			/* Initialize notifier. */
-    TransformGetFileHandleProc,		/* Get OS handles out of channel. */
-    NULL,				/* close2proc */
-    TransformBlockModeProc,		/* Set blocking/nonblocking mode.*/
-    NULL,				/* Flush proc. */
-    TransformNotifyProc,                /* Handling of events bubbling up */
-    TransformWideSeekProc,		/* Wide seek proc */
-    NULL
+    "transform",		/* Type name. */
+    TCL_CHANNEL_VERSION_5,	/* v5 channel */
+    TransformCloseProc,		/* Close proc. */
+    TransformInputProc,		/* Input proc. */
+    TransformOutputProc,	/* Output proc. */
+    TransformSeekProc,		/* Seek proc. */
+    TransformSetOptionProc,	/* Set option proc. */
+    TransformGetOptionProc,	/* Get option proc. */
+    TransformWatchProc,		/* Initialize notifier. */
+    TransformGetFileHandleProc,	/* Get OS handles out of channel. */
+    NULL,			/* close2proc */
+    TransformBlockModeProc,	/* Set blocking/nonblocking mode.*/
+    NULL,			/* Flush proc. */
+    TransformNotifyProc,	/* Handling of events bubbling up. */
+    TransformWideSeekProc,	/* Wide seek proc. */
+    NULL,			/* Thread action. */
+    NULL			/* Truncate. */
 };
 
 /*
  * Possible values for 'flags' field in control structure, see below.
  */
 
-#define CHANNEL_ASYNC		(1<<0) /* non-blocking mode */
+#define CHANNEL_ASYNC (1<<0)	/* Non-blocking mode. */
 
 /*
- * Definition of the structure containing the information about the
- * internal input buffer.
+ * Definition of the structure containing the information about the internal
+ * input buffer.
  */
 
 struct ResultBuffer {
-    unsigned char* buf;       /* Reference to the buffer area */
-    int		   allocated; /* Allocated size of the buffer area */
-    int		   used;      /* Number of bytes in the buffer, <= allocated */
+    unsigned char *buf;		/* Reference to the buffer area. */
+    size_t allocated;		/* Allocated size of the buffer area. */
+    size_t used;		/* Number of bytes in the buffer, no more than
+				 * number allocated. */
 };
 
 /*
- * Additional bytes to allocate during buffer expansion
+ * Additional bytes to allocate during buffer expansion.
  */
 
-#define INCREMENT (512)
+#define INCREMENT	512
 
 /*
- * Number of milliseconds to wait before firing an event to flush
- * out information waiting in buffers (fileevent support).
+ * Number of milliseconds to wait before firing an event to flush out
+ * information waiting in buffers (fileevent support).
  */
 
-#define FLUSH_DELAY (5)
+#define FLUSH_DELAY	5
 
 /*
  * Convenience macro to make some casts easier to use.
  */
 
-#define UCHARP(x) ((unsigned char*) (x))
-#define NO_INTERP ((Tcl_Interp*) NULL)
+#define UCHARP(x)	((unsigned char *) (x))
 
 /*
  * Definition of a structure used by all transformations generated here to
@@ -189,48 +179,47 @@ struct ResultBuffer {
  */
 
 struct TransformChannelData {
-
     /*
      * General section. Data to integrate the transformation into the channel
      * system.
      */
 
-    Tcl_Channel self;     /* Our own Channel handle */
-    int readIsFlushed;    /* Flag to note wether in.flushProc was called or not
-			   */
-    int flags;            /* Currently CHANNEL_ASYNC or zero */
-    int watchMask;        /* Current watch/event/interest mask */
-    int mode;             /* mode of parent channel, OR'ed combination of
-			   * TCL_READABLE, TCL_WRITABLE */
-    Tcl_TimerToken timer; /* Timer for automatic flushing of information
-			   * sitting in an internal buffer. Required for full
-			   * fileevent support */
+    Tcl_Channel self;		/* Our own Channel handle. */
+    int readIsFlushed;		/* Flag to note whether in.flushProc was
+				 * called or not. */
+    int flags;			/* Currently CHANNEL_ASYNC or zero. */
+    int watchMask;		/* Current watch/event/interest mask. */
+    int mode;			/* Mode of parent channel, OR'ed combination
+				 * of TCL_READABLE, TCL_WRITABLE. */
+    Tcl_TimerToken timer;	/* Timer for automatic flushing of information
+				 * sitting in an internal buffer. Required for
+				 * full fileevent support. */
+
     /*
      * Transformation specific data.
      */
 
-    int maxRead;            /* Maximum allowed number of bytes to read, as
-			     * given to us by the tcl script implementing the
-			     * transformation. */
-    Tcl_Interp*    interp;  /* Reference to the interpreter which created the
-			     * transformation. Used to execute the code
-			     * below. */
-    Tcl_Obj*       command; /* Tcl code to execute for a buffer */
-    ResultBuffer   result;  /* Internal buffer used to store the result of a
-			     * transformation of incoming data. Additionally
-			     * serves as buffer of all data not yet consumed by
-			     * the reader. */
+    int maxRead;		/* Maximum allowed number of bytes to read, as
+				 * given to us by the Tcl script implementing
+				 * the transformation. */
+    Tcl_Interp *interp;		/* Reference to the interpreter which created
+				 * the transformation. Used to execute the
+				 * code below. */
+    Tcl_Obj *command;		/* Tcl code to execute for a buffer */
+    ResultBuffer result;	/* Internal buffer used to store the result of
+				 * a transformation of incoming data. Also
+				 * serves as buffer of all data not yet
+				 * consumed by the reader. */
 };
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclChannelTransform --
  *
- *	Implements the Tcl "testchannel transform" debugging command.
- *	This is part of the testing environment.  This sets up a tcl
- *	script (cmdObjPtr) to be used as a transform on the channel.
+ *	Implements the Tcl "testchannel transform" debugging command. This is
+ *	part of the testing environment. This sets up a tcl script (cmdObjPtr)
+ *	to be used as a transform on the channel.
  *
  * Results:
  *	A standard Tcl result.
@@ -243,69 +232,63 @@ struct TransformChannelData {
 
 	/* ARGSUSED */
 int
-TclChannelTransform(interp, chan, cmdObjPtr)
-    Tcl_Interp	*interp;	/* Interpreter for result. */
-    Tcl_Channel chan;		/* Channel to transform. */
-    Tcl_Obj	*cmdObjPtr;	/* Script to use for transform. */
+TclChannelTransform(
+    Tcl_Interp *interp,		/* Interpreter for result. */
+    Tcl_Channel chan,		/* Channel to transform. */
+    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
 {
-    Channel			*chanPtr;	/* The actual channel. */
-    ChannelState		*statePtr;	/* state info for channel */
-    int				mode;		/* rw mode of the channel */
-    TransformChannelData	*dataPtr;
-    int				res;
-    Tcl_DString			ds;
-
-    if (chan == (Tcl_Channel) NULL) {
+    Channel *chanPtr;		/* The actual channel. */
+    ChannelState *statePtr;	/* State info for channel. */
+    int mode;			/* Read/write mode of the channel. */
+    TransformChannelData *dataPtr;
+    Tcl_DString ds;
+
+    if (chan == NULL) {
 	return TCL_ERROR;
     }
-    chanPtr	= (Channel *) chan;
-    statePtr	= chanPtr->state;
-    chanPtr	= statePtr->topChanPtr;
-    chan	= (Tcl_Channel) chanPtr;
-    mode	= (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+
+    chanPtr = (Channel *) chan;
+    statePtr = chanPtr->state;
+    chanPtr = statePtr->topChanPtr;
+    chan = (Tcl_Channel) chanPtr;
+    mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
 
     /*
-     * Now initialize the transformation state and stack it upon the
-     * specified channel. One of the necessary things to do is to
-     * retrieve the blocking regime of the underlying channel and to
-     * use the same for us too.
+     * Now initialize the transformation state and stack it upon the specified
+     * channel. One of the necessary things to do is to retrieve the blocking
+     * regime of the underlying channel and to use the same for us too.
      */
 
-    dataPtr = (TransformChannelData*) ckalloc(sizeof(TransformChannelData));
+    dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
 
-    Tcl_DStringInit (&ds);
+    Tcl_DStringInit(&ds);
     Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
-
     dataPtr->readIsFlushed = 0;
-    dataPtr->flags	= 0;
-
+    dataPtr->flags = 0;
     if (ds.string[0] == '0') {
 	dataPtr->flags |= CHANNEL_ASYNC;
     }
-
-    Tcl_DStringFree (&ds);
-
-    dataPtr->self	= chan;
-    dataPtr->watchMask	= 0;
-    dataPtr->mode	= mode;
-    dataPtr->timer	= (Tcl_TimerToken) NULL;
-    dataPtr->maxRead	= 4096; /* Initial value not relevant */
-    dataPtr->interp	= interp;
-    dataPtr->command	= cmdObjPtr;
-
+    Tcl_DStringFree(&ds);
+
+    dataPtr->self = chan;
+    dataPtr->watchMask = 0;
+    dataPtr->mode = mode;
+    dataPtr->timer = NULL;
+    dataPtr->maxRead = 4096;	/* Initial value not relevant. */
+    dataPtr->interp = interp;
+    dataPtr->command = cmdObjPtr;
     Tcl_IncrRefCount(dataPtr->command);
 
     ResultInit(&dataPtr->result);
 
-    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
-	    (ClientData) dataPtr, mode, chan);
-    if (dataPtr->self == (Tcl_Channel) NULL) {
+    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
+	    mode, chan);
+    if (dataPtr->self == NULL) {
 	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
-		Tcl_GetChannelName(chan), "\"", (char *) NULL);
-
+		Tcl_GetChannelName(chan), "\"", NULL);
 	Tcl_DecrRefCount(dataPtr->command);
 	ResultClear(&dataPtr->result);
-	ckfree((VOID *) dataPtr);
+	ckfree((char *) dataPtr);
 	return TCL_ERROR;
     }
 
@@ -313,65 +296,62 @@ TclChannelTransform(interp, chan, cmdObjPtr)
      * At last initialize the transformation at the script level.
      */
 
-    if (dataPtr->mode & TCL_WRITABLE) {
-	res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_WRITE,
-		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
-
-	if (res != TCL_OK) {
-	    Tcl_UnstackChannel(interp, chan);
-	    return TCL_ERROR;
-	}
+    if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
+	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
+	Tcl_UnstackChannel(interp, chan);
+	return TCL_ERROR;
     }
 
-    if (dataPtr->mode & TCL_READABLE) {
-	res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_READ,
-		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
-
-	if (res != TCL_OK) {
-	    ExecuteCallback (dataPtr, NO_INTERP, A_DELETE_WRITE,
-		    NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
-
-	    Tcl_UnstackChannel(interp, chan);
-	    return TCL_ERROR;
-	}
+    if ((dataPtr->mode & TCL_READABLE) && ExecuteCallback(dataPtr, NULL,
+	    A_CREATE_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK) {
+	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
+		P_NO_PRESERVE);
+	Tcl_UnstackChannel(interp, chan);
+	return TCL_ERROR;
     }
 
     return TCL_OK;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ExecuteCallback --
+ * ExecuteCallback --
  *
- *	Executes the defined callback for buffer and
- *	operation.
+ *	Executes the defined callback for buffer and operation.
  *
- *	Sideeffects:
- *		As of the executed tcl script.
+ * Side effects:
+ *	As of the executed tcl script.
  *
- *	Result:
- *		A standard TCL error code. In case of an
- *		error a message is left in the result area
- *		of the specified interpreter.
+ * Result:
+ *	A standard TCL error code. In case of an error a message is left in
+ *	the result area of the specified interpreter.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
-    TransformChannelData* dataPtr;  /* Transformation with the callback */
-    Tcl_Interp*           interp;   /* Current interpreter, possibly NULL */
-    unsigned char*        op;       /* Operation invoking the callback */
-    unsigned char*        buf;      /* Buffer to give to the script. */
-    int			  bufLen;   /* Ands its length */
-    int                   transmit; /* Flag, determines whether the result
-				     * of the callback is sent to the
-				     * underlying channel or not. */
-    int                   preserve; /* Flag. If true the procedure will
-				     * preserver the result state of all
-				     * accessed interpreters. */
+ExecuteCallback(
+    TransformChannelData *dataPtr,
+				/* Transformation with the callback. */
+    Tcl_Interp *interp,		/* Current interpreter, possibly NULL. */
+    unsigned char *op,		/* Operation invoking the callback. */
+    unsigned char *buf,		/* Buffer to give to the script. */
+    int bufLen,			/* And its length. */
+    int transmit,		/* Flag, determines whether the result of the
+				 * callback is sent to the underlying channel
+				 * or not. */
+    int preserve)		/* Flag. If true the procedure will preserve
+				 * the result state of all accessed
+				 * interpreters. */
 {
+    Tcl_Obj *resObj;		/* See below, switch (transmit). */
+    int resLen;
+    unsigned char *resBuf;
+    Tcl_InterpState state = NULL;
+    int res = TCL_OK;
+    Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+
     /*
      * Step 1, create the complete command to execute. Do this by appending
      * operation and buffer to operate upon to a copy of the callback
@@ -380,72 +360,43 @@ ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
      * arguments. Feather's curried commands would come in handy here.
      */
 
-    Tcl_Obj* resObj;		    /* See below, switch (transmit) */
-    int resLen;
-    unsigned char* resBuf;
-    Tcl_SavedResult ciSave;
-    int res = TCL_OK;
-    Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);
-    Tcl_Obj* temp;
-
-    if (preserve) {
-	Tcl_SaveResult (dataPtr->interp, &ciSave);
-    }
-
-    if (command == (Tcl_Obj*) NULL) {
-        /* Memory allocation problem */
-        res = TCL_ERROR;
-        goto cleanup;
+    if (preserve == P_PRESERVE) {
+	state = Tcl_SaveInterpState(dataPtr->interp, res);
     }
 
     Tcl_IncrRefCount(command);
-
-    temp = Tcl_NewStringObj((char*) op, -1);
-
-    if (temp == (Tcl_Obj*) NULL) {
-        /* Memory allocation problem */
-        res = TCL_ERROR;
-        goto cleanup;
-    }
-
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
-
-    if (res != TCL_OK)
+    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
+	    Tcl_NewStringObj((char *) op, -1));
+    if (res != TCL_OK) {
 	goto cleanup;
+    }
 
     /*
-     * Use a byte-array to prevent the misinterpretation of binary data
-     * coming through as UTF while at the tcl level.
+     * Use a byte-array to prevent the misinterpretation of binary data coming
+     * through as UTF while at the tcl level.
      */
 
-    temp = Tcl_NewByteArrayObj(buf, bufLen);
-
-    if (temp == (Tcl_Obj*) NULL) {
-        /* Memory allocation problem */
-	res = TCL_ERROR;
-        goto cleanup;
+    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
+	    Tcl_NewByteArrayObj(buf, bufLen));
+    if (res != TCL_OK) {
+	goto cleanup;
     }
 
-    res = Tcl_ListObjAppendElement (dataPtr->interp, command, temp);
-
-    if (res != TCL_OK)
-        goto cleanup;
-
     /*
-     * Step 2, execute the command at the global level of the interpreter
-     * used to create the transformation. Destroy the command afterward.
-     * If an error occured and the current interpreter is defined and not
-     * equal to the interpreter for the callback, then copy the error
-     * message into current interpreter. Don't copy if in preservation mode.
+     * Step 2, execute the command at the global level of the interpreter used
+     * to create the transformation. Destroy the command afterward. If an
+     * error occured and the current interpreter is defined and not equal to
+     * the interpreter for the callback, then copy the error message into
+     * current interpreter. Don't copy if in preservation mode.
      */
 
     res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
-    Tcl_DecrRefCount (command);
-    command = (Tcl_Obj*) NULL;
+    Tcl_DecrRefCount(command);
+    command = NULL;
 
-    if ((res != TCL_OK) && (interp != NO_INTERP) &&
-	    (dataPtr->interp != interp) && !preserve) {
-        Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+	    && (preserve == P_NO_PRESERVE)) {
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
 	return res;
     }
 
@@ -455,121 +406,115 @@ ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
      */
 
     switch (transmit) {
-	case TRANSMIT_DONT:
-	    /* nothing to do */
-	    break;
-
-	case TRANSMIT_DOWN:
-	    resObj = Tcl_GetObjResult(dataPtr->interp);
-	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
-	    Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),
-		    (char*) resBuf, resLen);
-	    break;
-
-	case TRANSMIT_SELF:
-	    resObj = Tcl_GetObjResult (dataPtr->interp);
-	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
-	    Tcl_WriteRaw(dataPtr->self, (char*) resBuf, resLen);
-	    break;
-
-	case TRANSMIT_IBUF:
-	    resObj = Tcl_GetObjResult (dataPtr->interp);
-	    resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
-	    ResultAdd(&dataPtr->result, resBuf, resLen);
-	    break;
-
-	case TRANSMIT_NUM:
-	    /* Interpret result as integer number */
-	    resObj = Tcl_GetObjResult (dataPtr->interp);
-	    Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
-	    break;
+    case TRANSMIT_DONT:
+	/* nothing to do */
+	break;
+
+    case TRANSMIT_DOWN:
+	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
+		resLen);
+	break;
+
+    case TRANSMIT_SELF:
+	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
+	break;
+
+    case TRANSMIT_IBUF:
+	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
+	ResultAdd(&dataPtr->result, resBuf, resLen);
+	break;
+
+    case TRANSMIT_NUM:
+	/*
+	 * Interpret result as integer number.
+	 */
+
+	resObj = Tcl_GetObjResult(dataPtr->interp);
+	TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+	break;
     }
 
     Tcl_ResetResult(dataPtr->interp);
-
-    if (preserve) {
-	Tcl_RestoreResult(dataPtr->interp, &ciSave);
+    if (preserve == P_PRESERVE) {
+	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
     }
-
     return res;
 
-    cleanup:
-    if (preserve) {
-	Tcl_RestoreResult(dataPtr->interp, &ciSave);
+  cleanup:
+    if (preserve == P_PRESERVE) {
+	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
     }
-
-    if (command != (Tcl_Obj*) NULL) {
-        Tcl_DecrRefCount(command);
+    if (command != NULL) {
+	Tcl_DecrRefCount(command);
     }
-
     return res;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformBlockModeProc --
+ * TransformBlockModeProc --
  *
- *	Trap handler. Called by the generic IO system
- *	during option processing to change the blocking
- *	mode of the channel.
+ *	Trap handler. Called by the generic IO system during option processing
+ *	to change the blocking mode of the channel.
  *
- *	Sideeffects:
- *		Forwards the request to the underlying
- *		channel.
+ * Side effects:
+ *	Forwards the request to the underlying channel.
  *
- *	Result:
- *		0 if successful, errno when failed.
+ * Result:
+ *	0 if successful, errno when failed.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformBlockModeProc (instanceData, mode)
-    ClientData  instanceData; /* State of transformation */
-    int         mode;         /* New blocking mode */
+TransformBlockModeProc(
+    ClientData instanceData,	/* State of transformation. */
+    int mode)			/* New blocking mode. */
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    TransformChannelData *dataPtr = instanceData;
 
     if (mode == TCL_MODE_NONBLOCKING) {
-        dataPtr->flags |= CHANNEL_ASYNC;
+	dataPtr->flags |= CHANNEL_ASYNC;
     } else {
-        dataPtr->flags &= ~(CHANNEL_ASYNC);
+	dataPtr->flags &= ~CHANNEL_ASYNC;
     }
     return 0;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformCloseProc --
+ * TransformCloseProc --
  *
- *	Trap handler. Called by the generic IO system
- *	during destruction of the transformation channel.
+ *	Trap handler. Called by the generic IO system during destruction of
+ *	the transformation channel.
  *
- *	Sideeffects:
- *		Releases the memory allocated in
- *		'Tcl_TransformObjCmd'.
+ * Side effects:
+ *	Releases the memory allocated in 'Tcl_TransformObjCmd'.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformCloseProc (instanceData, interp)
-    ClientData  instanceData;
-    Tcl_Interp* interp;
+TransformCloseProc(
+    ClientData instanceData,
+    Tcl_Interp *interp)
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
-
-    /*
-     * Important: In this procedure 'dataPtr->self' already points to
-     * the underlying channel.
-     */
+    TransformChannelData *dataPtr = instanceData;
 
     /*
+     * Important: In this procedure 'dataPtr->self' already points to the
+     * underlying channel.
+     *
      * There is no need to cancel an existing channel handler, this is already
      * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
      * 'Tcl_Close'.
@@ -578,81 +523,82 @@ TransformCloseProc (instanceData, interp)
      * removed channel.
      */
 
-    if (dataPtr->timer != (Tcl_TimerToken) NULL) {
-        Tcl_DeleteTimerHandler (dataPtr->timer);
-	dataPtr->timer = (Tcl_TimerToken) NULL;
+    if (dataPtr->timer != NULL) {
+	Tcl_DeleteTimerHandler(dataPtr->timer);
+	dataPtr->timer = NULL;
     }
 
     /*
      * Now flush data waiting in internal buffers to output and input. The
-     * input must be done despite the fact that there is no real receiver
-     * for it anymore. But the scripts might have sideeffects other parts
-     * of the system rely on (f.e. signaling the close to interested parties).
+     * input must be done despite the fact that there is no real receiver for
+     * it anymore. But the scripts might have sideeffects other parts of the
+     * system rely on (f.e. signaling the close to interested parties).
      */
 
     if (dataPtr->mode & TCL_WRITABLE) {
-        ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,
-		NULL, 0, TRANSMIT_DOWN, 1);
+	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
+		TRANSMIT_DOWN, P_PRESERVE);
     }
 
     if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
 	dataPtr->readIsFlushed = 1;
-        ExecuteCallback (dataPtr, interp, A_FLUSH_READ,
-		NULL, 0, TRANSMIT_IBUF, 1);
+	ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF,
+		P_PRESERVE);
     }
 
     if (dataPtr->mode & TCL_WRITABLE) {
-        ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,
-		NULL, 0, TRANSMIT_DONT, 1);
+	ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
+		TRANSMIT_DONT, P_PRESERVE);
     }
-
     if (dataPtr->mode & TCL_READABLE) {
-        ExecuteCallback (dataPtr, interp, A_DELETE_READ,
-		NULL, 0, TRANSMIT_DONT, 1);
+	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
+		TRANSMIT_DONT, P_PRESERVE);
     }
 
     /*
-     * General cleanup
+     * General cleanup.
      */
 
     ResultClear(&dataPtr->result);
     Tcl_DecrRefCount(dataPtr->command);
-    ckfree((VOID*) dataPtr);
-
+    ckfree((char *) dataPtr);
     return TCL_OK;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformInputProc --
+ * TransformInputProc --
  *
  *	Called by the generic IO system to convert read data.
  *
- *	Sideeffects:
- *		As defined by the conversion.
+ * Side effects:
+ *	As defined by the conversion.
  *
- *	Result:
- *		A transformed buffer.
+ * Result:
+ *	A transformed buffer.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformInputProc (instanceData, buf, toRead, errorCodePtr)
-    ClientData instanceData;
-    char*      buf;
-    int	       toRead;
-    int*       errorCodePtr;
+TransformInputProc(
+    ClientData instanceData,
+    char *buf,
+    int toRead,
+    int *errorCodePtr)
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
-    int gotBytes, read, res, copied;
+    TransformChannelData *dataPtr = instanceData;
+    int gotBytes, read, copied;
     Tcl_Channel downChan;
 
-    /* should assert (dataPtr->mode & TCL_READABLE) */
+    /*
+     * Should assert(dataPtr->mode & TCL_READABLE);
+     */
 
     if (toRead == 0) {
-	/* Catch a no-op.
+	/*
+	 * Catch a no-op.
 	 */
 	return 0;
     }
@@ -661,113 +607,116 @@ TransformInputProc (instanceData, buf, toRead, errorCodePtr)
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
     while (toRead > 0) {
-        /*
+	/*
 	 * Loop until the request is satisfied (or no data is available from
 	 * below, possibly EOF).
 	 */
 
-        copied    = ResultCopy (&dataPtr->result, UCHARP (buf), toRead);
-
-	toRead   -= copied;
-	buf      += copied;
+	copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
+	toRead -= copied;
+	buf += copied;
 	gotBytes += copied;
 
 	if (toRead == 0) {
-	    /* The request was completely satisfied from our buffers.
-	     * We can break out of the loop and return to the caller.
+	    /*
+	     * The request was completely satisfied from our buffers. We can
+	     * break out of the loop and return to the caller.
 	     */
+
 	    return gotBytes;
 	}
 
 	/*
-	 * Length (dataPtr->result) == 0, toRead > 0 here . Use the incoming
-	 * 'buf'! as target to store the intermediary information read
-	 * from the underlying channel.
+	 * Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
+	 * 'buf'! as target to store the intermediary information read from
+	 * the underlying channel.
 	 *
-	 * Ask the tcl level how much data it allows us to read from
-	 * the underlying channel. This feature allows the transform to
-	 * signal EOF upstream although there is none downstream. Useful
-	 * to control an unbounded 'fcopy', either through counting bytes,
-	 * or by pattern matching.
+	 * Ask the tcl level how much data it allows us to read from the
+	 * underlying channel. This feature allows the transform to signal EOF
+	 * upstream although there is none downstream. Useful to control an
+	 * unbounded 'fcopy', either through counting bytes, or by pattern
+	 * matching.
 	 */
 
-	ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,
-		NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
+	ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
+		TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
 
 	if (dataPtr->maxRead >= 0) {
 	    if (dataPtr->maxRead < toRead) {
-	        toRead = dataPtr->maxRead;
+		toRead = dataPtr->maxRead;
 	    }
-	} /* else: 'maxRead < 0' == Accept the current value of toRead */
-
+	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
 	if (toRead <= 0) {
 	    return gotBytes;
 	}
 
-	read = Tcl_ReadRaw(downChan, buf, toRead);
+	/*
+	 * Get bytes from the underlying channel.
+	 */
 
+	read = Tcl_ReadRaw(downChan, buf, toRead);
 	if (read < 0) {
-	    /* Report errors to caller. EAGAIN is a special situation.
-	     * If we had some data before we report that instead of the
-	     * request to re-try.
+	    /*
+	     * Report errors to caller. EAGAIN is a special situation. If we
+	     * had some data before we report that instead of the request to
+	     * re-try.
 	     */
 
 	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
-	        return gotBytes;
+		return gotBytes;
 	    }
 
 	    *errorCodePtr = Tcl_GetErrno();
-	    return -1;      
-	}
-
-	if (read == 0) {
+	    return -1;
+	} else if (read == 0) {
 	    /*
-	     * Check wether we hit on EOF in the underlying channel or
-	     * not. If not differentiate between blocking and
-	     * non-blocking modes. In non-blocking mode we ran
-	     * temporarily out of data. Signal this to the caller via
-	     * EWOULDBLOCK and error return (-1). In the other cases
-	     * we simply return what we got and let the caller wait
-	     * for more. On the other hand, if we got an EOF we have
-	     * to convert and flush all waiting partial data.
+	     * Check wether we hit on EOF in the underlying channel or not. If
+	     * not differentiate between blocking and non-blocking modes. In
+	     * non-blocking mode we ran temporarily out of data. Signal this
+	     * to the caller via EWOULDBLOCK and error return (-1). In the
+	     * other cases we simply return what we got and let the caller
+	     * wait for more. On the other hand, if we got an EOF we have to
+	     * convert and flush all waiting partial data.
 	     */
 
-	    if (! Tcl_Eof (downChan)) {
-	        if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
+	    if (!Tcl_Eof(downChan)) {
+		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
 		    *errorCodePtr = EWOULDBLOCK;
 		    return -1;
-		} else {
-		    return gotBytes;
-		}
-	    } else {
-	        if (dataPtr->readIsFlushed) {
-		    /* Already flushed, nothing to do anymore
-		     */
-		    return gotBytes;
 		}
+		return gotBytes;
+	    }
+
+	    if (dataPtr->readIsFlushed) {
+		/*
+		 * Already flushed, nothing to do anymore.
+		 */
 
-		dataPtr->readIsFlushed = 1;
+		return gotBytes;
+	    }
 
-		ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,
-			NULL, 0, TRANSMIT_IBUF, P_PRESERVE);
+	    dataPtr->readIsFlushed = 1;
+	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
+		    TRANSMIT_IBUF, P_PRESERVE);
 
-		if (ResultLength (&dataPtr->result) == 0) {
-		    /* we had nothing to flush */
-		    return gotBytes;
-		}
+	    if (ResultEmpty(&dataPtr->result)) {
+		/*
+		 * We had nothing to flush.
+		 */
 
-		continue; /* at: while (toRead > 0) */
+		return gotBytes;
 	    }
+
+	    continue;		/* at: while (toRead > 0) */
 	} /* read == 0 */
 
-	/* Transform the read chunk and add the result to our
-	 * read buffer (dataPtr->result)
+	/*
+	 * Transform the read chunk and add the result to our read buffer
+	 * (dataPtr->result).
 	 */
 
-	res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
-		UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE);
-
-	if (res != TCL_OK) {
+	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
+		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
 	    *errorCodePtr = EINVAL;
 	    return -1;
 	}
@@ -777,46 +726,45 @@ TransformInputProc (instanceData, buf, toRead, errorCodePtr)
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformOutputProc --
+ * TransformOutputProc --
  *
- *	Called by the generic IO system to convert data
- *	waiting to be written.
+ *	Called by the generic IO system to convert data waiting to be written.
  *
- *	Sideeffects:
- *		As defined by the transformation.
+ * Side effects:
+ *	As defined by the transformation.
  *
- *	Result:
- *		A transformed buffer.
+ * Result:
+ *	A transformed buffer.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
-    ClientData instanceData;
-    CONST char*      buf;
-    int        toWrite;
-    int*       errorCodePtr;
+TransformOutputProc(
+    ClientData instanceData,
+    const char *buf,
+    int toWrite,
+    int *errorCodePtr)
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
-    int res;
+    TransformChannelData *dataPtr = instanceData;
 
-    /* should assert (dataPtr->mode & TCL_WRITABLE) */
+    /*
+     * Should assert(dataPtr->mode & TCL_WRITABLE);
+     */
 
     if (toWrite == 0) {
-	/* Catch a no-op.
+	/*
+	 * Catch a no-op.
 	 */
+
 	return 0;
     }
 
-    res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,
-	    UCHARP (buf), toWrite,
-	    TRANSMIT_DOWN, P_NO_PRESERVE);
-
-    if (res != TCL_OK) {
-        *errorCodePtr = EINVAL;
+    if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
+	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
+	*errorCodePtr = EINVAL;
 	return -1;
     }
 
@@ -824,69 +772,67 @@ TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformSeekProc --
+ * TransformSeekProc --
  *
- *	This procedure is called by the generic IO level
- *	to move the access point in a channel.
+ *	This procedure is called by the generic IO level to move the access
+ *	point in a channel.
  *
- *	Sideeffects:
- *		Moves the location at which the channel
- *		will be accessed in future operations.
- *		Flushes all transformation buffers, then
- *		forwards it to the underlying channel.
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in future
+ *	operations. Flushes all transformation buffers, then forwards it to
+ *	the underlying channel.
  *
- *	Result:
- *		-1 if failed, the new position if
- *		successful. An output argument contains
- *		the POSIX error code if an error
- *		occurred, or zero.
+ * Result:
+ *	-1 if failed, the new position if successful. An output argument
+ *	contains the POSIX error code if an error occurred, or zero.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformSeekProc (instanceData, offset, mode, errorCodePtr)
-    ClientData  instanceData;	/* The channel to manipulate */
-    long	offset;		/* Size of movement. */
-    int         mode;		/* How to move */
-    int*        errorCodePtr;	/* Location of error flag. */
+TransformSeekProc(
+    ClientData instanceData,	/* The channel to manipulate. */
+    long offset,		/* Size of movement. */
+    int mode,			/* How to move. */
+    int *errorCodePtr)		/* Location of error flag. */
 {
-    TransformChannelData* dataPtr	= (TransformChannelData*) instanceData;
-    Tcl_Channel           parent        = Tcl_GetStackedChannel(dataPtr->self);
-    Tcl_ChannelType*      parentType	= Tcl_GetChannelType(parent);
-    Tcl_DriverSeekProc*   parentSeekProc = Tcl_ChannelSeekProc(parentType);
+    TransformChannelData *dataPtr = instanceData;
+    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
+    Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
+    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
 
     if ((offset == 0) && (mode == SEEK_CUR)) {
-        /* This is no seek but a request to tell the caller the current
+	/*
+	 * This is no seek but a request to tell the caller the current
 	 * location. Simply pass the request down.
 	 */
 
-	return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
-		offset, mode, errorCodePtr);
+	return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset,
+		mode, errorCodePtr);
     }
 
     /*
-     * It is a real request to change the position. Flush all data waiting
-     * for output and discard everything in the input buffers. Then pass
-     * the request down, unchanged.
+     * It is a real request to change the position. Flush all data waiting for
+     * output and discard everything in the input buffers. Then pass the
+     * request down, unchanged.
      */
 
     if (dataPtr->mode & TCL_WRITABLE) {
-        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
-		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
+	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+		P_NO_PRESERVE);
     }
 
     if (dataPtr->mode & TCL_READABLE) {
-        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
-		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+		P_NO_PRESERVE);
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
 
-    return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
-	    offset, mode, errorCodePtr);
+    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
+	    errorCodePtr);
 }
 
 /*
@@ -894,71 +840,64 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr)
  *
  * TransformWideSeekProc --
  *
- *	This procedure is called by the generic IO level to move the
- *	access point in a channel, with a (potentially) 64-bit offset.
+ *	This procedure is called by the generic IO level to move the access
+ *	point in a channel, with a (potentially) 64-bit offset.
  *
  * Side effects:
- *	Moves the location at which the channel will be accessed in
- *	future operations.  Flushes all transformation buffers, then
- *	forwards it to the underlying channel.
+ *	Moves the location at which the channel will be accessed in future
+ *	operations. Flushes all transformation buffers, then forwards it to
+ *	the underlying channel.
  *
  * Result:
- *	-1 if failed, the new position if successful. An output
- *	argument contains the POSIX error code if an error occurred,
- *	or zero.
+ *	-1 if failed, the new position if successful. An output argument
+ *	contains the POSIX error code if an error occurred, or zero.
  *
  *----------------------------------------------------------------------
  */
 
 static Tcl_WideInt
-TransformWideSeekProc (instanceData, offset, mode, errorCodePtr)
-    ClientData  instanceData;	/* The channel to manipulate */
-    Tcl_WideInt offset;		/* Size of movement. */
-    int         mode;		/* How to move */
-    int*        errorCodePtr;	/* Location of error flag. */
+TransformWideSeekProc(
+    ClientData instanceData,	/* The channel to manipulate. */
+    Tcl_WideInt offset,		/* Size of movement. */
+    int mode,			/* How to move. */
+    int *errorCodePtr)		/* Location of error flag. */
 {
-    TransformChannelData* dataPtr =
-	(TransformChannelData*) instanceData;
-    Tcl_Channel parent =
-	Tcl_GetStackedChannel(dataPtr->self);
-    Tcl_ChannelType* parentType	=
-	Tcl_GetChannelType(parent);
-    Tcl_DriverSeekProc* parentSeekProc =
-	Tcl_ChannelSeekProc(parentType);
-    Tcl_DriverWideSeekProc* parentWideSeekProc =
-	Tcl_ChannelWideSeekProc(parentType);
-    ClientData parentData =
-	Tcl_GetChannelInstanceData(parent);
+    TransformChannelData *dataPtr = instanceData;
+    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
+    Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
+    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
+    Tcl_DriverWideSeekProc *parentWideSeekProc =
+	    Tcl_ChannelWideSeekProc(parentType);
+    ClientData parentData = Tcl_GetChannelInstanceData(parent);
 
     if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
-        /*
+	/*
 	 * This is no seek but a request to tell the caller the current
 	 * location. Simply pass the request down.
 	 */
 
 	if (parentWideSeekProc != NULL) {
-	    return (*parentWideSeekProc) (parentData, offset, mode,
-		    errorCodePtr);
+	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
 	}
 
-	return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,
+	return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
 		errorCodePtr));
     }
 
     /*
-     * It is a real request to change the position. Flush all data waiting
-     * for output and discard everything in the input buffers. Then pass
-     * the request down, unchanged.
+     * It is a real request to change the position. Flush all data waiting for
+     * output and discard everything in the input buffers. Then pass the
+     * request down, unchanged.
      */
 
     if (dataPtr->mode & TCL_WRITABLE) {
-        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
-		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
+	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
+		P_NO_PRESERVE);
     }
 
     if (dataPtr->mode & TCL_READABLE) {
-        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
-		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
+		P_NO_PRESERVE);
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
@@ -966,487 +905,491 @@ TransformWideSeekProc (instanceData, offset, mode, errorCodePtr)
     /*
      * If we have a wide seek capability, we should stick with that.
      */
+
     if (parentWideSeekProc != NULL) {
-	return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr);
+	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
     }
 
     /*
-     * We're transferring to narrow seeks at this point; this is a bit
-     * complex because we have to check whether the seek is possible
-     * first (i.e. whether we are losing information in truncating the
-     * bits of the offset.)  Luckily, there's a defined error for what
-     * happens when trying to go out of the representable range.
+     * We're transferring to narrow seeks at this point; this is a bit complex
+     * because we have to check whether the seek is possible first (i.e.
+     * whether we are losing information in truncating the bits of the
+     * offset). Luckily, there's a defined error for what happens when trying
+     * to go out of the representable range.
      */
+
     if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
 	*errorCodePtr = EOVERFLOW;
 	return Tcl_LongAsWide(-1);
     }
-    return Tcl_LongAsWide((*parentSeekProc) (parentData,
-	    Tcl_WideAsLong(offset), mode, errorCodePtr));
+
+    return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
+	    mode, errorCodePtr));
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformSetOptionProc --
+ * TransformSetOptionProc --
  *
- *	Called by generic layer to handle the reconfi-
- *	guration of channel specific options. As this
- *	channel type does not have such, it simply passes
- *	all requests downstream.
+ *	Called by generic layer to handle the reconfiguration of channel
+ *	specific options. As this channel type does not have such, it simply
+ *	passes all requests downstream.
  *
- *	Sideeffects:
- *		As defined by the channel downstream.
+ * Side effects:
+ *	As defined by the channel downstream.
  *
- *	Result:
- *		A standard TCL error code.
+ * Result:
+ *	A standard TCL error code.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformSetOptionProc (instanceData, interp, optionName, value)
-    ClientData instanceData;
-    Tcl_Interp *interp;
-    CONST char *optionName;
-    CONST char *value;
+TransformSetOptionProc(
+    ClientData instanceData,
+    Tcl_Interp *interp,
+    const char *optionName,
+    const char *value)
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    TransformChannelData *dataPtr = instanceData;
     Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
     Tcl_DriverSetOptionProc *setOptionProc;
 
     setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
-    if (setOptionProc != NULL) {
-	return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
-		interp, optionName, value);
+    if (setOptionProc == NULL) {
+	return TCL_ERROR;
     }
-    return TCL_ERROR;
+
+    return setOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+	    optionName, value);
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformGetOptionProc --
+ * TransformGetOptionProc --
  *
- *	Called by generic layer to handle requests for
- *	the values of channel specific options. As this
- *	channel type does not have such, it simply passes
- *	all requests downstream.
+ *	Called by generic layer to handle requests for the values of channel
+ *	specific options. As this channel type does not have such, it simply
+ *	passes all requests downstream.
  *
- *	Sideeffects:
- *		As defined by the channel downstream.
+ * Side effects:
+ *	As defined by the channel downstream.
  *
- *	Result:
- *		A standard TCL error code.
+ * Result:
+ *	A standard TCL error code.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
-    ClientData   instanceData;
-    Tcl_Interp*  interp;
-    CONST char*        optionName;
-    Tcl_DString* dsPtr;
+TransformGetOptionProc(
+    ClientData instanceData,
+    Tcl_Interp *interp,
+    const char *optionName,
+    Tcl_DString *dsPtr)
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    TransformChannelData *dataPtr = instanceData;
     Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
     Tcl_DriverGetOptionProc *getOptionProc;
 
     getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
     if (getOptionProc != NULL) {
-	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
-		interp, optionName, dsPtr);
-    } else if (optionName == (CONST char*) NULL) {
+	return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
+		optionName, dsPtr);
+    } else if (optionName == NULL) {
 	/*
 	 * Request is query for all options, this is ok.
 	 */
+
 	return TCL_OK;
     }
+
     /*
-     * Request for a specific option has to fail, we don't have any.
+     * Request for a specific option has to fail, since we don't have any.
      */
+
     return TCL_ERROR;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformWatchProc --
+ * TransformWatchProc --
  *
- *	Initialize the notifier to watch for events from
- *	this channel.
+ *	Initialize the notifier to watch for events from this channel.
  *
- *	Sideeffects:
- *		Sets up the notifier so that a future
- *		event on the channel will be seen by Tcl.
+ * Side effects:
+ *	Sets up the notifier so that a future event on the channel will be
+ *	seen by Tcl.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
+
 	/* ARGSUSED */
 static void
-TransformWatchProc (instanceData, mask)
-    ClientData instanceData;	/* Channel to watch */
-    int        mask;		/* Events of interest */
+TransformWatchProc(
+    ClientData instanceData,	/* Channel to watch. */
+    int mask)			/* Events of interest. */
 {
-    /* The caller expressed interest in events occuring for this
-     * channel. We are forwarding the call to the underlying
-     * channel now.
-     */
+    TransformChannelData *dataPtr = instanceData;
+    Tcl_Channel downChan;
 
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
-    Tcl_Channel     downChan;
+    /*
+     * The caller expressed interest in events occuring for this channel. We
+     * are forwarding the call to the underlying channel now.
+     */
 
     dataPtr->watchMask = mask;
 
-    /* No channel handlers any more. We will be notified automatically
-     * about events on the channel below via a call to our
-     * 'TransformNotifyProc'. But we have to pass the interest down now.
-     * We are allowed to add additional 'interest' to the mask if we want
-     * to. But this transformation has no such interest. It just passes
-     * the request down, unchanged.
+    /*
+     * No channel handlers any more. We will be notified automatically about
+     * events on the channel below via a call to our 'TransformNotifyProc'.
+     * But we have to pass the interest down now. We are allowed to add
+     * additional 'interest' to the mask if we want to. But this
+     * transformation has no such interest. It just passes the request down,
+     * unchanged.
      */
 
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
-    (Tcl_GetChannelType(downChan))
-	->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
+    Tcl_GetChannelType(downChan)->watchProc(
+	    Tcl_GetChannelInstanceData(downChan), mask);
 
     /*
      * Management of the internal timer.
      */
 
-    if ((dataPtr->timer != (Tcl_TimerToken) NULL) &&
-	    (!(mask & TCL_READABLE) || (ResultLength(&dataPtr->result) == 0))) {
-
-        /* A pending timer exists, but either is there no (more)
-	 * interest in the events it generates or nothing is availablee
-	 * for reading, so remove it.
+    if ((dataPtr->timer != NULL) &&
+	    (!(mask & TCL_READABLE) || ResultEmpty(&dataPtr->result))) {
+	/*
+	 * A pending timer exists, but either is there no (more) interest in
+	 * the events it generates or nothing is available for reading, so
+	 * remove it.
 	 */
 
-        Tcl_DeleteTimerHandler (dataPtr->timer);
-	dataPtr->timer = (Tcl_TimerToken) NULL;
+	Tcl_DeleteTimerHandler(dataPtr->timer);
+	dataPtr->timer = NULL;
     }
 
-    if ((dataPtr->timer == (Tcl_TimerToken) NULL) &&
-	    (mask & TCL_READABLE) && (ResultLength (&dataPtr->result) > 0)) {
-
-        /* There is no pending timer, but there is interest in readable
-	 * events and we actually have data waiting, so generate a timer
-	 * to flush that.
+    if ((dataPtr->timer == NULL) && (mask & TCL_READABLE)
+	    && !ResultEmpty(&dataPtr->result)) {
+	/*
+	 * There is no pending timer, but there is interest in readable events
+	 * and we actually have data waiting, so generate a timer to flush
+	 * that.
 	 */
 
-	dataPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY,
-		TransformChannelHandlerTimer, (ClientData) dataPtr);
+	dataPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY,
+		TransformChannelHandlerTimer, dataPtr);
     }
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformGetFileHandleProc --
+ * TransformGetFileHandleProc --
  *
- *	Called from Tcl_GetChannelHandle to retrieve
- *	OS specific file handle from inside this channel.
+ *	Called from Tcl_GetChannelHandle to retrieve OS specific file handle
+ *	from inside this channel.
  *
- *	Sideeffects:
- *		None.
+ * Side effects:
+ *	None.
  *
- *	Result:
- *		The appropriate Tcl_File or NULL if not
- *		present. 
+ * Result:
+ *	The appropriate Tcl_File or NULL if not present.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
+
 static int
-TransformGetFileHandleProc (instanceData, direction, handlePtr)
-    ClientData  instanceData;	/* Channel to query */
-    int         direction;	/* Direction of interest */
-    ClientData* handlePtr;	/* Place to store the handle into */
+TransformGetFileHandleProc(
+    ClientData instanceData,	/* Channel to query. */
+    int direction,		/* Direction of interest. */
+    ClientData *handlePtr)	/* Place to store the handle into. */
 {
+    TransformChannelData *dataPtr = instanceData;
+
     /*
-     * Return the handle belonging to parent channel.
-     * IOW, pass the request down and the result up.
+     * Return the handle belonging to parent channel. IOW, pass the request
+     * down and the result up.
      */
 
-    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
-
     return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
 	    direction, handlePtr);
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformNotifyProc --
+ * TransformNotifyProc --
  *
- *	------------------------------------------------*
- *	Handler called by Tcl to inform us of activity
- *	on the underlying channel.
- *	------------------------------------------------*
+ *	Handler called by Tcl to inform us of activity on the underlying
+ *	channel.
  *
- *	Sideeffects:
- *		May process the incoming event by itself.
+ * Side effects:
+ *	May process the incoming event by itself.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static int
-TransformNotifyProc (clientData, mask)
-    ClientData	   clientData; /* The state of the notified transformation */
-    int		   mask;       /* The mask of occuring events */
+TransformNotifyProc(
+    ClientData clientData,	/* The state of the notified
+				 * transformation. */
+    int mask)			/* The mask of occuring events. */
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+    TransformChannelData *dataPtr = clientData;
 
     /*
-     * An event occured in the underlying channel.  This
-     * transformation doesn't process such events thus returns the
-     * incoming mask unchanged.
+     * An event occured in the underlying channel. This transformation doesn't
+     * process such events thus returns the incoming mask unchanged.
      */
 
-    if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+    if (dataPtr->timer != NULL) {
 	/*
-	 * Delete an existing timer. It was not fired, yet we are
-	 * here, so the channel below generated such an event and we
-	 * don't have to. The renewal of the interest after the
-	 * execution of channel handlers will eventually cause us to
-	 * recreate the timer (in TransformWatchProc).
+	 * Delete an existing timer. It was not fired, yet we are here, so the
+	 * channel below generated such an event and we don't have to. The
+	 * renewal of the interest after the execution of channel handlers
+	 * will eventually cause us to recreate the timer (in
+	 * TransformWatchProc).
 	 */
 
-	Tcl_DeleteTimerHandler (dataPtr->timer);
-	dataPtr->timer = (Tcl_TimerToken) NULL;
+	Tcl_DeleteTimerHandler(dataPtr->timer);
+	dataPtr->timer = NULL;
     }
-
     return mask;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	TransformChannelHandlerTimer --
+ * TransformChannelHandlerTimer --
  *
- *	Called by the notifier (-> timer) to flush out
- *	information waiting in the input buffer.
+ *	Called by the notifier (-> timer) to flush out information waiting in
+ *	the input buffer.
  *
- *	Sideeffects:
- *		As of 'Tcl_NotifyChannel'.
+ * Side effects:
+ *	As of 'Tcl_NotifyChannel'.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
 static void
-TransformChannelHandlerTimer (clientData)
-    ClientData clientData; /* Transformation to query */
+TransformChannelHandlerTimer(
+    ClientData clientData)	/* Transformation to query. */
 {
-    TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+    TransformChannelData *dataPtr = clientData;
 
-    dataPtr->timer = (Tcl_TimerToken) NULL;
-
-    if (!(dataPtr->watchMask & TCL_READABLE) ||
-	    (ResultLength (&dataPtr->result) == 0)) {
-	/* The timer fired, but either is there no (more)
-	 * interest in the events it generates or nothing is available
-	 * for reading, so ignore it and don't recreate it.
+    dataPtr->timer = NULL;
+    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
+	/*
+	 * The timer fired, but either is there no (more) interest in the
+	 * events it generates or nothing is available for reading, so ignore
+	 * it and don't recreate it.
 	 */
 
 	return;
     }
-
     Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ResultClear --
+ * ResultClear --
  *
  *	Deallocates any memory allocated by 'ResultAdd'.
  *
- *	Sideeffects:
- *		See above.
+ * Side effects:
+ *	See above.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
-static void
-ResultClear (r)
-    ResultBuffer* r; /* Reference to the buffer to clear out */
+static inline void
+ResultClear(
+    ResultBuffer *r)		/* Reference to the buffer to clear out. */
 {
     r->used = 0;
 
     if (r->allocated) {
-        ckfree((char*) r->buf);
-	r->buf       = UCHARP (NULL);
+	ckfree((char *) r->buf);
+	r->buf = NULL;
 	r->allocated = 0;
     }
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ResultInit --
+ * ResultInit --
  *
- *	Initializes the specified buffer structure. The
- *	structure will contain valid information for an
- *	emtpy buffer.
+ *	Initializes the specified buffer structure. The structure will contain
+ *	valid information for an emtpy buffer.
  *
- *	Sideeffects:
- *		See above.
+ * Side effects:
+ *	See above.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
-static void
-ResultInit (r)
-    ResultBuffer* r; /* Reference to the structure to initialize */
+static inline void
+ResultInit(
+    ResultBuffer *r)		/* Reference to the structure to
+				 * initialize. */
 {
-    r->used      = 0;
+    r->used = 0;
     r->allocated = 0;
-    r->buf       = UCHARP (NULL);
+    r->buf = NULL;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ResultLength --
+ * ResultEmpty --
  *
- *	Returns the number of bytes stored in the buffer.
+ *	Returns whether the number of bytes stored in the buffer is zero.
  *
- *	Sideeffects:
- *		None.
+ * Side effects:
+ *	None.
  *
- *	Result:
- *		An integer, see above too.
+ * Result:
+ *	A boolean.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
-static int
-ResultLength (r)
-    ResultBuffer* r; /* The structure to query */
+static inline int
+ResultEmpty(
+    ResultBuffer *r)		/* The structure to query. */
 {
-    return r->used;
+    return r->used == 0;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ResultCopy --
+ * ResultCopy --
  *
- *	Copies the requested number of bytes from the
- *	buffer into the specified array and removes them
- *	from the buffer afterward. Copies less if there
- *	is not enough data in the buffer.
+ *	Copies the requested number of bytes from the buffer into the
+ *	specified array and removes them from the buffer afterward. Copies
+ *	less if there is not enough data in the buffer.
  *
- *	Sideeffects:
- *		See above.
+ * Side effects:
+ *	See above.
  *
- *	Result:
- *		The number of actually copied bytes,
- *		possibly less than 'toRead'.
+ * Result:
+ *	The number of actually copied bytes, possibly less than 'toRead'.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
-static int
-ResultCopy (r, buf, toRead)
-    ResultBuffer*  r;      /* The buffer to read from */
-    unsigned char* buf;    /* The buffer to copy into */
-    int		   toRead; /* Number of requested bytes */
+static inline int
+ResultCopy(
+    ResultBuffer *r,		/* The buffer to read from. */
+    unsigned char *buf,		/* The buffer to copy into. */
+    size_t toRead)		/* Number of requested bytes. */
 {
     if (r->used == 0) {
-        /* Nothing to copy in the case of an empty buffer.
+	/*
+	 * Nothing to copy in the case of an empty buffer.
 	 */
 
-        return 0;
-    }
-
-    if (r->used == toRead) {
-        /* We have just enough. Copy everything to the caller.
+	return 0;
+    } else if (r->used == toRead) {
+	/*
+	 * We have just enough. Copy everything to the caller.
 	 */
 
-        memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
+	memcpy(buf, r->buf, toRead);
 	r->used = 0;
-	return toRead;
-    }
-
-    if (r->used > toRead) {
-        /* The internal buffer contains more than requested.
-	 * Copy the requested subset to the caller, and shift
-	 * the remaining bytes down.
+    } else if (r->used > toRead) {
+	/*
+	 * The internal buffer contains more than requested. Copy the
+	 * requested subset to the caller, and shift the remaining bytes down.
 	 */
 
-        memcpy  ((VOID*) buf,    (VOID*) r->buf,            (size_t) toRead);
-	memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead),
-		(size_t) r->used - toRead);
-
+	memcpy(buf, r->buf, toRead);
+	memmove(r->buf, r->buf + toRead, r->used - toRead);
 	r->used -= toRead;
-	return toRead;
-    }
-
-    /* There is not enough in the buffer to satisfy the caller, so
-     * take everything.
-     */
+    } else {
+	/*
+	 * There is not enough in the buffer to satisfy the caller, so take
+	 * everything.
+	 */
 
-    memcpy((VOID*) buf, (VOID*) r->buf, (size_t) r->used);
-    toRead  = r->used;
-    r->used = 0;
+	memcpy(buf, r->buf, r->used);
+	toRead = r->used;
+	r->used = 0;
+    }
     return toRead;
 }
 
 /*
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  *
- *	ResultAdd --
+ * ResultAdd --
  *
- *	Adds the bytes in the specified array to the
- *	buffer, by appending it.
+ *	Adds the bytes in the specified array to the buffer, by appending it.
  *
- *	Sideeffects:
- *		See above.
+ * Side effects:
+ *	See above.
  *
- *	Result:
- *		None.
+ * Result:
+ *	None.
  *
- *------------------------------------------------------*
+ *----------------------------------------------------------------------
  */
 
-static void
-ResultAdd (r, buf, toWrite)
-    ResultBuffer*  r;       /* The buffer to extend */
-    unsigned char* buf;     /* The buffer to read from */
-    int		   toWrite; /* The number of bytes in 'buf' */
+static inline void
+ResultAdd(
+    ResultBuffer *r,		/* The buffer to extend. */
+    unsigned char *buf,		/* The buffer to read from. */
+    size_t toWrite)		/* The number of bytes in 'buf'. */
 {
-    if ((r->used + toWrite) > r->allocated) {
-        /* Extension of the internal buffer is required.
+    if (r->used + toWrite > r->allocated) {
+	/*
+	 * Extension of the internal buffer is required.
 	 */
 
-        if (r->allocated == 0) {
+	if (r->allocated == 0) {
 	    r->allocated = toWrite + INCREMENT;
-	    r->buf       = UCHARP (ckalloc((unsigned) r->allocated));
+	    r->buf = UCHARP(ckalloc(r->allocated));
 	} else {
 	    r->allocated += toWrite + INCREMENT;
-	    r->buf        = UCHARP (ckrealloc((char*) r->buf,
-		    (unsigned) r->allocated));
+	    r->buf = UCHARP(ckrealloc((char *) r->buf, r->allocated));
 	}
     }
 
-    /* now copy data */
-    memcpy(r->buf + r->used, buf, (size_t) toWrite);
+    /*
+     * Now we may copy the data.
+     */
+
+    memcpy(r->buf + r->used, buf, toWrite);
     r->used += toWrite;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
new file mode 100644
index 0000000..ca3ab4b
--- /dev/null
+++ b/generic/tclIORChan.c
@@ -0,0 +1,3187 @@
+/*
+ * tclIORChan.c --
+ *
+ *	This file contains the implementation of Tcl's generic channel
+ *	reflection code, which allows the implementation of Tcl channels in
+ *	Tcl code.
+ *
+ *	Parts of this file are based on code contributed by Jean-Claude
+ *	Wippler.
+ *
+ *	See TIP #219 for the specification of this functionality.
+ *
+ * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include <tclInt.h>
+#include <tclIO.h>
+#include <assert.h>
+
+#ifndef EINVAL
+#define EINVAL	9
+#endif
+#ifndef EOK
+#define EOK	0
+#endif
+
+/*
+ * Signatures of all functions used in the C layer of the reflection.
+ */
+
+static int		ReflectClose(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		ReflectInput(ClientData clientData, char *buf,
+			    int toRead, int *errorCodePtr);
+static int		ReflectOutput(ClientData clientData, const char *buf,
+			    int toWrite, int *errorCodePtr);
+static void		ReflectWatch(ClientData clientData, int mask);
+static int		ReflectBlock(ClientData clientData, int mode);
+static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
+			    Tcl_WideInt offset, int mode, int *errorCodePtr);
+static int		ReflectSeek(ClientData clientData, long offset,
+			    int mode, int *errorCodePtr);
+static int		ReflectGetOption(ClientData clientData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
+static int		ReflectSetOption(ClientData clientData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *newValue);
+
+/*
+ * The C layer channel type/driver definition used by the reflection. This is
+ * a version 3 structure.
+ */
+
+static Tcl_ChannelType tclRChannelType = {
+    "tclrchannel",         /* Type name.                                  */
+    TCL_CHANNEL_VERSION_5, /* v5 channel */
+    ReflectClose,          /* Close channel, clean instance data          */
+    ReflectInput,          /* Handle read request                         */
+    ReflectOutput,         /* Handle write request                        */
+    ReflectSeek,           /* Move location of access point.   NULL'able  */
+    ReflectSetOption,      /* Set options.                     NULL'able  */
+    ReflectGetOption,      /* Get options.                     NULL'able  */
+    ReflectWatch,          /* Initialize notifier                         */
+    NULL,                  /* Get OS handle from the channel.  NULL'able  */
+    NULL,                  /* No close2 support.               NULL'able  */
+    ReflectBlock,          /* Set blocking/nonblocking.        NULL'able  */
+    NULL,                  /* Flush channel. Not used by core. NULL'able  */
+    NULL,                  /* Handle events.                   NULL'able  */
+    ReflectSeekWide,       /* Move access point (64 bit).      NULL'able  */
+    NULL,                  /* thread action */
+    NULL,                  /* truncate */
+};
+
+/*
+ * Instance data for a reflected channel. ===========================
+ */
+
+typedef struct {
+    Tcl_Channel chan;		/* Back reference to generic channel
+				 * structure. */
+    Tcl_Interp *interp;		/* Reference to the interpreter containing the
+				 * Tcl level part of the channel. NULL here
+				 * signals the channel is dead because the
+				 * interpreter/thread containing its Tcl
+				 * command is gone.
+				 */
+#ifdef TCL_THREADS
+    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
+#endif
+
+    /* See [==] as well.
+     * Storage for the command prefix and the additional words required for
+     * the invocation of methods in the command handler.
+     *
+     * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
+     *      cmd ... pfx | method   chan     | detail1 detail2
+     *      ~~~~ CT ~~~            ~~ CT ~~
+     *
+     * CT = Belongs to the 'Command handler Thread'.
+     */
+
+    int argc;			/* Number of preallocated words - 2 */
+    Tcl_Obj **argv;		/* Preallocated array for calling the handler.
+				 * args[0] is placeholder for cmd word.
+				 * Followed by the arguments in the prefix,
+				 * plus 4 placeholders for method, channel,
+				 * and at most two varying (method specific)
+				 * words. */
+    int methods;		/* Bitmask of supported methods */
+
+    /*
+     * NOTE (9): Should we have predefined shared literals for the method
+     * names?
+     */
+
+    int mode;			/* Mask of R/W mode */
+    int interest;		/* Mask of events the channel is interested
+				 * in. */
+
+    /*
+     * Note regarding the usage of timers.
+     *
+     * Most channel implementations need a timer in the C level to ensure that
+     * data in buffers is flushed out through the generation of fake file
+     * events.
+     *
+     * See 'rechan', 'memchan', etc.
+     *
+     * Here this is _not_ required. Interest in events is posted to the Tcl
+     * level via 'watch'. And posting of events is possible from the Tcl level
+     * as well, via 'chan postevent'. This means that the generation of all
+     * events, fake or not, timer based or not, is completely in the hands of
+     * the Tcl level. Therefore no timer here.
+     */
+} ReflectedChannel;
+
+/*
+ * Structure of the table maping from channel handles to reflected
+ * channels. Each interpreter which has the handler command for one or more
+ * reflected channels records them in such a table, so that 'chan postevent'
+ * is able to find them even if the actual channel was moved to a different
+ * interpreter and/or thread.
+ *
+ * The table is reachable via the standard interpreter AssocData, the key is
+ * defined below.
+ */
+
+typedef struct {
+    Tcl_HashTable map;
+} ReflectedChannelMap;
+
+#define RCMKEY "ReflectedChannelMap"
+
+/*
+ * Event literals. ==================================================
+ */
+
+static const char *eventOptions[] = {
+    "read", "write", NULL
+};
+typedef enum {
+    EVENT_READ, EVENT_WRITE
+} EventOption;
+
+/*
+ * Method literals. ==================================================
+ */
+
+static const char *methodNames[] = {
+    "blocking",		/* OPT */
+    "cget",		/* OPT \/ Together or none */
+    "cgetall",		/* OPT /\ of these two     */
+    "configure",	/* OPT */
+    "finalize",		/*     */
+    "initialize",	/*     */
+    "read",		/* OPT */
+    "seek",		/* OPT */
+    "watch",		/*     */
+    "write",		/* OPT */
+    NULL
+};
+typedef enum {
+    METH_BLOCKING,
+    METH_CGET,
+    METH_CGETALL,
+    METH_CONFIGURE,
+    METH_FINAL,
+    METH_INIT,
+    METH_READ,
+    METH_SEEK,
+    METH_WATCH,
+    METH_WRITE
+} MethodName;
+
+#define FLAG(m) (1 << (m))
+#define REQUIRED_METHODS \
+	(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
+#define NULLABLE_METHODS \
+	(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
+	FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
+
+#define RANDW \
+	(TCL_READABLE | TCL_WRITABLE)
+
+#define IMPLIES(a,b)	((!(a)) || (b))
+#define NEGIMPL(a,b)
+#define HAS(x,f)	(x & FLAG(f))
+
+#ifdef TCL_THREADS
+/*
+ * Thread specific types and structures.
+ *
+ * We are here essentially creating a very specific implementation of 'thread
+ * send'.
+ */
+
+/*
+ * Enumeration of all operations which can be forwarded.
+ */
+
+typedef enum {
+    ForwardedClose,
+    ForwardedInput,
+    ForwardedOutput,
+    ForwardedSeek,
+    ForwardedWatch,
+    ForwardedBlock,
+    ForwardedSetOpt,
+    ForwardedGetOpt,
+    ForwardedGetOptAll
+} ForwardedOperation;
+
+/*
+ * Event used to forward driver invocations to the thread actually managing
+ * the channel. We cannot construct the command to execute and forward that.
+ * Because then it will contain a mixture of Tcl_Obj's belonging to both the
+ * command handler thread (CT), and the thread managing the channel (MT),
+ * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
+ * forward an operation code, the argument details, and reference to results.
+ * The command is assembled in the CT and belongs fully to that thread. No
+ * sharing problems.
+ */
+
+typedef struct ForwardParamBase {
+    int code;			/* O: Ok/Fail of the cmd handler */
+    char *msgStr;		/* O: Error message for handler failure */
+    int mustFree;		/* O: True if msgStr is allocated, false if
+				 * otherwise (static). */
+} ForwardParamBase;
+
+/*
+ * Operation specific parameter/result structures. (These are "subtypes" of
+ * ForwardParamBase. Where an operation does not need any special types, it
+ * has no "subtype" and just uses ForwardParamBase, as listed above.)
+ */
+
+struct ForwardParamInput {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    char *buf;			/* O: Where to store the read bytes */
+    int toRead;			/* I: #bytes to read,
+				 * O: #bytes actually read */
+};
+struct ForwardParamOutput {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    const char *buf;		/* I: Where the bytes to write come from */
+    int toWrite;		/* I: #bytes to write,
+				 * O: #bytes actually written */
+};
+struct ForwardParamSeek {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    int seekMode;		/* I: How to seek */
+    Tcl_WideInt offset;		/* I: Where to seek,
+				 * O: New location */
+};
+struct ForwardParamWatch {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    int mask;			/* I: What events to watch for */
+};
+struct ForwardParamBlock {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    int nonblocking;		/* I: What mode to activate */
+};
+struct ForwardParamSetOpt {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    const char *name;		/* Name of option to set */
+    const char *value;		/* Value to set */
+};
+struct ForwardParamGetOpt {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    const char *name;		/* Name of option to get, maybe NULL */
+    Tcl_DString *value;		/* Result */
+};
+
+/*
+ * Now join all these together in a single union for convenience.
+ */
+
+typedef union ForwardParam {
+    ForwardParamBase base;
+    struct ForwardParamInput input;
+    struct ForwardParamOutput output;
+    struct ForwardParamSeek seek;
+    struct ForwardParamWatch watch;
+    struct ForwardParamBlock block;
+    struct ForwardParamSetOpt setOpt;
+    struct ForwardParamGetOpt getOpt;
+} ForwardParam;
+
+/*
+ * Forward declaration.
+ */
+
+typedef struct ForwardingResult ForwardingResult;
+
+/*
+ * General event structure, with reference to operation specific data.
+ */
+
+typedef struct ForwardingEvent {
+    Tcl_Event event;		/* Basic event data, has to be first item */
+    ForwardingResult *resultPtr;
+    ForwardedOperation op;	/* Forwarded driver operation */
+    ReflectedChannel *rcPtr;	/* Channel instance */
+    ForwardParam *param;	/* Packaged arguments and return values, a
+				 * ForwardParam pointer. */
+} ForwardingEvent;
+
+/*
+ * Structure to manage the result of the forwarding. This is not the result of
+ * the operation itself, but about the success of the forward event itself.
+ * The event can be successful, even if the operation which was forwarded
+ * failed. It is also there to manage the synchronization between the involved
+ * threads.
+ */
+
+struct ForwardingResult {
+    Tcl_ThreadId src;		/* Originating thread. */
+    Tcl_ThreadId dst;		/* Thread the op was forwarded to. */
+    Tcl_Interp*  dsti;          /* Interpreter in the thread the op was forwarded to. */
+    /*
+     * Note regarding 'dsti' above: Its information is also available via the
+     * chain evPtr->rcPtr->interp, however, as can be seen, two more
+     * indirections are needed to retrieve it. And the evPtr may be gone,
+     * breaking the chain.
+     */
+    Tcl_Condition done;		/* Condition variable the forwarder blocks
+				 * on. */
+    int result;			/* TCL_OK or TCL_ERROR */
+    ForwardingEvent *evPtr;	/* Event the result belongs to. */
+    ForwardingResult *prevPtr, *nextPtr;
+				/* Links into the list of pending forwarded
+				 * results. */
+};
+
+typedef struct ThreadSpecificData {
+    /*
+     * Table of all reflected channels owned by this thread. This is the
+     * per-thread version of the per-interpreter map.
+     */
+
+    ReflectedChannelMap* rcmPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * List of forwarded operations which have not completed yet, plus the mutex
+ * to protect the access to this process global list.
+ */
+
+static ForwardingResult *forwardList = NULL;
+TCL_DECLARE_MUTEX(rcForwardMutex)
+
+/*
+ * Function containing the generic code executing a forward, and wrapper
+ * macros for the actual operations we wish to forward. Uses ForwardProc as
+ * the event function executed by the thread receiving a forwarding event
+ * (which executes the appropriate function and collects the result, if any).
+ *
+ * The ExitProc ensures that things do not deadlock when the sending thread
+ * involved in the forwarding exits. It also clean things up so that we don't
+ * leak resources when threads go away.
+ */
+
+static void		ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
+			    ForwardedOperation op, const VOID *param);
+static int		ForwardProc(Tcl_Event *evPtr, int mask);
+static void		SrcExitProc(ClientData clientData);
+
+#define FreeReceivedError(p) \
+	if ((p)->base.mustFree) { \
+	    ckfree((p)->base.msgStr); \
+	}
+#define PassReceivedErrorInterp(i,p) \
+	if ((i) != NULL) { \
+	    Tcl_SetChannelErrorInterp((i), \
+		    Tcl_NewStringObj((p)->base.msgStr, -1)); \
+	} \
+	FreeReceivedError(p)
+#define PassReceivedError(c,p) \
+	Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
+	FreeReceivedError(p)
+#define ForwardSetStaticError(p,emsg) \
+	(p)->base.code = TCL_ERROR; \
+	(p)->base.mustFree = 0; \
+	(p)->base.msgStr = (char *) (emsg)
+#define ForwardSetDynamicError(p,emsg) \
+	(p)->base.code = TCL_ERROR; \
+	(p)->base.mustFree = 1; \
+	(p)->base.msgStr = (char *) (emsg)
+
+static void		ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
+
+static ReflectedChannelMap *	GetThreadReflectedChannelMap(void);
+static void		DeleteThreadReflectedChannelMap(ClientData clientData);
+
+#endif /* TCL_THREADS */
+
+#define SetChannelErrorStr(c,msgStr) \
+	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
+
+static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
+static void		UnmarshallErrorResult(Tcl_Interp *interp,
+			    Tcl_Obj *msgObj);
+
+/*
+ * Static functions for this file:
+ */
+
+static int		EncodeEventMask(Tcl_Interp *interp,
+			    const char *objName, Tcl_Obj *obj, int *mask);
+static Tcl_Obj *	DecodeEventMask(int mask);
+static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
+			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
+static Tcl_Obj *	NextHandle(void);
+static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
+static int		InvokeTclMethod(ReflectedChannel *rcPtr,
+			    const char *method, Tcl_Obj *argOneObj,
+			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
+
+static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
+static void		DeleteReflectedChannelMap(ClientData clientData,
+			    Tcl_Interp *interp);
+static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
+
+/*
+ * Global constant strings (messages). ==================
+ * These string are used directly as bypass errors, thus they have to be valid
+ * Tcl lists where the last element is the message itself. Hence the
+ * list-quoting to keep the words of the message together. See also [x].
+ */
+
+static const char *msg_read_unsup = "{read not supported by Tcl driver}";
+static const char *msg_read_toomuch = "{read delivered more than requested}";
+static const char *msg_write_unsup = "{write not supported by Tcl driver}";
+static const char *msg_write_toomuch = "{write wrote more than requested}";
+static const char *msg_write_nothing = "{write wrote nothing}";
+static const char *msg_seek_beforestart = "{Tried to seek before origin}";
+#ifdef TCL_THREADS
+static const char *msg_send_originlost = "{Channel thread lost}";
+static const char *msg_send_dstlost    = "{Owner lost}";
+#endif /* TCL_THREADS */
+static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
+
+/*
+ * Main methods to plug into the 'chan' ensemble'. ==================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanCreateObjCmd --
+ *
+ *	This function is invoked to process the "chan create" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result. The handle of the new channel is placed in the
+ *	interp result.
+ *
+ * Side effects:
+ *	Creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanCreateObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    ReflectedChannel *rcPtr;	/* Instance data of the new channel */
+    Tcl_Obj *rcId;		/* Handle of the new channel */
+    int mode;			/* R/W mode of new channel. Has to match
+				 * abilities of handler commands */
+    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
+    Tcl_Obj *cmdNameObj;	/* Command name */
+    Tcl_Channel chan;		/* Token for the new channel */
+    Tcl_Obj *modeObj;		/* mode in obj form for method call */
+    int listc;			/* Result of 'initialize', and of */
+    Tcl_Obj **listv;		/* its sublist in the 2nd element */
+    int methIndex;		/* Encoded method name */
+    int result;			/* Result code for 'initialize' */
+    Tcl_Obj *resObj;		/* Result data for 'initialize' */
+    int methods;		/* Bitmask for supported methods. */
+    Channel *chanPtr;		/* 'chan' resolved to internal struct. */
+    Tcl_Obj *err;		/* Error message */
+    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
+    Tcl_HashEntry* hPtr;         /* Entry in the above map */
+    int isNew;                   /* Placeholder. */
+
+    /*
+     * Syntax:   chan create MODE CMDPREFIX
+     *           [0]  [1]    [2]  [3]
+     *
+     * Actually: rCreate MODE CMDPREFIX
+     *           [0]     [1]  [2]
+     */
+
+#define MODE	(1)
+#define CMD	(2)
+
+    /*
+     * Number of arguments...
+     */
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
+	return TCL_ERROR;
+    }
+
+    /*
+     * First argument is a list of modes. Allowed entries are "read", "write".
+     * Expect at least one list element. Abbreviations are ok.
+     */
+
+    modeObj = objv[MODE];
+    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Second argument is command prefix, i.e. list of words, first word is
+     * name of handler command, other words are fixed arguments. Run the
+     * 'initialize' method to get the list of supported methods. Validate
+     * this.
+     */
+
+    cmdObj = objv[CMD];
+
+    /*
+     * Basic check that the command prefix truly is a list.
+     */
+
+    if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now create the channel.
+     */
+
+    rcId = NextHandle();
+    rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
+    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+	    mode);
+    rcPtr->chan = chan;
+    chanPtr = (Channel *) chan;
+
+    /*
+     * Invoke 'initialize' and validate that the handler is present and ok.
+     * Squash the channel if not.
+     *
+     * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
+     * 'initialize' is invoked with canonical mode names, and no
+     * abbreviations. Using modeObj directly could feed abbreviations into the
+     * handler, and the handler is not specified to handle such.
+     */
+
+    modeObj = DecodeEventMask(mode);
+    /* assert modeObj.refCount == 1 */
+    result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+    Tcl_DecrRefCount(modeObj);
+    if (result != TCL_OK) {
+	UnmarshallErrorResult(interp, resObj);
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	goto error;
+    }
+
+    /*
+     * Verify the result.
+     * - List, of method names. Convert to mask.
+     *   Check for non-optionals through the mask.
+     *   Compare open mode against optional r/w.
+     */
+
+    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
+	Tcl_AppendObjToObj(err, resObj);
+	Tcl_SetObjResult(interp, err);
+	Tcl_DecrRefCount(resObj);
+	goto error;
+    }
+
+    methods = 0;
+    while (listc > 0) {
+	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
+		"method", TCL_EXACT, &methIndex) != TCL_OK) {
+	    TclNewLiteralStringObj(err, "chan handler \"");
+	    Tcl_AppendObjToObj(err, cmdObj);
+	    Tcl_AppendToObj(err, " initialize\" returned ", -1);
+	    Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
+	    Tcl_SetObjResult(interp, err);
+	    Tcl_DecrRefCount(resObj);
+	    goto error;
+	}
+
+	methods |= FLAG(methIndex);
+	listc--;
+    }
+    Tcl_DecrRefCount(resObj);
+
+    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" does not support all required methods", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * Everything is fine now.
+     */
+
+    rcPtr->methods = methods;
+
+    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
+	/*
+	 * Some of the nullable methods are not supported. We clone the
+	 * channel type, null the associated C functions, and use the result
+	 * as the actual channel type.
+	 */
+
+	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
+		ckalloc(sizeof(Tcl_ChannelType));
+
+	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
+
+	if (!(methods & FLAG(METH_CONFIGURE))) {
+	    clonePtr->setOptionProc = NULL;
+	}
+
+	if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) {
+	    clonePtr->getOptionProc = NULL;
+	}
+	if (!(methods & FLAG(METH_BLOCKING))) {
+	    clonePtr->blockModeProc = NULL;
+	}
+	if (!(methods & FLAG(METH_SEEK))) {
+	    clonePtr->seekProc = NULL;
+	    clonePtr->wideSeekProc = NULL;
+	}
+
+	chanPtr->typePtr = clonePtr;
+    }
+
+    /*
+     * Register the channel in the I/O system, and in our our map for 'chan
+     * postevent'.
+     */
+
+    Tcl_RegisterChannel(interp, chan);
+
+    rcmPtr = GetReflectedChannelMap (interp);
+    hPtr   = Tcl_CreateHashEntry(&rcmPtr->map,
+				 chanPtr->state->channelName, &isNew);
+    if (!isNew) {
+	if (chanPtr != Tcl_GetHashValue(hPtr)) {
+	    Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
+	}
+    }
+    Tcl_SetHashValue(hPtr, chan);
+#ifdef TCL_THREADS
+    rcmPtr = GetThreadReflectedChannelMap();
+    hPtr   = Tcl_CreateHashEntry(&rcmPtr->map,
+				 chanPtr->state->channelName, &isNew);
+    Tcl_SetHashValue(hPtr, chan);
+#endif
+
+    /*
+     * Return handle as result of command.
+     */
+
+    Tcl_SetObjResult(interp, rcId);
+    return TCL_OK;
+
+ error:
+    /*
+     * Signal to ReflectClose to not call 'finalize'.
+     */
+
+    rcPtr->methods = 0;
+    Tcl_Close(interp, chan);
+    return TCL_ERROR;
+
+#undef MODE
+#undef CMD
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPostEventObjCmd --
+ *
+ *	This function is invoked to process the "chan postevent" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Posts events to a reflected channel, invokes event handlers. The
+ *	latter implies that arbitrary side effects are possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPostEventObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    /*
+     * Syntax:   chan postevent CHANNEL EVENTSPEC
+     *           [0]  [1]       [2]     [3]
+     *
+     * Actually: rPostevent CHANNEL EVENTSPEC
+     *           [0]        [1]     [2]
+     *
+     * where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
+     */
+
+#define CHAN	(1)
+#define EVENT	(2)
+
+    const char *chanId;		/* Tcl level channel handle */
+    Tcl_Channel chan;		/* Channel associated to the handle */
+    const Tcl_ChannelType *chanTypePtr;
+				/* Its associated driver structure */
+    ReflectedChannel *rcPtr;	/* Associated instance data */
+    int events;			/* Mask of events to post */
+    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
+    Tcl_HashEntry* hPtr;         /* Entry in the above map */
+
+    /*
+     * Number of arguments...
+     */
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
+	return TCL_ERROR;
+    }
+
+    /*
+     * First argument is a channel, a reflected channel, and the call of this
+     * command is done from the interp defining the channel handler cmd.
+     */
+
+    chanId = TclGetString(objv[CHAN]);
+
+    rcmPtr = GetReflectedChannelMap (interp);
+    hPtr = Tcl_FindHashEntry (&rcmPtr->map, chanId);
+
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "can not find reflected channel named \"", chanId,
+		"\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Note that the search above subsumes several of the older checks, namely:
+     *
+     * (1) Does the channel handle refer to a reflected channel ?
+     * (2) Is the post event issued from the interpreter holding the handler
+     *     of the reflected channel ?
+     *
+     * A successful search answers yes to both. Because the map holds only
+     * handles of reflected channels, and only of such whose handler is
+     * defined in this interpreter.
+     *
+     * We keep the old checks for both, for paranioa, but abort now instead of
+     * throwing errors, as failure now means that our internal datastructures
+     * have gone seriously haywire.
+     */
+
+    chan        = Tcl_GetHashValue(hPtr);
+    chanTypePtr = Tcl_GetChannelType(chan);
+
+    /*
+     * We use a function referenced by the channel type as our cookie to
+     * detect calls to non-reflecting channels. The channel type itself is not
+     * suitable, as it might not be the static definition in this file, but a
+     * clone thereof. And while we have reserved the name of the type nothing
+     * in the core checks against violation, so someone else might have
+     * created a channel type using our name, clashing with ourselves.
+     */
+
+    if (chanTypePtr->watchProc != &ReflectWatch) {
+	Tcl_Panic ("TclChanPostEventObjCmd: channel is not a reflected channel");
+    }
+
+    rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+
+    if (rcPtr->interp != interp) {
+	Tcl_Panic ("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
+    }
+
+    /*
+     * Second argument is a list of events. Allowed entries are "read",
+     * "write". Expect at least one list element. Abbreviations are ok.
+     */
+
+    if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check that the channel is actually interested in the provided events.
+     */
+
+    if (events & ~rcPtr->interest) {
+	Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
+		"\" is not interested in", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * We have the channel and the events to post.
+     */
+
+    Tcl_NotifyChannel(chan, events);
+
+    /*
+     * Squash interp results left by the event script.
+     */
+
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+
+#undef CHAN
+#undef EVENT
+}
+
+/*
+ * Channel error message marshalling utilities.
+ */
+
+static Tcl_Obj*
+MarshallError(
+    Tcl_Interp *interp)
+{
+    /*
+     * Capture the result status of the interpreter into a string. => List of
+     * options and values, followed by the error message. The result has
+     * refCount 0.
+     */
+
+    Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
+
+    /*
+     * => returnOpt.refCount == 0. We can append directly.
+     */
+
+    Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
+    return returnOpt;
+}
+
+static void
+UnmarshallErrorResult(
+    Tcl_Interp *interp,
+    Tcl_Obj *msgObj)
+{
+    int lc;
+    Tcl_Obj **lv;
+    int explicitResult;
+    int numOptions;
+
+    /*
+     * Process the caught message.
+     *
+     * Syntax = (option value)... ?message?
+     *
+     * Bad syntax causes a panic. This is OK because the other side uses
+     * Tcl_GetReturnOptions and list construction functions to marshall the
+     * information; if we panic here, something has gone badly wrong already.
+     */
+
+    if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
+    }
+    if (interp == NULL) {
+	return;
+    }
+
+    explicitResult = lc & 1;		/* Odd number of values? */
+    numOptions = lc - explicitResult;
+
+    if (explicitResult) {
+	Tcl_SetObjResult(interp, lv[lc-1]);
+    }
+
+    (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
+    ((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+int
+TclChanCaughtErrorBypass(
+    Tcl_Interp *interp,
+    Tcl_Channel chan)
+{
+    Tcl_Obj *chanMsgObj = NULL;
+    Tcl_Obj *interpMsgObj = NULL;
+    Tcl_Obj *msgObj = NULL;
+
+    /*
+     * Get a bypassed error message from channel and/or interpreter, save the
+     * reference, then kill the returned objects, if there were any. If there
+     * are messages in both the channel has preference.
+     */
+
+    if ((chan == NULL) && (interp == NULL)) {
+	return 0;
+    }
+
+    if (chan != NULL) {
+	Tcl_GetChannelError(chan, &chanMsgObj);
+    }
+    if (interp != NULL) {
+	Tcl_GetChannelErrorInterp(interp, &interpMsgObj);
+    }
+
+    if (chanMsgObj != NULL) {
+	msgObj = chanMsgObj;
+    } else if (interpMsgObj != NULL) {
+	msgObj = interpMsgObj;
+    }
+    if (msgObj != NULL) {
+	Tcl_IncrRefCount(msgObj);
+    }
+
+    if (chanMsgObj != NULL) {
+	Tcl_DecrRefCount(chanMsgObj);
+    }
+    if (interpMsgObj != NULL) {
+	Tcl_DecrRefCount(interpMsgObj);
+    }
+
+    /*
+     * No message returned, nothing caught.
+     */
+
+    if (msgObj == NULL) {
+	return 0;
+    }
+
+    UnmarshallErrorResult(interp, msgObj);
+
+    Tcl_DecrRefCount(msgObj);
+    return 1;
+}
+
+/*
+ * Driver functions. ================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectClose --
+ *
+ *	This function is invoked when the channel is closed, to delete the
+ *	driver specific instance data.
+ *
+ * Results:
+ *	A posix error.
+ *
+ * Side effects:
+ *	Releases memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectClose(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    int result;			/* Result code for 'close' */
+    Tcl_Obj *resObj;		/* Result data for 'close' */
+    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
+    Tcl_HashEntry* hPtr;         /* Entry in the above map */
+
+    if (TclInThreadExit()) {
+	/*
+	 * This call comes from TclFinalizeIOSystem. There are no
+	 * interpreters, and therefore we cannot call upon the handler command
+	 * anymore. Threading is irrelevant as well. We simply clean up all
+	 * our C level data structures and leave the Tcl level to the other
+	 * finalization functions.
+	 */
+
+	/*
+	 * THREADED => Forward this to the origin thread
+	 *
+	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler for the origin
+	 * thread. Use this to clean up the structure? Except if lost?
+	 */
+
+#ifdef TCL_THREADS
+	if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	    ForwardParam p;
+
+	    ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+	    result = p.base.code;
+
+	    /*
+	     * FreeReflectedChannel is done in the forwarded operation!, in
+	     * the other thread. rcPtr here is gone!
+	     */
+
+	    if (result != TCL_OK) {
+		FreeReceivedError(&p);
+	    }
+	    return EOK;
+	}
+#endif
+
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+	return EOK;
+    }
+
+    /*
+     * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
+     *
+     * A cleaned method mask here implies that the channel creation was
+     * aborted, and "finalize" must not be called.
+     */
+
+    if (rcPtr->methods == 0) {
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+	return EOK;
+    }
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+	result = p.base.code;
+
+	/*
+	 * FreeReflectedChannel is done in the forwarded operation!, in the
+	 * other thread. rcPtr here is gone!
+	 */
+
+	if (result != TCL_OK) {
+	    PassReceivedErrorInterp(interp, &p);
+	}
+    } else {
+#endif
+	result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+	if ((result != TCL_OK) && (interp != NULL)) {
+	    Tcl_SetChannelErrorInterp(interp, resObj);
+	}
+
+	Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
+					 * invoke */
+
+	/*
+	 * Remove the channel from the map before releasing the memory, to
+	 * prevent future accesses (like by 'postevent') from finding and
+	 * dereferencing a dangling pointer.
+	 *
+	 * NOTE: The channel may not be in the map. This is ok, that happens
+	 * when the channel was created in a different interpreter and/or
+	 * thread and then was moved here.
+	 *
+	 * NOTE: The channel may have been removed from the map already via
+	 * the per-interp DeleteReflectedChannelMap exit-handler.
+	 */
+
+	if (rcPtr->interp) {
+	    rcmPtr = GetReflectedChannelMap (rcPtr->interp);
+	    hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
+				      Tcl_GetChannelName (rcPtr->chan));
+	    if (hPtr) {
+		Tcl_DeleteHashEntry (hPtr);
+	    }
+	}
+#ifdef TCL_THREADS
+        rcmPtr = GetThreadReflectedChannelMap();
+	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
+				  Tcl_GetChannelName (rcPtr->chan));
+	if (hPtr) {
+	    Tcl_DeleteHashEntry (hPtr);
+	}
+#endif
+
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+#ifdef TCL_THREADS
+    }
+#endif
+    return (result == TCL_OK) ? EOK : EINVAL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectInput --
+ *
+ *	This function is invoked when more data is requested from the channel.
+ *
+ * Results:
+ *	The number of bytes read.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectInput(
+    ClientData clientData,
+    char *buf,
+    int toRead,
+    int *errorCodePtr)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *toReadObj;
+    int bytec;			/* Number of returned bytes */
+    unsigned char *bytev;	/* Array of returned bytes */
+    Tcl_Obj *resObj;		/* Result data for 'read' */
+
+    /*
+     * The following check can be done before thread redirection, because we
+     * are reading from an item which is readonly, i.e. will never change
+     * during the lifetime of the channel.
+     */
+
+    if (!(rcPtr->methods & FLAG(METH_READ))) {
+	SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.input.buf = buf;
+	p.input.toRead = toRead;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    if (p.base.code < 0) {
+		/* No error message, this is an errno signal. */
+		*errorCodePtr = -p.base.code;
+	    } else {
+		PassReceivedError(rcPtr->chan, &p);
+		*errorCodePtr = EINVAL;
+	    }
+	    p.input.toRead = -1;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	return p.input.toRead;
+    }
+#endif
+
+    /* ASSERT: rcPtr->method & FLAG(METH_READ) */
+    /* ASSERT: rcPtr->mode & TCL_READABLE */
+
+    Tcl_Preserve(rcPtr);
+
+    toReadObj = Tcl_NewIntObj(toRead);
+    Tcl_IncrRefCount(toReadObj);
+
+    if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+	int code = ErrnoReturn (rcPtr, resObj);
+
+	if (code < 0) {
+	    *errorCodePtr = -code;
+            goto error;
+	}
+
+	Tcl_SetChannelError(rcPtr->chan, resObj);
+        goto invalid;
+    }
+
+    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+    if (toRead < bytec) {
+	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
+        goto invalid;
+    }
+
+    *errorCodePtr = EOK;
+
+    if (bytec > 0) {
+	memcpy(buf, bytev, (size_t)bytec);
+    }
+
+ stop:
+    Tcl_DecrRefCount(toReadObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return bytec;
+ invalid:
+    *errorCodePtr = EINVAL;
+ error:
+    bytec = -1;
+    goto stop;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectOutput --
+ *
+ *	This function is invoked when data is writen to the channel.
+ *
+ * Results:
+ *	The number of bytes actually written.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectOutput(
+    ClientData clientData,
+    const char *buf,
+    int toWrite,
+    int *errorCodePtr)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *bufObj;
+    Tcl_Obj *resObj;		/* Result data for 'write' */
+    int written;
+
+    /*
+     * The following check can be done before thread redirection, because we
+     * are reading from an item which is readonly, i.e. will never change
+     * during the lifetime of the channel.
+     */
+
+    if (!(rcPtr->methods & FLAG(METH_WRITE))) {
+	SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.output.buf = buf;
+	p.output.toWrite = toWrite;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    if (p.base.code < 0) {
+		/* No error message, this is an errno signal. */
+		*errorCodePtr = -p.base.code;
+	    } else {
+                PassReceivedError(rcPtr->chan, &p);
+                *errorCodePtr = EINVAL;
+            }
+	    p.output.toWrite = -1;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	return p.output.toWrite;
+    }
+#endif
+
+    /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
+    /* ASSERT: rcPtr->mode & TCL_WRITABLE */
+
+    Tcl_Preserve(rcPtr);
+
+    bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+    Tcl_IncrRefCount(bufObj);
+
+    if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	int code = ErrnoReturn(rcPtr, resObj);
+
+	if (code < 0) {
+	    *errorCodePtr = -code;
+            goto error;
+	}
+
+	Tcl_SetChannelError(rcPtr->chan, resObj);
+        goto invalid;
+    }
+
+    if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
+	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
+        goto invalid;
+    }
+
+    if ((written == 0) && (toWrite > 0)) {
+	/*
+	 * The handler claims to have written nothing of what it was
+	 * given. That is bad.
+	 */
+
+	SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
+        goto invalid;
+    }
+    if (toWrite < written) {
+	/*
+	 * The handler claims to have written more than it was given. That is
+	 * bad. Note that the I/O core would crash if we were to return this
+	 * information, trying to write -nnn bytes in the next iteration.
+	 */
+
+	SetChannelErrorStr(rcPtr->chan, msg_write_toomuch);
+        goto invalid;
+    }
+
+    *errorCodePtr = EOK;
+ stop:
+    Tcl_DecrRefCount(bufObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return written;
+ invalid:
+    *errorCodePtr = EINVAL;
+ error:
+    written = -1;
+    goto stop;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSeekWide / ReflectSeek --
+ *
+ *	This function is invoked when the user wishes to seek on the channel.
+ *
+ * Results:
+ *	The new location of the access point.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+ReflectSeekWide(
+    ClientData clientData,
+    Tcl_WideInt offset,
+    int seekMode,
+    int *errorCodePtr)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *offObj, *baseObj;
+    Tcl_Obj *resObj;		/* Result for 'seek' */
+    Tcl_WideInt newLoc;
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.seek.seekMode = seekMode;
+	p.seek.offset = offset;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rcPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    p.seek.offset = -1;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	return p.seek.offset;
+    }
+#endif
+
+    /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */
+
+    Tcl_Preserve(rcPtr);
+
+    offObj = Tcl_NewWideIntObj(offset);
+    baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
+	    ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+    Tcl_IncrRefCount(offObj);
+    Tcl_IncrRefCount(baseObj);
+
+    if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+	Tcl_SetChannelError(rcPtr->chan, resObj);
+        goto invalid;
+    }
+
+    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
+	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
+        goto invalid;
+    }
+
+    if (newLoc < Tcl_LongAsWide(0)) {
+	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
+        goto invalid;
+    }
+
+    *errorCodePtr = EOK;
+ stop:
+    Tcl_DecrRefCount(offObj);
+    Tcl_DecrRefCount(baseObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return newLoc;
+ invalid:
+    *errorCodePtr = EINVAL;
+    newLoc = -1;
+    goto stop;
+}
+
+static int
+ReflectSeek(
+    ClientData clientData,
+    long offset,
+    int seekMode,
+    int *errorCodePtr)
+{
+    /*
+     * This function can be invoked from a transformation which is based on
+     * standard seeking, i.e. non-wide. Because of this we have to implement
+     * it, a dummy is not enough. We simply delegate the call to the wide
+     * routine.
+     */
+
+    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+	    errorCodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectWatch --
+ *
+ *	This function is invoked to tell the channel what events the I/O
+ *	system is interested in.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectWatch(
+    ClientData clientData,
+    int mask)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *maskObj;
+
+    /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
+
+    /*
+     * We restrict the interest to what the channel can support. IOW there
+     * will never be write events for a channel which is not writable.
+     * Analoguously for read events and non-readable channels.
+     */
+
+    mask &= rcPtr->mode;
+
+    if (mask == rcPtr->interest) {
+	/*
+	 * Same old, same old, why should we do something?
+	 */
+
+	return;
+    }
+
+    rcPtr->interest = mask;
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.watch.mask = mask;
+	ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);
+
+	/*
+	 * Any failure from the forward is ignored. We have no place to put
+	 * this.
+	 */
+
+	return;
+    }
+#endif
+
+    Tcl_Preserve(rcPtr);
+
+    maskObj = DecodeEventMask(mask);
+    /* assert maskObj.refCount == 1 */
+    (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+    Tcl_DecrRefCount(maskObj);
+
+    Tcl_Release(rcPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectBlock --
+ *
+ *	This function is invoked to tell the channel which blocking behaviour
+ *	is required of it.
+ *
+ * Results:
+ *	A posix error number.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectBlock(
+    ClientData clientData,
+    int nonblocking)
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *blockObj;
+    int errorNum;		/* EINVAL or EOK (success). */
+    Tcl_Obj *resObj;		/* Result data for 'blocking' */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.block.nonblocking = nonblocking;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rcPtr->chan, &p);
+	    return EINVAL;
+	}
+
+	return EOK;
+    }
+#endif
+
+    blockObj = Tcl_NewBooleanObj(!nonblocking);
+    Tcl_IncrRefCount(blockObj);
+
+    Tcl_Preserve(rcPtr);
+
+    if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) {
+	Tcl_SetChannelError(rcPtr->chan, resObj);
+	errorNum = EINVAL;
+    } else {
+	errorNum = EOK;
+    }
+
+    Tcl_DecrRefCount(blockObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+
+    Tcl_Release(rcPtr);
+    return errorNum;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSetOption --
+ *
+ *	This function is invoked to configure a channel option.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectSetOption(
+    ClientData clientData,	/* Channel to query */
+    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
+    const char *optionName,	/* Name of requested option */
+    const char *newValue)	/* The new value */
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    Tcl_Obj *optionObj, *valueObj;
+    int result;			/* Result code for 'configure' */
+    Tcl_Obj *resObj;		/* Result data for 'configure' */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.setOpt.name = optionName;
+	p.setOpt.value = newValue;
+
+	ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);
+
+	if (p.base.code != TCL_OK) {
+	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
+
+	    UnmarshallErrorResult(interp, err);
+	    Tcl_DecrRefCount(err);
+	    FreeReceivedError(&p);
+	}
+
+	return p.base.code;
+    }
+#endif
+    Tcl_Preserve(rcPtr);
+
+    optionObj = Tcl_NewStringObj(optionName, -1);
+    valueObj = Tcl_NewStringObj(newValue, -1);
+
+    Tcl_IncrRefCount(optionObj);
+    Tcl_IncrRefCount(valueObj);
+
+    result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+    if (result != TCL_OK) {
+	UnmarshallErrorResult(interp, resObj);
+    }
+
+    Tcl_DecrRefCount(optionObj);
+    Tcl_DecrRefCount(valueObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectGetOption --
+ *
+ *	This function is invoked to retrieve all or a channel option.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectGetOption(
+    ClientData clientData,	/* Channel to query */
+    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
+    const char *optionName,	/* Name of reuqested option */
+    Tcl_DString *dsPtr)		/* String to place the result into */
+{
+    /*
+     * This code is special. It has regular passing of Tcl result, and errors.
+     * The bypass functions are not required.
+     */
+
+    ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
+    Tcl_Obj *optionObj;
+    Tcl_Obj *resObj;		/* Result data for 'configure' */
+    int listc, result = TCL_OK;
+    Tcl_Obj **listv;
+    const char *method;
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	int opcode;
+	ForwardParam p;
+
+	p.getOpt.name = optionName;
+	p.getOpt.value = dsPtr;
+
+	if (optionName == NULL) {
+	    opcode = ForwardedGetOptAll;
+	} else {
+	    opcode = ForwardedGetOpt;
+	}
+
+	ForwardOpToOwnerThread(rcPtr, opcode, &p);
+
+	if (p.base.code != TCL_OK) {
+	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
+
+	    UnmarshallErrorResult(interp, err);
+	    Tcl_DecrRefCount(err);
+	    FreeReceivedError(&p);
+	}
+
+	return p.base.code;
+    }
+#endif
+
+    if (optionName == NULL) {
+	/*
+	 * Retrieve all options.
+	 */
+
+	method = "cgetall";
+	optionObj = NULL;
+    } else {
+	/*
+	 * Retrieve the value of one option.
+	 */
+
+	method = "cget";
+	optionObj = Tcl_NewStringObj(optionName, -1);
+        Tcl_IncrRefCount(optionObj);
+    }
+
+    Tcl_Preserve(rcPtr);
+
+    if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {
+	UnmarshallErrorResult(interp, resObj);
+        goto error;
+    }
+
+    /*
+     * The result has to go into the 'dsPtr' for propagation to the caller of
+     * the driver.
+     */
+
+    if (optionObj != NULL) {
+	Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
+        goto ok;
+    }
+
+    /*
+     * Extract the list and append each item as element.
+     */
+
+    /*
+     * NOTE (4): If we extract the string rep we can assume a properly quoted
+     * string. Together with a separating space this way of simply appending
+     * the whole string rep might be faster. It also doesn't check if the
+     * result is a valid list. Nor that the list has an even number elements.
+     */
+
+    if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+        goto error;
+    }
+
+    if ((listc % 2) == 1) {
+	/*
+	 * Odd number of elements is wrong.
+	 */
+
+	Tcl_ResetResult(interp);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"Expected list with even number of "
+		"elements, got %d element%s instead", listc,
+		(listc == 1 ? "" : "s")));
+        goto error;
+    } else {
+	int len;
+	char *str = Tcl_GetStringFromObj(resObj, &len);
+
+	if (len) {
+	    Tcl_DStringAppend(dsPtr, " ", 1);
+	    Tcl_DStringAppend(dsPtr, str, len);
+	}
+        goto ok;
+    }
+
+ ok:
+    result = TCL_OK;
+ stop:
+    if (optionObj) {
+        Tcl_DecrRefCount(optionObj);
+    }
+    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return result;
+ error:
+    result = TCL_ERROR;
+    goto stop;
+}
+
+/*
+ * Helpers. =========================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodeEventMask --
+ *
+ *	This function takes a list of event items and constructs the
+ *	equivalent internal bitmask. The list must contain at least one
+ *	element. Elements are "read", "write", or any unique abbreviation of
+ *	them. Note that the bitmask is not changed if problems are
+ *	encountered.
+ *
+ * Results:
+ *	A standard Tcl error code. A bitmask where TCL_READABLE and/or
+ *	TCL_WRITABLE can be set.
+ *
+ * Side effects:
+ *	May shimmer 'obj' to a list representation. May place an error message
+ *	into the interp result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EncodeEventMask(
+    Tcl_Interp *interp,
+    const char *objName,
+    Tcl_Obj *obj,
+    int *mask)
+{
+    int events;			/* Mask of events to post */
+    int listc;			/* #elements in eventspec list */
+    Tcl_Obj **listv;		/* Elements of eventspec list */
+    int evIndex;		/* Id of event for an element of the eventspec
+				 * list. */
+
+    if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (listc < 1) {
+	Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
+	return TCL_ERROR;
+    }
+
+    events = 0;
+    while (listc > 0) {
+	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
+		objName, 0, &evIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (evIndex) {
+	case EVENT_READ:
+	    events |= TCL_READABLE;
+	    break;
+	case EVENT_WRITE:
+	    events |= TCL_WRITABLE;
+	    break;
+	}
+	listc --;
+    }
+
+    *mask = events;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodeEventMask --
+ *
+ *	This function takes an internal bitmask of events and constructs the
+ *	equivalent list of event items.
+ *
+ * Results:
+ *	A Tcl_Obj reference. The object will have a refCount of one. The user
+ *	has to decrement it to release the object.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DecodeEventMask(
+    int mask)
+{
+    register const char *eventStr;
+    Tcl_Obj *evObj;
+
+    switch (mask & RANDW) {
+    case RANDW:
+	eventStr = "read write";
+	break;
+    case TCL_READABLE:
+	eventStr = "read";
+	break;
+    case TCL_WRITABLE:
+	eventStr = "write";
+	break;
+    default:
+	eventStr = "";
+	break;
+    }
+
+    evObj = Tcl_NewStringObj(eventStr, -1);
+    Tcl_IncrRefCount(evObj);
+    return evObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewReflectedChannel --
+ *
+ *	This function is invoked to allocate and initialize the instance data
+ *	of a new reflected channel.
+ *
+ * Results:
+ *	A heap-allocated channel instance.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedChannel *
+NewReflectedChannel(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdpfxObj,
+    int mode,
+    Tcl_Obj *handleObj)
+{
+    ReflectedChannel *rcPtr;
+    int i, listc;
+    Tcl_Obj **listv;
+
+    rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
+
+    /* rcPtr->chan: Assigned by caller. Dummy data here. */
+    /* rcPtr->methods: Assigned by caller. Dummy data here. */
+
+    rcPtr->chan = NULL;
+    rcPtr->methods = 0;
+    rcPtr->interp = interp;
+#ifdef TCL_THREADS
+    rcPtr->thread = Tcl_GetCurrentThread();
+#endif
+    rcPtr->mode = mode;
+    rcPtr->interest = 0;		/* Initially no interest registered */
+
+    /*
+     * Method placeholder.
+     */
+
+    /* ASSERT: cmdpfxObj is a Tcl List */
+
+    Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
+
+    /*
+     * See [==] as well.
+     * Storage for the command prefix and the additional words required for
+     * the invocation of methods in the command handler.
+     *
+     * listv [0] [listc-1] | [listc]  [listc+1] |
+     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
+     *       cmd   ... pfx | method   chan      | detail1 detail2
+     */
+
+    rcPtr->argc = listc + 2;
+    rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
+
+    /*
+     * Duplicate object references.
+     */
+
+    for (i=0; i<listc ; i++) {
+	Tcl_Obj *word = rcPtr->argv[i] = listv[i];
+
+	Tcl_IncrRefCount(word);
+    }
+
+    i++;				/* Skip placeholder for method */
+
+    /*
+     * [Bug 1667990]: See [x] in FreeReflectedChannel for release
+     */
+
+    rcPtr->argv[i] = handleObj;
+    Tcl_IncrRefCount(handleObj);
+
+    /*
+     * The next two objects are kept empty, varying arguments.
+     */
+
+    /*
+     * Initialization complete.
+     */
+
+    return rcPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextHandle --
+ *
+ *	This function is invoked to generate a channel handle for a new
+ *	reflected channel.
+ *
+ * Results:
+ *	A Tcl_Obj containing the string of the new channel handle. The
+ *	refcount of the returned object is -- zero --.
+ *
+ * Side effects:
+ *	May allocate memory. Mutex protected critical section locks out other
+ *	threads for a short time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NextHandle(void)
+{
+    /*
+     * Count number of generated reflected channels. Used for id generation.
+     * Ids are never reclaimed and there is no dealing with wrap around. On
+     * the other hand, "unsigned long" should be big enough except for
+     * absolute longrunners (generate a 100 ids per second => overflow will
+     * occur in 1 1/3 years).
+     */
+
+    TCL_DECLARE_MUTEX(rcCounterMutex)
+    static unsigned long rcCounter = 0;
+    Tcl_Obj *resObj;
+
+    Tcl_MutexLock(&rcCounterMutex);
+    resObj = Tcl_ObjPrintf("rc%lu", rcCounter);
+    rcCounter++;
+    Tcl_MutexUnlock(&rcCounterMutex);
+
+    return resObj;
+}
+
+static void
+FreeReflectedChannel(
+    ReflectedChannel *rcPtr)
+{
+    Channel *chanPtr = (Channel *) rcPtr->chan;
+    int i, n;
+
+    if (chanPtr->typePtr != &tclRChannelType) {
+	/*
+	 * Delete a cloned ChannelType structure.
+	 */
+
+	ckfree((char*) chanPtr->typePtr);
+    }
+
+    n = rcPtr->argc - 2;
+    for (i=0; i<n; i++) {
+	Tcl_DecrRefCount(rcPtr->argv[i]);
+    }
+
+    /*
+     * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
+     */
+
+    Tcl_DecrRefCount(rcPtr->argv[n+1]);
+
+    ckfree((char*) rcPtr->argv);
+    ckfree((char*) rcPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeTclMethod --
+ *
+ *	This function is used to invoke the Tcl level of a reflected channel.
+ *	It handles all the command assembly, invokation, and generic state and
+ *	result mgmt. It does *not* handle thread redirection; that is the
+ *	responsibility of clients of this function.
+ *
+ * Results:
+ *	Result code and data as returned by the method.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ * Contract:
+ *	argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
+ *	argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
+ *	resObj.refCount in {0, 1, ...}
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InvokeTclMethod(
+    ReflectedChannel *rcPtr,
+    const char *method,
+    Tcl_Obj *argOneObj,		/* NULL'able */
+    Tcl_Obj *argTwoObj,		/* NULL'able */
+    Tcl_Obj **resultObjPtr)	/* NULL'able */
+{
+    int cmdc;			/* #words in constructed command */
+    Tcl_Obj *methObj = NULL;	/* Method name in object form */
+    Tcl_InterpState sr;		/* State of handler interp */
+    int result;			/* Result code of method invokation */
+    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
+
+    if (!rcPtr->interp) {
+	/*
+	 * The channel is marked as dead. Bail out immediately, with an
+	 * appropriate error.
+	 */
+
+	if (resultObjPtr != NULL) {
+	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
+	    *resultObjPtr = resObj;
+	    Tcl_IncrRefCount(resObj);
+	}
+
+        /*
+         * Not touching argOneObj, argTwoObj, they have not been used.
+         * See the contract as well.
+         */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
+     * TSD data as reflections can be created in many different threads.
+     * NO: Caching of command resolutions means storage per channel.
+     */
+
+    /*
+     * Insert method into the pre-allocated area, after the command prefix,
+     * before the channel id.
+     */
+
+    methObj = Tcl_NewStringObj(method, -1);
+    Tcl_IncrRefCount(methObj);
+    rcPtr->argv[rcPtr->argc - 2] = methObj;
+
+    /*
+     * Append the additional argument containing method specific details
+     * behind the channel id. If specified.
+     */
+
+    cmdc = rcPtr->argc;
+    if (argOneObj) {
+	rcPtr->argv[cmdc] = argOneObj;
+	cmdc++;
+	if (argTwoObj) {
+	    rcPtr->argv[cmdc] = argTwoObj;
+	    cmdc++;
+	}
+    }
+
+    /*
+     * And run the handler... This is done in auch a manner which leaves any
+     * existing state intact.
+     */
+
+    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+    Tcl_Preserve(rcPtr->interp);
+    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+
+    /*
+     * We do not try to extract the result information if the caller has no
+     * interest in it. I.e. there is no need to put effort into creating
+     * something which is discarded immediately after.
+     */
+
+    if (resultObjPtr) {
+	if (result == TCL_OK) {
+	    /*
+	     * Ok result taken as is, also if the caller requests that there
+	     * is no capture.
+	     */
+
+	    resObj = Tcl_GetObjResult(rcPtr->interp);
+	} else {
+	    /*
+	     * Non-ok result is always treated as an error. We have to capture
+	     * the full state of the result, including additional options.
+	     *
+	     * This is complex and ugly, and would be completely unnecessary
+	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
+	     */
+
+	    if (result != TCL_ERROR) {
+		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
+		int cmdLen;
+		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+
+		Tcl_IncrRefCount(cmd);
+		Tcl_ResetResult(rcPtr->interp);
+		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
+			"chan handler returned bad code: %d", result));
+		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
+			cmdLen);
+		Tcl_DecrRefCount(cmd);
+		result = TCL_ERROR;
+	    }
+	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
+		    "\n    (chan handler subcommand \"%s\")", method));
+	    resObj = MarshallError(rcPtr->interp);
+	}
+	Tcl_IncrRefCount(resObj);
+    }
+    Tcl_RestoreInterpState(rcPtr->interp, sr);
+    Tcl_Release(rcPtr->interp);
+
+    /*
+     * Cleanup of the dynamic parts of the command.
+     *
+     * The detail objects survived the Tcl_EvalObjv without change because of
+     * the contract. Therefore there is no need to decrement the refcounts. Only
+     * the internal method object has to be disposed of.
+     */
+
+    Tcl_DecrRefCount(methObj);
+
+    /*
+     * The resObj has a ref count of 1 at this location. This means that the
+     * caller of InvokeTclMethod has to dispose of it (but only if it was
+     * returned to it).
+     */
+
+    if (resultObjPtr != NULL) {
+	*resultObjPtr = resObj;
+    }
+
+    /*
+     * There no need to handle the case where nothing is returned, because for
+     * that case resObj was not set anyway.
+     */
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ErrnoReturn --
+ *
+ *	Checks a method error result if it returned an 'errno'.
+ *
+ * Results:
+ *	The negative errno found in the error result, or 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Users:
+ *	ReflectInput/Output(), to enable the signaling of EAGAIN
+ *	on 0-sized short reads/writes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj)
+{
+    int code;
+    Tcl_InterpState sr;		/* State of handler interp */
+
+    if (!rcPtr->interp) {
+	return 0;
+    }
+
+    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+    UnmarshallErrorResult(rcPtr->interp, resObj);
+
+    resObj = Tcl_GetObjResult(rcPtr->interp);
+
+    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) || (code >= 0))) {
+	if (strcmp ("EAGAIN",Tcl_GetString(resObj)) == 0) {
+	    code = - EAGAIN;
+	} else {
+	    code = 0;
+	}
+    }
+
+    Tcl_RestoreInterpState(rcPtr->interp, sr);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReflectedChannelMap --
+ *
+ *	Gets and potentially initializes the reflected channel map for an
+ *	interpreter.
+ *
+ * Results:
+ *	A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ *	Initializes the reflected channel map for an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedChannelMap *
+GetReflectedChannelMap(
+    Tcl_Interp *interp)
+{
+    ReflectedChannelMap* rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
+
+    if (rcmPtr == NULL) {
+	rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
+	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
+	Tcl_SetAssocData(interp, RCMKEY,
+		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
+    }
+    return rcmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteReflectedChannelMap --
+ *
+ *	Deletes the channel table for an interpreter, closing any open
+ *	channels whose refcount reaches zero. This procedure is invoked when
+ *	an interpreter is deleted, via the AssocData cleanup mechanism.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the hash table of channels. May close channels. May flush
+ *	output on closed channels. Removes any channeEvent handlers that were
+ *	registered in this interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteReflectedChannelMap(
+    ClientData clientData,	/* The per-interpreter data structure. */
+    Tcl_Interp *interp)		/* The interpreter being deleted. */
+{
+    ReflectedChannelMap* rcmPtr; /* The map */
+    Tcl_HashSearch hSearch;	 /* Search variable. */
+    Tcl_HashEntry *hPtr;	 /* Search variable. */
+    ReflectedChannel* rcPtr;
+    Tcl_Channel chan;
+
+#ifdef TCL_THREADS
+    ForwardingResult *resultPtr;
+    ForwardingEvent *evPtr;
+    ForwardParam *paramPtr;
+#endif
+
+    /*
+     * Delete all entries. The channels may have been closed already, or will
+     * be closed later, by the standard IO finalization of an interpreter
+     * under destruction.  Except for the channels which were moved to a
+     * different interpreter and/or thread. They do not exist from the IO
+     * systems point of view and will not get closed. Therefore mark all as
+     * dead so that any future access will cause a proper error. For channels
+     * in a different thread we actually do the same as
+     * DeleteThreadReflectedChannelMap(), just restricted to the channels of
+     * this interp.
+     */
+
+    rcmPtr = clientData;
+    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+	 hPtr != NULL;
+	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+
+	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
+	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+
+	rcPtr->interp = NULL;
+
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    Tcl_DeleteHashTable(&rcmPtr->map);
+    ckfree((char *) &rcmPtr->map);
+
+#ifdef TCL_THREADS
+    /*
+     * The origin interpreter for one or more reflected channels is gone.
+     */
+
+    /*
+     * Go through the list of pending results and cancel all whose events were
+     * destined for this interpreter. While this is in progress we block any
+     * other access to the list of pending results.
+     */
+
+    Tcl_MutexLock(&rcForwardMutex);
+
+    for (resultPtr = forwardList;
+	 resultPtr != NULL;
+	 resultPtr = resultPtr->nextPtr) {
+	if (resultPtr->dsti != interp) {
+	    /* Ignore results/events for other interpreters. */
+	    continue;
+	}
+
+	/*
+	 * The receiver for the event exited, before processing the event. We
+	 * detach the result now, wake the originator up and signal failure.
+	 */
+
+	evPtr = resultPtr->evPtr;
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+
+    /*
+     * Get the map of all channels handled by the current thread. This is a
+     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
+     * through the channels and remove all which were handled by this
+     * interpreter. They have already been marked as dead.
+     */
+
+    rcmPtr = GetThreadReflectedChannelMap();
+    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
+	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+
+	if (rcPtr->interp != interp) {
+	    /* Ignore entries for other interpreters */
+	    continue;
+	}
+
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    Tcl_MutexUnlock(&rcForwardMutex);
+#endif
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadReflectedChannelMap --
+ *
+ *	Gets and potentially initializes the reflected channel map for a
+ *	thread.
+ *
+ * Results:
+ *	A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ *	Initializes the reflected channel map for a thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedChannelMap *
+GetThreadReflectedChannelMap()
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (!tsdPtr->rcmPtr) {
+	tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
+	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
+	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
+    }
+
+    return tsdPtr->rcmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteThreadReflectedChannelMap --
+ *
+ *	Deletes the channel table for a thread. This procedure is invoked when
+ *	a thread is deleted. The channels have already been marked as dead, in
+ *      DeleteReflectedChannelMap().
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the hash table of channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteThreadReflectedChannelMap(
+    ClientData clientData)	/* The per-thread data structure. */
+{
+    Tcl_HashSearch hSearch;	 /* Search variable. */
+    Tcl_HashEntry *hPtr;	 /* Search variable. */
+    Tcl_ThreadId self = Tcl_GetCurrentThread();
+
+    ReflectedChannelMap* rcmPtr; /* The map */
+    Tcl_Channel chan;
+    ReflectedChannel* rcPtr;
+    ForwardingResult *resultPtr;
+    ForwardingEvent *evPtr;
+    ForwardParam *paramPtr;
+
+    /*
+     * The origin thread for one or more reflected channels is gone.
+     * NOTE: If this function is called due to a thread getting killed the
+     *       per-interp DeleteReflectedChannelMap is apparently not called.
+     */
+
+    /*
+     * Go through the list of pending results and cancel all whose events were
+     * destined for this thread. While this is in progress we block any
+     * other access to the list of pending results.
+     */
+
+    Tcl_MutexLock(&rcForwardMutex);
+
+    for (resultPtr = forwardList;
+	 resultPtr != NULL;
+	 resultPtr = resultPtr->nextPtr) {
+	if (resultPtr->dst != self) {
+	    /* Ignore results/events for other threads. */
+	    continue;
+	}
+
+	/*
+	 * The receiver for the event exited, before processing the event. We
+	 * detach the result now, wake the originator up and signal failure.
+	 */
+
+	evPtr = resultPtr->evPtr;
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+
+    /*
+     * Get the map of all channels handled by the current thread. This is a
+     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
+     * through the channels, remove all, mark them as dead.
+     */
+
+    rcmPtr = GetThreadReflectedChannelMap();
+    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
+	 hPtr != NULL;
+	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+
+	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
+	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+
+	rcPtr->interp = NULL;
+
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    Tcl_MutexUnlock(&rcForwardMutex);
+}
+
+static void
+ForwardOpToOwnerThread(
+    ReflectedChannel *rcPtr,	/* Channel instance */
+    ForwardedOperation op,	/* Forwarded driver operation */
+    const VOID *param)		/* Arguments */
+{
+    Tcl_ThreadId dst = rcPtr->thread;
+    ForwardingEvent *evPtr;
+    ForwardingResult *resultPtr;
+
+    /*
+     * We gather the lock early. This allows us to check the liveness of the
+     * channel without interference from DeleteThreadReflectedChannelMap().
+     */
+
+    Tcl_MutexLock(&rcForwardMutex);
+
+    if (rcPtr->interp == NULL) {
+	/*
+	 * The channel is marked as dead. Bail out immediately, with an
+	 * appropriate error. Do not forget to unlock the mutex on this path.
+	 */
+
+	ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost);
+	Tcl_MutexUnlock(&rcForwardMutex);
+	return;
+    }
+
+    /*
+     * Create and initialize the event and data structures.
+     */
+
+    evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
+    resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+
+    evPtr->event.proc = ForwardProc;
+    evPtr->resultPtr = resultPtr;
+    evPtr->op = op;
+    evPtr->rcPtr = rcPtr;
+    evPtr->param = (ForwardParam *) param;
+
+    resultPtr->src  = Tcl_GetCurrentThread();
+    resultPtr->dst  = dst;
+    resultPtr->dsti = rcPtr->interp;
+    resultPtr->done = NULL;
+    resultPtr->result = -1;
+    resultPtr->evPtr = evPtr;
+
+    /*
+     * Now execute the forward.
+     */
+
+    TclSpliceIn(resultPtr, forwardList);
+    /* Do not unlock here. That is done by the ConditionWait */
+
+    /*
+     * Ensure cleanup of the event if the origin thread exits while this event
+     * is pending or in progress. Exitus of the destination thread is handled
+     * by DeleteThreadReflectionChannelMap(), this is set up by
+     * GetThreadReflectedChannelMap().  This is what we use the 'forwardList'
+     * (see above) for.
+     */
+
+    Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+
+    /*
+     * Queue the event and poke the other thread's notifier.
+     */
+
+    Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
+    Tcl_ThreadAlert(dst);
+
+    /*
+     * (*) Block until the other thread has either processed the transfer or
+     * rejected it.
+     */
+
+    while (resultPtr->result < 0) {
+	/*
+	 * NOTE (1): Is it possible that the current thread goes away while
+	 * waiting here? IOW Is it possible that "SrcExitProc" is called while
+	 * we are here? See complementary note (2) in "SrcExitProc"
+	 *
+	 * The ConditionWait unlocks the mutex during the wait and relocks it
+	 * immediately after.
+	 */
+
+	Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
+    }
+
+    /*
+     * Unlink result from the forwarder list.
+     * No need to lock. Either still locked, or locked by the ConditionWait
+     */
+
+    TclSpliceOut(resultPtr, forwardList);
+
+    resultPtr->nextPtr = NULL;
+    resultPtr->prevPtr = NULL;
+
+    Tcl_MutexUnlock(&rcForwardMutex);
+    Tcl_ConditionFinalize(&resultPtr->done);
+
+    /*
+     * Kill the cleanup handler now, and the result structure as well, before
+     * returning the success code.
+     *
+     * Note: The event structure has already been deleted.
+     */
+
+    Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+
+    ckfree((char*) resultPtr);
+}
+
+static int
+ForwardProc(
+    Tcl_Event *evGPtr,
+    int mask)
+{
+    /*
+     * Notes regarding access to the referenced data.
+     *
+     * In principle the data belongs to the originating thread (see
+     * evPtr->src), however this thread is currently blocked at (*), i.e.
+     * quiescent. Because of this we can treat the data as belonging to us,
+     * without fear of race conditions. I.e. we can read and write as we like.
+     *
+     * The only thing we cannot be sure of is the resultPtr. This can be be
+     * NULLed if the originating thread went away while the event is handled
+     * here now.
+     */
+
+    ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
+    ForwardingResult *resultPtr = evPtr->resultPtr;
+    ReflectedChannel *rcPtr = evPtr->rcPtr;
+    Tcl_Interp *interp = rcPtr->interp;
+    ForwardParam *paramPtr = evPtr->param;
+    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
+    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
+    Tcl_HashEntry* hPtr;         /* Entry in the above map */
+
+    /*
+     * Ignore the event if no one is waiting for its result anymore.
+     */
+
+    if (!resultPtr) {
+	return 1;
+    }
+
+    paramPtr->base.code = TCL_OK;
+    paramPtr->base.msgStr = NULL;
+    paramPtr->base.mustFree = 0;
+
+    switch (evPtr->op) {
+	/*
+	 * The destination thread for the following operations is
+	 * rcPtr->thread, which contains rcPtr->interp, the interp we have to
+	 * call upon for the driver.
+	 */
+
+    case ForwardedClose:
+	/*
+	 * No parameters/results.
+	 */
+
+	if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	}
+
+	/*
+	 * Freeing is done here, in the origin thread, because the argv[]
+	 * objects belong to this thread. Deallocating them in a different
+	 * thread is not allowed
+	 *
+	 * We remove the channel from both interpreter and thread maps before
+	 * releasing the memory, to prevent future accesses (like by
+	 * 'postevent') from finding and dereferencing a dangling pointer.
+	 */
+
+	rcmPtr = GetReflectedChannelMap (interp);
+	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
+				  Tcl_GetChannelName (rcPtr->chan));
+	Tcl_DeleteHashEntry (hPtr);
+
+        rcmPtr = GetThreadReflectedChannelMap();
+	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
+				  Tcl_GetChannelName (rcPtr->chan));
+	Tcl_DeleteHashEntry (hPtr);
+
+        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+	break;
+
+    case ForwardedInput: {
+	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
+        Tcl_IncrRefCount(toReadObj);
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+	    int code = ErrnoReturn (rcPtr, resObj);
+
+	    if (code < 0) {
+		paramPtr->base.code = code;
+	    } else {
+		ForwardSetObjError(paramPtr, resObj);
+	    }
+	    paramPtr->input.toRead = -1;
+	} else {
+	    /*
+	     * Process a regular result.
+	     */
+
+	    int bytec;			/* Number of returned bytes */
+	    unsigned char *bytev;	/* Array of returned bytes */
+
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	    if (paramPtr->input.toRead < bytec) {
+		ForwardSetStaticError(paramPtr, msg_read_toomuch);
+		paramPtr->input.toRead = -1;
+	    } else {
+		if (bytec > 0) {
+		    memcpy(paramPtr->input.buf, bytev, (size_t)bytec);
+		}
+		paramPtr->input.toRead = bytec;
+	    }
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(toReadObj);
+	break;
+    }
+
+    case ForwardedOutput: {
+	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+		paramPtr->output.buf, paramPtr->output.toWrite);
+        Tcl_IncrRefCount(bufObj);
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	    int code = ErrnoReturn(rcPtr, resObj);
+
+	    if (code < 0) {
+		paramPtr->base.code = code;
+	    } else {
+		ForwardSetObjError(paramPtr, resObj);
+	    }
+	    paramPtr->output.toWrite = -1;
+	} else {
+	    /*
+	     * Process a regular result.
+	     */
+
+	    int written;
+
+	    if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
+		ForwardSetObjError(paramPtr, MarshallError(interp));
+		paramPtr->output.toWrite = -1;
+	    } else if (written==0 || paramPtr->output.toWrite<written) {
+		ForwardSetStaticError(paramPtr, msg_write_toomuch);
+		paramPtr->output.toWrite = -1;
+	    } else {
+		paramPtr->output.toWrite = written;
+	    }
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(bufObj);
+	break;
+    }
+
+    case ForwardedSeek: {
+	Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
+	Tcl_Obj *baseObj = Tcl_NewStringObj(
+		(paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+		(paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
+
+        Tcl_IncrRefCount(offObj);
+        Tcl_IncrRefCount(baseObj);
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->seek.offset = -1;
+	} else {
+	    /*
+	     * Process a regular result. If the type is wrong this may change
+	     * into an error.
+	     */
+
+	    Tcl_WideInt newLoc;
+
+	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
+		if (newLoc < Tcl_LongAsWide(0)) {
+		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
+		    paramPtr->seek.offset = -1;
+		} else {
+		    paramPtr->seek.offset = newLoc;
+		}
+	    } else {
+		ForwardSetObjError(paramPtr, MarshallError(interp));
+		paramPtr->seek.offset = -1;
+	    }
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(offObj);
+        Tcl_DecrRefCount(baseObj);
+	break;
+    }
+
+    case ForwardedWatch: {
+	Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
+        /* assert maskObj.refCount == 1 */
+
+        Tcl_Preserve(rcPtr);
+	(void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+	Tcl_DecrRefCount(maskObj);
+        Tcl_Release(rcPtr);
+	break;
+    }
+
+    case ForwardedBlock: {
+	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
+        Tcl_IncrRefCount(blockObj);
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+		&resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(blockObj);
+	break;
+    }
+
+    case ForwardedSetOpt: {
+	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
+	Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
+
+        Tcl_IncrRefCount(optionObj);
+        Tcl_IncrRefCount(valueObj);
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+		&resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(optionObj);
+        Tcl_DecrRefCount(valueObj);
+	break;
+    }
+
+    case ForwardedGetOpt: {
+	/*
+	 * Retrieve the value of one option.
+	 */
+
+	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
+        Tcl_IncrRefCount(optionObj);
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+	    ForwardSetObjError(paramPtr, resObj);
+	} else {
+	    Tcl_DStringAppend(paramPtr->getOpt.value,
+		    TclGetString(resObj), -1);
+	}
+        Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(optionObj);
+	break;
+    }
+
+    case ForwardedGetOptAll:
+	/*
+	 * Retrieve all options.
+	 */
+
+        Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+	    ForwardSetObjError(paramPtr, resObj);
+	} else {
+	    /*
+	     * Extract list, validate that it is a list, and #elements. See
+	     * NOTE (4) as well.
+	     */
+
+	    int listc;
+	    Tcl_Obj **listv;
+
+	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
+		    &listv) != TCL_OK) {
+		ForwardSetObjError(paramPtr, MarshallError(interp));
+	    } else if ((listc % 2) == 1) {
+		/*
+		 * Odd number of elements is wrong. [x].
+		 */
+
+		char *buf = ckalloc(200);
+		sprintf(buf,
+			"{Expected list with even number of elements, got %d %s instead}",
+			listc, (listc == 1 ? "element" : "elements"));
+
+		ForwardSetDynamicError(paramPtr, buf);
+	    } else {
+		int len;
+		const char *str = Tcl_GetStringFromObj(resObj, &len);
+
+		if (len) {
+		    Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
+		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
+		}
+	    }
+	}
+        Tcl_Release(rcPtr);
+	break;
+
+    default:
+	/*
+	 * Bad operation code.
+	 */
+
+	Tcl_Panic("Bad operation code in ForwardProc");
+	break;
+    }
+
+    /*
+     * Remove the reference we held on the result of the invoke, if we had
+     * such.
+     */
+
+    if (resObj != NULL) {
+	Tcl_DecrRefCount(resObj);
+    }
+
+    if (resultPtr) {
+	/*
+	 * Report the forwarding result synchronously to the waiting caller.
+	 * This unblocks (*) as well. This is wrapped into a conditional
+	 * because the caller may have exited in the mean time.
+	 */
+
+	Tcl_MutexLock(&rcForwardMutex);
+	resultPtr->result = TCL_OK;
+	Tcl_ConditionNotify(&resultPtr->done);
+	Tcl_MutexUnlock(&rcForwardMutex);
+    }
+
+    return 1;
+}
+
+static void
+SrcExitProc(
+    ClientData clientData)
+{
+    ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
+    ForwardingResult *resultPtr;
+    ForwardParam *paramPtr;
+
+    /*
+     * NOTE (2): Can this handler be called with the originator blocked?
+     */
+
+    /*
+     * The originator for the event exited. It is not sure if this can happen,
+     * as the originator should be blocked at (*) while the event is in
+     * transit/pending.
+     *
+     * We make sure that the event cannot refer to the result anymore, remove
+     * it from the list of pending results and free the structure. Locking the
+     * access ensures that we cannot get in conflict with "ForwardProc",
+     * should it already execute the event.
+     */
+
+    Tcl_MutexLock(&rcForwardMutex);
+
+    resultPtr = evPtr->resultPtr;
+    paramPtr = evPtr->param;
+
+    evPtr->resultPtr = NULL;
+    resultPtr->evPtr = NULL;
+    resultPtr->result = TCL_ERROR;
+
+    ForwardSetStaticError(paramPtr, msg_send_originlost);
+
+    /*
+     * See below: TclSpliceOut(resultPtr, forwardList);
+     */
+
+    Tcl_MutexUnlock(&rcForwardMutex);
+
+    /*
+     * This unlocks (*). The structure will be spliced out and freed by
+     * "ForwardProc". Maybe.
+     */
+
+    Tcl_ConditionNotify(&resultPtr->done);
+}
+
+static void
+ForwardSetObjError(
+    ForwardParam *paramPtr,
+    Tcl_Obj *obj)
+{
+    int len;
+    const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+
+    len++;
+    ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
+}
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
+ * End:
+ */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 251780c..97dec06 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -1,30 +1,28 @@
-/* 
+/*
  * tclIOSock.c --
  *
  *	Common routines used by all socket based channel types.
  *
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
  *---------------------------------------------------------------------------
  *
  * TclSockGetPort --
  *
- *	Maps from a string, which could be a service name, to a port.
- *	Used by socket creation code to get port numbers and resolve
- *	registered service names to port numbers.
+ *	Maps from a string, which could be a service name, to a port. Used by
+ *	socket creation code to get port numbers and resolve registered
+ *	service names to port numbers.
  *
  * Results:
- *	A standard Tcl result.  On success, the port number is returned
- *	in portPtr. On failure, an error message is left in the interp's
- *	result.
+ *	A standard Tcl result. On success, the port number is returned in
+ *	portPtr. On failure, an error message is left in the interp's result.
  *
  * Side effects:
  *	None.
@@ -33,21 +31,21 @@
  */
 
 int
-TclSockGetPort(interp, string, proto, portPtr)
-    Tcl_Interp *interp;
-    char *string;		/* Integer or service name */
-    char *proto;		/* "tcp" or "udp", typically */
-    int *portPtr;		/* Return port number */
+TclSockGetPort(
+    Tcl_Interp *interp,
+    const char *string, /* Integer or service name */
+    const char *proto, /* "tcp" or "udp", typically */
+    int *portPtr)		/* Return port number */
 {
     struct servent *sp;		/* Protocol info for named services */
     Tcl_DString ds;
-    CONST char *native;
+    const char *native;
 
     if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
 	/*
 	 * Don't bother translating 'proto' to native.
 	 */
-	 
+
 	native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
 	sp = getservbyname(native, proto);		/* INTL: Native. */
 	Tcl_DStringFree(&ds);
@@ -60,8 +58,8 @@ TclSockGetPort(interp, string, proto, portPtr)
 	return TCL_ERROR;
     }
     if (*portPtr > 0xFFFF) {
-        Tcl_AppendResult(interp, "couldn't open socket: port number too high",
-                (char *) NULL);
+	Tcl_AppendResult(interp, "couldn't open socket: port number too high",
+		NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -89,9 +87,9 @@ TclSockGetPort(interp, string, proto, portPtr)
 #endif
 
 int
-TclSockMinimumBuffers(sock, size)
-    void *sock;			/* Socket file descriptor */
-    int size;			/* Minimum buffer size */
+TclSockMinimumBuffers(
+    void *sock,			/* Socket file descriptor */
+    int size)			/* Minimum buffer size */
 {
     int current;
     socklen_t len;
@@ -110,3 +108,11 @@ TclSockMinimumBuffers(sock, size)
     }
     return TCL_OK;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 105c038..295e313 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1,182 +1,144 @@
-/* 
+/*
  * tclIOUtil.c --
  *
- *	This file contains the implementation of Tcl's generic
- *	filesystem code, which supports a pluggable filesystem
- *	architecture allowing both platform specific filesystems and
- *	'virtual filesystems'.  All filesystem access should go through
- *	the functions defined in this file.  Most of this code was
- *	contributed by Vince Darley.
+ *	This file contains the implementation of Tcl's generic filesystem
+ *	code, which supports a pluggable filesystem architecture allowing both
+ *	platform specific filesystems and 'virtual filesystems'. All
+ *	filesystem access should go through the functions defined in this
+ *	file. Most of this code was contributed by Vince Darley.
  *
- *	Parts of this file are based on code contributed by Karl
- *	Lehenbauer, Mark Diekhans and Peter da Silva.
+ *	Parts of this file are based on code contributed by Karl Lehenbauer,
+ *	Mark Diekhans and Peter da Silva.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2001-2004 Vincent Darley.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#ifndef _WIN64
-/* See [Bug 3354324]: file mtime sets wrong time */
-#   define _USE_32BIT_TIME_T
-#endif
-
-#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclPort.h"
 #ifdef __WIN32__
-/* for tclWinProcs->useWide */
-#include "tclWinInt.h"
+#   include "tclWinInt.h"
 #endif
+#include "tclFileSystem.h"
 
-/* 
+/*
  * struct FilesystemRecord --
- * 
- * A filesystem record is used to keep track of each
- * filesystem currently registered with the core,
- * in a linked list.  Pointers to these structures
- * are also kept by each "path" Tcl_Obj, and we must
- * retain a refCount on the number of such references.
+ *
+ * A filesystem record is used to keep track of each filesystem currently
+ * registered with the core, in a linked list.
  */
+
 typedef struct FilesystemRecord {
-    ClientData	     clientData;  /* Client specific data for the new
-				   * filesystem (can be NULL) */
-    Tcl_Filesystem *fsPtr;        /* Pointer to filesystem dispatch
-				   * table. */
-    int fileRefCount;             /* How many Tcl_Obj's use this
-				   * filesystem. */
-    struct FilesystemRecord *nextPtr;  
-				  /* The next filesystem registered
-				   * to Tcl, or NULL if no more. */
-    struct FilesystemRecord *prevPtr;  
-				  /* The previous filesystem registered
-				   * to Tcl, or NULL if no more. */
+    ClientData clientData;	/* Client specific data for the new filesystem
+				 * (can be NULL) */
+    Tcl_Filesystem *fsPtr;	/* Pointer to filesystem dispatch table. */
+    struct FilesystemRecord *nextPtr;
+				/* The next filesystem registered to Tcl, or
+				 * NULL if no more. */
+    struct FilesystemRecord *prevPtr;
+				/* The previous filesystem registered to Tcl,
+				 * or NULL if no more. */
 } FilesystemRecord;
 
-/* 
- * The internal TclFS API provides routines for handling and
- * manipulating paths efficiently, taking direct advantage of
- * the "path" Tcl_Obj type.
- * 
- * These functions are not exported at all at present.
+/*
+ * This structure holds per-thread private copy of the current directory
+ * maintained by the global cwdPathPtr. This structure holds per-thread
+ * private copies of some global data. This way we avoid most of the
+ * synchronization calls which boosts performance, at cost of having to update
+ * this information each time the corresponding epoch counter changes.
  */
 
-int      TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr));
-int	 TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, 
-		Tcl_Obj *objPtr));
-int      TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, 
-		Tcl_Obj *pathPtr, int startAt));
-Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, 
-		Tcl_Obj *objPtr, Tcl_Obj *cwdPtr));
-Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_((
-		Tcl_Filesystem *fromFilesystem, ClientData clientData,
-		FilesystemRecord **fsRecPtrPtr));
-int      TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathObjPtr,
-		Tcl_Filesystem **fsPtrPtr));
-void     TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
-		FilesystemRecord *fsRecPtr, ClientData clientData)); 
-
-/* 
- * Private variables for use in this file
- */
-extern Tcl_Filesystem tclNativeFilesystem;
-extern int theFilesystemEpoch;
+typedef struct ThreadSpecificData {
+    int initialized;
+    int cwdPathEpoch;
+    int filesystemEpoch;
+    Tcl_Obj *cwdPathPtr;
+    ClientData cwdClientData;
+    FilesystemRecord *filesystemList;
+    int claims;
+} ThreadSpecificData;
 
-/* 
- * Private functions for use in this file
- */
-static Tcl_PathType     FSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
-			    Tcl_Filesystem **filesystemPtrPtr, 
-			    int *driveNameLengthPtr));
-static Tcl_PathType     GetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
-			    Tcl_Filesystem **filesystemPtrPtr, 
-			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
-static Tcl_FSPathInFilesystemProc NativePathInFilesystem;
-static Tcl_Obj*  TclFSNormalizeAbsolutePath 
-			    _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));
 /*
- * Prototypes for procedures defined later in this file.
+ * Prototypes for functions defined later in this file.
  */
 
-static FilesystemRecord* FsGetFirstFilesystem(void);
-static void FsThrExitProc(ClientData cd);
-static Tcl_Obj* FsListMounts          _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-						   CONST char *pattern));
-static Tcl_Obj* FsAddMountsToGlobResult  _ANSI_ARGS_((Tcl_Obj *result, 
-	   Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types));
+static FilesystemRecord*FsGetFirstFilesystem(void);
+static void		FsThrExitProc(ClientData cd);
+static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
+static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
+			    Tcl_Obj *pathPtr, const char *pattern,
+			    Tcl_GlobTypeData *types);
+static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
 
-#ifdef TCL_THREADS
-static void FsRecacheFilesystemList(void);
-#endif
+static void		FsRecacheFilesystemList(void);
+static void		Claim(void);
+static void		Disclaim(void);
 
-/* 
- * These form part of the native filesystem support.  They are needed
- * here because we have a few native filesystem functions (which are
- * the same for mac/win/unix) in this file.  There is no need to place
- * them in tclInt.h, because they are not (and should not be) used
- * anywhere else.
+
+/*
+ * These form part of the native filesystem support. They are needed here
+ * because we have a few native filesystem functions (which are the same for
+ * win/unix) in this file. There is no need to place them in tclInt.h, because
+ * they are not (and should not be) used anywhere else.
  */
-extern CONST char *		tclpFileAttrStrings[];
-extern CONST TclFileAttrProcs	tclpFileAttrProcs[];
 
-/* 
- * The following functions are obsolete string based APIs, and should
- * be removed in a future release (Tcl 9 would be a good time).
+MODULE_SCOPE const char *		tclpFileAttrStrings[];
+MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];
+
+/*
+ * The following functions are obsolete string based APIs, and should be
+ * removed in a future release (Tcl 9 would be a good time).
  */
+
 
 /* Obsolete */
 int
-Tcl_Stat(path, oldStyleBuf)
-    CONST char *path;		/* Path of file to stat (in current CP). */
-    struct stat *oldStyleBuf;	/* Filled with results of stat call. */
+Tcl_Stat(
+    const char *path,		/* Path of file to stat (in current CP). */
+    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
 {
     int ret;
     Tcl_StatBuf buf;
-    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
 
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSStat(pathPtr, &buf);
     Tcl_DecrRefCount(pathPtr);
     if (ret != -1) {
 #ifndef TCL_WIDE_INT_IS_LONG
-#   define OUT_OF_RANGE(x) \
+	Tcl_WideInt tmp1, tmp2, tmp3 = 0;
+# define OUT_OF_RANGE(x) \
 	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
 	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-#if defined(__GNUC__) && __GNUC__ >= 2
-/*
- * Workaround gcc warning of "comparison is always false due to limited range of
- * data type" in this macro by checking max type size, and when necessary ANDing
- * with the complement of ULONG_MAX instead of the comparison:
- */
-#   define OUT_OF_URANGE(x) \
-	((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
-	 (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
-#else
-#   define OUT_OF_URANGE(x) \
-	(((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
-#endif
+# define OUT_OF_URANGE(x) \
+	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
 
 	/*
 	 * Perform the result-buffer overflow check manually.
 	 *
 	 * Note that ino_t/ino64_t is unsigned...
+	 *
+	 * Workaround gcc warning of "comparison is always false due to
+	 * limited range of data type" by assigning to tmp var of type
+	 * Tcl_WideInt.
 	 */
 
-        if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
-#ifdef HAVE_ST_BLOCKS
-		|| OUT_OF_RANGE(buf.st_blocks)
+        tmp1 = (Tcl_WideInt) buf.st_ino;
+        tmp2 = (Tcl_WideInt) buf.st_size;
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+        tmp3 = (Tcl_WideInt) buf.st_blocks;
 #endif
-	    ) {
-#ifdef EFBIG
+
+	if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
+#if defined(EFBIG)
 	    errno = EFBIG;
-#else
-#  ifdef EOVERFLOW
+#elif defined(EOVERFLOW)
 	    errno = EOVERFLOW;
-#  else
-#    error  "What status should be returned for file size out of range?"
-#  endif
+#else
+#error "What status should be returned for file size out of range?"
 #endif
 	    return -1;
 	}
@@ -186,27 +148,33 @@ Tcl_Stat(path, oldStyleBuf)
 #endif /* !TCL_WIDE_INT_IS_LONG */
 
 	/*
-	 * Copy across all supported fields, with possible type
-	 * coercions on those fields that change between the normal
-	 * and lf64 versions of the stat structure (on Solaris at
-	 * least.)  This is slow when the structure sizes coincide,
-	 * but that's what you get for using an obsolete interface.
+	 * Copy across all supported fields, with possible type coercions on
+	 * those fields that change between the normal and lf64 versions of
+	 * the stat structure (on Solaris at least). This is slow when the
+	 * structure sizes coincide, but that's what you get for using an
+	 * obsolete interface.
 	 */
 
-	oldStyleBuf->st_mode    = buf.st_mode;
-	oldStyleBuf->st_ino     = (ino_t) buf.st_ino;
-	oldStyleBuf->st_dev     = buf.st_dev;
-	oldStyleBuf->st_rdev    = buf.st_rdev;
-	oldStyleBuf->st_nlink   = buf.st_nlink;
-	oldStyleBuf->st_uid     = buf.st_uid;
-	oldStyleBuf->st_gid     = buf.st_gid;
-	oldStyleBuf->st_size    = (off_t) buf.st_size;
-	oldStyleBuf->st_atime   = buf.st_atime;
-	oldStyleBuf->st_mtime   = buf.st_mtime;
-	oldStyleBuf->st_ctime   = buf.st_ctime;
-#ifdef HAVE_ST_BLOCKS
-	oldStyleBuf->st_blksize = buf.st_blksize;
-	oldStyleBuf->st_blocks  = (blkcnt_t) buf.st_blocks;
+	oldStyleBuf->st_mode	= buf.st_mode;
+	oldStyleBuf->st_ino	= (ino_t) buf.st_ino;
+	oldStyleBuf->st_dev	= buf.st_dev;
+	oldStyleBuf->st_rdev	= buf.st_rdev;
+	oldStyleBuf->st_nlink	= buf.st_nlink;
+	oldStyleBuf->st_uid	= buf.st_uid;
+	oldStyleBuf->st_gid	= buf.st_gid;
+	oldStyleBuf->st_size	= (off_t) buf.st_size;
+	oldStyleBuf->st_atime	= buf.st_atime;
+	oldStyleBuf->st_mtime	= buf.st_mtime;
+	oldStyleBuf->st_ctime	= buf.st_ctime;
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
+	oldStyleBuf->st_blksize	= buf.st_blksize;
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
+#ifdef HAVE_BLKCNT_T
+	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
+#else
+	oldStyleBuf->st_blocks	= (unsigned long) buf.st_blocks;
+#endif
 #endif
     }
     return ret;
@@ -214,43 +182,45 @@ Tcl_Stat(path, oldStyleBuf)
 
 /* Obsolete */
 int
-Tcl_Access(path, mode)
-    CONST char *path;		/* Path of file to access (in current CP). */
-    int mode;                   /* Permission setting. */
+Tcl_Access(
+    const char *path,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSAccess(pathPtr,mode);
     Tcl_DecrRefCount(pathPtr);
+
     return ret;
 }
 
 /* Obsolete */
 Tcl_Channel
-Tcl_OpenFileChannel(interp, path, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-					 * can be NULL. */
-    CONST char *path;                   /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-					 * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-					 * file, with what modes to create
-					 * it? */
+Tcl_OpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    const char *path,		/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or a string such
+				 * as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
 {
     Tcl_Channel ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
     Tcl_DecrRefCount(pathPtr);
-    return ret;
 
+    return ret;
 }
 
 /* Obsolete */
 int
-Tcl_Chdir(dirName)
-    CONST char *dirName;
+Tcl_Chdir(
+    const char *dirName)
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
@@ -262,9 +232,9 @@ Tcl_Chdir(dirName)
 
 /* Obsolete */
 char *
-Tcl_GetCwd(interp, cwdPtr)
-    Tcl_Interp *interp;
-    Tcl_DString *cwdPtr;
+Tcl_GetCwd(
+    Tcl_Interp *interp,
+    Tcl_DString *cwdPtr)
 {
     Tcl_Obj *cwd;
     cwd = Tcl_FSGetCwd(interp);
@@ -280,9 +250,9 @@ Tcl_GetCwd(interp, cwdPtr)
 
 /* Obsolete */
 int
-Tcl_EvalFile(interp, fileName)
-    Tcl_Interp *interp;		/* Interpreter in which to process file. */
-    CONST char *fileName;	/* Name of file to process.  Tilde-substitution
+Tcl_EvalFile(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    const char *fileName)	/* Name of file to process. Tilde-substitution
 				 * will be performed on this name. */
 {
     int ret;
@@ -293,59 +263,58 @@ Tcl_EvalFile(interp, fileName)
     return ret;
 }
 
-
-/* 
- * The 3 hooks for Stat, Access and OpenFileChannel are obsolete.  The
- * complete, general hooked filesystem APIs should be used instead.
- * This define decides whether to include the obsolete hooks and
- * related code.  If these are removed, we'll also want to remove them
- * from stubs/tclInt.  The only known users of these APIs are prowrap
- * and mktclapp.  New code/extensions should not use them, since they
- * do not provide as full support as the full filesystem API.
- * 
- * As soon as prowrap and mktclapp are updated to use the full
- * filesystem support, I suggest all these hooks are removed.
+/*
+ * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
+ * complete, general hooked filesystem APIs should be used instead. This
+ * define decides whether to include the obsolete hooks and related code. If
+ * these are removed, we'll also want to remove them from stubs/tclInt. The
+ * only known users of these APIs are prowrap and mktclapp. New
+ * code/extensions should not use them, since they do not provide as full
+ * support as the full filesystem API.
+ *
+ * As soon as prowrap and mktclapp are updated to use the full filesystem
+ * support, I suggest all these hooks are removed.
  */
-#define USE_OBSOLETE_FS_HOOKS
 
+#undef USE_OBSOLETE_FS_HOOKS
 
 #ifdef USE_OBSOLETE_FS_HOOKS
+
 /*
- * The following typedef declarations allow for hooking into the chain
- * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
- * 'Tcl_OpenFileChannel(...)'.  Basically for each hookable function
- * a linked list is defined.
+ * The following typedef declarations allow for hooking into the chain of
+ * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
+ * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
+ * list is defined.
  */
 
 typedef struct StatProc {
-    TclStatProc_ *proc;		 /* Function to process a 'stat()' call */
-    struct StatProc *nextPtr;    /* The next 'stat()' function to call */
+    TclStatProc_ *proc;		/* Function to process a 'stat()' call */
+    struct StatProc *nextPtr;	/* The next 'stat()' function to call */
 } StatProc;
 
 typedef struct AccessProc {
-    TclAccessProc_ *proc;	 /* Function to process a 'access()' call */
-    struct AccessProc *nextPtr;  /* The next 'access()' function to call */
+    TclAccessProc_ *proc;	/* Function to process a 'access()' call */
+    struct AccessProc *nextPtr;	/* The next 'access()' function to call */
 } AccessProc;
 
 typedef struct OpenFileChannelProc {
-    TclOpenFileChannelProc_ *proc;  /* Function to process a
-				     * 'Tcl_OpenFileChannel()' call */
+    TclOpenFileChannelProc_ *proc;
+				/* Function to process a
+				 * 'Tcl_OpenFileChannel()' call */
     struct OpenFileChannelProc *nextPtr;
-				    /* The next 'Tcl_OpenFileChannel()'
-				     * function to call */
+				/* The next 'Tcl_OpenFileChannel()' function
+				 * to call */
 } OpenFileChannelProc;
 
 /*
- * For each type of (obsolete) hookable function, a static node is
- * declared to hold the function pointer for the "built-in" routine
- * (e.g. 'TclpStat(...)') and the respective list is initialized as a
- * pointer to that node.
- * 
- * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
- * these statically declared list entry cannot be inadvertently removed.
+ * For each type of (obsolete) hookable function, a static node is declared to
+ * hold the function pointer for the "built-in" routine (e.g. 'TclpStat(...)')
+ * and the respective list is initialized as a pointer to that node.
  *
- * This method avoids the need to call any sort of "initialization"
- * function.
+ * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that these
+ * statically declared list entry cannot be inadvertently removed.
+ *
+ * This method avoids the need to call any sort of "initialization" function.
  *
  * All three lists are protected by a global obsoleteFsHookMutex.
  */
@@ -358,71 +327,69 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
 
 #endif /* USE_OBSOLETE_FS_HOOKS */
 
-/* 
- * Declare the native filesystem support.  These functions should
- * be considered private to Tcl, and should really not be called
- * directly by any code other than this file (i.e. neither by
- * Tcl's core nor by extensions).  Similarly, the old string-based
- * Tclp... native filesystem functions should not be called.
- * 
- * The correct API to use now is the Tcl_FS... set of functions,
- * which ensure correct and complete virtual filesystem support.
- * 
- * We cannot make all of these static, since some of them
- * are implemented in the platform-specific directories.
+/*
+ * Declare the native filesystem support. These functions should be considered
+ * private to Tcl, and should really not be called directly by any code other
+ * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
+ * the old string-based Tclp... native filesystem functions should not be
+ * called.
+ *
+ * The correct API to use now is the Tcl_FS... set of functions, which ensure
+ * correct and complete virtual filesystem support.
+ *
+ * We cannot make all of these static, since some of them are implemented in
+ * the platform-specific directories.
  */
+
 static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
 static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
 static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
-static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
-static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
-
-/* 
- * The only reason these functions are not static is that they
- * are either called by code in the native (win/unix/mac) directories
- * or they are actually implemented in those directories.  They
- * should simply not be called by code outside Tcl's native
- * filesystem core.  i.e. they should be considered 'static' to
- * Tcl's filesystem code (if we ever built the native filesystem
- * support into a separate code library, this could actually be
- * enforced).
+static Tcl_FSFileAttrsGetProc	NativeFileAttrsGet;
+static Tcl_FSFileAttrsSetProc	NativeFileAttrsSet;
+
+/*
+ * The only reason these functions are not static is that they are either
+ * called by code in the native (win/unix) directories or they are actually
+ * implemented in those directories. They should simply not be called by code
+ * outside Tcl's native filesystem core i.e. they should be considered
+ * 'static' to Tcl's filesystem code (if we ever built the native filesystem
+ * support into a separate code library, this could actually be enforced).
  */
-Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
-Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
-Tcl_FSStatProc TclpObjStat;
-Tcl_FSAccessProc TclpObjAccess;	    
-Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;  
-Tcl_FSGetCwdProc TclpObjGetCwd;     
-Tcl_FSChdirProc TclpObjChdir;	    
-Tcl_FSLstatProc TclpObjLstat;	    
-Tcl_FSCopyFileProc TclpObjCopyFile; 
-Tcl_FSDeleteFileProc TclpObjDeleteFile;	    
-Tcl_FSRenameFileProc TclpObjRenameFile;	    
-Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;	    
-Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;	    
-Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;	    
-Tcl_FSUnloadFileProc TclpUnloadFile;	    
-Tcl_FSLinkProc TclpObjLink; 
-Tcl_FSListVolumesProc TclpObjListVolumes;	    
-
-/* 
- * Define the native filesystem dispatch table.  If necessary, it
- * is ok to make this non-static, but it should only be accessed
- * by the functions actually listed within it (or perhaps other
- * helper functions of them).  Anything which is not part of this
- * 'native filesystem implementation' should not be delving inside
- * here!
+
+Tcl_FSFilesystemPathTypeProc	TclpFilesystemPathType;
+Tcl_FSInternalToNormalizedProc	TclpNativeToNormalized;
+Tcl_FSStatProc			TclpObjStat;
+Tcl_FSAccessProc		TclpObjAccess;
+Tcl_FSMatchInDirectoryProc	TclpMatchInDirectory;
+Tcl_FSChdirProc			TclpObjChdir;
+Tcl_FSLstatProc			TclpObjLstat;
+Tcl_FSCopyFileProc		TclpObjCopyFile;
+Tcl_FSDeleteFileProc		TclpObjDeleteFile;
+Tcl_FSRenameFileProc		TclpObjRenameFile;
+Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
+Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
+Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
+Tcl_FSUnloadFileProc		TclpUnloadFile;
+Tcl_FSLinkProc			TclpObjLink;
+Tcl_FSListVolumesProc		TclpObjListVolumes;
+
+/*
+ * Define the native filesystem dispatch table. If necessary, it is ok to make
+ * this non-static, but it should only be accessed by the functions actually
+ * listed within it (or perhaps other helper functions of them). Anything
+ * which is not part of this 'native filesystem implementation' should not be
+ * delving inside here!
  */
+
 Tcl_Filesystem tclNativeFilesystem = {
     "native",
     sizeof(Tcl_Filesystem),
-    TCL_FILESYSTEM_VERSION_1,
-    &NativePathInFilesystem,
+    TCL_FILESYSTEM_VERSION_2,
+    &TclNativePathInFilesystem,
     &TclNativeDupInternalRep,
     &NativeFreeInternalRep,
     &TclpNativeToNormalized,
-    &NativeCreateNativeRep,
+    &TclNativeCreateNativeRep,
     &TclpObjNormalizePath,
     &TclpFilesystemPathType,
     &NativeFilesystemSeparator,
@@ -441,238 +408,336 @@ Tcl_Filesystem tclNativeFilesystem = {
     &NativeFileAttrsGet,
     &NativeFileAttrsSet,
     &TclpObjCreateDirectory,
-    &TclpObjRemoveDirectory, 
+    &TclpObjRemoveDirectory,
     &TclpObjDeleteFile,
     &TclpObjCopyFile,
     &TclpObjRenameFile,
-    &TclpObjCopyDirectory, 
+    &TclpObjCopyDirectory,
     &TclpObjLstat,
     &TclpDlopen,
-    &TclpObjGetCwd,
+    /* Needs a cast since we're using version_2 */
+    (Tcl_FSGetCwdProc *) &TclpGetNativeCwd,
     &TclpObjChdir
 };
 
-/* 
- * Define the tail of the linked list.  Note that for unconventional
- * uses of Tcl without a native filesystem, we may in the future wish
- * to modify the current approach of hard-coding the native filesystem
- * in the lookup list 'filesystemList' below.
- * 
- * We initialize the record so that it thinks one file uses it.  This
- * means it will never be freed.
+/*
+ * Define the tail of the linked list. Note that for unconventional uses of
+ * Tcl without a native filesystem, we may in the future wish to modify the
+ * current approach of hard-coding the native filesystem in the lookup list
+ * 'filesystemList' below.
+ *
+ * We initialize the record so that it thinks one file uses it. This means it
+ * will never be freed.
  */
+
 static FilesystemRecord nativeFilesystemRecord = {
     NULL,
     &tclNativeFilesystem,
-    1,
     NULL,
     NULL
 };
 
-/* 
- * This is incremented each time we modify the linked list of
- * filesystems.  Any time it changes, all cached filesystem
- * representations are suspect and must be freed.
- * For multithreading builds, change of the filesystem epoch
- * will trigger cache cleanup in all threads.  
+/*
+ * This is incremented each time we modify the linked list of filesystems. Any
+ * time it changes, all cached filesystem representations are suspect and must
+ * be freed. For multithreading builds, change of the filesystem epoch will
+ * trigger cache cleanup in all threads.
  */
-int theFilesystemEpoch = 0;
+
+static int theFilesystemEpoch = 1;
 
 /*
- * Stores the linked list of filesystems. A 1:1 copy of this
- * list is also maintained in the TSD for each thread. This
- * is to avoid synchronization issues.
+ * Stores the linked list of filesystems. A 1:1 copy of this list is also
+ * maintained in the TSD for each thread. This is to avoid synchronization
+ * issues.
  */
-static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
 
+static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
 TCL_DECLARE_MUTEX(filesystemMutex)
 
-/* 
+/*
  * Used to implement Tcl_FSGetCwd in a file-system independent way.
  */
+
 static Tcl_Obj* cwdPathPtr = NULL;
 static int cwdPathEpoch = 0;
+static ClientData cwdClientData = NULL;
 TCL_DECLARE_MUTEX(cwdMutex)
 
-/*
- * This structure holds per-thread private copies of
- * some global data. This way we avoid most of the
- * synchronization calls which boosts performance, at
- * cost of having to update this information each
- * time the corresponding epoch counter changes.
- * 
- */
-typedef struct ThreadSpecificData {
-    int initialized;
-    int cwdPathEpoch;
-    int filesystemEpoch; 
-    Tcl_Obj *cwdPathPtr;
-    FilesystemRecord *filesystemList;
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/* 
- * Declare fallback support function and 
- * information for Tcl_FSLoadFile 
- */
-static Tcl_FSUnloadFileProc FSUnloadTempFile;
+static Tcl_ThreadDataKey fsDataKey;
 
 /*
- * One of these structures is used each time we successfully load a
- * file from a file system by way of making a temporary copy of the
- * file on the native filesystem.  We need to store both the actual
- * unloadProc/clientData combination which was used, and the original
- * and modified filenames, so that we can correctly undo the entire
- * operation when we want to unload the code.
+ * One of these structures is used each time we successfully load a file from
+ * a file system by way of making a temporary copy of the file on the native
+ * filesystem. We need to store both the actual unloadProc/clientData
+ * combination which was used, and the original and modified filenames, so
+ * that we can correctly undo the entire operation when we want to unload the
+ * code.
  */
+
 typedef struct FsDivertLoad {
     Tcl_LoadHandle loadHandle;
-    Tcl_FSUnloadFileProc *unloadProcPtr;	
+    Tcl_FSUnloadFileProc *unloadProcPtr;
     Tcl_Obj *divertedFile;
-    Tcl_Filesystem *divertedFilesystem;
+    const Tcl_Filesystem *divertedFilesystem;
     ClientData divertedFileNativeRep;
 } FsDivertLoad;
-
-/* Now move on to the basic filesystem implementation */
+
+/*
+ * Now move on to the basic filesystem implementation
+ */
 
 static void
-FsThrExitProc(cd)
-    ClientData cd;
+FsThrExitProc(
+    ClientData cd)
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd;
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
     FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
 
-    /* Trash the cwd copy */
+    /*
+     * Trash the cwd copy.
+     */
+
     if (tsdPtr->cwdPathPtr != NULL) {
 	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
 	tsdPtr->cwdPathPtr = NULL;
     }
-    /* Trash the filesystems cache */
+    if (tsdPtr->cwdClientData != NULL) {
+	NativeFreeInternalRep(tsdPtr->cwdClientData);
+    }
+
+    /*
+     * Trash the filesystems cache.
+     */
+
     fsRecPtr = tsdPtr->filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr->nextPtr;
-	if (--fsRecPtr->fileRefCount <= 0) {
-	    ckfree((char *)fsRecPtr);
-	}
+	fsRecPtr->fsPtr = NULL;
+	ckfree((char *)fsRecPtr);
 	fsRecPtr = tmpFsRecPtr;
     }
+    tsdPtr->filesystemList = NULL;
     tsdPtr->initialized = 0;
 }
 
-int 
-TclFSCwdPointerEquals(objPtr)
-    Tcl_Obj* objPtr;
+int
+TclFSCwdIsNative(void)
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
+    if (tsdPtr->cwdClientData != NULL) {
+	return 1;
+    } else {
+	return 0;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFSCwdPointerEquals --
+ *
+ *	Check whether the current working directory is equal to the path
+ *	given.
+ *
+ * Results:
+ *	1 (equal) or 0 (un-equal) as appropriate.
+ *
+ * Side effects:
+ *	If the paths are equal, but are not the same object, this method will
+ *	modify the given pathPtrPtr to refer to the same object. In this case
+ *	the object pointed to by pathPtrPtr will have its refCount
+ *	decremented, and it will be adjusted to point to the cwd (with a new
+ *	refCount).
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFSCwdPointerEquals(
+    Tcl_Obj** pathPtrPtr)
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 
     Tcl_MutexLock(&cwdMutex);
-    if (tsdPtr->cwdPathPtr == NULL) {
+    if (tsdPtr->cwdPathPtr == NULL
+	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
+	if (tsdPtr->cwdPathPtr != NULL) {
+	    Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
+	}
+	if (tsdPtr->cwdClientData != NULL) {
+	    NativeFreeInternalRep(tsdPtr->cwdClientData);
+	}
 	if (cwdPathPtr == NULL) {
 	    tsdPtr->cwdPathPtr = NULL;
 	} else {
 	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
 	}
-	tsdPtr->cwdPathEpoch = cwdPathEpoch;
-    } else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) { 
-	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
-	if (cwdPathPtr == NULL) {
-	    tsdPtr->cwdPathPtr = NULL;
+	if (cwdClientData == NULL) {
+	    tsdPtr->cwdClientData = NULL;
 	} else {
-	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
-	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
+	    tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData);
 	}
+	tsdPtr->cwdPathEpoch = cwdPathEpoch;
     }
     Tcl_MutexUnlock(&cwdMutex);
 
     if (tsdPtr->initialized == 0) {
-	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
 	tsdPtr->initialized = 1;
     }
-    return (tsdPtr->cwdPathPtr == objPtr); 
+
+    if (pathPtrPtr == NULL) {
+	return (tsdPtr->cwdPathPtr == NULL);
+    }
+
+    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
+	return 1;
+    } else {
+	int len1, len2;
+	const char *str1, *str2;
+
+	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
+	if (len1 == len2 && !strcmp(str1,str2)) {
+	    /*
+	     * They are equal, but different objects. Update so they will be
+	     * the same object in the future.
+	     */
+
+	    Tcl_DecrRefCount(*pathPtrPtr);
+	    *pathPtrPtr = tsdPtr->cwdPathPtr;
+	    Tcl_IncrRefCount(*pathPtrPtr);
+	    return 1;
+	} else {
+	    return 0;
+	}
+    }
 }
-#ifdef TCL_THREADS
 
 static void
 FsRecacheFilesystemList(void)
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;
+
+    /*
+     * Trash the current cache.
+     */
 
-    /* Trash the current cache */
     fsRecPtr = tsdPtr->filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr->nextPtr;
-	if (--fsRecPtr->fileRefCount <= 0) {
-	    ckfree((char *)fsRecPtr);
-	}
+	fsRecPtr->nextPtr = toFree;
+	toFree = fsRecPtr;
 	fsRecPtr = tmpFsRecPtr;
     }
-    tsdPtr->filesystemList = NULL;
 
     /*
-     * Code below operates on shared data. We
-     * are already called under mutex lock so   
-     * we can safely proceed.
+     * Locate tail of the global filesystem list.
      */
 
-    /* Locate tail of the global filesystem list */
+    Tcl_MutexLock(&filesystemMutex);
     fsRecPtr = filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr;
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
-    /* Refill the cache honouring the order */
+
+    /*
+     * Refill the cache honouring the order.
+     */
+
+    list = NULL;
     fsRecPtr = tmpFsRecPtr;
     while (fsRecPtr != NULL) {
-	tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));
+	tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
 	*tmpFsRecPtr = *fsRecPtr;
-	tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
+	tmpFsRecPtr->nextPtr = list;
 	tmpFsRecPtr->prevPtr = NULL;
-	if (tsdPtr->filesystemList) {
-	    tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
-	}
-	tsdPtr->filesystemList = tmpFsRecPtr;
-        fsRecPtr = fsRecPtr->prevPtr;
+	list = tmpFsRecPtr;
+	fsRecPtr = fsRecPtr->prevPtr;
+    }
+    tsdPtr->filesystemList = list;
+    tsdPtr->filesystemEpoch = theFilesystemEpoch;
+    Tcl_MutexUnlock(&filesystemMutex);
+
+    while (toFree) {
+	FilesystemRecord *next = toFree->nextPtr;
+	toFree->fsPtr = NULL;
+	ckfree((char *)toFree);
+	toFree = next;
     }
 
-    /* Make sure the above gets released on thread exit */
+    /*
+     * Make sure the above gets released on thread exit.
+     */
+
     if (tsdPtr->initialized == 0) {
-	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
 	tsdPtr->initialized = 1;
     }
 }
-#endif
 
 static FilesystemRecord *
-FsGetFirstFilesystem(void) {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    FilesystemRecord *fsRecPtr;
-#ifndef TCL_THREADS
-    tsdPtr->filesystemEpoch = theFilesystemEpoch;
-    fsRecPtr = filesystemList;
-#else
-    Tcl_MutexLock(&filesystemMutex);
-    if (tsdPtr->filesystemList == NULL
-	    || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
- 	FsRecacheFilesystemList();
-	tsdPtr->filesystemEpoch = theFilesystemEpoch;
+FsGetFirstFilesystem(void)
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+    if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
+	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
+	FsRecacheFilesystemList();
     }
-    Tcl_MutexUnlock(&filesystemMutex);
-    fsRecPtr = tsdPtr->filesystemList;
-#endif
-    return fsRecPtr;
+    return tsdPtr->filesystemList;
+}
+
+/*
+ * The epoch can be changed both by filesystems being added or removed and by
+ * env(HOME) changing.
+ */
+
+int
+TclFSEpochOk(
+    int filesystemEpoch)
+{
+    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
+}
+
+static void
+Claim()
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+    tsdPtr->claims++;
+}
+
+static void
+Disclaim()
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+    tsdPtr->claims--;
 }
+
+int
+TclFSEpoch()
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+    return tsdPtr->filesystemEpoch;
+}
+
 
+/*
+ * If non-NULL, clientData is owned by us and must be freed later.
+ */
+
 static void
-FsUpdateCwd(cwdObj)
-    Tcl_Obj *cwdObj;
+FsUpdateCwd(
+    Tcl_Obj *cwdObj,
+    ClientData clientData)
 {
     int len;
     char *str = NULL;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 
     if (cwdObj != NULL) {
 	str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -680,26 +745,42 @@ FsUpdateCwd(cwdObj)
 
     Tcl_MutexLock(&cwdMutex);
     if (cwdPathPtr != NULL) {
-        Tcl_DecrRefCount(cwdPathPtr);
+	Tcl_DecrRefCount(cwdPathPtr);
     }
+    if (cwdClientData != NULL) {
+	NativeFreeInternalRep(cwdClientData);
+    }
+
     if (cwdObj == NULL) {
 	cwdPathPtr = NULL;
+	cwdClientData = NULL;
     } else {
-	/* This MUST be stored as string object! */
-	cwdPathPtr = Tcl_NewStringObj(str, len); 
+	/*
+	 * This must be stored as string obj!
+	 */
+
+	cwdPathPtr = Tcl_NewStringObj(str, len);
     	Tcl_IncrRefCount(cwdPathPtr);
+	cwdClientData = TclNativeDupInternalRep(clientData);
     }
+
     cwdPathEpoch++;
     tsdPtr->cwdPathEpoch = cwdPathEpoch;
     Tcl_MutexUnlock(&cwdMutex);
 
     if (tsdPtr->cwdPathPtr) {
-        Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
+	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
     }
+    if (tsdPtr->cwdClientData) {
+	NativeFreeInternalRep(tsdPtr->cwdClientData);
+    }
+
     if (cwdObj == NULL) {
 	tsdPtr->cwdPathPtr = NULL;
+	tsdPtr->cwdClientData = NULL;
     } else {
-	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); 
+	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
+	tsdPtr->cwdClientData = clientData;
 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
     }
 }
@@ -709,12 +790,12 @@ FsUpdateCwd(cwdObj)
  *
  * TclFinalizeFilesystem --
  *
- *	Clean up the filesystem.  After this, calls to all Tcl_FS...
- *	functions will fail.
- *	
- *	We will later call TclResetFilesystem to restore the FS
- *	to a pristine state.
- *	
+ *	Clean up the filesystem. After this, calls to all Tcl_FS... functions
+ *	will fail.
+ *
+ *	We will later call TclResetFilesystem to restore the FS to a pristine
+ *	state.
+ *
  * Results:
  *	None.
  *
@@ -725,47 +806,54 @@ FsUpdateCwd(cwdObj)
  */
 
 void
-TclFinalizeFilesystem()
+TclFinalizeFilesystem(void)
 {
     FilesystemRecord *fsRecPtr;
 
-    /* 
-     * Assumption that only one thread is active now.  Otherwise
-     * we would need to put various mutexes around this code.
+    /*
+     * Assumption that only one thread is active now. Otherwise we would need
+     * to put various mutexes around this code.
      */
-    
+
     if (cwdPathPtr != NULL) {
 	Tcl_DecrRefCount(cwdPathPtr);
 	cwdPathPtr = NULL;
-        cwdPathEpoch = 0;
+	cwdPathEpoch = 0;
+    }
+    if (cwdClientData != NULL) {
+	NativeFreeInternalRep(cwdClientData);
+	cwdClientData = NULL;
     }
 
-    /* 
-     * Remove all filesystems, freeing any allocated memory
-     * that is no longer needed
+    /*
+     * Remove all filesystems, freeing any allocated memory that is no longer
+     * needed
      */
 
     fsRecPtr = filesystemList;
     while (fsRecPtr != NULL) {
 	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
-	if (fsRecPtr->fileRefCount <= 0) {
-	    /* The native filesystem is static, so we don't free it */
-	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
-		ckfree((char *)fsRecPtr);
-	    }
+
+	/* The native filesystem is static, so we don't free it. */
+
+	if (fsRecPtr != &nativeFilesystemRecord) {
+	    ckfree((char *)fsRecPtr);
 	}
 	fsRecPtr = tmpFsRecPtr;
     }
+    theFilesystemEpoch++;
     filesystemList = NULL;
 
     /*
-     * Now filesystemList is NULL.  This means that any attempt
-     * to use the filesystem is likely to fail.
+     * Now filesystemList is NULL. This means that any attempt to use the
+     * filesystem is likely to fail.
      */
 
+#ifdef USE_OBSOLETE_FS_HOOKS
     statProcList = NULL;
     accessProcList = NULL;
     openFileChannelProcList = NULL;
+#endif
 #ifdef __WIN32__
     TclWinEncodingsCleanup();
 #endif
@@ -777,7 +865,7 @@ TclFinalizeFilesystem()
  * TclResetFilesystem --
  *
  *	Restore the filesystem to a pristine state.
- *	
+ *
  * Results:
  *	None.
  *
@@ -788,22 +876,17 @@ TclFinalizeFilesystem()
  */
 
 void
-TclResetFilesystem()
+TclResetFilesystem(void)
 {
     filesystemList = &nativeFilesystemRecord;
+    theFilesystemEpoch++;
 
-    /* 
-     * Note, at this point, I believe nativeFilesystemRecord ->
-     * fileRefCount should equal 1 and if not, we should try to track
-     * down the cause.
-     */
-    
 #ifdef __WIN32__
-    /* 
-     * Cleans up the win32 API filesystem proc lookup table. This must
-     * happen very late in finalization so that deleting of copied
-     * dlls can occur.
+    /*
+     * Cleans up the win32 API filesystem proc lookup table. This must happen
+     * very late in finalization so that deleting of copied dlls can occur.
      */
+
     TclWinResetInterfaces();
 #endif
 }
@@ -813,36 +896,35 @@ TclResetFilesystem()
  *
  * Tcl_FSRegister --
  *
- *    Insert the filesystem function table at the head of the list of
- *    functions which are used during calls to all file-system
- *    operations.  The filesystem will be added even if it is 
- *    already in the list.  (You can use Tcl_FSData to
- *    check if it is in the list, provided the ClientData used was
- *    not NULL).
- *    
- *    Note that the filesystem handling is head-to-tail of the list.
- *    Each filesystem is asked in turn whether it can handle a
- *    particular request, _until_ one of them says 'yes'. At that
- *    point no further filesystems are asked.
- *    
- *    In particular this means if you want to add a diagnostic
- *    filesystem (which simply reports all fs activity), it must be 
- *    at the head of the list: i.e. it must be the last registered.
+ *	Insert the filesystem function table at the head of the list of
+ *	functions which are used during calls to all file-system operations.
+ *	The filesystem will be added even if it is already in the list. (You
+ *	can use Tcl_FSData to check if it is in the list, provided the
+ *	ClientData used was not NULL).
+ *
+ *	Note that the filesystem handling is head-to-tail of the list. Each
+ *	filesystem is asked in turn whether it can handle a particular
+ *	request, until one of them says 'yes'. At that point no further
+ *	filesystems are asked.
+ *
+ *	In particular this means if you want to add a diagnostic filesystem
+ *	(which simply reports all fs activity), it must be at the head of the
+ *	list: i.e. it must be the last registered.
  *
  * Results:
- *    Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- *    could not be allocated.
+ *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ *	not be allocated.
  *
  * Side effects:
- *    Memory allocated and modifies the link list for filesystems.
+ *	Memory allocated and modifies the link list for filesystems.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSRegister(clientData, fsPtr)
-    ClientData clientData;    /* Client specific data for this fs */
-    Tcl_Filesystem  *fsPtr;   /* The filesystem record for the new fs. */
+Tcl_FSRegister(
+    ClientData clientData,	/* Client specific data for this fs */
+    Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
 {
     FilesystemRecord *newFilesystemPtr;
 
@@ -854,25 +936,20 @@ Tcl_FSRegister(clientData, fsPtr)
 
     newFilesystemPtr->clientData = clientData;
     newFilesystemPtr->fsPtr = fsPtr;
-    /* 
-     * We start with a refCount of 1.  If this drops to zero, then
-     * anyone is welcome to ckfree us.
-     */
-    newFilesystemPtr->fileRefCount = 1;
-
-    /* 
-     * Is this lock and wait strictly speaking necessary?  Since any
-     * iterators out there will have grabbed a copy of the head of
-     * the list and be iterating away from that, if we add a new
-     * element to the head of the list, it can't possibly have any
-     * effect on any of their loops.  In fact it could be better not
-     * to wait, since we are adjusting the filesystem epoch, any
-     * cached representations calculated by existing iterators are
+
+    /*
+     * Is this lock and wait strictly speaking necessary? Since any iterators
+     * out there will have grabbed a copy of the head of the list and be
+     * iterating away from that, if we add a new element to the head of the
+     * list, it can't possibly have any effect on any of their loops. In fact
+     * it could be better not to wait, since we are adjusting the filesystem
+     * epoch, any cached representations calculated by existing iterators are
      * going to have to be thrown away anyway.
-     * 
-     * However, since registering and unregistering filesystems is
-     * a very rare action, this is not a very important point.
+     *
+     * However, since registering and unregistering filesystems is a very rare
+     * action, this is not a very important point.
      */
+
     Tcl_MutexLock(&filesystemMutex);
 
     newFilesystemPtr->nextPtr = filesystemList;
@@ -882,10 +959,11 @@ Tcl_FSRegister(clientData, fsPtr)
     }
     filesystemList = newFilesystemPtr;
 
-    /* 
-     * Increment the filesystem epoch counter, since existing paths
-     * might conceivably now belong to different filesystems.
+    /*
+     * Increment the filesystem epoch counter, since existing paths might
+     * conceivably now belong to different filesystems.
      */
+
     theFilesystemEpoch++;
     Tcl_MutexUnlock(&filesystemMutex);
 
@@ -897,29 +975,28 @@ Tcl_FSRegister(clientData, fsPtr)
  *
  * Tcl_FSUnregister --
  *
- *    Remove the passed filesystem from the list of filesystem
- *    function tables.  It also ensures that the built-in
- *    (native) filesystem is not removable, although we may wish
- *    to change that decision in the future to allow a smaller
- *    Tcl core, in which the native filesystem is not used at
- *    all (we could, say, initialise Tcl completely over a network
- *    connection).
+ *	Remove the passed filesystem from the list of filesystem function
+ *	tables. It also ensures that the built-in (native) filesystem is not
+ *	removable, although we may wish to change that decision in the future
+ *	to allow a smaller Tcl core, in which the native filesystem is not
+ *	used at all (we could, say, initialise Tcl completely over a network
+ *	connection).
  *
  * Results:
- *    TCL_OK if the procedure pointer was successfully removed,
- *    TCL_ERROR otherwise.
+ *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
+ *	otherwise.
  *
  * Side effects:
- *    Memory may be deallocated (or will be later, once no "path" 
- *    objects refer to this filesystem), but the list of registered
- *    filesystems is updated immediately.
+ *	Memory may be deallocated (or will be later, once no "path" objects
+ *	refer to this filesystem), but the list of registered filesystems is
+ *	updated immediately.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSUnregister(fsPtr)
-    Tcl_Filesystem  *fsPtr;   /* The filesystem record to remove. */
+Tcl_FSUnregister(
+    Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
 {
     int retVal = TCL_ERROR;
     FilesystemRecord *fsRecPtr;
@@ -927,13 +1004,13 @@ Tcl_FSUnregister(fsPtr)
     Tcl_MutexLock(&filesystemMutex);
 
     /*
-     * Traverse the 'filesystemList' looking for the particular node
-     * whose 'fsPtr' member matches 'fsPtr' and remove that one from
-     * the list.  Ensure that the "default" node cannot be removed.
+     * Traverse the 'filesystemList' looking for the particular node whose
+     * 'fsPtr' member matches 'fsPtr' and remove that one from the list.
+     * Ensure that the "default" node cannot be removed.
      */
 
     fsRecPtr = filesystemList;
-    while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {
+    while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) {
 	if (fsRecPtr->fsPtr == fsPtr) {
 	    if (fsRecPtr->prevPtr) {
 		fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
@@ -943,20 +1020,18 @@ Tcl_FSUnregister(fsPtr)
 	    if (fsRecPtr->nextPtr) {
 		fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;
 	    }
-	    /* 
-	     * Increment the filesystem epoch counter, since existing
-	     * paths might conceivably now belong to different
-	     * filesystems.  This should also ensure that paths which
-	     * have cached the filesystem which is about to be deleted
-	     * do not reference that filesystem (which would of course
-	     * lead to memory exceptions).
+
+	    /*
+	     * Increment the filesystem epoch counter, since existing paths
+	     * might conceivably now belong to different filesystems. This
+	     * should also ensure that paths which have cached the filesystem
+	     * which is about to be deleted do not reference that filesystem
+	     * (which would of course lead to memory exceptions).
 	     */
+
 	    theFilesystemEpoch++;
-	    
-	    fsRecPtr->fileRefCount--;
-	    if (fsRecPtr->fileRefCount <= 0) {
-	        ckfree((char *)fsRecPtr);
-	    }
+
+	    ckfree((char *)fsRecPtr);
 
 	    retVal = TCL_OK;
 	} else {
@@ -965,7 +1040,7 @@ Tcl_FSUnregister(fsPtr)
     }
 
     Tcl_MutexUnlock(&filesystemMutex);
-    return (retVal);
+    return retVal;
 }
 
 /*
@@ -973,132 +1048,145 @@ Tcl_FSUnregister(fsPtr)
  *
  * Tcl_FSMatchInDirectory --
  *
- *	This routine is used by the globbing code to search a directory
- *	for all files which match a given pattern.  The appropriate
- *	function for the filesystem to which pathPtr belongs will be
- *	called.  If pathPtr does not belong to any filesystem and if it
- *	is NULL or the empty string, then we assume the pattern is to be
- *	matched in the current working directory.  To avoid each
- *	filesystem's Tcl_FSMatchInDirectoryProc having to deal with this
- *	issue, we create a pathPtr on the fly (equal to the cwd), and
- *	then remove it from the results returned.  This makes filesystems
- *	easy to write, since they can assume the pathPtr passed to them
- *	is an ordinary path.  In fact this means we could remove such
- *	special case handling from Tcl's native filesystems.
- *	
- *	If 'pattern' is NULL, then pathPtr is assumed to be a fully
- *	specified path of a single file/directory which must be
- *	checked for existence and correct type.
- *
- * Results: 
- *	
- *	The return value is a standard Tcl result indicating whether an
- *	error occurred in globbing.  Error messages are placed in
- *	interp, but good results are placed in the resultPtr given.
- *	
+ *	This routine is used by the globbing code to search a directory for
+ *	all files which match a given pattern. The appropriate function for
+ *	the filesystem to which pathPtr belongs will be called. If pathPtr
+ *	does not belong to any filesystem and if it is NULL or the empty
+ *	string, then we assume the pattern is to be matched in the current
+ *	working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
+ *	each filesystem from having to deal with this issue, we create a
+ *	pathPtr on the fly (equal to the cwd), and then remove it from the
+ *	results returned. This makes filesystems easy to write, since they can
+ *	assume the pathPtr passed to them is an ordinary path. In fact this
+ *	means we could remove such special case handling from Tcl's native
+ *	filesystems.
+ *
+ *	If 'pattern' is NULL, then pathPtr is assumed to be a fully specified
+ *	path of a single file/directory which must be checked for existence
+ *	and correct type.
+ *
+ * Results:
+ *
+ *	The return value is a standard Tcl result indicating whether an error
+ *	occurred in globbing. Error messages are placed in interp, but good
+ *	results are placed in the resultPtr given.
+ *
  *	Recursive searches, e.g.
- *	
- *	   glob -dir $dir -join * pkgIndex.tcl
- *	   
- *	which must recurse through each directory matching '*' are
- *	handled internally by Tcl, by passing specific flags in a 
- *	modified 'types' parameter.  This means the actual filesystem
- *	only ever sees patterns which match in a single directory.
+ *		glob -dir $dir -join * pkgIndex.tcl
+ *	which must recurse through each directory matching '*' are handled
+ *	internally by Tcl, by passing specific flags in a modified 'types'
+ *	parameter. This means the actual filesystem only ever sees patterns
+ *	which match in a single directory.
  *
  * Side effects:
  *	The interpreter may have an error message inserted into it.
  *
- *---------------------------------------------------------------------- 
+ *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
-    Tcl_Interp *interp;		/* Interpreter to receive error messages. */
-    Tcl_Obj *result;		/* List object to receive results. */
-    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
-    CONST char *pattern;	/* Pattern to match against. */
-    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
+Tcl_FSMatchInDirectory(
+    Tcl_Interp *interp,		/* Interpreter to receive error messages, but
+                       		 * may be NULL. */
+    Tcl_Obj *resultPtr,		/* List object to receive results. */
+    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
+    const char *pattern,	/* Pattern to match against. */
+    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr;
+    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
+    int resLength, i, ret = -1;
+
+    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+	/*
+	 * We don't currently allow querying of mounts by external code (a
+	 * valuable future step), so since we're the only function that
+	 * actually knows about mounts, this means we're being called
+	 * recursively by ourself. Return no matches.
+	 */
+
+	return TCL_OK;
+    }
+
+    if (pathPtr != NULL) {
+	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    } else {
+	fsPtr = NULL;
+    }
+
+    /*
+     * Check if we've successfully mapped the path to a filesystem within
+     * which to search.
+     */
+
     if (fsPtr != NULL) {
-	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
-	if (proc != NULL) {
-	    int ret = (*proc)(interp, result, pathPtr, pattern, types);
-	    if (ret == TCL_OK && pattern != NULL) {
-		result = FsAddMountsToGlobResult(result, pathPtr, 
-						 pattern, types);
-	    }
-	    return ret;
+	if (fsPtr->matchInDirectoryProc == NULL) {
+	    Tcl_SetErrno(ENOENT);
+	    return -1;
 	}
-    } else {
-	Tcl_Obj* cwd;
-	int ret = -1;
-	if (pathPtr != NULL) {
-	    int len;
-	    Tcl_GetStringFromObj(pathPtr,&len);
-	    if (len != 0) {
-		/* 
-		 * We have no idea how to match files in a directory
-		 * which belongs to no known filesystem
-		 */
-		Tcl_SetErrno(ENOENT);
-		return -1;
-	    }
+	ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
+		pattern, types);
+	if (ret == TCL_OK && pattern != NULL) {
+	    FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
 	}
-	/* 
-	 * We have an empty or NULL path.  This is defined to mean we
-	 * must search for files within the current 'cwd'.  We
-	 * therefore use that, but then since the proc we call will
-	 * return results which include the cwd we must then trim it
-	 * off the front of each path in the result.  We choose to deal
-	 * with this here (in the generic code), since if we don't,
-	 * every single filesystem's implementation of
-	 * Tcl_FSMatchInDirectory will have to deal with it for us.
-	 */
-	cwd = Tcl_FSGetCwd(NULL);
-	if (cwd == NULL) {
-	    if (interp != NULL) {
-		Tcl_SetResult(interp, "glob couldn't determine "
-			  "the current working directory", TCL_STATIC);
-	    }
-	    return TCL_ERROR;
+	return ret;
+    }
+
+    /*
+     * If the path isn't empty, we have no idea how to match files in a
+     * directory which belongs to no known filesystem
+     */
+
+    if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
+	Tcl_SetErrno(ENOENT);
+	return -1;
+    }
+
+    /*
+     * We have an empty or NULL path. This is defined to mean we must search
+     * for files within the current 'cwd'. We therefore use that, but then
+     * since the proc we call will return results which include the cwd we
+     * must then trim it off the front of each path in the result. We choose
+     * to deal with this here (in the generic code), since if we don't, every
+     * single filesystem's implementation of Tcl_FSMatchInDirectory will have
+     * to deal with it for us.
+     */
+
+    cwd = Tcl_FSGetCwd(NULL);
+    if (cwd == NULL) {
+	if (interp != NULL) {
+	    Tcl_SetResult(interp, "glob couldn't determine "
+		    "the current working directory", TCL_STATIC);
 	}
-	fsPtr = Tcl_FSGetFileSystemForPath(cwd);
-	if (fsPtr != NULL) {
-	    Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
-	    if (proc != NULL) {
-		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
-		Tcl_IncrRefCount(tmpResultPtr);
-		ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
-		if (ret == TCL_OK) {
-		    int resLength;
-
-		    tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,
-							   pattern, types);
-
-		    ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
-		    if (ret == TCL_OK) {
-			int i;
-
-			for (i = 0; i < resLength; i++) {
-			    Tcl_Obj *elt;
-			    
-			    Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
-			    Tcl_ListObjAppendElement(interp, result, 
-				TclFSMakePathRelative(interp, elt, cwd));
-			}
-		    }
-		}
-		Tcl_DecrRefCount(tmpResultPtr);
+	return TCL_ERROR;
+    }
+
+    fsPtr = Tcl_FSGetFileSystemForPath(cwd);
+    if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
+	TclNewObj(tmpResultPtr);
+	Tcl_IncrRefCount(tmpResultPtr);
+	ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
+		pattern, types);
+	if (ret == TCL_OK) {
+	    FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
+
+	    /*
+	     * Note that we know resultPtr and tmpResultPtr are distinct.
+	     */
+
+	    ret = Tcl_ListObjGetElements(interp, tmpResultPtr,
+		    &resLength, &elemsPtr);
+	    for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
+		ret = Tcl_ListObjAppendElement(interp, resultPtr,
+			TclFSMakePathRelative(interp, elemsPtr[i], cwd));
 	    }
 	}
-	Tcl_DecrRefCount(cwd);
-	return ret;
+	TclDecrRefCount(tmpResultPtr);
     }
-    Tcl_SetErrno(ENOENT);
-    return -1;
+    Tcl_DecrRefCount(cwd);
+    return ret;
 }
 
 /*
@@ -1106,85 +1194,104 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
  *
  * FsAddMountsToGlobResult --
  *
- *	This routine is used by the globbing code to take the results
- *	of a directory listing and add any mounted paths to that
- *	listing.  This is required so that simple things like 
- *	'glob *' merge mounts and listings correctly.
- *	
- * Results: 
- *	
- *	The passed in 'result' may be modified (in place, if
- *	necessary), and the correct list is returned.
+ *	This routine is used by the globbing code to take the results of a
+ *	directory listing and add any mounted paths to that listing. This is
+ *	required so that simple things like 'glob *' merge mounts and listings
+ *	correctly.
  *
- * Side effects:
+ * Results:
  *	None.
  *
- *---------------------------------------------------------------------- 
+ * Side effects:
+ *	Modifies the resultPtr.
+ *
+ *----------------------------------------------------------------------
  */
-static Tcl_Obj*
-FsAddMountsToGlobResult(result, pathPtr, pattern, types)
-    Tcl_Obj *result;    /* The current list of matching paths */
-    Tcl_Obj *pathPtr;   /* The directory in question */
-    CONST char *pattern;
-    Tcl_GlobTypeData *types;
+
+static void
+FsAddMountsToGlobResult(
+    Tcl_Obj *resultPtr,		/* The current list of matching paths; must
+				 * not be shared! */
+    Tcl_Obj *pathPtr,		/* The directory in question */
+    const char *pattern,	/* Pattern to match against. */
+    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
+				 * May be NULL. In particular the directory
+				 * flag is very important. */
 {
     int mLength, gLength, i;
     int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
     Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
 
-    if (mounts == NULL) return result; 
+    if (mounts == NULL) {
+	return;
+    }
 
     if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
 	goto endOfMounts;
     }
-    if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
+    if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
 	goto endOfMounts;
     }
-    for (i = 0; i < mLength; i++) {
+    for (i=0 ; i<mLength ; i++) {
 	Tcl_Obj *mElt;
 	int j;
 	int found = 0;
-	
+
 	Tcl_ListObjIndex(NULL, mounts, i, &mElt);
 
-	for (j = 0; j < gLength; j++) {
+	for (j=0 ; j<gLength ; j++) {
 	    Tcl_Obj *gElt;
-	    Tcl_ListObjIndex(NULL, result, j, &gElt);
+
+	    Tcl_ListObjIndex(NULL, resultPtr, j, &gElt);
 	    if (Tcl_FSEqualPaths(mElt, gElt)) {
 		found = 1;
 		if (!dir) {
-		    /* We don't want to list this */
-		    if (Tcl_IsShared(result)) {
-			Tcl_Obj *newList;
-			newList = Tcl_DuplicateObj(result);
-			Tcl_DecrRefCount(result);
-			result = newList;
-		    }
-		    Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);
+		    /*
+		     * We don't want to list this.
+		     */
+
+		    Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
 		    gLength--;
 		}
-		/* Break out of for loop */
-		break;
+		break;		/* Break out of for loop */
 	    }
 	}
 	if (!found && dir) {
-	    if (Tcl_IsShared(result)) {
-		Tcl_Obj *newList;
-		newList = Tcl_DuplicateObj(result);
-		Tcl_DecrRefCount(result);
-		result = newList;
+	    Tcl_Obj *norm;
+	    int len, mlen;
+
+	    /*
+	     * We know mElt is absolute normalized and lies inside pathPtr, so
+	     * now we must add to the result the right representation of mElt,
+	     * i.e. the representation which is relative to pathPtr.
+	     */
+
+	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+	    if (norm != NULL) {
+		const char *path, *mount;
+
+		mount = Tcl_GetStringFromObj(mElt, &mlen);
+		path = Tcl_GetStringFromObj(norm, &len);
+		if (path[len-1] == '/') {
+		    /*
+		     * Deal with the root of the volume.
+		     */
+
+		    len--;
+		}
+		len++; /* account for '/' in the mElt [Bug 1602539] */
+		mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len);
+		Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
 	    }
-	    Tcl_ListObjAppendElement(NULL, result, mElt);
-	    /* 
-	     * No need to increment gLength, since we
-	     * don't want to compare mounts against
-	     * mounts.
+	    /*
+	     * No need to increment gLength, since we don't want to compare
+	     * mounts against mounts.
 	     */
 	}
     }
+
   endOfMounts:
     Tcl_DecrRefCount(mounts);
-    return result;
 }
 
 /*
@@ -1192,65 +1299,65 @@ FsAddMountsToGlobResult(result, pathPtr, pattern, types)
  *
  * Tcl_FSMountsChanged --
  *
- *    Notify the filesystem that the available mounted filesystems
- *    (or within any one filesystem type, the number or location of
- *    mount points) have changed.
+ *	Notify the filesystem that the available mounted filesystems (or
+ *	within any one filesystem type, the number or location of mount
+ *	points) have changed.
  *
  * Results:
- *    None.
+ *	None.
  *
  * Side effects:
- *    The global filesystem variable 'theFilesystemEpoch' is
- *    incremented.  The effect of this is to make all cached
- *    path representations invalid.  Clearly it should only therefore
- *    be called when it is really required!  There are a few 
- *    circumstances when it should be called:
- *    
- *    (1) when a new filesystem is registered or unregistered.  
- *    Strictly speaking this is only necessary if the new filesystem
- *    accepts file paths as is (normally the filesystem itself is
- *    really a shell which hasn't yet had any mount points established
- *    and so its 'pathInFilesystem' proc will always fail).  However,
- *    for safety, Tcl always calls this for you in these circumstances.
- * 
- *    (2) when additional mount points are established inside any
- *    existing filesystem (except the native fs)
- *    
- *    (3) when any filesystem (except the native fs) changes the list
- *    of available volumes.
- *    
- *    (4) when the mapping from a string representation of a file to
- *    a full, normalized path changes.  For example, if 'env(HOME)' 
- *    is modified, then any path containing '~' will map to a different
- *    filesystem location.  Therefore all such paths need to have
- *    their internal representation invalidated.
- *    
- *    Tcl has no control over (2) and (3), so any registered filesystem
- *    must make sure it calls this function when those situations
- *    occur.
- *    
- *    (Note: the reason for the exception in 2,3 for the native
- *    filesystem is that the native filesystem by default claims all
- *    unknown files even if it really doesn't understand them or if
- *    they don't exist).
+ *	The global filesystem variable 'theFilesystemEpoch' is incremented.
+ *	The effect of this is to make all cached path representations invalid.
+ *	Clearly it should only therefore be called when it is really required!
+ *	There are a few circumstances when it should be called:
+ *
+ *	(1) when a new filesystem is registered or unregistered. Strictly
+ *	speaking this is only necessary if the new filesystem accepts file
+ *	paths as is (normally the filesystem itself is really a shell which
+ *	hasn't yet had any mount points established and so its
+ *	'pathInFilesystem' proc will always fail). However, for safety, Tcl
+ *	always calls this for you in these circumstances.
+ *
+ *	(2) when additional mount points are established inside any existing
+ *	filesystem (except the native fs)
+ *
+ *	(3) when any filesystem (except the native fs) changes the list of
+ *	available volumes.
+ *
+ *	(4) when the mapping from a string representation of a file to a full,
+ *	normalized path changes. For example, if 'env(HOME)' is modified, then
+ *	any path containing '~' will map to a different filesystem location.
+ *	Therefore all such paths need to have their internal representation
+ *	invalidated.
+ *
+ *	Tcl has no control over (2) and (3), so any registered filesystem must
+ *	make sure it calls this function when those situations occur.
+ *
+ *	(Note: the reason for the exception in 2,3 for the native filesystem
+ *	is that the native filesystem by default claims all unknown files even
+ *	if it really doesn't understand them or if they don't exist).
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_FSMountsChanged(fsPtr)
-    Tcl_Filesystem *fsPtr;
+Tcl_FSMountsChanged(
+    Tcl_Filesystem *fsPtr)
 {
-    /* 
-     * We currently don't do anything with this parameter.  We
-     * could in the future only invalidate files for this filesystem
-     * or otherwise take more advanced action.
+    /*
+     * We currently don't do anything with this parameter. We could in the
+     * future only invalidate files for this filesystem or otherwise take more
+     * advanced action.
      */
+
     (void)fsPtr;
-    /* 
-     * Increment the filesystem epoch counter, since existing paths
-     * might now belong to different filesystems.
+
+    /*
+     * Increment the filesystem epoch counter, since existing paths might now
+     * belong to different filesystems.
      */
+
     Tcl_MutexLock(&filesystemMutex);
     theFilesystemEpoch++;
     Tcl_MutexUnlock(&filesystemMutex);
@@ -1261,31 +1368,31 @@ Tcl_FSMountsChanged(fsPtr)
  *
  * Tcl_FSData --
  *
- *    Retrieve the clientData field for the filesystem given,
- *    or NULL if that filesystem is not registered.
+ *	Retrieve the clientData field for the filesystem given, or NULL if
+ *	that filesystem is not registered.
  *
  * Results:
- *    A clientData value, or NULL.  Note that if the filesystem
- *    was registered with a NULL clientData field, this function
- *    will return that NULL value.
+ *	A clientData value, or NULL. Note that if the filesystem was
+ *	registered with a NULL clientData field, this function will return
+ *	that NULL value.
  *
  * Side effects:
- *    None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 ClientData
-Tcl_FSData(fsPtr)
-    Tcl_Filesystem  *fsPtr;   /* The filesystem record to query. */
+Tcl_FSData(
+    Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
 {
     ClientData retVal = NULL;
     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
 
     /*
-     * Traverse the 'filesystemList' looking for the particular node
-     * whose 'fsPtr' member matches 'fsPtr' and remove that one from
-     * the list.  Ensure that the "default" node cannot be removed.
+     * Traverse the list of filesystems look for a particular one. If found,
+     * return that filesystem's clientData (originally provided when calling
+     * Tcl_FSRegister).
      */
 
     while ((retVal == NULL) && (fsRecPtr != NULL)) {
@@ -1301,197 +1408,84 @@ Tcl_FSData(fsPtr)
 /*
  *---------------------------------------------------------------------------
  *
- * TclFSNormalizeAbsolutePath --
- *
- * Description:
- *	Takes an absolute path specification and computes a 'normalized'
- *	path from it.
- *	
- *	A normalized path is one which has all '../', './' removed.
- *	Also it is one which is in the 'standard' format for the native
- *	platform.  On MacOS, Unix, this means the path must be free of
- *	symbolic links/aliases, and on Windows it means we want the
- *	long form, with that long form's case-dependence (which gives
- *	us a unique, case-dependent path).
- *	
- *	The behaviour of this function if passed a non-absolute path
- *	is NOT defined.
- *
- * Results:
- *	The result is returned in a Tcl_Obj with a refCount of 1,
- *	which is therefore owned by the caller.  It must be
- *	freed (with Tcl_DecrRefCount) by the caller when no longer needed.
- *
- * Side effects:
- *	None (beyond the memory allocation for the result).
- *
- * Special note:
- *	This code is based on code from Matt Newman and Jean-Claude
- *	Wippler, with additions from Vince Darley and is copyright 
- *	those respective authors.
- *
- *---------------------------------------------------------------------------
- */
-static Tcl_Obj *
-TclFSNormalizeAbsolutePath(interp, pathPtr)
-    Tcl_Interp* interp;    /* Interpreter to use */
-    Tcl_Obj *pathPtr;      /* Absolute path to normalize */
-{
-    int splen = 0, nplen, eltLen, i;
-    char *eltName;
-    Tcl_Obj *retVal;
-    Tcl_Obj *split;
-    Tcl_Obj *elt;
-    
-    /* Split has refCount zero */
-    split = Tcl_FSSplitPath(pathPtr, &splen);
-
-    /* 
-     * Modify the list of entries in place, by removing '.', and
-     * removing '..' and the entry before -- unless that entry before
-     * is the top-level entry, i.e. the name of a volume.
-     */
-    nplen = 0;
-    for (i = 0; i < splen; i++) {
-	Tcl_ListObjIndex(NULL, split, nplen, &elt);
-	eltName = Tcl_GetStringFromObj(elt, &eltLen);
-
-	if ((eltLen == 1) && (eltName[0] == '.')) {
-	    Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
-	} else if ((eltLen == 2)
-		&& (eltName[0] == '.') && (eltName[1] == '.')) {
-	    if (nplen > 1) {
-	        nplen--;
-		Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
-	    } else {
-		Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
-	    }
-	} else {
-	    nplen++;
-	}
-    }
-    if (nplen > 0) {
-	retVal = Tcl_FSJoinPath(split, nplen);
-	/* 
-	 * Now we have an absolute path, with no '..', '.' sequences,
-	 * but it still may not be in 'unique' form, depending on the
-	 * platform.  For instance, Unix is case-sensitive, so the
-	 * path is ok.  Windows is case-insensitive, and also has the
-	 * weird 'longname/shortname' thing (e.g. C:/Program Files/ and
-	 * C:/Progra~1/ are equivalent).  MacOS is case-insensitive.
-	 * 
-	 * Virtual file systems which may be registered may have
-	 * other criteria for normalizing a path.
-	 */
-	Tcl_IncrRefCount(retVal);
-	TclFSNormalizeToUniquePath(interp, retVal, 0);
-	/* 
-	 * Since we know it is a normalized path, we can
-	 * actually convert this object into an "path" object for
-	 * greater efficiency 
-	 */
-	TclFSMakePathFromNormalized(interp, retVal);
-    } else {
-	/* Init to an empty string */
-	retVal = Tcl_NewStringObj("",0);
-	Tcl_IncrRefCount(retVal);
-    }
-    /* 
-     * We increment and then decrement the refCount of split to free
-     * it.  We do this right at the end, in case there are
-     * optimisations in Tcl_FSJoinPath(split, nplen) above which would
-     * let it make use of split more effectively if it has a refCount
-     * of zero.  Also we can't just decrement the ref count, in case
-     * 'split' was actually returned by the join call above, in a
-     * single-element optimisation when nplen == 1.
-     */
-    Tcl_IncrRefCount(split);
-    Tcl_DecrRefCount(split);
-
-    /* This has a refCount of 1 for the caller */
-    return retVal;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
  * TclFSNormalizeToUniquePath --
  *
- * Description:
- *	Takes a path specification containing no ../, ./ sequences,
- *	and converts it into a unique path for the given platform.
- *      On MacOS, Unix, this means the path must be free of
- *	symbolic links/aliases, and on Windows it means we want the
- *	long form, with that long form's case-dependence (which gives
- *	us a unique, case-dependent path).
+ *	Takes a path specification containing no ../, ./ sequences, and
+ *	converts it into a unique path for the given platform. On Unix, this
+ *	means the path must be free of symbolic links/aliases, and on Windows
+ *	it means we want the long form, with that long form's case-dependence
+ *	(which gives us a unique, case-dependent path).
  *
  * Results:
- *	The pathPtr is modified in place.  The return value is
- *	the last byte offset which was recognised in the path
- *	string.
+ *	The pathPtr is modified in place. The return value is the last byte
+ *	offset which was recognised in the path string.
  *
  * Side effects:
  *	None (beyond the memory allocation for the result).
  *
  * Special notes:
- *	If the filesystem-specific normalizePathProcs can re-introduce
- *	../, ./ sequences into the path, then this function will
- *	not return the correct result.  This may be possible with
- *	symbolic links on unix/macos.
- *
- *      Important assumption: if startAt is non-zero, it must point
- *      to a directory separator that we know exists and is already
- *      normalized (so it is important not to point to the char just
- *      after the separator).
+ *	If the filesystem-specific normalizePathProcs can re-introduce ../, ./
+ *	sequences into the path, then this function will not return the
+ *	correct result. This may be possible with symbolic links on unix.
+ *
+ *	Important assumption: if startAt is non-zero, it must point to a
+ *	directory separator that we know exists and is already normalized (so
+ *	it is important not to point to the char just after the separator).
+ *
  *---------------------------------------------------------------------------
  */
+
 int
-TclFSNormalizeToUniquePath(interp, pathPtr, startAt)
-    Tcl_Interp *interp;
-    Tcl_Obj *pathPtr;
-    int startAt;
+TclFSNormalizeToUniquePath(
+    Tcl_Interp *interp,		/* Used for error messages. */
+    Tcl_Obj *pathPtr,		/* The path to normalize in place */
+    int startAt)		/* Start at this char-offset */
 {
     FilesystemRecord *fsRecPtr, *firstFsRecPtr;
-    
+
     /*
-     * Call each of the "normalise path" functions in succession. This is
-     * a special case, in which if we have a native filesystem handler,
-     * we call it first.  This is because the root of Tcl's filesystem
-     * is always a native filesystem (i.e. '/' on unix is native).
+     * Call each of the "normalise path" functions in succession. This is a
+     * special case, in which if we have a native filesystem handler, we call
+     * it first. This is because the root of Tcl's filesystem is always a
+     * native filesystem (i.e. '/' on unix is native).
      */
 
     firstFsRecPtr = FsGetFirstFilesystem();
 
+    Claim();
     fsRecPtr = firstFsRecPtr;
     while (fsRecPtr != NULL) {
-        if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
+	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
 	    if (proc != NULL) {
 		startAt = (*proc)(interp, pathPtr, startAt);
 	    }
 	    break;
-        }
+	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
-    fsRecPtr = firstFsRecPtr; 
+
+    fsRecPtr = firstFsRecPtr;
     while (fsRecPtr != NULL) {
-	/* Skip the native system next time through */
+	/*
+	 * Skip the native system next time through.
+	 */
+
 	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
 	    if (proc != NULL) {
 		startAt = (*proc)(interp, pathPtr, startAt);
 	    }
-	    /* 
+
+	    /*
 	     * We could add an efficiency check like this:
-	     * 
-	     *   if (retVal == length-of(pathPtr)) {break;}
-	     * 
+	     *		if (retVal == length-of(pathPtr)) {break;}
 	     * but there's not much benefit.
 	     */
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
+    Disclaim();
 
     return startAt;
 }
@@ -1501,10 +1495,40 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt)
  *
  * TclGetOpenMode --
  *
- * Description:
+ *	This routine is an obsolete, limited version of TclGetOpenModeEx()
+ *	below. It exists only to satisfy any extensions imprudently using it
+ *	via Tcl's internal stubs table.
+ *
+ * Results:
+ *	Same as TclGetOpenModeEx().
+ *
+ * Side effects:
+ *	Same as TclGetOpenModeEx().
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetOpenMode(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting -
+				 * may be NULL. */
+    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
+    int *seekFlagPtr)		/* Set this to 1 if the caller should seek to
+				 * EOF during the opening of the file. */
+{
+    int binary = 0;
+    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetOpenModeEx --
+ *
  *	Computes a POSIX mode mask for opening a file, from a given string,
- *	and also sets a flag to indicate whether the caller should seek to
- *	EOF after opening the file.
+ *	and also sets flags to indicate whether the caller should seek to EOF
+ *	after opening the file, and whether the caller should configure the
+ *	channel for binary data.
  *
  * Results:
  *	On success, returns mode to pass to "open". If an error occurs, the
@@ -1512,37 +1536,41 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt)
  *	object to an error message.
  *
  * Side effects:
- *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller
- *	to seek to EOF after opening the file.
+ *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller to
+ *	seek to EOF after opening the file, or to 0 otherwise. Sets the
+ *	integer referenced by binaryPtr to 1 to tell the caller to seek to
+ *	configure the channel for binary data, or to 0 otherwise.
  *
  * Special note:
- *	This code is based on a prototype implementation contributed
- *	by Mark Diekhans.
+ *	This code is based on a prototype implementation contributed by Mark
+ *	Diekhans.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-TclGetOpenMode(interp, string, seekFlagPtr)
-    Tcl_Interp *interp;			/* Interpreter to use for error
-					 * reporting - may be NULL. */
-    CONST char *string;			/* Mode string, e.g. "r+" or
-					 * "RDONLY CREAT". */
-    int *seekFlagPtr;			/* Set this to 1 if the caller
-                                         * should seek to EOF during the
-                                         * opening of the file. */
+TclGetOpenModeEx(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting -
+				 * may be NULL. */
+    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
+    int *seekFlagPtr,		/* Set this to 1 if the caller should seek to
+				 * EOF during the opening of the file. */
+    int *binaryPtr)		/* Set this to 1 if the caller should
+				 * configure the opened channel for binary
+				 * operations */
 {
     int mode, modeArgc, c, i, gotRW;
-    CONST char **modeArgv, *flag;
+    const char **modeArgv, *flag;
 #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
 
     /*
-     * Check for the simpler fopen-like access modes (e.g. "r").  They
-     * are distinguished from the POSIX access modes by the presence
-     * of a lower-case first letter.
+     * Check for the simpler fopen-like access modes (e.g. "r"). They are
+     * distinguished from the POSIX access modes by the presence of a
+     * lower-case first letter.
      */
 
     *seekFlagPtr = 0;
+    *binaryPtr = 0;
     mode = 0;
 
     /*
@@ -1550,66 +1578,82 @@ TclGetOpenMode(interp, string, seekFlagPtr)
      * routines.
      */
 
-    if (!(string[0] & 0x80)
-	    && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
-	switch (string[0]) {
-	    case 'r':
-		mode = O_RDONLY;
-		break;
-	    case 'w':
-		mode = O_WRONLY|O_CREAT|O_TRUNC;
-		break;
-	    case 'a':
-	        /* [Bug 680143].
-		 * Added O_APPEND for proper automatic
-		 * seek-to-end-on-write by the OS.
+    if (!(modeString[0] & 0x80)
+	    && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
+	switch (modeString[0]) {
+	case 'r':
+	    mode = O_RDONLY;
+	    break;
+	case 'w':
+	    mode = O_WRONLY|O_CREAT|O_TRUNC;
+	    break;
+	case 'a':
+	    /*
+	     * Added O_APPEND for proper automatic seek-to-end-on-write by the
+	     * OS. [Bug 680143]
+	     */
+
+	    mode = O_WRONLY|O_CREAT|O_APPEND;
+	    *seekFlagPtr = 1;
+	    break;
+	default:
+	    goto error;
+	}
+	i=1;
+	while (i<3 && modeString[i]) {
+	    if (modeString[i] == modeString[i-1]) {
+		goto error;
+	    }
+	    switch (modeString[i++]) {
+	    case '+':
+		/*
+		 * Must remove the O_APPEND flag so that the seek command
+		 * works. [Bug 1773127]
 		 */
-	        mode = O_WRONLY|O_CREAT|O_APPEND;
-                *seekFlagPtr = 1;
+
+		mode &= ~(O_RDONLY|O_WRONLY|O_APPEND);
+		mode |= O_RDWR;
+		break;
+	    case 'b':
+		*binaryPtr = 1;
 		break;
 	    default:
-		error:
-                if (interp != (Tcl_Interp *) NULL) {
-                    Tcl_AppendResult(interp,
-                            "illegal access mode \"", string, "\"",
-                            (char *) NULL);
-                }
-		return -1;
-	}
-	if (string[1] == '+') {
-	    /*
-	     * Must remove the O_APPEND flag so that the seek command
-	     * works. [Bug 1773127]
-	     */
-	    mode &= ~(O_RDONLY|O_WRONLY|O_APPEND);
-	    mode |= O_RDWR;
-	    if (string[2] != 0) {
 		goto error;
 	    }
-	} else if (string[1] != 0) {
+	}
+	if (modeString[i] != 0) {
 	    goto error;
 	}
-        return mode;
+	return mode;
+
+    error:
+	*seekFlagPtr = 0;
+	*binaryPtr = 0;
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "illegal access mode \"", modeString,
+		    "\"", NULL);
+	}
+	return -1;
     }
 
     /*
-     * The access modes are specified using a list of POSIX modes
-     * such as O_CREAT.
+     * The access modes are specified using a list of POSIX modes such as
+     * O_CREAT.
      *
-     * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
-     * a NULL interpreter is passed in.
+     * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when a NULL
+     * interpreter is passed in.
      */
 
-    if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
-        if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AddErrorInfo(interp,
-                    "\n    while processing open access modes \"");
-            Tcl_AddErrorInfo(interp, string);
-            Tcl_AddErrorInfo(interp, "\"");
-        }
-        return -1;
+    if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
+	if (interp != NULL) {
+	    Tcl_AddErrorInfo(interp,
+		    "\n    while processing open access modes \"");
+	    Tcl_AddErrorInfo(interp, modeString);
+	    Tcl_AddErrorInfo(interp, "\"");
+	}
+	return -1;
     }
-    
+
     gotRW = 0;
     for (i = 0; i < modeArgc; i++) {
 	flag = modeArgv[i];
@@ -1625,88 +1669,106 @@ TclGetOpenMode(interp, string, seekFlagPtr)
 	    gotRW = 1;
 	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
 	    mode |= O_APPEND;
-            *seekFlagPtr = 1;
+	    *seekFlagPtr = 1;
 	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
 	    mode |= O_CREAT;
 	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
 	    mode |= O_EXCL;
+
 	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
 #ifdef O_NOCTTY
 	    mode |= O_NOCTTY;
 #else
-	    if (interp != (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "access mode \"", flag,
-                        "\" not supported by this system", (char *) NULL);
-            }
-            ckfree((char *) modeArgv);
+	    if (interp != NULL) {
+		Tcl_AppendResult(interp, "access mode \"", flag,
+			"\" not supported by this system", NULL);
+	    }
+	    ckfree((char *) modeArgv);
 	    return -1;
 #endif
+
 	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
-#if defined(O_NDELAY) || defined(O_NONBLOCK)
-#   ifdef O_NONBLOCK
+#ifdef O_NONBLOCK
 	    mode |= O_NONBLOCK;
-#   else
-	    mode |= O_NDELAY;
-#   endif
 #else
-            if (interp != (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "access mode \"", flag,
-                        "\" not supported by this system", (char *) NULL);
-            }
-            ckfree((char *) modeArgv);
+	    if (interp != NULL) {
+		Tcl_AppendResult(interp, "access mode \"", flag,
+			"\" not supported by this system", NULL);
+	    }
+	    ckfree((char *) modeArgv);
 	    return -1;
 #endif
+
 	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
 	    mode |= O_TRUNC;
+	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
+	    *binaryPtr = 1;
 	} else {
-            if (interp != (Tcl_Interp *) NULL) {
-                Tcl_AppendResult(interp, "invalid access mode \"", flag,
-                        "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
-                        " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
-            }
+
+	    if (interp != NULL) {
+		Tcl_AppendResult(interp, "invalid access mode \"", flag,
+			"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
+			"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
+	    }
 	    ckfree((char *) modeArgv);
 	    return -1;
 	}
     }
+
     ckfree((char *) modeArgv);
+
     if (!gotRW) {
-        if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "access mode must include either",
-                    " RDONLY, WRONLY, or RDWR", (char *) NULL);
-        }
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "access mode must include either"
+		    " RDONLY, WRONLY, or RDWR", NULL);
+	}
 	return -1;
     }
     return mode;
 }
 
 /*
+ * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
+ */
+
+int
+Tcl_FSEvalFile(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    Tcl_Obj *pathPtr)		/* Path of file to process. Tilde-substitution
+				 * will be performed on this name. */
+{
+    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
+}
+
+/*
  *----------------------------------------------------------------------
  *
- * Tcl_FSEvalFile --
+ * Tcl_FSEvalFileEx --
  *
- *	Read in a file and process the entire file as one gigantic
- *	Tcl command.
+ *	Read in a file and process the entire file as one gigantic Tcl
+ *	command.
  *
  * Results:
- *	A standard Tcl result, which is either the result of executing
- *	the file or an error indicating why the file couldn't be read.
+ *	A standard Tcl result, which is either the result of executing the
+ *	file or an error indicating why the file couldn't be read.
  *
  * Side effects:
- *	Depends on the commands in the file.  During the evaluation
- *	of the contents of the file, iPtr->scriptFile is made to
- *	point to pathPtr (the old value is cached and replaced when
- *	this function returns).
+ *	Depends on the commands in the file. During the evaluation of the
+ *	contents of the file, iPtr->scriptFile is made to point to pathPtr
+ *	(the old value is cached and replaced when this function returns).
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSEvalFile(interp, pathPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to process file. */
-    Tcl_Obj *pathPtr;		/* Path of file to process.  Tilde-substitution
+Tcl_FSEvalFileEx(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    Tcl_Obj *pathPtr,		/* Path of file to process. Tilde-substitution
 				 * will be performed on this name. */
+    const char *encodingName)	/* If non-NULL, then use this encoding for the
+				 * file. NULL means use the system encoding. */
 {
-    int result, length;
+    int length, result = TCL_ERROR;
     Tcl_StatBuf statBuf;
     Tcl_Obj *oldScriptFile;
     Interp *iPtr;
@@ -1715,41 +1777,52 @@ Tcl_FSEvalFile(interp, pathPtr)
     Tcl_Obj *objPtr;
 
     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
-	return TCL_ERROR;
+	return result;
     }
 
-    result = TCL_ERROR;
-    objPtr = Tcl_NewObj();
-    Tcl_IncrRefCount(objPtr);
-
     if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
-        Tcl_SetErrno(errno);
-	Tcl_AppendResult(interp, "couldn't read file \"", 
-		Tcl_GetString(pathPtr),
-		"\": ", Tcl_PosixError(interp), (char *) NULL);
-	goto end;
+	Tcl_SetErrno(errno);
+	Tcl_AppendResult(interp, "couldn't read file \"",
+		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	return result;
     }
     chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
     if (chan == (Tcl_Channel) NULL) {
-        Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "couldn't read file \"", 
-		Tcl_GetString(pathPtr),
-		"\": ", Tcl_PosixError(interp), (char *) NULL);
-	goto end;
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read file \"",
+		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	return result;
     }
+
     /*
-     * The eofchar is \32 (^Z).  This is the usual on Windows, but we
-     * effect this cross-platform to allow for scripted documents.
-     * [Bug: 2040]
+     * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
+     * this cross-platform to allow for scripted documents. [Bug: 2040]
      */
+
     Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
+
+    /*
+     * If the encoding is specified, set it for the channel. Else don't touch
+     * it (and use the system encoding) Report error on unknown encoding.
+     */
+
+    if (encodingName != NULL) {
+	if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
+		!= TCL_OK) {
+	    Tcl_Close(interp,chan);
+	    return result;
+	}
+    }
+
+    objPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(objPtr);
     /* Try to read first character of stream, so we can
      * check for utf-8 BOM to be handled especially.
      */
     if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
 	Tcl_Close(interp, chan);
-	Tcl_AppendResult(interp, "couldn't read file \"", 
-		Tcl_GetString(pathPtr),	"\": ", Tcl_PosixError(interp), NULL);
+	Tcl_AppendResult(interp, "couldn't read file \"",
+		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
 	goto end;
     }
     string = Tcl_GetString(objPtr);
@@ -1764,8 +1837,9 @@ Tcl_FSEvalFile(interp, pathPtr)
 		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
 	goto end;
     }
+
     if (Tcl_Close(interp, chan) != TCL_OK) {
-        goto end;
+	goto end;
     }
 
     iPtr = (Interp *) interp;
@@ -1773,18 +1847,17 @@ Tcl_FSEvalFile(interp, pathPtr)
     iPtr->scriptFile = pathPtr;
     Tcl_IncrRefCount(iPtr->scriptFile);
     string = Tcl_GetStringFromObj(objPtr, &length);
-
-#ifdef TCL_TIP280
     /* TIP #280 Force the evaluator to open a frame for a sourced
      * file. */
     iPtr->evalFlags |= TCL_EVAL_FILE;
-#endif
     result = Tcl_EvalEx(interp, string, length, 0);
-    /* 
+
+    /*
      * Now we have to be careful; the script may have changed the
-     * iPtr->scriptFile value, so we must reset it without
-     * assuming it still points to 'pathPtr'.
+     * iPtr->scriptFile value, so we must reset it without assuming it still
+     * points to 'pathPtr'.
      */
+
     if (iPtr->scriptFile != NULL) {
 	Tcl_DecrRefCount(iPtr->scriptFile);
     }
@@ -1793,18 +1866,21 @@ Tcl_FSEvalFile(interp, pathPtr)
     if (result == TCL_RETURN) {
 	result = TclUpdateReturnInfo(iPtr);
     } else if (result == TCL_ERROR) {
-	char msg[200 + TCL_INTEGER_SPACE];
-
 	/*
 	 * Record information telling where the error occurred.
 	 */
 
-	sprintf(msg, "\n    (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),
-		interp->errorLine);
-	Tcl_AddErrorInfo(interp, msg);
+	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
+	int limit = 150;
+	int overflow = (length > limit);
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (file \"%.*s%s\" line %d)",
+		(overflow ? limit : length), pathString,
+		(overflow ? "..." : ""), interp->errorLine));
     }
 
-    end:
+  end:
     Tcl_DecrRefCount(objPtr);
     return result;
 }
@@ -1815,21 +1891,21 @@ Tcl_FSEvalFile(interp, pathPtr)
  * Tcl_GetErrno --
  *
  *	Gets the current value of the Tcl error code variable. This is
- *	currently the global variable "errno" but could in the future
- *	change to something else.
+ *	currently the global variable "errno" but could in the future change
+ *	to something else.
  *
  * Results:
  *	The value of the Tcl error code variable.
  *
  * Side effects:
- *	None. Note that the value of the Tcl error code variable is
- *	UNDEFINED if a call to Tcl_SetErrno did not precede this call.
+ *	None. Note that the value of the Tcl error code variable is UNDEFINED
+ *	if a call to Tcl_SetErrno did not precede this call.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetErrno()
+Tcl_GetErrno(void)
 {
     return errno;
 }
@@ -1851,8 +1927,8 @@ Tcl_GetErrno()
  */
 
 void
-Tcl_SetErrno(err)
-    int err;			/* The new value. */
+Tcl_SetErrno(
+    int err)			/* The new value. */
 {
     errno = err;
 }
@@ -1862,32 +1938,31 @@ Tcl_SetErrno(err)
  *
  * Tcl_PosixError --
  *
- *	This procedure is typically called after UNIX kernel calls
- *	return errors.  It stores machine-readable information about
- *	the error in $errorCode returns an information string for
- *	the caller's use.
+ *	This function is typically called after UNIX kernel calls return
+ *	errors. It stores machine-readable information about the error in
+ *	errorCode field of interp and returns an information string for the
+ *	caller's use.
  *
  * Results:
- *	The return value is a human-readable string describing the
- *	error.
+ *	The return value is a human-readable string describing the error.
  *
  * Side effects:
- *	The global variable $errorCode is reset.
+ *	The errorCode field of the interp is set.
  *
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_PosixError(interp)
-    Tcl_Interp *interp;		/* Interpreter whose $errorCode variable
-				 * is to be changed. */
+const char *
+Tcl_PosixError(
+    Tcl_Interp *interp)		/* Interpreter whose errorCode field is to be
+				 * set. */
 {
-    CONST char *id, *msg;
+    const char *id, *msg;
 
     msg = Tcl_ErrnoMsg(errno);
     id = Tcl_ErrnoId();
     if (interp) {
-	Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
+	Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
     }
     return msg;
 }
@@ -1897,37 +1972,37 @@ Tcl_PosixError(interp)
  *
  * Tcl_FSStat --
  *
- *	This procedure replaces the library version of stat and lsat.
- *	
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	This function replaces the library version of stat and lsat.
+ *
+ *	The appropriate function for the filesystem to which pathPtr belongs
+ *	will be called.
  *
  * Results:
- *      See stat documentation.
+ *	See stat documentation.
  *
  * Side effects:
- *      See stat documentation.
+ *	See stat documentation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSStat(pathPtr, buf)
-    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
+Tcl_FSStat(
+    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
-    Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr;
 #ifdef USE_OBSOLETE_FS_HOOKS
-    Tcl_StatBuf oldStyleStatBuffer;
+    struct stat oldStyleStatBuffer;
     int retVal = -1;
 
     /*
-     * Call each of the "stat" function in succession.  A non-return
-     * value of -1 indicates the particular function has succeeded.
+     * Call each of the "stat" function in succession. A non-return value of
+     * -1 indicates the particular function has succeeded.
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
-    
+
     if (statProcList != NULL) {
 	StatProc *statProcPtr;
 	char *path;
@@ -1947,13 +2022,14 @@ Tcl_FSStat(pathPtr, buf)
 	    Tcl_DecrRefCount(transPtr);
 	}
     }
-    
+
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
     if (retVal != -1) {
 	/*
-	 * Note that EOVERFLOW is not a problem here, and these
-	 * assignments should all be widening (if not identity.)
+	 * Note that EOVERFLOW is not a problem here, and these assignments
+	 * should all be widening (if not identity.)
 	 */
+
 	buf->st_mode = oldStyleStatBuffer.st_mode;
 	buf->st_ino = oldStyleStatBuffer.st_ino;
 	buf->st_dev = oldStyleStatBuffer.st_dev;
@@ -1965,13 +2041,16 @@ Tcl_FSStat(pathPtr, buf)
 	buf->st_atime = oldStyleStatBuffer.st_atime;
 	buf->st_mtime = oldStyleStatBuffer.st_mtime;
 	buf->st_ctime = oldStyleStatBuffer.st_ctime;
-#ifdef HAVE_ST_BLOCKS
+#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
 	buf->st_blksize = oldStyleStatBuffer.st_blksize;
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
 	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
 #endif
-        return retVal;
+	return retVal;
     }
 #endif /* USE_OBSOLETE_FS_HOOKS */
+
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSStatProc *proc = fsPtr->statProc;
@@ -1988,27 +2067,26 @@ Tcl_FSStat(pathPtr, buf)
  *
  * Tcl_FSLstat --
  *
- *	This procedure replaces the library version of lstat.
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.  If no 'lstat' function is listed,
- *	but a 'stat' function is, then Tcl will fall back on the
- *	stat function.
+ *	This function replaces the library version of lstat. The appropriate
+ *	function for the filesystem to which pathPtr belongs will be called.
+ *	If no 'lstat' function is listed, but a 'stat' function is, then Tcl
+ *	will fall back on the stat function.
  *
  * Results:
- *      See lstat documentation.
+ *	See lstat documentation.
  *
  * Side effects:
- *      See lstat documentation.
+ *	See lstat documentation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSLstat(pathPtr, buf)
-    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
+Tcl_FSLstat(
+    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
 	if (proc != NULL) {
@@ -2029,31 +2107,30 @@ Tcl_FSLstat(pathPtr, buf)
  *
  * Tcl_FSAccess --
  *
- *	This procedure replaces the library version of access.
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	This function replaces the library version of access. The appropriate
+ *	function for the filesystem to which pathPtr belongs will be called.
  *
  * Results:
- *      See access documentation.
+ *	See access documentation.
  *
  * Side effects:
- *      See access documentation.
+ *	See access documentation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSAccess(pathPtr, mode)
-    Tcl_Obj *pathPtr;		/* Path of file to access (in current CP). */
-    int mode;                   /* Permission setting. */
+Tcl_FSAccess(
+    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
 {
-    Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr;
 #ifdef USE_OBSOLETE_FS_HOOKS
     int retVal = -1;
 
     /*
-     * Call each of the "access" function in succession.  A non-return
-     * value of -1 indicates the particular function has succeeded.
+     * Call each of the "access" function in succession. A non-return value of
+     * -1 indicates the particular function has succeeded.
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -2077,12 +2154,13 @@ Tcl_FSAccess(pathPtr, mode)
 	    Tcl_DecrRefCount(transPtr);
 	}
     }
-    
+
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
     if (retVal != -1) {
 	return retVal;
     }
 #endif /* USE_OBSOLETE_FS_HOOKS */
+
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSAccessProc *proc = fsPtr->accessProc;
@@ -2100,38 +2178,36 @@ Tcl_FSAccess(pathPtr, mode)
  *
  * Tcl_FSOpenFileChannel --
  *
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	The appropriate function for the filesystem to which pathPtr belongs
+ *	will be called.
  *
  * Results:
  *	The new channel or NULL, if the named file could not be opened.
  *
  * Side effects:
- *	May open the channel and may cause creation of a file on the
- *	file system.
+ *	May open the channel and may cause creation of a file on the file
+ *	system.
  *
  *----------------------------------------------------------------------
  */
- 
+
 Tcl_Channel
-Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-                                         * can be NULL. */
-    Tcl_Obj *pathPtr;                   /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-                                         * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-                                         * file, with what modes to create
-                                         * it? */
+Tcl_FSOpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    Tcl_Obj *pathPtr,		/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or a string such
+				 * as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
 {
-    Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
+    const Tcl_Filesystem *fsPtr;
     Tcl_Channel retVal = NULL;
 
+#ifdef USE_OBSOLETE_FS_HOOKS
     /*
-     * Call each of the "Tcl_OpenFileChannel" functions in succession.
-     * A non-NULL return value indicates the particular function has
-     * succeeded.
+     * Call each of the "Tcl_OpenFileChannel" functions in succession. A
+     * non-NULL return value indicates the particular function has succeeded.
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -2139,7 +2215,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
 	OpenFileChannelProc *openFileChannelProcPtr;
 	char *path;
 	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-	
+
 	if (transPtr == NULL) {
 	    path = NULL;
 	} else {
@@ -2147,10 +2223,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
 	}
 
 	openFileChannelProcPtr = openFileChannelProcList;
-	
+
 	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
 	    retVal = (*openFileChannelProcPtr->proc)(interp, path,
-						     modeString, permissions);
+		    modeString, permissions);
 	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
 	}
 	if (transPtr != NULL) {
@@ -2162,49 +2238,70 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
 	return retVal;
     }
 #endif /* USE_OBSOLETE_FS_HOOKS */
-    
-    /* 
-     * We need this just to ensure we return the correct error messages
-     * under some circumstances.
+
+    /*
+     * We need this just to ensure we return the correct error messages under
+     * some circumstances.
      */
+
     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
-        return NULL;
+	return NULL;
     }
-    
+
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
 	if (proc != NULL) {
-	    int mode, seekFlag;
-	    mode = TclGetOpenMode(interp, modeString, &seekFlag);
+	    int mode, seekFlag, binary;
+
+	    /*
+	     * Parse the mode, picking up whether we want to seek to start
+	     * with and/or set the channel automatically into binary mode.
+	     */
+
+	    mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
 	    if (mode == -1) {
-	        return NULL;
+		return NULL;
 	    }
+
+	    /*
+	     * Do the actual open() call.
+	     */
+
 	    retVal = (*proc)(interp, pathPtr, mode, permissions);
-	    if (retVal != NULL) {
-		if (seekFlag) {
-		    if (Tcl_Seek(retVal, (Tcl_WideInt)0, 
-				 SEEK_END) < (Tcl_WideInt)0) {
-			if (interp != (Tcl_Interp *) NULL) {
-			    Tcl_AppendResult(interp,
-			      "could not seek to end of file while opening \"",
-			      Tcl_GetString(pathPtr), "\": ", 
-			      Tcl_PosixError(interp), (char *) NULL);
-			}
-			Tcl_Close(NULL, retVal);
-			return NULL;
-		    }
+	    if (retVal == NULL) {
+		return NULL;
+	    }
+
+	    /*
+	     * Apply appropriate flags parsed out above.
+	     */
+
+	    if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
+		    SEEK_END) < (Tcl_WideInt)0) {
+		if (interp != NULL) {
+		    Tcl_AppendResult(interp, "could not seek to end "
+			    "of file while opening \"", Tcl_GetString(pathPtr),
+			    "\": ", Tcl_PosixError(interp), NULL);
 		}
+		Tcl_Close(NULL, retVal);
+		return NULL;
+	    }
+	    if (binary) {
+		Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
 	    }
 	    return retVal;
 	}
     }
-    /* File doesn't belong to any filesystem that can open it */
+
+    /*
+     * File doesn't belong to any filesystem that can open it.
+     */
+
     Tcl_SetErrno(ENOENT);
     if (interp != NULL) {
-	Tcl_AppendResult(interp, "couldn't open \"", 
-			 Tcl_GetString(pathPtr), "\": ",
-			 Tcl_PosixError(interp), (char *) NULL);
+	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
+		"\": ", Tcl_PosixError(interp), NULL);
     }
     return NULL;
 }
@@ -2214,26 +2311,25 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
  *
  * Tcl_FSUtime --
  *
- *	This procedure replaces the library version of utime.
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	This function replaces the library version of utime. The appropriate
+ *	function for the filesystem to which pathPtr belongs will be called.
  *
  * Results:
- *      See utime documentation.
+ *	See utime documentation.
  *
  * Side effects:
- *      See utime documentation.
+ *	See utime documentation.
  *
  *----------------------------------------------------------------------
  */
 
-int 
-Tcl_FSUtime (pathPtr, tval)
-    Tcl_Obj *pathPtr;       /* File to change access/modification times */
-    struct utimbuf *tval;   /* Structure containing access/modification 
-                             * times to use.  Should not be modified. */
+int
+Tcl_FSUtime(
+    Tcl_Obj *pathPtr,		/* File to change access/modification times */
+    struct utimbuf *tval)	/* Structure containing access/modification
+				 * times to use. Should not be modified. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
 	if (proc != NULL) {
@@ -2248,25 +2344,25 @@ Tcl_FSUtime (pathPtr, tval)
  *
  * NativeFileAttrStrings --
  *
- *	This procedure implements the platform dependent 'file
- *	attributes' subcommand, for the native filesystem, for listing
- *	the set of possible attribute strings.  This function is part
- *	of Tcl's native filesystem support, and is placed here because
- *	it is shared by Unix, MacOS and Windows code.
+ *	This function implements the platform dependent 'file attributes'
+ *	subcommand, for the native filesystem, for listing the set of possible
+ *	attribute strings. This function is part of Tcl's native filesystem
+ *	support, and is placed here because it is shared by Unix and Windows
+ *	code.
  *
  * Results:
- *      An array of strings
+ *	An array of strings
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-static CONST char**
-NativeFileAttrStrings(pathPtr, objPtrRef)
-    Tcl_Obj *pathPtr;
-    Tcl_Obj** objPtrRef;
+static const char **
+NativeFileAttrStrings(
+    Tcl_Obj *pathPtr,
+    Tcl_Obj **objPtrRef)
 {
     return tclpFileAttrStrings;
 }
@@ -2276,34 +2372,32 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
  *
  * NativeFileAttrsGet --
  *
- *	This procedure implements the platform dependent
- *	'file attributes' subcommand, for the native
- *	filesystem, for 'get' operations.  This function is part
- *	of Tcl's native filesystem support, and is placed here
- *	because it is shared by Unix, MacOS and Windows code.
+ *	This function implements the platform dependent 'file attributes'
+ *	subcommand, for the native filesystem, for 'get' operations. This
+ *	function is part of Tcl's native filesystem support, and is placed
+ *	here because it is shared by Unix and Windows code.
  *
  * Results:
- *      Standard Tcl return code.  The object placed in objPtrRef
- *      (if TCL_OK was returned) is likely to have a refCount of zero.
- *      Either way we must either store it somewhere (e.g. the Tcl 
- *      result), or Incr/Decr its refCount to ensure it is properly
- *      freed.
+ *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ *	was returned) is likely to have a refCount of zero. Either way we must
+ *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ *	refCount to ensure it is properly freed.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *pathPtr;		/* path of file we are operating on. */
-    Tcl_Obj **objPtrRef;	/* for output. */
+NativeFileAttrsGet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
+    Tcl_Obj **objPtrRef)	/* for output. */
 {
-    return (*tclpFileAttrProcs[index].getProc)(interp, index, 
-					       pathPtr, objPtrRef);
+    return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
+	    objPtrRef);
 }
 
 /*
@@ -2311,30 +2405,28 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
  *
  * NativeFileAttrsSet --
  *
- *	This procedure implements the platform dependent
- *	'file attributes' subcommand, for the native
- *	filesystem, for 'set' operations. This function is part
- *	of Tcl's native filesystem support, and is placed here
- *	because it is shared by Unix, MacOS and Windows code.
+ *	This function implements the platform dependent 'file attributes'
+ *	subcommand, for the native filesystem, for 'set' operations. This
+ *	function is part of Tcl's native filesystem support, and is placed
+ *	here because it is shared by Unix and Windows code.
  *
  * Results:
- *      Standard Tcl return code.
+ *	Standard Tcl return code.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NativeFileAttrsSet(interp, index, pathPtr, objPtr)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *pathPtr;		/* path of file we are operating on. */
-    Tcl_Obj *objPtr;		/* set to this value. */
+NativeFileAttrsSet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
+    Tcl_Obj *objPtr)		/* set to this value. */
 {
-    return (*tclpFileAttrProcs[index].setProc)(interp, index,
-					       pathPtr, objPtr);
+    return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
 }
 
 /*
@@ -2342,32 +2434,32 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
  *
  * Tcl_FSFileAttrStrings --
  *
- *	This procedure implements part of the hookable 'file
- *	attributes' subcommand.  The appropriate function for the
- *	filesystem to which pathPtr belongs will be called.
+ *	This function implements part of the hookable 'file attributes'
+ *	subcommand. The appropriate function for the filesystem to which
+ *	pathPtr belongs will be called.
  *
  * Results:
- *      The called procedure may either return an array of strings,
- *      or may instead return NULL and place a Tcl list into the 
- *      given objPtrRef.  Tcl will take that list and first increment
- *      its refCount before using it.  On completion of that use, Tcl
- *      will decrement its refCount.  Hence if the list should be
- *      disposed of by Tcl when done, it should have a refCount of zero,
- *      and if the list should not be disposed of, the filesystem
- *      should ensure it retains a refCount on the object.
+ *	The called function may either return an array of strings, or may
+ *	instead return NULL and place a Tcl list into the given objPtrRef.
+ *	Tcl will take that list and first increment its refCount before using
+ *	it. On completion of that use, Tcl will decrement its refCount. Hence
+ *	if the list should be disposed of by Tcl when done, it should have a
+ *	refCount of zero, and if the list should not be disposed of, the
+ *	filesystem should ensure it retains a refCount on the object.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-CONST char **
-Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
-    Tcl_Obj* pathPtr;
-    Tcl_Obj** objPtrRef;
+const char **
+Tcl_FSFileAttrStrings(
+    Tcl_Obj *pathPtr,
+    Tcl_Obj **objPtrRef)
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr != NULL) {
 	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
 	if (proc != NULL) {
@@ -2381,34 +2473,110 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FSFileAttrsGet --
+ * TclFSFileAttrIndex --
  *
- *	This procedure implements read access for the hookable 'file
- *	attributes' subcommand.  The appropriate function for the
- *	filesystem to which pathPtr belongs will be called.
+ *	Helper function for converting an attribute name to an index into the
+ *	attribute table.
  *
  * Results:
- *      Standard Tcl return code.  The object placed in objPtrRef
- *      (if TCL_OK was returned) is likely to have a refCount of zero.
- *      Either way we must either store it somewhere (e.g. the Tcl 
- *      result), or Incr/Decr its refCount to ensure it is properly
- *      freed.
+ *	Tcl result code, index written to *indexPtr on result==TCL_OK
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFSFileAttrIndex(
+    Tcl_Obj *pathPtr,		/* File whose attributes are to be indexed
+				 * into. */
+    const char *attributeName,	/* The attribute being looked for. */
+    int *indexPtr)		/* Where to write the found index. */
+{
+    Tcl_Obj *listObj = NULL;
+    const char **attrTable;
+
+    /*
+     * Get the attribute table for the file.
+     */
+
+    attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj);
+    if (listObj != NULL) {
+	Tcl_IncrRefCount(listObj);
+    }
+
+    if (attrTable != NULL) {
+	/*
+	 * It's a constant attribute table, so use T_GIFO.
+	 */
+
+	Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1);
+	int result;
+
+	result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT,
+		indexPtr);
+	TclDecrRefCount(tmpObj);
+	if (listObj != NULL) {
+	    TclDecrRefCount(listObj);
+	}
+	return result;
+    } else if (listObj != NULL) {
+	/*
+	 * It's a non-constant attribute list, so do a literal search.
+	 */
 
+	int i, objc;
+	Tcl_Obj **objv;
+
+	if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
+	    TclDecrRefCount(listObj);
+	    return TCL_ERROR;
+	}
+	for (i=0 ; i<objc ; i++) {
+	    if (!strcmp(attributeName, TclGetString(objv[i]))) {
+		TclDecrRefCount(listObj);
+		*indexPtr = i;
+		return TCL_OK;
+	    }
+	}
+	TclDecrRefCount(listObj);
+	return TCL_ERROR;
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSFileAttrsGet --
+ *
+ *	This function implements read access for the hookable 'file
+ *	attributes' subcommand. The appropriate function for the filesystem to
+ *	which pathPtr belongs will be called.
+ *
+ * Results:
+ *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ *	was returned) is likely to have a refCount of zero. Either way we must
+ *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ *	refCount to ensure it is properly freed.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *pathPtr;		/* filename we are operating on. */
-    Tcl_Obj **objPtrRef;	/* for output. */
+Tcl_FSFileAttrsGet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *pathPtr,		/* filename we are operating on. */
+    Tcl_Obj **objPtrRef)	/* for output. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr != NULL) {
 	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
 	if (proc != NULL) {
@@ -2424,27 +2592,28 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
  *
  * Tcl_FSFileAttrsSet --
  *
- *	This procedure implements write access for the hookable 'file
- *	attributes' subcommand.  The appropriate function for the
- *	filesystem to which pathPtr belongs will be called.
+ *	This function implements write access for the hookable 'file
+ *	attributes' subcommand. The appropriate function for the filesystem to
+ *	which pathPtr belongs will be called.
  *
  * Results:
- *      Standard Tcl return code.
+ *	Standard Tcl return code.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *pathPtr;		/* filename we are operating on. */
-    Tcl_Obj *objPtr;		/* Input value. */
+Tcl_FSFileAttrsSet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *pathPtr,		/* filename we are operating on. */
+    Tcl_Obj *objPtr)		/* Input value. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr != NULL) {
 	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
 	if (proc != NULL) {
@@ -2461,34 +2630,32 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
  * Tcl_FSGetCwd --
  *
  *	This function replaces the library version of getcwd().
- *	
- *	Most VFS's will *not* implement a 'cwdProc'.  Tcl now maintains
- *	its own record (in a Tcl_Obj) of the cwd, and an attempt
- *	is made to synchronise this with the cwd's containing filesystem,
- *	if that filesystem provides a cwdProc (e.g. the native filesystem).
- *	
- *	Note that if Tcl's cwd is not in the native filesystem, then of
- *	course Tcl's cwd and the native cwd are different: extensions
- *	should therefore ensure they only access the cwd through this
- *	function to avoid confusion.
- *	
+ *
+ *	Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own
+ *	record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this
+ *	with the cwd's containing filesystem, if that filesystem provides a
+ *	cwdProc (e.g. the native filesystem).
+ *
+ *	Note that if Tcl's cwd is not in the native filesystem, then of course
+ *	Tcl's cwd and the native cwd are different: extensions should
+ *	therefore ensure they only access the cwd through this function to
+ *	avoid confusion.
+ *
  *	If a global cwdPathPtr already exists, it is cached in the thread's
  *	private data structures and reference to the cached copy is returned,
  *	subject to a synchronisation attempt in that cwdPathPtr's fs.
- *	
- *	Otherwise, the chain of functions that have been "inserted"
- *	into the filesystem will be called in succession until either a
- *	value other than NULL is returned, or the entire list is
- *	visited.
+ *
+ *	Otherwise, the chain of functions that have been "inserted" into the
+ *	filesystem will be called in succession until either a value other
+ *	than NULL is returned, or the entire list is visited.
  *
  * Results:
- *	The result is a pointer to a Tcl_Obj specifying the current
- *	directory, or NULL if the current directory could not be
- *	determined.  If NULL is returned, an error message is left in the
- *	interp's result.  
- *	
- *	The result already has its refCount incremented for the caller.
- *	When it is no longer needed, that refCount should be decremented.
+ *	The result is a pointer to a Tcl_Obj specifying the current directory,
+ *	or NULL if the current directory could not be determined. If NULL is
+ *	returned, an error message is left in the interp's result.
+ *
+ *	The result already has its refCount incremented for the caller. When
+ *	it is no longer needed, that refCount should be decremented.
  *
  * Side effects:
  *	Various objects may be freed and allocated.
@@ -2496,117 +2663,220 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj*
-Tcl_FSGetCwd(interp)
-    Tcl_Interp *interp;
+Tcl_Obj *
+Tcl_FSGetCwd(
+    Tcl_Interp *interp)
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
     if (TclFSCwdPointerEquals(NULL)) {
 	FilesystemRecord *fsRecPtr;
 	Tcl_Obj *retVal = NULL;
 
-	/* 
-	 * We've never been called before, try to find a cwd.  Call
-	 * each of the "Tcl_GetCwd" function in succession.  A non-NULL
-	 * return value indicates the particular function has
-	 * succeeded.
+	/*
+	 * We've never been called before, try to find a cwd. Call each of the
+	 * "Tcl_GetCwd" function in succession. A non-NULL return value
+	 * indicates the particular function has succeeded.
 	 */
 
 	fsRecPtr = FsGetFirstFilesystem();
+	Claim();
 	while ((retVal == NULL) && (fsRecPtr != NULL)) {
 	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
 	    if (proc != NULL) {
-		retVal = (*proc)(interp);
+		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
+		    ClientData retCd;
+		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
+
+		    retCd = (*proc2)(NULL);
+		    if (retCd != NULL) {
+			Tcl_Obj *norm;
+			/* Looks like a new current directory */
+			retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
+				retCd);
+			Tcl_IncrRefCount(retVal);
+			norm = TclFSNormalizeAbsolutePath(interp,retVal);
+			if (norm != NULL) {
+			    /*
+			     * We found a cwd, which is now in our global
+			     * storage. We must make a copy. Norm already has
+			     * a refCount of 1.
+			     *
+			     * Threading issue: note that multiple threads at
+			     * system startup could in principle call this
+			     * function simultaneously. They will therefore
+			     * each set the cwdPathPtr independently. That
+			     * behaviour is a bit peculiar, but should be
+			     * fine. Once we have a cwd, we'll always be in
+			     * the 'else' branch below which is simpler.
+			     */
+
+			    FsUpdateCwd(norm, retCd);
+			    Tcl_DecrRefCount(norm);
+			} else {
+			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
+			}
+			Tcl_DecrRefCount(retVal);
+			retVal = NULL;
+			Disclaim();
+			goto cdDidNotChange;
+		    } else if (interp != NULL) {
+			Tcl_AppendResult(interp,
+				"error getting working directory name: ",
+				Tcl_PosixError(interp), NULL);
+		    }
+		} else {
+		    retVal = (*proc)(interp);
+		}
 	    }
 	    fsRecPtr = fsRecPtr->nextPtr;
 	}
-	/* 
-	 * Now the 'cwd' may NOT be normalized, at least on some
-	 * platforms.  For the sake of efficiency, we want a completely
-	 * normalized cwd at all times.
-	 * 
-	 * Finally, if retVal is NULL, we do not have a cwd, which
-	 * could be problematic.
+	Disclaim();
+
+	/*
+	 * Now the 'cwd' may NOT be normalized, at least on some platforms.
+	 * For the sake of efficiency, we want a completely normalized cwd at
+	 * all times.
+	 *
+	 * Finally, if retVal is NULL, we do not have a cwd, which could be
+	 * problematic.
 	 */
+
 	if (retVal != NULL) {
 	    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
 	    if (norm != NULL) {
-		/* 
-		 * We found a cwd, which is now in our global storage.
-		 * We must make a copy. Norm already has a refCount of 1.
-		 * 
+		/*
+		 * We found a cwd, which is now in our global storage. We must
+		 * make a copy. Norm already has a refCount of 1.
+		 *
 		 * Threading issue: note that multiple threads at system
-		 * startup could in principle call this procedure 
-		 * simultaneously.  They will therefore each set the
-		 * cwdPathPtr independently.  That behaviour is a bit
-		 * peculiar, but should be fine.  Once we have a cwd,
-		 * we'll always be in the 'else' branch below which
-		 * is simpler.
+		 * startup could in principle call this function
+		 * simultaneously. They will therefore each set the cwdPathPtr
+		 * independently. That behaviour is a bit peculiar, but should
+		 * be fine. Once we have a cwd, we'll always be in the 'else'
+		 * branch below which is simpler.
 		 */
-		FsUpdateCwd(norm);
+
+		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
+		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
 		Tcl_DecrRefCount(norm);
 	    }
 	    Tcl_DecrRefCount(retVal);
 	}
     } else {
-	/* 
-	 * We already have a cwd cached, but we want to give the
-	 * filesystem it is in a chance to check whether that cwd
-	 * has changed, or is perhaps no longer accessible.  This
-	 * allows an error to be thrown if, say, the permissions on
-	 * that directory have changed.
+	/*
+	 * We already have a cwd cached, but we want to give the filesystem it
+	 * is in a chance to check whether that cwd has changed, or is perhaps
+	 * no longer accessible. This allows an error to be thrown if, say,
+	 * the permissions on that directory have changed.
 	 */
-	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
-	/* 
-	 * If the filesystem couldn't be found, or if no cwd function
-	 * exists for this filesystem, then we simply assume the cached
-	 * cwd is ok.  If we do call a cwd, we must watch for errors
-	 * (if the cwd returns NULL).  This ensures that, say, on Unix
-	 * if the permissions of the cwd change, 'pwd' does actually
-	 * throw the correct error in Tcl.  (This is tested for in the
-	 * test suite on unix).
+
+	const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+
+	/*
+	 * If the filesystem couldn't be found, or if no cwd function exists
+	 * for this filesystem, then we simply assume the cached cwd is ok.
+	 * If we do call a cwd, we must watch for errors (if the cwd returns
+	 * NULL). This ensures that, say, on Unix if the permissions of the
+	 * cwd change, 'pwd' does actually throw the correct error in Tcl.
+	 * (This is tested for in the test suite on unix).
 	 */
+
 	if (fsPtr != NULL) {
 	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
+	    ClientData retCd = NULL;
 	    if (proc != NULL) {
-		Tcl_Obj *retVal = (*proc)(interp);
+		Tcl_Obj *retVal;
+		if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
+		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
+
+		    retCd = (*proc2)(tsdPtr->cwdClientData);
+		    if (retCd == NULL && interp != NULL) {
+			Tcl_AppendResult(interp,
+				"error getting working directory name: ",
+				Tcl_PosixError(interp), NULL);
+		    }
+
+		    if (retCd == tsdPtr->cwdClientData) {
+			goto cdDidNotChange;
+		    }
+
+		    /*
+		     * Looks like a new current directory.
+		     */
+
+		    retVal = (*fsPtr->internalToNormalizedProc)(retCd);
+		    Tcl_IncrRefCount(retVal);
+		} else {
+		    retVal = (*proc)(interp);
+		}
 		if (retVal != NULL) {
 		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
-		    /* 
-		     * Check whether cwd has changed from the value
-		     * previously stored in cwdPathPtr.  Really 'norm'
-		     * shouldn't be null, but we are careful.
+
+		    /*
+		     * Check whether cwd has changed from the value previously
+		     * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
+		     * but we are careful.
 		     */
+
 		    if (norm == NULL) {
 			/* Do nothing */
-		    } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {
-			/* 
-			 * If the paths were equal, we can be more
-			 * efficient and retain the old path object
-			 * which will probably already be shared.  In
-			 * this case we can simply free the normalized
-			 * path we just calculated.
-			 */
-			Tcl_DecrRefCount(norm);
+			if (retCd != NULL) {
+			    (*fsPtr->freeInternalRepProc)(retCd);
+			}
+		    } else if (norm == tsdPtr->cwdPathPtr) {
+			goto cdEqual;
 		    } else {
-			FsUpdateCwd(norm);
-			Tcl_DecrRefCount(norm);
+			/*
+			 * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
+			 * normalized paths. Therefore we can be more
+			 * efficient than calling 'Tcl_FSEqualPaths', and in
+			 * addition avoid a nasty infinite loop bug when
+			 * trying to normalize tsdPtr->cwdPathPtr.
+			 */
+
+			int len1, len2;
+			char *str1, *str2;
+
+			str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+			str2 = Tcl_GetStringFromObj(norm, &len2);
+			if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
+			    /*
+			     * If the paths were equal, we can be more
+			     * efficient and retain the old path object which
+			     * will probably already be shared. In this case
+			     * we can simply free the normalized path we just
+			     * calculated.
+			     */
+
+			cdEqual:
+			    Tcl_DecrRefCount(norm);
+			    if (retCd != NULL) {
+				(*fsPtr->freeInternalRepProc)(retCd);
+			    }
+			} else {
+			    FsUpdateCwd(norm, retCd);
+			    Tcl_DecrRefCount(norm);
+			}
 		    }
 		    Tcl_DecrRefCount(retVal);
 		} else {
-		    /* The 'cwd' function returned an error; reset the cwd */
-		    FsUpdateCwd(NULL);
+		    /*
+		     * The 'cwd' function returned an error; reset the cwd.
+		     */
+
+		    FsUpdateCwd(NULL, NULL);
 		}
 	    }
 	}
     }
-    
+
+  cdDidNotChange:
     if (tsdPtr->cwdPathPtr != NULL) {
 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
     }
-    
-    return tsdPtr->cwdPathPtr; 
+
+    return tsdPtr->cwdPathPtr;
 }
 
 /*
@@ -2615,131 +2885,148 @@ Tcl_FSGetCwd(interp)
  * Tcl_FSChdir --
  *
  *	This function replaces the library version of chdir().
- *	
- *	The path is normalized and then passed to the filesystem
- *	which claims it.
+ *
+ *	The path is normalized and then passed to the filesystem which claims
+ *	it.
  *
  * Results:
- *	See chdir() documentation.  If successful, we keep a 
- *	record of the successful path in cwdPathPtr for subsequent 
- *	calls to getcwd.
+ *	See chdir() documentation. If successful, we keep a record of the
+ *	successful path in cwdPathPtr for subsequent calls to getcwd.
  *
  * Side effects:
- *	See chdir() documentation.  The global cwdPathPtr may 
- *	change value.
+ *	See chdir() documentation. The global cwdPathPtr may change value.
  *
  *----------------------------------------------------------------------
  */
+
 int
-Tcl_FSChdir(pathPtr)
-    Tcl_Obj *pathPtr;
+Tcl_FSChdir(
+    Tcl_Obj *pathPtr)
 {
-    Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr;
     int retVal = -1;
-    
-#ifdef WIN32
-    /*
-     * This complete hack addresses the bug tested in winFCmd-16.12,
-     * where having your HOME as "C:" (IOW, a seemingly path relative
-     * dir) would cause a crash when you cd'd to it and requested 'pwd'.
-     * The work-around is to force such a dir into an absolute path by
-     * tacking on '/'.
-     *
-     * We check for '~' specifically because that's what Tcl_CdObjCmd
-     * passes in that triggers the bug.  A direct 'cd C:' call will not
-     * because that gets the volumerelative pwd.
-     *
-     * This is not an issue for 8.5 as that has a more elaborate change
-     * that requires the use of TCL_FILESYSTEM_VERSION_2.
-     */
-    Tcl_Obj *objPtr = NULL;
-    if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') {
-	int len;
-	char *str;
 
-	objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
-	if (objPtr == NULL) {
-	    Tcl_SetErrno(ENOENT);
-	    return -1;
-	}
-	Tcl_IncrRefCount(objPtr);
-	str = Tcl_GetStringFromObj(objPtr, &len);
-	if (len == 2 && str[1] == ':') {
-	    pathPtr = Tcl_NewStringObj(str, len);
-	    Tcl_AppendToObj(pathPtr, "/", 1);
-	    Tcl_IncrRefCount(pathPtr);
-	    Tcl_DecrRefCount(objPtr);
-	    objPtr = pathPtr;
-	} else {
-	    Tcl_DecrRefCount(objPtr);
-	    objPtr = NULL;
-	}
-    }
-#endif
     if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
-#ifdef WIN32
-	if (objPtr) { Tcl_DecrRefCount(objPtr); }
-#endif
 	Tcl_SetErrno(ENOENT);
-        return -1;
+	return retVal;
     }
-    
+
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
 	if (proc != NULL) {
+	    /*
+	     * If this fails, an appropriate errno will have been stored using
+	     * 'Tcl_SetErrno()'.
+	     */
+
 	    retVal = (*proc)(pathPtr);
 	} else {
-	    /* Fallback on stat-based implementation */
+	    /*
+	     * Fallback on stat-based implementation.
+	     */
+
 	    Tcl_StatBuf buf;
-	    /* If the file can be stat'ed and is a directory and
-	     * is readable, then we can chdir. */
-	    if ((Tcl_FSStat(pathPtr, &buf) == 0) 
-	      && (S_ISDIR(buf.st_mode))
-	      && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
-		/* We allow the chdir */
+
+	    /*
+	     * If the file can be stat'ed and is a directory and is readable,
+	     * then we can chdir. If any of these actions fail, then
+	     * 'Tcl_SetErrno()' should automatically have been called to set
+	     * an appropriate error code
+	     */
+
+	    if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode))
+		    && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
+		/*
+		 * We allow the chdir.
+		 */
+
 		retVal = 0;
 	    }
 	}
+    } else {
+	Tcl_SetErrno(ENOENT);
     }
 
-    if (retVal != -1) {
-	/* 
-	 * The cwd changed, or an error was thrown.  If an error was
-	 * thrown, we can just continue (and that will report the error
-	 * to the user).  If there was no error we must assume that the
-	 * cwd was actually changed to the normalized value we
-	 * calculated above, and we must therefore cache that
-	 * information.
+    /*
+     * The cwd changed, or an error was thrown. If an error was thrown, we can
+     * just continue (and that will report the error to the user). If there
+     * was no error we must assume that the cwd was actually changed to the
+     * normalized value we calculated above, and we must therefore cache that
+     * information.
+     */
+
+    /*
+     * If the filesystem in question has a getCwdProc, then the correct logic
+     * which performs the part below is already part of the Tcl_FSGetCwd()
+     * call, so no need to replicate it again. This will have a side effect
+     * though. The private authoritative representation of the current working
+     * directory stored in cwdPathPtr in static memory will be out-of-sync
+     * with the real OS-maintained value. The first call to Tcl_FSGetCwd will
+     * however recalculate the private copy to match the OS-value so
+     * everything will work right.
+     *
+     * However, if there is no getCwdProc, then we _must_ update our private
+     * storage of the cwd, since this is the only opportunity to do that!
+     *
+     * Note: We currently call this block of code irrespective of whether
+     * there was a getCwdProc or not, but the code should all in principle
+     * work if we only call this block if fsPtr->getCwdProc == NULL.
+     */
+
+    if (retVal == 0) {
+	/*
+	 * Note that this normalized path may be different to what we found
+	 * above (or at least a different object), if the filesystem epoch
+	 * changed recently. This can actually happen with scripted documents
+	 * very easily. Therefore we ask for the normalized path again (the
+	 * correct value will have been cached as a result of the
+	 * Tcl_FSGetFileSystemForPath call above anyway).
 	 */
-	if (retVal == 0) {
-	    /* 
-	     * Note that this normalized path may be different to what
-	     * we found above (or at least a different object), if the
-	     * filesystem epoch changed recently.  This can actually
-	     * happen with scripted documents very easily.  Therefore
-	     * we ask for the normalized path again (the correct value
-	     * will have been cached as a result of the
-	     * Tcl_FSGetFileSystemForPath call above anyway).
+
+	Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
+	if (normDirName == NULL) {
+	    /* Not really true, but what else to do? */
+	    Tcl_SetErrno(ENOENT);
+	    return -1;
+	}
+
+	if (fsPtr == &tclNativeFilesystem) {
+	    /*
+	     * For the native filesystem, we keep a cache of the native
+	     * representation of the cwd. But, we want to do that for the
+	     * exact format that is returned by 'getcwd' (so that we can later
+	     * compare the two representations for equality), which might not
+	     * be exactly the same char-string as the native representation of
+	     * the fully normalized path (e.g. on Windows there's a
+	     * forward-slash vs backslash difference). Hence we ask for this
+	     * again here. On Unix it might actually be true that we always
+	     * have the correct form in the native rep in which case we could
+	     * simply use:
+	     *		cd = Tcl_FSGetNativePath(pathPtr);
+	     * instead. This should be examined by someone on Unix.
 	     */
-	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
-	    if (normDirName == NULL) {
-#ifdef WIN32
-		if (objPtr) { Tcl_DecrRefCount(objPtr); }
-#endif
-		Tcl_SetErrno(ENOENT);
-	        return -1;
+
+	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+	    ClientData cd;
+	    ClientData oldcd = tsdPtr->cwdClientData;
+
+	    /*
+	     * Assumption we are using a filesystem version 2.
+	     */
+
+	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
+	    cd = (*proc2)(oldcd);
+	    if (cd != oldcd) {
+		FsUpdateCwd(normDirName, cd);
 	    }
-	    FsUpdateCwd(normDirName);
+	} else {
+	    FsUpdateCwd(normDirName, NULL);
 	}
-    } else {
-	Tcl_SetErrno(ENOENT);
     }
-    
-#ifdef WIN32
-    if (objPtr) { Tcl_DecrRefCount(objPtr); }
-#endif
-    return (retVal);
+
+    return retVal;
 }
 
 /*
@@ -2747,26 +3034,114 @@ Tcl_FSChdir(pathPtr)
  *
  * Tcl_FSLoadFile --
  *
- *	Dynamically loads a binary code file into memory and returns
- *	the addresses of two procedures within that file, if they are
- *	defined.  The appropriate function for the filesystem to which
- *	pathPtr belongs will be called.
- *	
- *	Note that the native filesystem doesn't actually assume
- *	'pathPtr' is a path.  Rather it assumes filename is either
- *	a path or just the name of a file which can be found somewhere
- *	in the environment's loadable path.  This behaviour is not
- *	very compatible with virtual filesystems (and has other problems
- *	documented in the load man-page), so it is advised that full
- *	paths are always used.
+ *	Dynamically loads a binary code file into memory and returns the
+ *	addresses of two functions within that file, if they are defined. The
+ *	appropriate function for the filesystem to which pathPtr belongs will
+ *	be called.
+ *
+ *	Note that the native filesystem doesn't actually assume 'pathPtr' is a
+ *	path. Rather it assumes pathPtr is either a path or just the name
+ *	(tail) of a file which can be found somewhere in the environment's
+ *	loadable path. This behaviour is not very compatible with virtual
+ *	filesystems (and has other problems documented in the load man-page),
+ *	so it is advised that full paths are always used.
+ *
+ * Results:
+ *	A standard Tcl completion code. If an error occurs, an error message
+ *	is left in the interp's result.
+ *
+ * Side effects:
+ *	New code suddenly appears in memory. This may later be unloaded by
+ *	passing the clientData to the unloadProc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_FSLoadFile(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
+				 * code. */
+    const char *sym1, const char *sym2,
+				/* Names of two functions to look up in the
+				 * file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+    Tcl_LoadHandle *handlePtr,	/* Filled with token for dynamically loaded
+				 * file which will be passed back to
+				 * (*unloadProcPtr)() to unload the file. */
+    Tcl_FSUnloadFileProc **unloadProcPtr)
+				/* Filled with address of Tcl_FSUnloadFileProc
+				 * function which should be used for this
+				 * file. */
+{
+    const char *symbols[2];
+    Tcl_PackageInitProc **procPtrs[2];
+    ClientData clientData;
+    int res;
+
+    /*
+     * Initialize the arrays.
+     */
+
+    symbols[0] = sym1;
+    symbols[1] = sym2;
+    procPtrs[0] = proc1Ptr;
+    procPtrs[1] = proc2Ptr;
+
+    /*
+     * Perform the load.
+     */
+
+    res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr,
+	    &clientData, unloadProcPtr);
+
+    /*
+     * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
+     * library, we don't keep the loadHandle (for TclpFindSymbol) and the
+     * clientData (for the unloadProc) separately. In fact we effectively
+     * throw away the loadHandle and only use the clientData. It just so
+     * happens, for the native filesystem only, that these two are identical.
+     *
+     * This also means that the signatures Tcl_FSUnloadFileProc and
+     * Tcl_FSLoadFileProc are both misleading.
+     */
+
+    *handlePtr = (Tcl_LoadHandle) clientData;
+    return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ *	Dynamically loads a binary code file into memory and returns the
+ *	addresses of a number of given functions within that file, if they are
+ *	defined. The appropriate function for the filesystem to which pathPtr
+ *	belongs will be called.
+ *
+ *	Note that the native filesystem doesn't actually assume 'pathPtr' is a
+ *	path. Rather it assumes pathPtr is either a path or just the name
+ *	(tail) of a file which can be found somewhere in the environment's
+ *	loadable path. This behaviour is not very compatible with virtual
+ *	filesystems (and has other problems documented in the load man-page),
+ *	so it is advised that full paths are always used.
+ *
+ *	This function is currently private to Tcl. It may be exported in the
+ *	future and its interface fixed (but we should clean up the
+ *	loadHandle/clientData confusion at that time -- see the above comments
+ *	in Tcl_FSLoadFile for details). For a public function, see
+ *	Tcl_FSLoadFile.
  *
  * Results:
- *	A standard Tcl completion code.  If an error occurs, an error
- *	message is left in the interp's result.
+ *	A standard Tcl completion code. If an error occurs, an error message
+ *	is left in the interp's result.
  *
  * Side effects:
- *	New code suddenly appears in memory.  This may later be
- *	unloaded by passing the clientData to the unloadProc.
+ *	New code suddenly appears in memory. This may later be unloaded by
+ *	passing the clientData to the unloadProc.
  *
  *----------------------------------------------------------------------
  */
@@ -2775,369 +3150,384 @@ typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
 	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 
 int
-Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
-	       handlePtr, unloadProcPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
+TclLoadFile(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
 				 * code. */
-    CONST char *sym1, *sym2;	/* Names of two procedures to look up in
-				 * the file's symbol table. */
-    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+    int symc,			/* Number of symbols/procPtrs in the next two
+				 * arrays. */
+    const char *symbols[],	/* Names of functions to look up in the file's
+				 * symbol table. */
+    Tcl_PackageInitProc **procPtrs[],
 				/* Where to return the addresses corresponding
-				 * to sym1 and sym2. */
-    Tcl_LoadHandle *handlePtr;	/* Filled with token for dynamically loaded
-				 * file which will be passed back to 
+				 * to symbols[]. */
+    Tcl_LoadHandle *handlePtr,	/* Filled with token for shared library
+				 * information which can be used in
+				 * TclpFindSymbol. */
+    ClientData *clientDataPtr,	/* Filled with token for dynamically loaded
+				 * file which will be passed back to
 				 * (*unloadProcPtr)() to unload the file. */
-    Tcl_FSUnloadFileProc **unloadProcPtr;	
-                                /* Filled with address of Tcl_FSUnloadFileProc
-                                 * function which should be used for
-                                 * this file. */
+    Tcl_FSUnloadFileProc **unloadProcPtr)
+				/* Filled with address of Tcl_FSUnloadFileProc
+				 * function which should be used for this
+				 * file. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
-	if (proc != NULL) {
-	    int retVal = ((Tcl_FSLoadFileProc2 *)proc)
-		    (interp, pathPtr, handlePtr, unloadProcPtr, 0);
-	    if (retVal != TCL_OK) {
-		return retVal;
-	    }
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    Tcl_FSLoadFileProc *proc;
+    Tcl_Filesystem *copyFsPtr;
+    Tcl_Obj *copyToPtr;
+    Tcl_LoadHandle newLoadHandle = NULL;
+    ClientData newClientData = NULL;
+    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
+    FsDivertLoad *tvdlPtr;
+    int retVal;
+
+    if (fsPtr == NULL) {
+	Tcl_SetErrno(ENOENT);
+	return TCL_ERROR;
+    }
+
+    proc = fsPtr->loadFileProc;
+    if (proc != NULL) {
+	int retVal = ((Tcl_FSLoadFileProc2 *)proc)
+		(interp, pathPtr, handlePtr, unloadProcPtr, 0);
+	if (retVal == TCL_OK) {
 	    if (*handlePtr == NULL) {
 		return TCL_ERROR;
 	    }
-	    if (sym1 != NULL) {
-	        *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
-	    }
-	    if (sym2 != NULL) {
-	        *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
-	    }
+
+	    /*
+	     * Copy this across, since both are equal for the native fs.
+	     */
+
+	    *clientDataPtr = (ClientData)*handlePtr;
+	    Tcl_ResetResult(interp);
+	    goto resolveSymbols;
+	}
+	if (Tcl_GetErrno() != EXDEV) {
 	    return retVal;
-	} else {
-	    Tcl_Filesystem *copyFsPtr;
-	    Tcl_Obj *copyToPtr;
-	    
-	    /* First check if it is readable -- and exists! */
-	    if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
-		Tcl_AppendResult(interp, "couldn't load library \"",
-				 Tcl_GetString(pathPtr), "\": ", 
-				 Tcl_PosixError(interp), (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    
+	}
+    }
+
+    /*
+     * The filesystem doesn't support 'load', so we fall back on the following
+     * technique:
+     *
+     * First check if it is readable -- and exists!
+     */
+
+    if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
+	Tcl_AppendResult(interp, "couldn't load library \"",
+		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	return TCL_ERROR;
+    }
+
 #ifdef TCL_LOAD_FROM_MEMORY
-	/* 
-	 * The platform supports loading code from memory, so ask for a
-	 * buffer of the appropriate size, read the file into it and 
-	 * load the code from the buffer:
+    /*
+     * The platform supports loading code from memory, so ask for a buffer of
+     * the appropriate size, read the file into it and load the code from the
+     * buffer:
+     */
+
+    {
+	int ret, size;
+	void *buffer;
+	Tcl_StatBuf statBuf;
+	Tcl_Channel data;
+
+	ret = Tcl_FSStat(pathPtr, &statBuf);
+	if (ret < 0) {
+	    goto mustCopyToTempAnyway;
+	}
+	size = (int) statBuf.st_size;
+
+	/*
+	 * Tcl_Read takes an int: check that file size isn't wide.
 	 */
-	do {
-            int ret, size;
-            void *buffer;
-            Tcl_StatBuf statBuf;
-            Tcl_Channel data;
-            
-            ret = Tcl_FSStat(pathPtr, &statBuf);
-            if (ret < 0) {
-                break;
-            }
-            size = (int) statBuf.st_size;
-            /* Tcl_Read takes an int: check that file size isn't wide */
-            if (size != (Tcl_WideInt)statBuf.st_size) {
-                break;
-            }
-	    data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
-            if (!data) {
-                break;
-            }
-            buffer = TclpLoadMemoryGetBuffer(interp, size);
-            if (!buffer) {
-                Tcl_Close(interp, data);
-                break;
-            }
-            Tcl_SetChannelOption(interp, data, "-translation", "binary");
-            ret = Tcl_Read(data, buffer, size);
-            Tcl_Close(interp, data);
-            ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr);
-            if (ret == TCL_OK) {
-		if (*handlePtr == NULL) {
-		    break;
-		}
-                if (sym1 != NULL) {
-                    *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
-                }
-                if (sym2 != NULL) {
-                    *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
-                }
-		return TCL_OK;
-	    }
-	} while (0); 
-	Tcl_ResetResult(interp);
+
+	if (size != (Tcl_WideInt) statBuf.st_size) {
+	    goto mustCopyToTempAnyway;
+	}
+	data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
+	if (!data) {
+	    goto mustCopyToTempAnyway;
+	}
+	buffer = TclpLoadMemoryGetBuffer(interp, size);
+	if (!buffer) {
+	    Tcl_Close(interp, data);
+	    goto mustCopyToTempAnyway;
+	}
+	ret = Tcl_Read(data, buffer, size);
+	Tcl_Close(interp, data);
+	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
+		unloadProcPtr);
+	if (ret == TCL_OK && *handlePtr != NULL) {
+	    *clientDataPtr = (ClientData) *handlePtr;
+	    goto resolveSymbols;
+	}
+    }
+
+  mustCopyToTempAnyway:
+    Tcl_ResetResult(interp);
 #endif
 
-	    /* 
-	     * Get a temporary filename to use, first to
-	     * copy the file into, and then to load. 
-	     */
-	    copyToPtr = TclpTempFileName();
-	    if (copyToPtr == NULL) {
-	        return -1;
-	    }
-	    Tcl_IncrRefCount(copyToPtr);
-	    
-	    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
-	    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
-		/* 
-		 * We already know we can't use Tcl_FSLoadFile from 
-		 * this filesystem, and we must avoid a possible
-		 * infinite loop.  Try to delete the file we
-		 * probably created, and then exit.
-		 */
-		Tcl_FSDeleteFile(copyToPtr);
-		Tcl_DecrRefCount(copyToPtr);
-		return -1;
-	    }
-	    
-	    if (TclCrossFilesystemCopy(interp, pathPtr, 
-				       copyToPtr) == TCL_OK) {
-		Tcl_LoadHandle newLoadHandle = NULL;
-		Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
-		FsDivertLoad *tvdlPtr;
-		int retVal;
+    /*
+     * Get a temporary filename to use, first to copy the file into, and then
+     * to load.
+     */
+
+    copyToPtr = TclpTempFileName();
+    if (copyToPtr == NULL) {
+	Tcl_AppendResult(interp, "couldn't create temporary file: ",
+		Tcl_PosixError(interp), NULL);
+	return TCL_ERROR;
+    }
+    Tcl_IncrRefCount(copyToPtr);
+
+    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
+    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
+	/*
+	 * We already know we can't use Tcl_FSLoadFile from this filesystem,
+	 * and we must avoid a possible infinite loop. Try to delete the file
+	 * we probably created, and then exit.
+	 */
+
+	Tcl_FSDeleteFile(copyToPtr);
+	Tcl_DecrRefCount(copyToPtr);
+	Tcl_AppendResult(interp, "couldn't load from current filesystem",NULL);
+	return TCL_ERROR;
+    }
+
+    if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) {
+	/*
+	 * Cross-platform copy failed.
+	 */
+
+	Tcl_FSDeleteFile(copyToPtr);
+	Tcl_DecrRefCount(copyToPtr);
+	return TCL_ERROR;
+    }
 
 #if !defined(__WIN32__)
-		/* 
-		 * Do we need to set appropriate permissions 
-		 * on the file?  This may be required on some
-		 * systems.  On Unix we could loop over
-		 * the file attributes, and set any that are
-		 * called "-permissions" to 0700.  However,
-		 * we just do this directly, like this:
-		 */
-		
-		Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
-		Tcl_IncrRefCount(perm);
-		Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
-		Tcl_DecrRefCount(perm);
-#endif
-		
-		/* 
-		 * We need to reset the result now, because the cross-
-		 * filesystem copy may have stored the number of bytes
-		 * in the result
-		 */
-		Tcl_ResetResult(interp);
-		
-		retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2,
-					proc1Ptr, proc2Ptr, 
-					&newLoadHandle,
-					&newUnloadProcPtr);
-	        if (retVal != TCL_OK) {
-		    /* The file didn't load successfully */
-		    Tcl_FSDeleteFile(copyToPtr);
-		    Tcl_DecrRefCount(copyToPtr);
-		    return retVal;
-		}
-		/* 
-		 * Try to delete the file immediately -- this is
-		 * possible in some OSes, and avoids any worries
-		 * about leaving the copy laying around on exit. 
-		 */
-		if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
-		    Tcl_DecrRefCount(copyToPtr);
-		    /* 
-		     * We tell our caller about the real shared
-		     * library which was loaded.  Note that this
-		     * does mean that the package list maintained
-		     * by 'load' will store the original (vfs)
-		     * path alongside the temporary load handle
-		     * and unload proc ptr.
-		     */
-		    (*handlePtr) = newLoadHandle;
-		    (*unloadProcPtr) = newUnloadProcPtr;
-		    return TCL_OK;
-		}
-		/* 
-		 * When we unload this file, we need to divert the 
-		 * unloading so we can unload and cleanup the 
-		 * temporary file correctly.
-		 */
-		tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));
+    /*
+     * Do we need to set appropriate permissions on the file? This may be
+     * required on some systems. On Unix we could loop over the file
+     * attributes, and set any that are called "-permissions" to 0700. However
+     * we just do this directly, like this:
+     */
 
-		/* 
-		 * Remember three pieces of information.  This allows
-		 * us to cleanup the diverted load completely, on
-		 * platforms which allow proper unloading of code.
-		 */
-		tvdlPtr->loadHandle = newLoadHandle;
-		tvdlPtr->unloadProcPtr = newUnloadProcPtr;
-
-		if (copyFsPtr != &tclNativeFilesystem) {
-		    /* copyToPtr is already incremented for this reference */
-		    tvdlPtr->divertedFile = copyToPtr;
-
-		    /* 
-		     * This is the filesystem we loaded it into.  Since
-		     * we have a reference to 'copyToPtr', we already
-		     * have a refCount on this filesystem, so we don't
-		     * need to worry about it disappearing on us.
-		     */
-		    tvdlPtr->divertedFilesystem = copyFsPtr;
-		    tvdlPtr->divertedFileNativeRep = NULL;
-		} else {
-		    /* We need the native rep */
-		    tvdlPtr->divertedFileNativeRep = 
-		      TclNativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr, 
-								copyFsPtr));
-		    /* 
-		     * We don't need or want references to the copied
-		     * Tcl_Obj or the filesystem if it is the native
-		     * one.
-		     */
-		    tvdlPtr->divertedFile = NULL;
-		    tvdlPtr->divertedFilesystem = NULL;
-		    Tcl_DecrRefCount(copyToPtr);
-		}
+    {
+	int index;
+	Tcl_Obj *perm;
 
-		copyToPtr = NULL;
-		(*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
-		(*unloadProcPtr) = &FSUnloadTempFile;
-		return retVal;
-	    } else {
-		/* Cross-platform copy failed */
-		Tcl_FSDeleteFile(copyToPtr);
-		Tcl_DecrRefCount(copyToPtr);
-		return TCL_ERROR;
-	    }
+	TclNewLiteralStringObj(perm, "0700");
+	Tcl_IncrRefCount(perm);
+	if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
+	    Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
 	}
+	Tcl_DecrRefCount(perm);
     }
-    Tcl_SetErrno(ENOENT);
-    return -1;
-}
-/* 
- * This function used to be in the platform specific directories, but it
- * has now been made to work cross-platform
- */
-int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
-	     clientDataPtr, unloadProcPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
-				 * code (UTF-8). */
-    CONST 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. */
-    ClientData *clientDataPtr;	/* Filled with token for dynamically loaded
-				 * file which will be passed back to 
-				 * (*unloadProcPtr)() to unload the file. */
-    Tcl_FSUnloadFileProc **unloadProcPtr;	
-				/* Filled with address of Tcl_FSUnloadFileProc
-				 * function which should be used for
-				 * this file. */
-{
-    Tcl_LoadHandle handle = NULL;
-    int res;
-    
-    res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
-    
-    if (res != TCL_OK) {
-        return res;
+#endif
+
+    /*
+     * We need to reset the result now, because the cross-filesystem copy may
+     * have stored the number of bytes in the result.
+     */
+
+    Tcl_ResetResult(interp);
+
+    retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
+	    &newLoadHandle, &newClientData, &newUnloadProcPtr);
+    if (retVal != TCL_OK) {
+	/*
+	 * The file didn't load successfully.
+	 */
+
+	Tcl_FSDeleteFile(copyToPtr);
+	Tcl_DecrRefCount(copyToPtr);
+	return retVal;
     }
 
-    if (handle == NULL) {
-	return TCL_ERROR;
+    /*
+     * Try to delete the file immediately - this is possible in some OSes, and
+     * avoids any worries about leaving the copy laying around on exit.
+     */
+
+    if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+	Tcl_DecrRefCount(copyToPtr);
+
+	/*
+	 * We tell our caller about the real shared library which was loaded.
+	 * Note that this does mean that the package list maintained by 'load'
+	 * will store the original (vfs) path alongside the temporary load
+	 * handle and unload proc ptr.
+	 */
+
+	(*handlePtr) = newLoadHandle;
+	(*clientDataPtr) = newClientData;
+	(*unloadProcPtr) = newUnloadProcPtr;
+	Tcl_ResetResult(interp);
+	return TCL_OK;
+    }
+
+    /*
+     * When we unload this file, we need to divert the unloading so we can
+     * unload and cleanup the temporary file correctly.
+     */
+
+    tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+
+    /*
+     * Remember three pieces of information. This allows us to cleanup the
+     * diverted load completely, on platforms which allow proper unloading of
+     * code.
+     */
+
+    tvdlPtr->loadHandle = newLoadHandle;
+    tvdlPtr->unloadProcPtr = newUnloadProcPtr;
+
+    if (copyFsPtr != &tclNativeFilesystem) {
+	/*
+	 * copyToPtr is already incremented for this reference.
+	 */
+
+	tvdlPtr->divertedFile = copyToPtr;
+
+	/*
+	 * This is the filesystem we loaded it into. Since we have a reference
+	 * to 'copyToPtr', we already have a refCount on this filesystem, so
+	 * we don't need to worry about it disappearing on us.
+	 */
+
+	tvdlPtr->divertedFilesystem = copyFsPtr;
+	tvdlPtr->divertedFileNativeRep = NULL;
+    } else {
+	/*
+	 * We need the native rep.
+	 */
+
+	tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
+		Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
+
+	/*
+	 * We don't need or want references to the copied Tcl_Obj or the
+	 * filesystem if it is the native one.
+	 */
+
+	tvdlPtr->divertedFile = NULL;
+	tvdlPtr->divertedFilesystem = NULL;
+	Tcl_DecrRefCount(copyToPtr);
+    }
+
+    copyToPtr = NULL;
+    (*handlePtr) = newLoadHandle;
+    (*clientDataPtr) = (ClientData) tvdlPtr;
+    (*unloadProcPtr) = TclFSUnloadTempFile;
+
+    Tcl_ResetResult(interp);
+    return retVal;
+
+  resolveSymbols:
+    {
+	int i;
+
+	for (i=0 ; i<symc ; i++) {
+	    if (symbols[i] != NULL) {
+		*procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]);
+	    }
+	}
     }
-    
-    *clientDataPtr = (ClientData)handle;
-    
-    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
-    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
     return TCL_OK;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * FSUnloadTempFile --
+ * TclFSUnloadTempFile --
  *
- *	This function is called when we loaded a library of code via
- *	an intermediate temporary file.  This function ensures
- *	the library is correctly unloaded and the temporary file
- *	is correctly deleted.
+ *	This function is called when we loaded a library of code via an
+ *	intermediate temporary file. This function ensures the library is
+ *	correctly unloaded and the temporary file is correctly deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The effects of the 'unload' function called, and of course
- *	the temporary file will be deleted.
+ *	The effects of the 'unload' function called, and of course the
+ *	temporary file will be deleted.
  *
  *---------------------------------------------------------------------------
  */
-static void 
-FSUnloadTempFile(loadHandle)
-    Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
-			       * to Tcl_FSLoadFile().  The loadHandle is 
-			       * a token that represents the loaded 
-			       * file. */
+
+void
+TclFSUnloadTempFile(
+    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
+				 * Tcl_FSLoadFile(). The loadHandle is a token
+				 * that represents the loaded file. */
 {
-    FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
-    /* 
-     * This test should never trigger, since we give
-     * the client data in the function above.
+    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle;
+
+    /*
+     * This test should never trigger, since we give the client data in the
+     * function above.
      */
-    if (tvdlPtr == NULL) { return; }
-    
-    /* 
-     * Call the real 'unloadfile' proc we actually used. It is very
-     * important that we call this first, so that the shared library
-     * is actually unloaded by the OS.  Otherwise, the following
-     * 'delete' may well fail because the shared library is still in
-     * use.
+
+    if (tvdlPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Call the real 'unloadfile' proc we actually used. It is very important
+     * that we call this first, so that the shared library is actually
+     * unloaded by the OS. Otherwise, the following 'delete' may well fail
+     * because the shared library is still in use.
      */
+
     if (tvdlPtr->unloadProcPtr != NULL) {
 	(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
     }
-    
+
     if (tvdlPtr->divertedFilesystem == NULL) {
-	/* 
-	 * It was the native filesystem, and we have a special
-	 * function available just for this purpose, which we 
-	 * know works even at this late stage.
+	/*
+	 * It was the native filesystem, and we have a special function
+	 * available just for this purpose, which we know works even at this
+	 * late stage.
 	 */
+
 	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
 	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
+
     } else {
-	/* 
-	 * Remove the temporary file we created.  Note, we may crash
-	 * here because encodings have been taken down already.
+	/*
+	 * Remove the temporary file we created. Note, we may crash here
+	 * because encodings have been taken down already.
 	 */
+
 	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
-	    != TCL_OK) {
-	    /* 
+		!= TCL_OK) {
+	    /*
 	     * The above may have failed because the filesystem, or something
 	     * it depends upon (e.g. encodings) have been taken down because
 	     * Tcl is exiting.
-	     * 
-	     * We may need to work out how to delete this file more
-	     * robustly (or give the filesystem the information it needs
-	     * to delete the file more robustly).
-	     * 
-	     * In particular, one problem might be that the filesystem
-	     * cannot extract the information it needs from the above
-	     * path object because Tcl's entire filesystem apparatus
-	     * (the code in this file) has been finalized, and it
-	     * refuses to pass the internal representation to the
-	     * filesystem.
+	     *
+	     * We may need to work out how to delete this file more robustly
+	     * (or give the filesystem the information it needs to delete the
+	     * file more robustly).
+	     *
+	     * In particular, one problem might be that the filesystem cannot
+	     * extract the information it needs from the above path object
+	     * because Tcl's entire filesystem apparatus (the code in this
+	     * file) has been finalized, and it refuses to pass the internal
+	     * representation to the filesystem.
 	     */
 	}
-	
-	/* 
-	 * And free up the allocations.  This will also of course remove
-	 * a refCount from the Tcl_Filesystem to which this file belongs,
-	 * which could then free up the filesystem if we are exiting.
+
+	/*
+	 * And free up the allocations. This will also of course remove a
+	 * refCount from the Tcl_Filesystem to which this file belongs, which
+	 * could then free up the filesystem if we are exiting.
 	 */
+
 	Tcl_DecrRefCount(tvdlPtr->divertedFile);
     }
 
@@ -3149,57 +3539,58 @@ FSUnloadTempFile(loadHandle)
  *
  * Tcl_FSLink --
  *
- *	This function replaces the library version of readlink() and
- *	can also be used to make links.  The appropriate function for
- *	the filesystem to which pathPtr belongs will be called.
+ *	This function replaces the library version of readlink() and can also
+ *	be used to make links. The appropriate function for the filesystem to
+ *	which pathPtr belongs will be called.
  *
  * Results:
- *      If toPtr is NULL, then the result is a Tcl_Obj specifying the 
- *      contents of the symbolic link given by 'pathPtr', or NULL if
- *      the symbolic link could not be read.  The result is owned by
- *      the caller, which should call Tcl_DecrRefCount when the result
- *      is no longer needed.
- *      
- *      If toPtr is non-NULL, then the result is toPtr if the link action
- *      was successful, or NULL if not.  In this case the result has no
- *      additional reference count, and need not be freed.  The actual
- *      action to perform is given by the 'linkAction' flags, which is
- *      an or'd combination of:
- *      
- *        TCL_CREATE_SYMBOLIC_LINK
- *        TCL_CREATE_HARD_LINK
- *      
- *      Note that most filesystems will not support linking across
- *      to different filesystems, so this function will usually
- *      fail unless toPtr is in the same FS as pathPtr.
- *      
+ *	If toPtr is NULL, then the result is a Tcl_Obj specifying the contents
+ *	of the symbolic link given by 'pathPtr', or NULL if the symbolic link
+ *	could not be read. The result is owned by the caller, which should
+ *	call Tcl_DecrRefCount when the result is no longer needed.
+ *
+ *	If toPtr is non-NULL, then the result is toPtr if the link action was
+ *	successful, or NULL if not. In this case the result has no additional
+ *	reference count, and need not be freed. The actual action to perform
+ *	is given by the 'linkAction' flags, which is an or'd combination of:
+ *
+ *		TCL_CREATE_SYMBOLIC_LINK
+ *		TCL_CREATE_HARD_LINK
+ *
+ *	Note that most filesystems will not support linking across to
+ *	different filesystems, so this function will usually fail unless toPtr
+ *	is in the same FS as pathPtr.
+ *
  * Side effects:
- *	See readlink() documentation.  A new filesystem link 
- *	object may appear
+ *	See readlink() documentation. A new filesystem link object may appear.
  *
  *---------------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_FSLink(pathPtr, toPtr, linkAction)
-    Tcl_Obj *pathPtr;		/* Path of file to readlink or link */
-    Tcl_Obj *toPtr;		/* NULL or path to be linked to */
-    int linkAction;             /* Action to perform */
+Tcl_FSLink(
+    Tcl_Obj *pathPtr,		/* Path of file to readlink or link */
+    Tcl_Obj *toPtr,		/* NULL or path to be linked to */
+    int linkAction)		/* Action to perform */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr != NULL) {
 	Tcl_FSLinkProc *proc = fsPtr->linkProc;
+
 	if (proc != NULL) {
 	    return (*proc)(pathPtr, toPtr, linkAction);
 	}
     }
+
     /*
-     * If S_IFLNK isn't defined it means that the machine doesn't
-     * support symbolic links, so the file can't possibly be a
-     * symbolic link.  Generate an EINVAL error, which is what
-     * happens on machines that do support symbolic links when
-     * you invoke readlink on a file that isn't a symbolic link.
+     * If S_IFLNK isn't defined it means that the machine doesn't support
+     * symbolic links, so the file can't possibly be a symbolic link. Generate
+     * an EINVAL error, which is what happens on machines that do support
+     * symbolic links when you invoke readlink on a file that isn't a symbolic
+     * link.
      */
+
 #ifndef S_IFLNK
     errno = EINVAL;
 #else
@@ -3213,17 +3604,16 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
  *
  * Tcl_FSListVolumes --
  *
- *	Lists the currently mounted volumes.  The chain of functions
- *	that have been "inserted" into the filesystem will be called in
- *	succession; each may return a list of volumes, all of which are
- *	added to the result until all mounted file systems are listed.
- *	
- *	Notice that we assume the lists returned by each filesystem
- *	(if non NULL) have been given a refCount for us already.
- *	However, we are NOT allowed to hang on to the list itself
- *	(it belongs to the filesystem we called).  Therefore we
- *	quite naturally add its contents to the result we are
- *	building, and then decrement the refCount.
+ *	Lists the currently mounted volumes. The chain of functions that have
+ *	been "inserted" into the filesystem will be called in succession; each
+ *	may return a list of volumes, all of which are added to the result
+ *	until all mounted file systems are listed.
+ *
+ *	Notice that we assume the lists returned by each filesystem (if non
+ *	NULL) have been given a refCount for us already. However, we are NOT
+ *	allowed to hang on to the list itself (it belongs to the filesystem we
+ *	called). Therefore we quite naturally add its contents to the result
+ *	we are building, and then decrement the refCount.
  *
  * Results:
  *	The list of volumes, in an object which has refCount 0.
@@ -3239,15 +3629,16 @@ Tcl_FSListVolumes(void)
 {
     FilesystemRecord *fsRecPtr;
     Tcl_Obj *resultPtr = Tcl_NewObj();
-    
+
     /*
-     * Call each of the "listVolumes" function in succession.
-     * A non-NULL return value indicates the particular function has
-     * succeeded.  We call all the functions registered, since we want
-     * a list of all drives from all filesystems.
+     * Call each of the "listVolumes" function in succession. A non-NULL
+     * return value indicates the particular function has succeeded. We call
+     * all the functions registered, since we want a list of all drives from
+     * all filesystems.
      */
 
     fsRecPtr = FsGetFirstFilesystem();
+    Claim();
     while (fsRecPtr != NULL) {
 	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
 	if (proc != NULL) {
@@ -3259,7 +3650,8 @@ Tcl_FSListVolumes(void)
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
+    Disclaim();
+
     return resultPtr;
 }
 
@@ -3268,13 +3660,12 @@ Tcl_FSListVolumes(void)
  *
  * FsListMounts --
  *
- *	List all mounts within the given directory, which match the
- *	given pattern.
+ *	List all mounts within the given directory, which match the given
+ *	pattern.
  *
  * Results:
- *	The list of mounts, in a list object which has refCount 0, or
- *	NULL if we didn't even find any filesystems to try to list
- *	mounts.
+ *	The list of mounts, in a list object which has refCount 0, or NULL if
+ *	we didn't even find any filesystems to try to list mounts.
  *
  * Side effects:
  *	None
@@ -3282,27 +3673,28 @@ Tcl_FSListVolumes(void)
  *---------------------------------------------------------------------------
  */
 
-static Tcl_Obj*
-FsListMounts(pathPtr, pattern)
-    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
-    CONST char *pattern;	/* Pattern to match against. */
+static Tcl_Obj *
+FsListMounts(
+    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
+    const char *pattern)	/* Pattern to match against. */
 {
     FilesystemRecord *fsRecPtr;
     Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
     Tcl_Obj *resultPtr = NULL;
-    
+
     /*
-     * Call each of the "listMounts" functions in succession.
-     * A non-NULL return value indicates the particular function has
-     * succeeded.  We call all the functions registered, since we want
-     * a list from each filesystems.
+     * Call each of the "matchInDirectory" functions in succession, with the
+     * specific type information 'mountsOnly'. A non-NULL return value
+     * indicates the particular function has succeeded. We call all the
+     * functions registered, since we want a list from each filesystems.
      */
 
     fsRecPtr = FsGetFirstFilesystem();
+    Claim();
     while (fsRecPtr != NULL) {
 	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
-	    Tcl_FSMatchInDirectoryProc *proc = 
-				  fsRecPtr->fsPtr->matchInDirectoryProc;
+	    Tcl_FSMatchInDirectoryProc *proc =
+		    fsRecPtr->fsPtr->matchInDirectoryProc;
 	    if (proc != NULL) {
 		if (resultPtr == NULL) {
 		    resultPtr = Tcl_NewObj();
@@ -3312,7 +3704,8 @@ FsListMounts(pathPtr, pattern)
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
+    Disclaim();
+
     return resultPtr;
 }
 
@@ -3321,14 +3714,14 @@ FsListMounts(pathPtr, pattern)
  *
  * Tcl_FSSplitPath --
  *
- *      This function takes the given Tcl_Obj, which should be a valid
- *      path, and returns a Tcl List object containing each segment of
- *      that path as an element.
+ *	This function takes the given Tcl_Obj, which should be a valid path,
+ *	and returns a Tcl List object containing each segment of that path as
+ *	an element.
  *
  * Results:
- *      Returns list object with refCount of zero.  If the passed in
- *      lenPtr is non-NULL, we use it to return the number of elements
- *      in the returned list.
+ *	Returns list object with refCount of zero. If the passed in lenPtr is
+ *	non-NULL, we use it to return the number of elements in the returned
+ *	list.
  *
  * Side effects:
  *	None.
@@ -3336,23 +3729,23 @@ FsListMounts(pathPtr, pattern)
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj* 
-Tcl_FSSplitPath(pathPtr, lenPtr)
-    Tcl_Obj *pathPtr;		/* Path to split. */
-    int *lenPtr;		/* int to store number of path elements. */
+Tcl_Obj *
+Tcl_FSSplitPath(
+    Tcl_Obj *pathPtr,		/* Path to split. */
+    int *lenPtr)		/* int to store number of path elements. */
 {
-    Tcl_Obj *result = NULL;  /* Needed only to prevent gcc warnings. */
+    Tcl_Obj *result = NULL;	/* Needed only to prevent gcc warnings. */
     Tcl_Filesystem *fsPtr;
     char separator = '/';
     int driveNameLength;
     char *p;
-    
+
     /*
-     * Perform platform specific splitting. 
+     * Perform platform specific splitting.
      */
 
-    if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength) 
-	== TCL_PATH_ABSOLUTE) {
+    if (TclFSGetPathType(pathPtr, &fsPtr,
+	    &driveNameLength) == TCL_PATH_ABSOLUTE) {
 	if (fsPtr == &tclNativeFilesystem) {
 	    return TclpNativeSplitPath(pathPtr, lenPtr);
 	}
@@ -3360,27 +3753,35 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
 	return TclpNativeSplitPath(pathPtr, lenPtr);
     }
 
-    /* We assume separators are single characters */
+    /*
+     * We assume separators are single characters.
+     */
+
     if (fsPtr->filesystemSeparatorProc != NULL) {
 	Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
 	if (sep != NULL) {
+	    Tcl_IncrRefCount(sep);
 	    separator = Tcl_GetString(sep)[0];
+	    Tcl_DecrRefCount(sep);
 	}
     }
-    
-    /* 
-     * Place the drive name as first element of the
-     * result list.  The drive name may contain strange
-     * characters, like colons and multiple forward slashes
-     * (for example 'ftp://' is a valid vfs drive name)
+
+    /*
+     * Place the drive name as first element of the result list. The drive
+     * name may contain strange characters, like colons and multiple forward
+     * slashes (for example 'ftp://' is a valid vfs drive name)
      */
+
     result = Tcl_NewObj();
     p = Tcl_GetString(pathPtr);
-    Tcl_ListObjAppendElement(NULL, result, 
-			     Tcl_NewStringObj(p, driveNameLength));
-    p+= driveNameLength;
-    			
-    /* Add the remaining path elements to the list */
+    Tcl_ListObjAppendElement(NULL, result,
+	    Tcl_NewStringObj(p, driveNameLength));
+    p += driveNameLength;
+
+    /*
+     * Add the remaining path elements to the list.
+     */
+
     for (;;) {
 	char *elementStart = p;
 	int length;
@@ -3391,7 +3792,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
 	    if (elementStart[0] == '~') {
-		nextElt = Tcl_NewStringObj("./",2);
+		TclNewLiteralStringObj(nextElt, "./");
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
@@ -3402,53 +3803,85 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
 	    break;
 	}
     }
-			     
+
     /*
      * Compute the number of elements in the result.
      */
 
     if (lenPtr != NULL) {
-	Tcl_ListObjLength(NULL, result, lenPtr);
+	TclListObjLength(NULL, result, lenPtr);
     }
     return result;
 }
 
-/* Simple helper function */
-Tcl_Obj* 
-TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
-    Tcl_Filesystem *fromFilesystem;
-    ClientData clientData;
-    FilesystemRecord **fsRecPtrPtr;
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetPathType --
+ *
+ *	Helper function used by FSGetPathType.
+ *
+ * Results:
+ *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ *	TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
+ *	only if it is non-NULL and the function's return value is
+ *	TCL_PATH_ABSOLUTE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_PathType
+TclGetPathType(
+    Tcl_Obj *pathPtr,		/* Path to determine type for */
+    Tcl_Filesystem **filesystemPtrPtr,
+				/* If absolute path and this is not NULL, then
+				 * set to the filesystem which claims this
+				 * path. */
+    int *driveNameLengthPtr,	/* If the path is absolute, and this is
+				 * non-NULL, then set to the length of the
+				 * driveName. */
+    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
+				 * non-NULL, then set to the name of the
+				 * drive, network-volume which contains the
+				 * path, already with a refCount for the
+				 * caller. */
 {
-    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
+    int pathLen;
+    char *path;
+    Tcl_PathType type;
 
-    while (fsRecPtr != NULL) {
-	if (fsRecPtr->fsPtr == fromFilesystem) {
-	    *fsRecPtrPtr = fsRecPtr;
-	    break;
+    path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+
+    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
+	    driveNameLengthPtr, driveNameRef);
+
+    if (type != TCL_PATH_ABSOLUTE) {
+	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
+		driveNameRef);
+	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
+	    *filesystemPtrPtr = &tclNativeFilesystem;
 	}
-	fsRecPtr = fsRecPtr->nextPtr;
-    }
-    
-    if ((fsRecPtr != NULL) 
-      && (fromFilesystem->internalToNormalizedProc != NULL)) {
-	return (*fromFilesystem->internalToNormalizedProc)(clientData);
-    } else {
-	return NULL;
     }
+    return type;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * GetPathType --
+ * TclFSNonnativePathType --
  *
- *	Helper function used by FSGetPathType.
+ *	Helper function used by TclGetPathType. Its purpose is to check
+ *	whether the given path starts with a string which corresponds to a
+ *	file volume in any registered filesystem except the native one. For
+ *	speed and historical reasons the native filesystem has special
+ *	hard-coded checks dotted here and there in the filesystem code.
  *
  * Results:
- *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- *	TCL_PATH_VOLUME_RELATIVE.  The filesystem reference will
- *	be set if and only if it is non-NULL and the function's 
+ *	Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
+ *	reference will be set if and only if it is non-NULL and the function's
  *	return value is TCL_PATH_ABSOLUTE.
  *
  * Side effects:
@@ -3457,64 +3890,73 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
  *----------------------------------------------------------------------
  */
 
-static Tcl_PathType
-GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
-    Tcl_Obj *pathObjPtr;
-    Tcl_Filesystem **filesystemPtrPtr;
-    int *driveNameLengthPtr;
-    Tcl_Obj **driveNameRef;
+Tcl_PathType
+TclFSNonnativePathType(
+    const char *path,		/* Path to determine type for */
+    int pathLen,		/* Length of the path */
+    Tcl_Filesystem **filesystemPtrPtr,
+				/* If absolute path and this is not NULL, then
+				 * set to the filesystem which claims this
+				 * path. */
+    int *driveNameLengthPtr,	/* If the path is absolute, and this is
+				 * non-NULL, then set to the length of the
+				 * driveName. */
+    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
+				 * non-NULL, then set to the name of the
+				 * drive, network-volume which contains the
+				 * path, already with a refCount for the
+				 * caller. */
 {
     FilesystemRecord *fsRecPtr;
-    int pathLen;
-    char *path;
     Tcl_PathType type = TCL_PATH_RELATIVE;
-    
-    path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
 
     /*
-     * Call each of the "listVolumes" function in succession, checking
-     * whether the given path is an absolute path on any of the volumes
-     * returned (this is done by checking whether the path's prefix
-     * matches).
+     * Call each of the "listVolumes" function in succession, checking whether
+     * the given path is an absolute path on any of the volumes returned (this
+     * is done by checking whether the path's prefix matches).
      */
 
     fsRecPtr = FsGetFirstFilesystem();
+    Claim();
     while (fsRecPtr != NULL) {
 	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
-	/* 
+
+	/*
 	 * We want to skip the native filesystem in this loop because
-	 * otherwise we won't necessarily pass all the Tcl testsuite --
-	 * this is because some of the tests artificially change the
-	 * current platform (between mac, win, unix) but the list
-	 * of volumes we get by calling (*proc) will reflect the current
-	 * (real) platform only and this may cause some tests to fail.
-	 * In particular, on unix '/' will match the beginning of 
-	 * certain absolute Windows paths starting '//' and those tests
-	 * will go wrong.
-	 * 
-	 * Besides these test-suite issues, there is one other reason
-	 * to skip the native filesystem --- since the tclFilename.c
-	 * code has nice fast 'absolute path' checkers, we don't want
-	 * to waste time repeating that effort here, and this 
-	 * function is actually called quite often, so if we can
-	 * save the overhead of the native filesystem returning us
-	 * a list of volumes all the time, it is better.
+	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
+	 * is because some of the tests artificially change the current
+	 * platform (between win, unix) but the list of volumes we get by
+	 * calling (*proc) will reflect the current (real) platform only and
+	 * this may cause some tests to fail. In particular, on unix '/' will
+	 * match the beginning of certain absolute Windows paths starting '//'
+	 * and those tests will go wrong.
+	 *
+	 * Besides these test-suite issues, there is one other reason to skip
+	 * the native filesystem --- since the tclFilename.c code has nice
+	 * fast 'absolute path' checkers, we don't want to waste time
+	 * repeating that effort here, and this function is actually called
+	 * quite often, so if we can save the overhead of the native
+	 * filesystem returning us a list of volumes all the time, it is
+	 * better.
 	 */
+
 	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
 	    int numVolumes;
 	    Tcl_Obj *thisFsVolumes = (*proc)();
+
 	    if (thisFsVolumes != NULL) {
-		if (Tcl_ListObjLength(NULL, thisFsVolumes, 
-				      &numVolumes) != TCL_OK) {
-		    /* 
-		     * This is VERY bad; the Tcl_FSListVolumesProc
-		     * didn't return a valid list.  Set numVolumes to
-		     * -1 so that we skip the while loop below and just
-		     * return with the current value of 'type'.
-		     * 
-		     * It would be better if we could signal an error
-		     * here (but panic seems a bit excessive).
+		if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
+			!= TCL_OK) {
+		    /*
+		     * This is VERY bad; the Tcl_FSListVolumesProc didn't
+		     * return a valid list. Set numVolumes to -1 so that we
+		     * skip the while loop below and just return with the
+		     * current value of 'type'.
+		     *
+		     * It would be better if we could signal an error here
+		     * (but Tcl_Panic seems a bit excessive).
 		     */
+
 		    numVolumes = -1;
 		}
 		while (numVolumes > 0) {
@@ -3545,21 +3987,16 @@ GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
 		}
 		Tcl_DecrRefCount(thisFsVolumes);
 		if (type == TCL_PATH_ABSOLUTE) {
-		    /* We don't need to examine any more filesystems */
+		    /*
+		     * We don't need to examine any more filesystems.
+		     */
 		    break;
 		}
 	    }
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-    
-    if (type != TCL_PATH_ABSOLUTE) {
-	type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, 
-				     driveNameRef);
-	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
-	    *filesystemPtrPtr = &tclNativeFilesystem;
-	}
-    }
+    Disclaim();
     return type;
 }
 
@@ -3568,12 +4005,12 @@ GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
  *
  * Tcl_FSRenameFile --
  *
- *	If the two paths given belong to the same filesystem, we call
- *	that filesystems rename function.  Otherwise we simply
- *	return the posix error 'EXDEV', and -1.
+ *	If the two paths given belong to the same filesystem, we call that
+ *	filesystems rename function. Otherwise we simply return the POSIX
+ *	error 'EXDEV', and -1.
  *
  * Results:
- *      Standard Tcl error code if a function was called.
+ *	Standard Tcl error code if a function was called.
  *
  * Side effects:
  *	A file may be renamed.
@@ -3582,21 +4019,21 @@ GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
  */
 
 int
-Tcl_FSRenameFile(srcPathPtr, destPathPtr)
-    Tcl_Obj* srcPathPtr;	/* Pathname of file or dir to be renamed
+Tcl_FSRenameFile(
+    Tcl_Obj* srcPathPtr,	/* Pathname of file or dir to be renamed
 				 * (UTF-8). */
-    Tcl_Obj *destPathPtr;	/* New pathname of file or directory
+    Tcl_Obj *destPathPtr)	/* New pathname of file or directory
 				 * (UTF-8). */
 {
     int retVal = -1;
-    Tcl_Filesystem *fsPtr, *fsPtr2;
+    const Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if (fsPtr == fsPtr2 && fsPtr != NULL) {
+    if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
 	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
 	if (proc != NULL) {
-	    retVal =  (*proc)(srcPathPtr, destPathPtr);
+	    retVal = (*proc)(srcPathPtr, destPathPtr);
 	}
     }
     if (retVal == -1) {
@@ -3610,16 +4047,16 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
  *
  * Tcl_FSCopyFile --
  *
- *	If the two paths given belong to the same filesystem, we call
- *	that filesystem's copy function.  Otherwise we simply
- *	return the posix error 'EXDEV', and -1.
- *	
- *	Note that in the native filesystems, 'copyFileProc' is defined
- *	to copy soft links (i.e. it copies the links themselves, not
- *	the things they point to).
+ *	If the two paths given belong to the same filesystem, we call that
+ *	filesystem's copy function. Otherwise we simply return the POSIX error
+ *	'EXDEV', and -1.
+ *
+ *	Note that in the native filesystems, 'copyFileProc' is defined to copy
+ *	soft links (i.e. it copies the links themselves, not the things they
+ *	point to).
  *
  * Results:
- *      Standard Tcl error code if a function was called.
+ *	Standard Tcl error code if a function was called.
  *
  * Side effects:
  *	A file may be copied.
@@ -3627,13 +4064,13 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
  *---------------------------------------------------------------------------
  */
 
-int 
-Tcl_FSCopyFile(srcPathPtr, destPathPtr)
-    Tcl_Obj* srcPathPtr;	/* Pathname of file to be copied (UTF-8). */
-    Tcl_Obj *destPathPtr;	/* Pathname of file to copy to (UTF-8). */
+int
+Tcl_FSCopyFile(
+    Tcl_Obj *srcPathPtr,	/* Pathname of file to be copied (UTF-8). */
+    Tcl_Obj *destPathPtr)	/* Pathname of file to copy to (UTF-8). */
 {
     int retVal = -1;
-    Tcl_Filesystem *fsPtr, *fsPtr2;
+    const Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
@@ -3654,64 +4091,75 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
  *
  * TclCrossFilesystemCopy --
  *
- *	Helper for above function, and for Tcl_FSLoadFile, to copy
- *	files from one filesystem to another.  This function will
- *	overwrite the target file if it already exists.
+ *	Helper for above function, and for Tcl_FSLoadFile, to copy files from
+ *	one filesystem to another. This function will overwrite the target
+ *	file if it already exists.
  *
  * Results:
- *      Standard Tcl error code.
+ *	Standard Tcl error code.
  *
  * Side effects:
  *	A file may be created.
  *
  *---------------------------------------------------------------------------
  */
-int 
-TclCrossFilesystemCopy(interp, source, target) 
-    Tcl_Interp *interp; /* For error messages */
-    Tcl_Obj *source;	/* Pathname of file to be copied (UTF-8). */
-    Tcl_Obj *target;	/* Pathname of file to copy to (UTF-8). */
+int
+TclCrossFilesystemCopy(
+    Tcl_Interp *interp,		/* For error messages */
+    Tcl_Obj *source,		/* Pathname of file to be copied (UTF-8). */
+    Tcl_Obj *target)		/* Pathname of file to copy to (UTF-8). */
 {
     int result = TCL_ERROR;
     int prot = 0666;
-    
-    Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
-    if (out != NULL) {
-	/* It looks like we can copy it over */
-	Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
-					       "r", prot);
-	if (in == NULL) {
-	    /* This is very strange, we checked this above */
-	    Tcl_Close(interp, out);
-	} else {
-	    Tcl_StatBuf sourceStatBuf;
-	    struct utimbuf tval;
-	    /* 
-	     * Copy it synchronously.  We might wish to add an
-	     * asynchronous option to support vfs's which are
-	     * slow (e.g. network sockets).
-	     */
-	    Tcl_SetChannelOption(interp, in, "-translation", "binary");
-	    Tcl_SetChannelOption(interp, out, "-translation", "binary");
-	    
-	    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
-		result = TCL_OK;
-	    }
-	    /* 
-	     * If the copy failed, assume that copy channel left
-	     * a good error message.
-	     */
-	    Tcl_Close(interp, in);
-	    Tcl_Close(interp, out);
-	    
-	    /* Set modification date of copied file */
-	    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
-		tval.actime = sourceStatBuf.st_atime;
-		tval.modtime = sourceStatBuf.st_mtime;
-		Tcl_FSUtime(target, &tval);
-	    }
-	}
+    Tcl_Channel in, out;
+    Tcl_StatBuf sourceStatBuf;
+    struct utimbuf tval;
+
+    out = Tcl_FSOpenFileChannel(interp, target, "wb", prot);
+    if (out == NULL) {
+	/*
+	 * It looks like we cannot copy it over. Bail out...
+	 */
+	goto done;
+    }
+
+    in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
+    if (in == NULL) {
+	/*
+	 * This is very strange, caller should have checked this...
+	 */
+
+	Tcl_Close(interp, out);
+	goto done;
+    }
+
+    /*
+     * Copy it synchronously. We might wish to add an asynchronous option to
+     * support vfs's which are slow (e.g. network sockets).
+     */
+
+    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
+	result = TCL_OK;
+    }
+
+    /*
+     * If the copy failed, assume that copy channel left a good error message.
+     */
+
+    Tcl_Close(interp, in);
+    Tcl_Close(interp, out);
+
+    /*
+     * Set modification date of copied file.
+     */
+
+    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
+	tval.actime = sourceStatBuf.st_atime;
+	tval.modtime = sourceStatBuf.st_mtime;
+	Tcl_FSUtime(target, &tval);
     }
+
+  done:
     return result;
 }
 
@@ -3720,11 +4168,11 @@ TclCrossFilesystemCopy(interp, source, target)
  *
  * Tcl_FSDeleteFile --
  *
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	The appropriate function for the filesystem to which pathPtr belongs
+ *	will be called.
  *
  * Results:
- *      Standard Tcl error code.
+ *	Standard Tcl error code.
  *
  * Side effects:
  *	A file may be deleted.
@@ -3733,10 +4181,10 @@ TclCrossFilesystemCopy(interp, source, target)
  */
 
 int
-Tcl_FSDeleteFile(pathPtr)
-    Tcl_Obj *pathPtr;		/* Pathname of file to be removed (UTF-8). */
+Tcl_FSDeleteFile(
+    Tcl_Obj *pathPtr)		/* Pathname of file to be removed (UTF-8). */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
 	if (proc != NULL) {
@@ -3752,11 +4200,11 @@ Tcl_FSDeleteFile(pathPtr)
  *
  * Tcl_FSCreateDirectory --
  *
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	The appropriate function for the filesystem to which pathPtr belongs
+ *	will be called.
  *
  * Results:
- *      Standard Tcl error code.
+ *	Standard Tcl error code.
  *
  * Side effects:
  *	A directory may be created.
@@ -3765,10 +4213,10 @@ Tcl_FSDeleteFile(pathPtr)
  */
 
 int
-Tcl_FSCreateDirectory(pathPtr)
-    Tcl_Obj *pathPtr;		/* Pathname of directory to create (UTF-8). */
+Tcl_FSCreateDirectory(
+    Tcl_Obj *pathPtr)		/* Pathname of directory to create (UTF-8). */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
 	if (proc != NULL) {
@@ -3784,12 +4232,12 @@ Tcl_FSCreateDirectory(pathPtr)
  *
  * Tcl_FSCopyDirectory --
  *
- *	If the two paths given belong to the same filesystem, we call
- *	that filesystems copy-directory function.  Otherwise we simply
- *	return the posix error 'EXDEV', and -1.
+ *	If the two paths given belong to the same filesystem, we call that
+ *	filesystems copy-directory function. Otherwise we simply return the
+ *	POSIX error 'EXDEV', and -1.
  *
  * Results:
- *      Standard Tcl error code if a function was called.
+ *	Standard Tcl error code if a function was called.
  *
  * Side effects:
  *	A directory may be copied.
@@ -3798,16 +4246,16 @@ Tcl_FSCreateDirectory(pathPtr)
  */
 
 int
-Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
-    Tcl_Obj* srcPathPtr;	/* Pathname of directory to be copied
+Tcl_FSCopyDirectory(
+    Tcl_Obj* srcPathPtr,	/* Pathname of directory to be copied
 				 * (UTF-8). */
-    Tcl_Obj *destPathPtr;	/* Pathname of target directory (UTF-8). */
-    Tcl_Obj **errorPtr;	        /* If non-NULL, then will be set to a
-                       	         * new object containing name of file
-                       	         * causing error, with refCount 1. */
+    Tcl_Obj *destPathPtr,	/* Pathname of target directory (UTF-8). */
+    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
+				 * object containing name of file causing
+				 * error, with refCount 1. */
 {
     int retVal = -1;
-    Tcl_Filesystem *fsPtr, *fsPtr2;
+    const Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
@@ -3828,11 +4276,11 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
  *
  * Tcl_FSRemoveDirectory --
  *
- *	The appropriate function for the filesystem to which pathPtr
- *	belongs will be called.
+ *	The appropriate function for the filesystem to which pathPtr belongs
+ *	will be called.
  *
  * Results:
- *      Standard Tcl error code.
+ *	Standard Tcl error code.
  *
  * Side effects:
  *	A directory may be deleted.
@@ -3841,49 +4289,53 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
  */
 
 int
-Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
-    Tcl_Obj *pathPtr;		/* Pathname of directory to be removed
+Tcl_FSRemoveDirectory(
+    Tcl_Obj *pathPtr,		/* Pathname of directory to be removed
 				 * (UTF-8). */
-    int recursive;		/* If non-zero, removes directories that
-				 * are nonempty.  Otherwise, will only remove
-				 * empty directories. */
-    Tcl_Obj **errorPtr;	        /* If non-NULL, then will be set to a
-				 * new object containing name of file
-				 * causing error, with refCount 1. */
+    int recursive,		/* If non-zero, removes directories that are
+				 * nonempty. Otherwise, will only remove empty
+				 * directories. */
+    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
+				 * object containing name of file causing
+				 * error, with refCount 1. */
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
 	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
-	if (proc != NULL) {
-	    if (recursive) {
-	        /* 
-	         * We check whether the cwd lies inside this directory
-	         * and move it if it does.
-	         */
-		Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
-		if (cwdPtr != NULL) {
-		    char *cwdStr, *normPathStr;
-		    int cwdLen, normLen;
-		    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
-		    if (normPath != NULL) {
-		        normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
-			cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
-			if ((cwdLen >= normLen) && (strncmp(normPathStr, 
-					cwdStr, (size_t) normLen) == 0)) {
-			    /* 
-			     * the cwd is inside the directory, so we
-			     * perform a 'cd [file dirname $path]'
-			     */
-			    Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr);
-			    Tcl_FSChdir(dirPtr);
-			    Tcl_DecrRefCount(dirPtr);
-			}
+	if (recursive) {
+	    /*
+	     * We check whether the cwd lies inside this directory and move it
+	     * if it does.
+	     */
+
+	    Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
+
+	    if (cwdPtr != NULL) {
+		char *cwdStr, *normPathStr;
+		int cwdLen, normLen;
+		Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
+		if (normPath != NULL) {
+		    normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
+		    cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+		    if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
+			    (size_t) normLen) == 0)) {
+			/*
+			 * The cwd is inside the directory, so we perform a
+			 * 'cd [file dirname $path]'.
+			 */
+
+			Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
+				TCL_PATH_DIRNAME);
+
+			Tcl_FSChdir(dirPtr);
+			Tcl_DecrRefCount(dirPtr);
 		    }
-		    Tcl_DecrRefCount(cwdPtr);
 		}
+		Tcl_DecrRefCount(cwdPtr);
 	    }
-	    return (*proc)(pathPtr, recursive, errorPtr);
 	}
+	return (*proc)(pathPtr, recursive, errorPtr);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -3894,13 +4346,13 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
  *
  * Tcl_FSGetFileSystemForPath --
  *
- *      This function determines which filesystem to use for a
- *      particular path object, and returns the filesystem which
- *      accepts this file.  If no filesystem will accept this object
- *      as a valid file path, then NULL is returned.
+ *	This function determines which filesystem to use for a particular path
+ *	object, and returns the filesystem which accepts this file. If no
+ *	filesystem will accept this object as a valid file path, then NULL is
+ *	returned.
  *
  * Results:
-.*      NULL or a filesystem which will accept this path.
+ *	NULL or a filesystem which will accept this path.
  *
  * Side effects:
  *	The object may be converted to a path type.
@@ -3908,61 +4360,68 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
  *---------------------------------------------------------------------------
  */
 
-Tcl_Filesystem*
-Tcl_FSGetFileSystemForPath(pathObjPtr)
-    Tcl_Obj* pathObjPtr;
+Tcl_Filesystem *
+Tcl_FSGetFileSystemForPath(
+    Tcl_Obj* pathPtr)
 {
     FilesystemRecord *fsRecPtr;
     Tcl_Filesystem* retVal = NULL;
-    
-    /* 
-     * If the object has a refCount of zero, we reject it.  This
-     * is to avoid possible segfaults or nondeterministic memory
-     * leaks (i.e. the user doesn't know if they should decrement
-     * the ref count on return or not).
+
+    if (pathPtr == NULL) {
+	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
+	return NULL;
+    }
+
+    /*
+     * If the object has a refCount of zero, we reject it. This is to avoid
+     * possible segfaults or nondeterministic memory leaks (i.e. the user
+     * doesn't know if they should decrement the ref count on return or not).
      */
-    
-    if (pathObjPtr->refCount == 0) {
-	panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
+
+    if (pathPtr->refCount == 0) {
+	Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
 	return NULL;
     }
-    
-    /* 
-     * Check if the filesystem has changed in some way since
-     * this object's internal representation was calculated.
-     * Before doing that, assure we have the most up-to-date
-     * copy of the master filesystem. This is accomplished
-     * by the FsGetFirstFilesystem() call.
+
+    /*
+     * Check if the filesystem has changed in some way since this object's
+     * internal representation was calculated. Before doing that, assure we
+     * have the most up-to-date copy of the master filesystem. This is
+     * accomplished by the FsGetFirstFilesystem() call.
      */
 
     fsRecPtr = FsGetFirstFilesystem();
+    Claim();
 
-    if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) {
+    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
+	Disclaim();
 	return NULL;
     }
 
     /*
-     * Call each of the "pathInFilesystem" functions in succession.  A
-     * non-return value of -1 indicates the particular function has
-     * succeeded.
+     * Call each of the "pathInFilesystem" functions in succession. A
+     * non-return value of -1 indicates the particular function has succeeded.
      */
 
     while ((retVal == NULL) && (fsRecPtr != NULL)) {
-	Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
+	Tcl_FSPathInFilesystemProc *proc =
+		fsRecPtr->fsPtr->pathInFilesystemProc;
+
 	if (proc != NULL) {
 	    ClientData clientData = NULL;
-	    int ret = (*proc)(pathObjPtr, &clientData);
-	    if (ret != -1) {
-		/* 
-		 * We assume the type of pathObjPtr hasn't been changed 
-		 * by the above call to the pathInFilesystemProc.
+	    if ((*proc)(pathPtr, &clientData) != -1) {
+		/*
+		 * We assume the type of pathPtr hasn't been changed by the
+		 * above call to the pathInFilesystemProc.
 		 */
-		TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData);
+
+		TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
 		retVal = fsRecPtr->fsPtr;
 	    }
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
+    Disclaim();
 
     return retVal;
 }
@@ -3972,26 +4431,23 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
  *
  * Tcl_FSGetNativePath --
  *
- *      This function is for use by the Win/Unix/MacOS native filesystems,
- *      so that they can easily retrieve the native (char* or TCHAR*)
- *      representation of a path.  Other filesystems will probably
- *      want to implement similar functions.  They basically act as a 
- *      safety net around Tcl_FSGetInternalRep.  Normally your file-
- *      system procedures will always be called with path objects
- *      already converted to the correct filesystem, but if for 
- *      some reason they are called directly (i.e. by procedures 
- *      not in this file), then one cannot necessarily guarantee that
- *      the path object pointer is from the correct filesystem.
- *      
- *      Note: in the future it might be desireable to have separate
- *      versions of this function with different signatures, for
- *      example Tcl_FSGetNativeMacPath, Tcl_FSGetNativeUnixPath etc.
- *      Right now, since native paths are all string based, we use just
- *      one function.  On MacOS we could possibly use an FSSpec or
- *      FSRef as the native representation.
+ *	This function is for use by the Win/Unix native filesystems, so that
+ *	they can easily retrieve the native (char* or TCHAR*) representation
+ *	of a path. Other filesystems will probably want to implement similar
+ *	functions. They basically act as a safety net around
+ *	Tcl_FSGetInternalRep. Normally your file-system functions will always
+ *	be called with path objects already converted to the correct
+ *	filesystem, but if for some reason they are called directly (i.e. by
+ *	functions not in this file), then one cannot necessarily guarantee
+ *	that the path object pointer is from the correct filesystem.
+ *
+ *	Note: in the future it might be desireable to have separate versions
+ *	of this function with different signatures, for example
+ *	Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
+ *	native paths are all string based, we use just one function.
  *
  * Results:
- *      NULL or a valid native path.
+ *	NULL or a valid native path.
  *
  * Side effects:
  *	See Tcl_FSGetInternalRep.
@@ -3999,164 +4455,11 @@ Tcl_FSGetFileSystemForPath(pathObjPtr)
  *---------------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_FSGetNativePath(pathObjPtr)
-    Tcl_Obj *pathObjPtr;
-{
-    return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * NativeCreateNativeRep --
- *
- *      Create a native representation for the given path.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-static ClientData 
-NativeCreateNativeRep(pathObjPtr)
-    Tcl_Obj* pathObjPtr;
-{
-    char *nativePathPtr;
-    Tcl_DString ds;
-    Tcl_Obj* validPathObjPtr;
-    int len;
-    char *str;
-
-    /* Make sure the normalized path is set */
-    validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
-    if (validPathObjPtr == NULL) {
-	return NULL;
-    }
-
-    str = Tcl_GetStringFromObj(validPathObjPtr, &len);
-#ifdef __WIN32__
-    Tcl_WinUtfToTChar(str, len, &ds);
-    if (tclWinProcs->useWide) {
-	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
-    } else {
-	len = Tcl_DStringLength(&ds) + sizeof(char);
-    }
-#else
-    Tcl_UtfToExternalDString(NULL, str, len, &ds);
-    len = Tcl_DStringLength(&ds) + sizeof(char);
-#endif
-    nativePathPtr = ckalloc((unsigned) len);
-    memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
-
-    Tcl_DStringFree(&ds);
-    return (ClientData)nativePathPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpNativeToNormalized --
- *
- *      Convert native format to a normalized path object, with refCount
- *      of zero.
- *
- * Results:
- *      A valid normalized path.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-Tcl_Obj* 
-TclpNativeToNormalized(clientData)
-    ClientData clientData;
-{
-    Tcl_DString ds;
-    Tcl_Obj *objPtr;
-    CONST char *copy;
-    int len;
-    
-#ifdef __WIN32__
-    Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
-#else
-    Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
-#endif
-    
-    copy = Tcl_DStringValue(&ds);
-    len = Tcl_DStringLength(&ds);
-
-#ifdef __WIN32__
-    /* 
-     * Certain native path representations on Windows have this special
-     * prefix to indicate that they are to be treated specially.  For
-     * example extremely long paths, or symlinks 
-     */
-    if (*copy == '\\') {
-        if (0 == strncmp(copy,"\\??\\",4)) {
-	    copy += 4;
-	    len -= 4;
-	} else if (0 == strncmp(copy,"\\\\?\\",4)) {
-	    copy += 4;
-	    len -= 4;
-	}
-    }
-#endif
-
-    objPtr = Tcl_NewStringObj(copy,len);
-    Tcl_DStringFree(&ds);
-    
-    return objPtr;
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclNativeDupInternalRep --
- *
- *      Duplicate the native representation.
- *
- * Results:
- *      The copied native representation, or NULL if it is not possible
- *      to copy the representation.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-ClientData 
-TclNativeDupInternalRep(clientData)
-    ClientData clientData;
+const char *
+Tcl_FSGetNativePath(
+    Tcl_Obj *pathPtr)
 {
-    ClientData copy;
-    size_t len;
-
-    if (clientData == NULL) {
-	return NULL;
-    }
-
-#ifdef __WIN32__
-    if (tclWinProcs->useWide) {
-	/* unicode representation when running on NT/2K/XP */
-	len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
-    } else {
-	/* ansi representation when running on 95/98/ME */
-	len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
-    }
-#else
-    /* ansi representation when running on Unix/MacOS */
-    len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
-#endif
-    
-    copy = (ClientData) ckalloc(len);
-    memcpy((VOID*)copy, (VOID*)clientData, len);
-    return copy;
+    return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
 }
 
 /*
@@ -4164,21 +4467,22 @@ TclNativeDupInternalRep(clientData)
  *
  * NativeFreeInternalRep --
  *
- *      Free a native internal representation, which will be non-NULL.
+ *	Free a native internal representation, which will be non-NULL.
  *
  * Results:
- *      None.
+ *	None.
  *
  * Side effects:
  *	Memory is released.
  *
  *---------------------------------------------------------------------------
  */
-static void 
-NativeFreeInternalRep(clientData)
-    ClientData clientData;
+
+static void
+NativeFreeInternalRep(
+    ClientData clientData)
 {
-    ckfree((char*)clientData);
+    ckfree((char *) clientData);
 }
 
 /*
@@ -4186,44 +4490,42 @@ NativeFreeInternalRep(clientData)
  *
  * Tcl_FSFileSystemInfo --
  *
- *      This function returns a list of two elements.  The first
- *      element is the name of the filesystem (e.g. "native" or "vfs"),
- *      and the second is the particular type of the given path within
- *      that filesystem.
+ *	This function returns a list of two elements. The first element is the
+ *	name of the filesystem (e.g. "native" or "vfs"), and the second is the
+ *	particular type of the given path within that filesystem.
  *
  * Results:
- *      A list of two elements.
+ *	A list of two elements.
  *
  * Side effects:
  *	The object may be converted to a path type.
  *
  *---------------------------------------------------------------------------
  */
-Tcl_Obj*
-Tcl_FSFileSystemInfo(pathObjPtr)
-    Tcl_Obj* pathObjPtr;
+
+Tcl_Obj *
+Tcl_FSFileSystemInfo(
+    Tcl_Obj *pathPtr)
 {
     Tcl_Obj *resPtr;
     Tcl_FSFilesystemPathTypeProc *proc;
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
-    
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr == NULL) {
 	return NULL;
     }
-    
-    resPtr = Tcl_NewListObj(0,NULL);
-    
-    Tcl_ListObjAppendElement(NULL, resPtr, 
-			     Tcl_NewStringObj(fsPtr->typeName,-1));
+
+    resPtr = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));
 
     proc = fsPtr->filesystemPathTypeProc;
     if (proc != NULL) {
-	Tcl_Obj *typePtr = (*proc)(pathObjPtr);
+	Tcl_Obj *typePtr = (*proc)(pathPtr);
 	if (typePtr != NULL) {
 	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
 	}
     }
-    
+
     return resPtr;
 }
 
@@ -4232,33 +4534,42 @@ Tcl_FSFileSystemInfo(pathObjPtr)
  *
  * Tcl_FSPathSeparator --
  *
- *      This function returns the separator to be used for a given
- *      path.  The object returned should have a refCount of zero
+ *	This function returns the separator to be used for a given path. The
+ *	object returned should have a refCount of zero
  *
  * Results:
- *      A Tcl object, with a refCount of zero.  If the caller
- *      needs to retain a reference to the object, it should
- *      call Tcl_IncrRefCount.
+ *	A Tcl object, with a refCount of zero. If the caller needs to retain a
+ *	reference to the object, it should call Tcl_IncrRefCount, and should
+ *	otherwise free the object.
  *
  * Side effects:
  *	The path object may be converted to a path type.
  *
  *---------------------------------------------------------------------------
  */
-Tcl_Obj*
-Tcl_FSPathSeparator(pathObjPtr)
-    Tcl_Obj* pathObjPtr;
+
+Tcl_Obj *
+Tcl_FSPathSeparator(
+    Tcl_Obj *pathPtr)
 {
-    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
-    
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr == NULL) {
 	return NULL;
     }
     if (fsPtr->filesystemSeparatorProc != NULL) {
-	return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
+	return (*fsPtr->filesystemSeparatorProc)(pathPtr);
+    } else {
+	Tcl_Obj *resultObj;
+
+	/*
+	 * Allow filesystems not to provide a filesystemSeparatorProc if they
+	 * wish to use the standard forward slash.
+	 */
+
+	TclNewLiteralStringObj(resultObj, "/");
+	return resultObj;
     }
-    
-    return NULL;
 }
 
 /*
@@ -4266,29 +4577,30 @@ Tcl_FSPathSeparator(pathObjPtr)
  *
  * NativeFilesystemSeparator --
  *
- *      This function is part of the native filesystem support, and
- *      returns the separator for the given path.
+ *	This function is part of the native filesystem support, and returns
+ *	the separator for the given path.
  *
  * Results:
- *      String object containing the separator character.
+ *	String object containing the separator character.
  *
  * Side effects:
  *	None.
  *
  *---------------------------------------------------------------------------
  */
-static Tcl_Obj*
-NativeFilesystemSeparator(pathObjPtr)
-    Tcl_Obj* pathObjPtr;
+
+static Tcl_Obj *
+NativeFilesystemSeparator(
+    Tcl_Obj *pathPtr)
 {
-    char *separator = NULL; /* lint */
+    const char *separator = NULL; /* lint */
     switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    separator = "/";
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    separator = "\\";
-	    break;
+    case TCL_PLATFORM_UNIX:
+	separator = "/";
+	break;
+    case TCL_PLATFORM_WINDOWS:
+	separator = "\\";
+	break;
     }
     return Tcl_NewStringObj(separator,1);
 }
@@ -4301,26 +4613,25 @@ NativeFilesystemSeparator(pathObjPtr)
  *
  * TclStatInsertProc --
  *
- *	Insert the passed procedure pointer at the head of the list of
- *	functions which are used during a call to 'TclStat(...)'. The
- *	passed function should behave exactly like 'TclStat' when called
- *	during that time (see 'TclStat(...)' for more information).
- *	The function will be added even if it already in the list.
+ *	Insert the passed function pointer at the head of the list of
+ *	functions which are used during a call to 'TclStat(...)'. The passed
+ *	function should behave exactly like 'TclStat' when called during that
+ *	time (see 'TclStat(...)' for more information). The function will be
+ *	added even if it already in the list.
  *
  * Results:
- *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- *	could not be allocated.
+ *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ *	not be allocated.
  *
  * Side effects:
- *      Memory allocated and modifies the link list for 'TclStat'
- *	functions.
+ *	Memory allocated and modifies the link list for 'TclStat' functions.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclStatInsertProc (proc)
-    TclStatProc_ *proc;
+TclStatInsertProc(
+    TclStatProc_ *proc)
 {
     int retVal = TCL_ERROR;
 
@@ -4349,22 +4660,21 @@ TclStatInsertProc (proc)
  * TclStatDeleteProc --
  *
  *	Removed the passed function pointer from the list of 'TclStat'
- *	functions.  Ensures that the built-in stat function is not
- *	removvable.
+ *	functions. Ensures that the built-in stat function is not removable.
  *
  * Results:
- *      TCL_OK if the procedure pointer was successfully removed,
- *	TCL_ERROR otherwise.
+ *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
+ *	otherwise.
  *
  * Side effects:
- *      Memory is deallocated and the respective list updated.
+ *	Memory is deallocated and the respective list updated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclStatDeleteProc (proc)
-    TclStatProc_ *proc;
+TclStatDeleteProc(
+    TclStatProc_ *proc)
 {
     int retVal = TCL_ERROR;
     StatProc *tmpStatProcPtr;
@@ -4372,10 +4682,11 @@ TclStatDeleteProc (proc)
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
     tmpStatProcPtr = statProcList;
+
     /*
-     * Traverse the 'statProcList' looking for the particular node
-     * whose 'proc' member matches 'proc' and remove that one from
-     * the list.  Ensure that the "default" node cannot be removed.
+     * Traverse the 'statProcList' looking for the particular node whose
+     * 'proc' member matches 'proc' and remove that one from the list. Ensure
+     * that the "default" node cannot be removed.
      */
 
     while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
@@ -4405,27 +4716,25 @@ TclStatDeleteProc (proc)
  *
  * TclAccessInsertProc --
  *
- *	Insert the passed procedure pointer at the head of the list of
- *	functions which are used during a call to 'TclAccess(...)'.
- *	The passed function should behave exactly like 'TclAccess' when
- *	called during that time (see 'TclAccess(...)' for more
- *	information).  The function will be added even if it already in
- *	the list.
+ *	Insert the passed function pointer at the head of the list of
+ *	functions which are used during a call to 'TclAccess(...)'. The passed
+ *	function should behave exactly like 'TclAccess' when called during
+ *	that time (see 'TclAccess(...)' for more information). The function
+ *	will be added even if it already in the list.
  *
  * Results:
- *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- *	could not be allocated.
+ *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ *	not be allocated.
  *
  * Side effects:
- *      Memory allocated and modifies the link list for 'TclAccess'
- *	functions.
+ *	Memory allocated and modifies the link list for 'TclAccess' functions.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclAccessInsertProc(proc)
-    TclAccessProc_ *proc;
+TclAccessInsertProc(
+    TclAccessProc_ *proc)
 {
     int retVal = TCL_ERROR;
 
@@ -4454,31 +4763,30 @@ TclAccessInsertProc(proc)
  * TclAccessDeleteProc --
  *
  *	Removed the passed function pointer from the list of 'TclAccess'
- *	functions.  Ensures that the built-in access function is not
- *	removvable.
+ *	functions. Ensures that the built-in access function is not removable.
  *
  * Results:
- *      TCL_OK if the procedure pointer was successfully removed,
- *	TCL_ERROR otherwise.
+ *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
+ *	otherwise.
  *
  * Side effects:
- *      Memory is deallocated and the respective list updated.
+ *	Memory is deallocated and the respective list updated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclAccessDeleteProc(proc)
-    TclAccessProc_ *proc;
+TclAccessDeleteProc(
+    TclAccessProc_ *proc)
 {
     int retVal = TCL_ERROR;
     AccessProc *tmpAccessProcPtr;
     AccessProc *prevAccessProcPtr = NULL;
 
     /*
-     * Traverse the 'accessProcList' looking for the particular node
-     * whose 'proc' member matches 'proc' and remove that one from
-     * the list.  Ensure that the "default" node cannot be removed.
+     * Traverse the 'accessProcList' looking for the particular node whose
+     * 'proc' member matches 'proc' and remove that one from the list. Ensure
+     * that the "default" node cannot be removed.
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -4509,45 +4817,43 @@ TclAccessDeleteProc(proc)
  *
  * TclOpenFileChannelInsertProc --
  *
- *	Insert the passed procedure pointer at the head of the list of
- *	functions which are used during a call to
- *	'Tcl_OpenFileChannel(...)'. The passed function should behave
- *	exactly like 'Tcl_OpenFileChannel' when called during that time
- *	(see 'Tcl_OpenFileChannel(...)' for more information). The
- *	function will be added even if it already in the list.
+ *	Insert the passed function pointer at the head of the list of
+ *	functions which are used during a call to 'Tcl_OpenFileChannel(...)'.
+ *	The passed function should behave exactly like 'Tcl_OpenFileChannel'
+ *	when called during that time (see 'Tcl_OpenFileChannel(...)' for more
+ *	information). The function will be added even if it already in the
+ *	list.
  *
  * Results:
- *      Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- *	could not be allocated.
+ *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ *	not be allocated.
  *
  * Side effects:
- *      Memory allocated and modifies the link list for
- *	'Tcl_OpenFileChannel' functions.
+ *	Memory allocated and modifies the link list for 'Tcl_OpenFileChannel'
+ *	functions.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclOpenFileChannelInsertProc(proc)
-    TclOpenFileChannelProc_ *proc;
+TclOpenFileChannelInsertProc(
+    TclOpenFileChannelProc_ *proc)
 {
     int retVal = TCL_ERROR;
 
     if (proc != NULL) {
 	OpenFileChannelProc *newOpenFileChannelProcPtr;
 
-	newOpenFileChannelProcPtr =
-		(OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
+	newOpenFileChannelProcPtr = (OpenFileChannelProc *)
+		ckalloc(sizeof(OpenFileChannelProc));
 
-	if (newOpenFileChannelProcPtr != NULL) {
-	    newOpenFileChannelProcPtr->proc = proc;
-	    Tcl_MutexLock(&obsoleteFsHookMutex);
-	    newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
-	    openFileChannelProcList = newOpenFileChannelProcPtr;
-	    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+	newOpenFileChannelProcPtr->proc = proc;
+	Tcl_MutexLock(&obsoleteFsHookMutex);
+	newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
+	openFileChannelProcList = newOpenFileChannelProcPtr;
+	Tcl_MutexUnlock(&obsoleteFsHookMutex);
 
-	    retVal = TCL_OK;
-	}
+	retVal = TCL_OK;
     }
 
     return retVal;
@@ -4559,31 +4865,30 @@ TclOpenFileChannelInsertProc(proc)
  * TclOpenFileChannelDeleteProc --
  *
  *	Removed the passed function pointer from the list of
- *	'Tcl_OpenFileChannel' functions.  Ensures that the built-in
- *	open file channel function is not removable.
+ *	'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
+ *	channel function is not removable.
  *
  * Results:
- *      TCL_OK if the procedure pointer was successfully removed,
- *	TCL_ERROR otherwise.
+ *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
+ *	otherwise.
  *
  * Side effects:
- *      Memory is deallocated and the respective list updated.
+ *	Memory is deallocated and the respective list updated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclOpenFileChannelDeleteProc(proc)
-    TclOpenFileChannelProc_ *proc;
+TclOpenFileChannelDeleteProc(
+    TclOpenFileChannelProc_ *proc)
 {
     int retVal = TCL_ERROR;
     OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
     OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
 
     /*
-     * Traverse the 'openFileChannelProcList' looking for the particular
-     * node whose 'proc' member matches 'proc' and remove that one from
-     * the list.  
+     * Traverse the 'openFileChannelProcList' looking for the particular node
+     * whose 'proc' member matches 'proc' and remove that one from the list.
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -4598,7 +4903,7 @@ TclOpenFileChannelDeleteProc(proc)
 			tmpOpenFileChannelProcPtr->nextPtr;
 	    }
 
-	    ckfree((char *)tmpOpenFileChannelProcPtr);
+	    ckfree((char *) tmpOpenFileChannelProcPtr);
 
 	    retVal = TCL_OK;
 	} else {
@@ -4611,1869 +4916,11 @@ TclOpenFileChannelDeleteProc(proc)
     return retVal;
 }
 #endif /* USE_OBSOLETE_FS_HOOKS */
-
-
-/*
- * Prototypes for procedures defined later in this file.
- */
-
-static void		DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static void		FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
-static void             UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int		SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static int 		FindSplitPos _ANSI_ARGS_((char *path, char *separator));
-
-
-
-/*
- * Define the 'path' object type, which Tcl uses to represent
- * file paths internally.
- */
-static Tcl_ObjType tclFsPathType = {
-    "path",				/* name */
-    FreeFsPathInternalRep,		/* freeIntRepProc */
-    DupFsPathInternalRep,	        /* dupIntRepProc */
-    UpdateStringOfFsPath,		/* updateStringProc */
-    SetFsPathFromAny			/* setFromAnyProc */
-};
-
-/* 
- * struct FsPath --
- * 
- * Internal representation of a Tcl_Obj of "path" type.  This
- * can be used to represent relative or absolute paths, and has
- * certain optimisations when used to represent paths which are
- * already normalized and absolute.
- * 
- * Note that 'normPathPtr' can be a circular reference to the
- * container Tcl_Obj of this FsPath.
- */
-typedef struct FsPath {
-    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences.
-				 * If this is NULL, then this is a 
-				 * pure normalized, absolute path
-				 * object, in which the parent Tcl_Obj's
-				 * string rep is already both translated
-				 * and normalized. */
-    Tcl_Obj *normPathPtr;       /* Normalized absolute path, without 
-				 * ., .. or ~user sequences. If the 
-				 * Tcl_Obj containing 
-				 * this FsPath is already normalized, 
-				 * this may be a circular reference back
-				 * to the container.  If that is NOT the
-				 * case, we have a refCount on the object. */
-    Tcl_Obj *cwdPtr;            /* If null, path is absolute, else
-				 * this points to the cwd object used
-				 * for this path.  We have a refCount
-				 * on the object. */
-    int flags;                  /* Flags to describe interpretation */
-    ClientData nativePathPtr;   /* Native representation of this path,
-				 * which is filesystem dependent. */
-    int filesystemEpoch;        /* Used to ensure the path representation
-				 * was generated during the correct
-				 * filesystem epoch.  The epoch changes
-				 * when filesystem-mounts are changed. */ 
-    struct FilesystemRecord *fsRecPtr;
-				/* Pointer to the filesystem record 
-				 * entry to use for this path. */
-} FsPath;
-
-/* 
- * Define some macros to give us convenient access to path-object
- * specific fields.
- */
-#define PATHOBJ(objPtr) (objPtr->internalRep.otherValuePtr)
-#define PATHFLAGS(objPtr) \
- (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags)
-
-#define TCLPATH_APPENDED 1
-#define TCLPATH_RELATIVE 2
-#define TCLPATH_NEEDNORM 4
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FSGetPathType --
- *
- *	Determines whether a given path is relative to the current
- *	directory, relative to the current volume, or absolute.  
- *
- * Results:
- *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- *	TCL_PATH_VOLUME_RELATIVE.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_PathType
-Tcl_FSGetPathType(pathObjPtr)
-    Tcl_Obj *pathObjPtr;
-{
-    return FSGetPathType(pathObjPtr, NULL, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FSGetPathType --
- *
- *	Determines whether a given path is relative to the current
- *	directory, relative to the current volume, or absolute.  If the
- *	caller wishes to know which filesystem claimed the path (in the
- *	case for which the path is absolute), then a reference to a
- *	filesystem pointer can be passed in (but passing NULL is
- *	acceptable).
- *
- * Results:
- *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- *	TCL_PATH_VOLUME_RELATIVE.  The filesystem reference will
- *	be set if and only if it is non-NULL and the function's 
- *	return value is TCL_PATH_ABSOLUTE.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_PathType
-FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr)
-    Tcl_Obj *pathObjPtr;
-    Tcl_Filesystem **filesystemPtrPtr;
-    int *driveNameLengthPtr;
-{
-    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
-	return GetPathType(pathObjPtr, filesystemPtrPtr, 
-			   driveNameLengthPtr, NULL);
-    } else {
-	FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-	if (fsPathPtr->cwdPtr != NULL) {
-	    if (PATHFLAGS(pathObjPtr) == 0) {
-		/* The path is not absolute... */
-#ifdef __WIN32__
-		/* ... on Windows we must make another call to determine
-		 * whether it's relative or volumerelative [Bug 2571597]. */
-		return GetPathType(pathObjPtr, filesystemPtrPtr, 
-			driveNameLengthPtr, NULL);
-#else
-		/* On other systems, quickly deduce !absolute -> relative */
-		return TCL_PATH_RELATIVE;
-#endif
-	    }
-	    return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 
-				 driveNameLengthPtr);
-	} else {
-	    return GetPathType(pathObjPtr, filesystemPtrPtr, 
-			       driveNameLengthPtr, NULL);
-	}
-    }
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSJoinPath --
- *
- *      This function takes the given Tcl_Obj, which should be a valid
- *      list, and returns the path object given by considering the
- *      first 'elements' elements as valid path segments.  If elements < 0,
- *      we use the entire list.
- *      
- * Results:
- *      Returns object with refCount of zero, (or if non-zero, it has
- *      references elsewhere in Tcl).  Either way, the caller must
- *      increment its refCount before use.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-Tcl_Obj* 
-Tcl_FSJoinPath(listObj, elements)
-    Tcl_Obj *listObj;
-    int elements;
-{
-    Tcl_Obj *res;
-    int i;
-    Tcl_Filesystem *fsPtr = NULL;
-    
-    if (elements < 0) {
-	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
-	    return NULL;
-	}
-    } else {
-	/* Just make sure it is a valid list */
-	int listTest;
-	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
-	    return NULL;
-	}
-	/* 
-	 * Correct this if it is too large, otherwise we will
-	 * waste our time joining null elements to the path 
-	 */
-	if (elements > listTest) {
-	    elements = listTest;
-	}
-    }
-    
-    res = Tcl_NewObj();
-    
-    for (i = 0; i < elements; i++) {
-	Tcl_Obj *elt;
-	int driveNameLength;
-	Tcl_PathType type;
-	char *strElt;
-	int strEltLen;
-	int length;
-	char *ptr;
-	Tcl_Obj *driveName = NULL;
-	
-	Tcl_ListObjIndex(NULL, listObj, i, &elt);
-	
-	/* 
-	 * This is a special case where we can be much more
-	 * efficient, where we are joining a single relative path
-	 * onto an object that is already of path type.  The 
-	 * 'TclNewFSPathObj' call below creates an object which
-	 * can be normalized more efficiently.  Currently we only
-	 * use the special case when we have exactly two elements,
-	 * but we could expand that in the future.
-	 */
-	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
-	  && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
-	    Tcl_Obj *tail;
-	    Tcl_PathType type;
-	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
-	    type = GetPathType(tail, NULL, NULL, NULL);
-	    if (type == TCL_PATH_RELATIVE) {
-		CONST char *str;
-		int len;
-		str = Tcl_GetStringFromObj(tail,&len);
-		if (len == 0) {
-		    /* 
-		     * This happens if we try to handle the root volume
-		     * '/'.  There's no need to return a special path
-		     * object, when the base itself is just fine!
-		     */
-		    Tcl_DecrRefCount(res);
-		    return elt;
-		}
-		/* 
-		 * If it doesn't begin with '.'  and is a mac or unix
-		 * path or it a windows path without backslashes, then we
-		 * can be very efficient here.  (In fact even a windows
-		 * path with backslashes can be joined efficiently, but
-		 * the path object would not have forward slashes only,
-		 * and this would therefore contradict our 'file join'
-		 * documentation).
-		 */
-		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 
-				      || (strchr(str, '\\') == NULL))) {
-		    /* 
-		     * Finally, on Windows, 'file join' is defined to 
-		     * convert all backslashes to forward slashes,
-		     * so the base part cannot have backslashes either.
-		     */
-		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
-			|| (strchr(Tcl_GetString(elt), '\\') == NULL)) {
-			if (res != NULL) {
-			    TclDecrRefCount(res);
-			}
-			return TclNewFSPathObj(elt, str, len);
-		    }
-		}
-		/* 
-		 * Otherwise we don't have an easy join, and
-		 * we must let the more general code below handle
-		 * things
-		 */
-	    } else {
-		if (tclPlatform == TCL_PLATFORM_UNIX) {
-		    Tcl_DecrRefCount(res);
-		    return tail;
-		} else {
-		    CONST char *str;
-		    int len;
-		    str = Tcl_GetStringFromObj(tail,&len);
-		    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
-			if (strchr(str, '\\') == NULL) {
-			    Tcl_DecrRefCount(res);
-			    return tail;
-			}
-		    }
-		}
-	    }
-	}
-	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
-	type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
-	if (type != TCL_PATH_RELATIVE) {
-	    /* Zero out the current result */
-	    Tcl_DecrRefCount(res);
-	    if (driveName != NULL) {
-		res = Tcl_DuplicateObj(driveName);
-		Tcl_DecrRefCount(driveName);
-	    } else {
-		res = Tcl_NewStringObj(strElt, driveNameLength);
-	    }
-	    strElt += driveNameLength;
-	}
-	
-	ptr = Tcl_GetStringFromObj(res, &length);
-	
-	/* 
-	 * Strip off any './' before a tilde, unless this is the
-	 * beginning of the path.
-	 */
-	if (length > 0 && strEltLen > 0) {
-	    if ((strElt[0] == '.') && (strElt[1] == '/') 
-	      && (strElt[2] == '~')) {
-		strElt += 2;
-	    }
-	}
-
-	/* 
-	 * A NULL value for fsPtr at this stage basically means
-	 * we're trying to join a relative path onto something
-	 * which is also relative (or empty).  There's nothing
-	 * particularly wrong with that.
-	 */
-	if (*strElt == '\0') continue;
-	
-	if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
-	    TclpNativeJoinPath(res, strElt);
-	} else {
-	    char separator = '/';
-	    int needsSep = 0;
-	    
-	    if (fsPtr->filesystemSeparatorProc != NULL) {
-		Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
-		if (sep != NULL) {
-		    separator = Tcl_GetString(sep)[0];
-		}
-	    }
-
-	    if (length > 0 && ptr[length -1] != '/') {
-		Tcl_AppendToObj(res, &separator, 1);
-		Tcl_GetStringFromObj(res, &length);
-	    }
-	    Tcl_SetObjLength(res, length + (int) strlen(strElt));
-	    
-	    ptr = Tcl_GetString(res) + length;
-	    for (; *strElt != '\0'; strElt++) {
-		if (*strElt == separator) {
-		    while (strElt[1] == separator) {
-			strElt++;
-		    }
-		    if (strElt[1] != '\0') {
-			if (needsSep) {
-			    *ptr++ = separator;
-			}
-		    }
-		} else {
-		    *ptr++ = *strElt;
-		    needsSep = 1;
-		}
-	    }
-	    length = ptr - Tcl_GetString(res);
-	    Tcl_SetObjLength(res, length);
-	}
-    }
-    return res;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSConvertToPathType --
- *
- *      This function tries to convert the given Tcl_Obj to a valid
- *      Tcl path type, taking account of the fact that the cwd may
- *      have changed even if this object is already supposedly of
- *      the correct type.
- *      
- *      The filename may begin with "~" (to indicate current user's
- *      home directory) or "~<user>" (to indicate any user's home
- *      directory).
- *
- * Results:
- *      Standard Tcl error code.
- *
- * Side effects:
- *	The old representation may be freed, and new memory allocated.
- *
- *---------------------------------------------------------------------------
- */
-int 
-Tcl_FSConvertToPathType(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to store error
-				 * message (if necessary). */
-    Tcl_Obj *objPtr;		/* Object to convert to a valid, current
-				 * path type. */
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    /* 
-     * While it is bad practice to examine an object's type directly,
-     * this is actually the best thing to do here.  The reason is that
-     * if we are converting this object to FsPath type for the first
-     * time, we don't need to worry whether the 'cwd' has changed.
-     * On the other hand, if this object is already of FsPath type,
-     * and is a relative path, we do have to worry about the cwd.
-     * If the cwd has changed, we must recompute the path.
-     */
-    if (objPtr->typePtr == &tclFsPathType) {
-	FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
-	if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
-	    if (objPtr->bytes == NULL) {
-		UpdateStringOfFsPath(objPtr);
-	    }
-	    FreeFsPathInternalRep(objPtr);
-	    objPtr->typePtr = NULL;
-	    return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
-	}
-	return TCL_OK;
-    } else {
-	return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
-    }
-}
-
-/* 
- * Helper function for SetFsPathFromAny.  Returns position of first
- * directory delimiter in the path.
- */
-static int
-FindSplitPos(path, separator)
-    char *path;
-    char *separator;
-{
-    int count = 0;
-    switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    while (path[count] != 0) {
-		if (path[count] == *separator) {
-		    return count;
-		}
-		count++;
-	    }
-	    break;
-
-	case TCL_PLATFORM_WINDOWS:
-	    while (path[count] != 0) {
-		if (path[count] == *separator || path[count] == '\\') {
-		    return count;
-		}
-		count++;
-	    }
-	    break;
-    }
-    return count;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclNewFSPathObj --
- *
- *      Creates a path object whose string representation is 
- *      '[file join dirPtr addStrRep]', but does so in a way that
- *      allows for more efficient caching of normalized paths.
- *      
- * Assumptions:
- *      'dirPtr' must be an absolute path.  
- *      'len' may not be zero.
- *      
- * Results:
- *      The new Tcl object, with refCount zero.
- *
- * Side effects:
- *	Memory is allocated.  'dirPtr' gets an additional refCount.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj*
-TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
-{
-    FsPath *fsPathPtr;
-    Tcl_Obj *objPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    CONST char *p;
-    int state = 0, count = 0;
-    
-    objPtr = Tcl_NewObj();
-    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-    
-    /* Setup the path */
-    fsPathPtr->translatedPathPtr = NULL;
-    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
-    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
-    fsPathPtr->cwdPtr = dirPtr;
-    Tcl_IncrRefCount(dirPtr);
-    fsPathPtr->nativePathPtr = NULL;
-    fsPathPtr->fsRecPtr = NULL;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
-    PATHFLAGS(objPtr) = TCLPATH_RELATIVE | TCLPATH_APPENDED;
-    objPtr->typePtr = &tclFsPathType;
-    objPtr->bytes = NULL;
-    objPtr->length = 0;
-
-    /*
-     * Look for path components made up of only "."
-     * This is overly conservative analysis to keep simple.  It may
-     * mark some things as needing more aggressive normalization
-     * that don't actually need it.  No harm done.
-     */
-    for (p = addStrRep; len > 0; p++, len--) {
-	switch (state) {
-	case 0:	/* So far only "." since last dirsep or start */
-	    switch (*p) {
-	    case '.':
-		count++;
-		break;
-	    case '/':
-	    case '\\':
-	    case ':':
-		if (count) {
-		    PATHFLAGS(objPtr) |= TCLPATH_NEEDNORM;
-		    len = 0;
-		}
-		break;
-	    default:
-		count = 0;
-		state = 1;
-	    }
-	case 1: /* Scanning for next dirsep */
-	    switch (*p) {
-	    case '/':
-	    case '\\':
-	    case ':':
-		state = 0;
-		break;
-	    }
-	}
-    }
-    if (len == 0 && count) {
-	PATHFLAGS(objPtr) |= TCLPATH_NEEDNORM;
-    }
-
-    return objPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFSMakePathRelative --
- *
- *      Only for internal use.
- *      
- *      Takes a path and a directory, where we _assume_ both path and
- *      directory are absolute, normalized and that the path lies
- *      inside the directory.  Returns a Tcl_Obj representing filename 
- *      of the path relative to the directory.
- *      
- *      In the case where the resulting path would start with a '~', we
- *      take special care to return an ordinary string.  This means to
- *      use that path (and not have it interpreted as a user name),
- *      one must prepend './'.  This may seem strange, but that is how
- *      'glob' is currently defined.
- *      
- * Results:
- *      NULL on error, otherwise a valid object, typically with
- *      refCount of zero, which it is assumed the caller will
- *      increment.
- *
- * Side effects:
- *	The old representation may be freed, and new memory allocated.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj*
-TclFSMakePathRelative(interp, objPtr, cwdPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object we have. */
-    Tcl_Obj *cwdPtr;		/* Make it relative to this. */
-{
-    int cwdLen, len;
-    CONST char *tempStr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    
-    if (objPtr->typePtr == &tclFsPathType) {
-	FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
-	if (PATHFLAGS(objPtr) != 0 
-		&& fsPathPtr->cwdPtr == cwdPtr) {
-	    objPtr = fsPathPtr->normPathPtr;
-	    /* Free old representation */
-	    if (objPtr->typePtr != NULL) {
-		if (objPtr->bytes == NULL) {
-		    if (objPtr->typePtr->updateStringProc == NULL) {
-			if (interp != NULL) {
-			    Tcl_ResetResult(interp);
-			    Tcl_AppendResult(interp, "can't find object",
-					     "string representation", (char *) NULL);
-			}
-			return NULL;
-		    }
-		    objPtr->typePtr->updateStringProc(objPtr);
-		}
-		if ((objPtr->typePtr->freeIntRepProc) != NULL) {
-		    (*objPtr->typePtr->freeIntRepProc)(objPtr);
-		}
-	    }
-	    /* Now objPtr is a string object */
-	    
-	    if (Tcl_GetString(objPtr)[0] == '~') {
-		/* 
-		 * If the first character of the path is a tilde,
-		 * we must just return the path as is, to agree
-		 * with the defined behaviour of 'glob'.
-		 */
-		return objPtr;
-	    }
-
-	    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-
-	    /* Circular reference, by design */
-	    fsPathPtr->translatedPathPtr = objPtr;
-	    fsPathPtr->normPathPtr = NULL;
-	    fsPathPtr->cwdPtr = cwdPtr;
-	    Tcl_IncrRefCount(cwdPtr);
-	    fsPathPtr->nativePathPtr = NULL;
-	    fsPathPtr->fsRecPtr = NULL;
-	    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-	    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
-	    PATHFLAGS(objPtr) = 0;
-	    objPtr->typePtr = &tclFsPathType;
-
-	    return objPtr;
-	}
-    }
-    /* 
-     * We know the cwd is a normalised object which does
-     * not end in a directory delimiter, unless the cwd
-     * is the name of a volume, in which case it will
-     * end in a delimiter!  We handle this situation here.
-     * A better test than the '!= sep' might be to simply
-     * check if 'cwd' is a root volume.
-     * 
-     * Note that if we get this wrong, we will strip off
-     * either too much or too little below, leading to
-     * wrong answers returned by glob.
-     */
-    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
-    /* 
-     * Should we perhaps use 'Tcl_FSPathSeparator'?
-     * But then what about the Windows special case?
-     * Perhaps we should just check if cwd is a root
-     * volume.
-     */
-    switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    if (tempStr[cwdLen-1] != '/') {
-		cwdLen++;
-	    }
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    if (tempStr[cwdLen-1] != '/' 
-		    && tempStr[cwdLen-1] != '\\') {
-		cwdLen++;
-	    }
-	    break;
-    }
-    tempStr = Tcl_GetStringFromObj(objPtr, &len);
-
-    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFSMakePathFromNormalized --
- *
- *      Like SetFsPathFromAny, but assumes the given object is an
- *      absolute normalized path. Only for internal use.
- *      
- * Results:
- *      Standard Tcl error code.
- *
- * Side effects:
- *	The old representation may be freed, and new memory allocated.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclFSMakePathFromNormalized(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object to convert. */
-{
-    FsPath *fsPathPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (objPtr->typePtr == &tclFsPathType) {
-	return TCL_OK;
-    }
-    
-    /* Free old representation */
-    if (objPtr->typePtr != NULL) {
-	if (objPtr->bytes == NULL) {
-	    if (objPtr->typePtr->updateStringProc == NULL) {
-		if (interp != NULL) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendResult(interp, "can't find object",
-				     "string representation", (char *) NULL);
-		}
-		return TCL_ERROR;
-	    }
-	    objPtr->typePtr->updateStringProc(objPtr);
-	}
-	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
-	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
-	}
-    }
-
-    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-    /* It's a pure normalized absolute path */
-    fsPathPtr->translatedPathPtr = NULL;
-    fsPathPtr->normPathPtr = objPtr;
-    fsPathPtr->cwdPtr = NULL;
-    fsPathPtr->nativePathPtr = NULL;
-    fsPathPtr->fsRecPtr = NULL;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
-    PATHFLAGS(objPtr) = 0;
-    objPtr->typePtr = &tclFsPathType;
-
-    return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSNewNativePath --
- *
- *      This function performs the something like that reverse of the 
- *      usual obj->path->nativerep conversions.  If some code retrieves
- *      a path in native form (from, e.g. readlink or a native dialog),
- *      and that path is to be used at the Tcl level, then calling
- *      this function is an efficient way of creating the appropriate
- *      path object type.
- *      
- *      Any memory which is allocated for 'clientData' should be retained
- *      until clientData is passed to the filesystem's freeInternalRepProc
- *      when it can be freed.  The built in platform-specific filesystems
- *      use 'ckalloc' to allocate clientData, and ckfree to free it.
- *
- * Results:
- *      NULL or a valid path object pointer, with refCount zero.
- *
- * Side effects:
- *	New memory may be allocated.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_FSNewNativePath(fromFilesystem, clientData)
-    Tcl_Filesystem* fromFilesystem;
-    ClientData clientData;
-{
-    Tcl_Obj *objPtr;
-    FsPath *fsPathPtr;
-
-    FilesystemRecord *fsFromPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    
-    objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr);
-    if (objPtr == NULL) {
-	return NULL;
-    }
-    
-    /* 
-     * Free old representation; shouldn't normally be any,
-     * but best to be safe. 
-     */
-    if (objPtr->typePtr != NULL) {
-	if (objPtr->bytes == NULL) {
-	    if (objPtr->typePtr->updateStringProc == NULL) {
-		return NULL;
-	    }
-	    objPtr->typePtr->updateStringProc(objPtr);
-	}
-	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
-	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
-	}
-    }
-    
-    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-
-    fsPathPtr->translatedPathPtr = NULL;
-    /* Circular reference, by design */
-    fsPathPtr->normPathPtr = objPtr;
-    fsPathPtr->cwdPtr = NULL;
-    fsPathPtr->nativePathPtr = clientData;
-    fsPathPtr->fsRecPtr = fsFromPtr;
-    fsPathPtr->fsRecPtr->fileRefCount++;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
-    PATHFLAGS(objPtr) = 0;
-    objPtr->typePtr = &tclFsPathType;
-
-    return objPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSGetTranslatedPath --
- *
- *      This function attempts to extract the translated path
- *      from the given Tcl_Obj.  If the translation succeeds (i.e. the
- *      object is a valid path), then it is returned.  Otherwise NULL
- *      will be returned, and an error message may be left in the
- *      interpreter (if it is non-NULL)
- *
- * Results:
- *      NULL or a valid Tcl_Obj pointer.
- *
- * Side effects:
- *	Only those of 'Tcl_FSConvertToPathType'
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj* 
-Tcl_FSGetTranslatedPath(interp, pathPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj* pathPtr;
-{
-    Tcl_Obj *retObj = NULL;
-    FsPath *srcFsPathPtr;
-
-    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
-	return NULL;
-    }
-    srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
-    if (srcFsPathPtr->translatedPathPtr == NULL) {
-	if (PATHFLAGS(pathPtr) != 0) {
-	    /*
-	     * We lack a translated path result, but we have a directory
-	     * (cwdPtr) and a tail (normPathPtr), and if we join the
-	     * translated version of cwdPtr to normPathPtr, we'll get the
-	     * translated result we need, and can store it for future use.
-	     */
-
-	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
-		    srcFsPathPtr->cwdPtr);
-
-	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
-		    &(srcFsPathPtr->normPathPtr));
-	    srcFsPathPtr->translatedPathPtr = retObj;
-	    Tcl_IncrRefCount(retObj);
-	    Tcl_DecrRefCount(translatedCwdPtr);
-	} else {
-	    /* 
-	     * It is a pure absolute, normalized path object.
-	     * This is something like being a 'pure list'.  The
-	     * object's string, translatedPath and normalizedPath
-	     * are all identical.
-	     */
-	    retObj = srcFsPathPtr->normPathPtr;
-	}
-    } else {
-	/* It is an ordinary path object */
-	retObj = srcFsPathPtr->translatedPathPtr;
-    }
-
-    if (retObj) {
-	Tcl_IncrRefCount(retObj);
-    }
-    return retObj;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSGetTranslatedStringPath --
- *
- *      This function attempts to extract the translated path
- *      from the given Tcl_Obj.  If the translation succeeds (i.e. the
- *      object is a valid path), then the path is returned.  Otherwise NULL
- *      will be returned, and an error message may be left in the
- *      interpreter (if it is non-NULL)
- *
- * Results:
- *      NULL or a valid string.
- *
- * Side effects:
- *	Only those of 'Tcl_FSConvertToPathType'
- *
- *---------------------------------------------------------------------------
- */
-CONST char*
-Tcl_FSGetTranslatedStringPath(interp, pathPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj* pathPtr;
-{
-    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-
-    if (transPtr != NULL) {
-	int len;
-	CONST char *result, *orig;
-	orig = Tcl_GetStringFromObj(transPtr, &len);
-	result = (char*) ckalloc((unsigned)(len+1));
-	memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
-	Tcl_DecrRefCount(transPtr);
-	return result;
-    }
-
-    return NULL;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSGetNormalizedPath --
- *
- *      This important function attempts to extract from the given Tcl_Obj
- *      a unique normalised path representation, whose string value can
- *      be used as a unique identifier for the file.
- *
- * Results:
- *      NULL or a valid path object pointer.
- *
- * Side effects:
- *	New memory may be allocated.  The Tcl 'errno' may be modified
- *      in the process of trying to examine various path possibilities.
- *
- *---------------------------------------------------------------------------
- */
-
-Tcl_Obj* 
-Tcl_FSGetNormalizedPath(interp, pathObjPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj* pathObjPtr;
-{
-    FsPath *fsPathPtr;
-
-    if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
-	return NULL;
-    }
-    fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-
-    if (PATHFLAGS(pathObjPtr) != 0) {
-	/* 
-	 * This is a special path object which is the result of
-	 * something like 'file join' 
-	 */
-	Tcl_Obj *dir, *copy;
-	int cwdLen;
-	int pathType;
-	CONST char *cwdStr;
-	
-	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
-	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
-	if (dir == NULL) {
-	    return NULL;
-	}
-	if (pathObjPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(pathObjPtr);
-	}
-	copy = Tcl_DuplicateObj(dir);
-	Tcl_IncrRefCount(copy);
-	Tcl_IncrRefCount(dir);
-	/* We now own a reference on both 'dir' and 'copy' */
-	
-	cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
-	/* 
-	 * Should we perhaps use 'Tcl_FSPathSeparator'?
-	 * But then what about the Windows special case?
-	 * Perhaps we should just check if cwd is a root volume.
-	 * We should never get cwdLen == 0 in this code path.
-	 */
-	switch (tclPlatform) {
-	    case TCL_PLATFORM_UNIX:
-		if (cwdStr[cwdLen-1] != '/') {
-		    Tcl_AppendToObj(copy, "/", 1);
-		    cwdLen++;
-		}
-		break;
-	    case TCL_PLATFORM_WINDOWS:
-		if (cwdStr[cwdLen-1] != '/' 
-			&& cwdStr[cwdLen-1] != '\\') {
-		    Tcl_AppendToObj(copy, "/", 1);
-		    cwdLen++;
-		}
-		break;
-	}
-	Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
-
-	/* Normalize the combined string. */
-
-	if (PATHFLAGS(pathObjPtr) & TCLPATH_NEEDNORM) {
-	    /*
-	     * If the "tail" part has components (like /../) that cause
-	     * the combined path to need more complete normalizing,
-	     * call on the more powerful routine to accomplish that so
-	     * we avoid [Bug 2385549] ...
-	     */
-
-	    Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
-	    Tcl_DecrRefCount(copy);
-	    copy = newCopy;
-	} else {
-	    /*
-	     * ... but in most cases where we join a trouble free tail
-	     * to a normalized head, we can more efficiently normalize the
-	     * combined path by passing over only the unnormalized tail
-	     * portion.  When this is sufficient, prior developers claim
-	     * this should be much faster.  We use 'cwdLen-1' so that we are
-	     * already pointing at the dir-separator that we know about.
-	     * The normalization code will actually start off directly
-	     * after that separator.
-	     */
-
-	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
-	}
-
-	/* Now we need to construct the new path object */
-	
-	if (pathType == TCL_PATH_RELATIVE) {
-	    FsPath* origDirFsPathPtr;
-	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;
-	    origDirFsPathPtr = (FsPath*) PATHOBJ(origDir);
-	    
-	    fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
-	    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
-	    
-	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
-	    fsPathPtr->normPathPtr = copy;
-	    /* That's our reference to copy used */
-	    Tcl_DecrRefCount(dir);
-	    Tcl_DecrRefCount(origDir);
-	} else {
-	    Tcl_DecrRefCount(fsPathPtr->cwdPtr);
-	    fsPathPtr->cwdPtr = NULL;
-	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
-	    fsPathPtr->normPathPtr = copy;
-	    /* That's our reference to copy used */
-	    Tcl_DecrRefCount(dir);
-	}
-	PATHFLAGS(pathObjPtr) = 0;
-    }
-    /* Ensure cwd hasn't changed */
-    if (fsPathPtr->cwdPtr != NULL) {
-	if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) {
-	    if (pathObjPtr->bytes == NULL) {
-		UpdateStringOfFsPath(pathObjPtr);
-	    }
-	    FreeFsPathInternalRep(pathObjPtr);
-	    pathObjPtr->typePtr = NULL;
-	    if (Tcl_ConvertToType(interp, pathObjPtr, 
-				  &tclFsPathType) != TCL_OK) {
-		return NULL;
-	    }
-	    fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-	} else if (fsPathPtr->normPathPtr == NULL) {
-	    int cwdLen;
-	    Tcl_Obj *copy;
-	    CONST char *cwdStr;
-	    
-	    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
-	    Tcl_IncrRefCount(copy);
-	    cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
-	    /* 
-	     * Should we perhaps use 'Tcl_FSPathSeparator'?
-	     * But then what about the Windows special case?
-	     * Perhaps we should just check if cwd is a root volume.
-	     * We should never get cwdLen == 0 in this code path.
-	     */
-	    switch (tclPlatform) {
-		case TCL_PLATFORM_UNIX:
-		    if (cwdStr[cwdLen-1] != '/') {
-			Tcl_AppendToObj(copy, "/", 1);
-			cwdLen++;
-		    }
-		    break;
-		case TCL_PLATFORM_WINDOWS:
-		    if (cwdStr[cwdLen-1] != '/' 
-			    && cwdStr[cwdLen-1] != '\\') {
-			Tcl_AppendToObj(copy, "/", 1);
-			cwdLen++;
-		    }
-		    break;
-	    }
-	    Tcl_AppendObjToObj(copy, pathObjPtr);
-	    /* 
-	     * Normalize the combined string, but only starting after
-	     * the end of the previously normalized 'dir'.  This should
-	     * be much faster!
-	     */
-	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
-	    fsPathPtr->normPathPtr = copy;
-	}
-    }
-    if (fsPathPtr->normPathPtr == NULL) {
-	Tcl_Obj *useThisCwd = NULL;
-	/* 
-	 * Since normPathPtr is NULL, but this is a valid path
-	 * object, we know that the translatedPathPtr cannot be NULL.
-	 */
-	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
-	char *path = Tcl_GetString(absolutePath);
-	
-	/* 
-	 * We have to be a little bit careful here to avoid infinite loops
-	 * we're asking Tcl_FSGetPathType to return the path's type, but
-	 * that call can actually result in a lot of other filesystem
-	 * action, which might loop back through here.
-	 */
-	if (path[0] != '\0') {
-	    Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr);
-	    if (type == TCL_PATH_RELATIVE) {
-		useThisCwd = Tcl_FSGetCwd(interp);
-
-		if (useThisCwd == NULL) return NULL;
-
-		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
-		Tcl_IncrRefCount(absolutePath);
-		/* We have a refCount on the cwd */
-#ifdef __WIN32__
-	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
-		/* 
-		 * Only Windows has volume-relative paths.  These
-		 * paths are rather rare, but is is nice if Tcl can
-		 * handle them.  It is much better if we can
-		 * handle them here, rather than in the native fs code,
-		 * because we really need to have a real absolute path
-		 * just below.
-		 * 
-		 * We do not let this block compile on non-Windows
-		 * platforms because the test suite's manual forcing
-		 * of tclPlatform can otherwise cause this code path
-		 * to be executed, causing various errors because
-		 * volume-relative paths really do not exist.
-		 */
-		useThisCwd = Tcl_FSGetCwd(interp);
-		if (useThisCwd == NULL) return NULL;
-		
-		if (path[0] == '/') {
-		    /* 
-		     * Path of form /foo/bar which is a path in the
-		     * root directory of the current volume.
-		     */
-		    CONST char *drive = Tcl_GetString(useThisCwd);
-		    absolutePath = Tcl_NewStringObj(drive,2);
-		    Tcl_AppendToObj(absolutePath, path, -1);
-		    Tcl_IncrRefCount(absolutePath);
-		    /* We have a refCount on the cwd */
-		} else {
-		    /* 
-		     * Path of form C:foo/bar, but this only makes
-		     * sense if the cwd is also on drive C.
-		     */
-		    CONST char *drive = Tcl_GetString(useThisCwd);
-		    char drive_c = path[0];
-		    if (drive_c >= 'a') {
-			drive_c -= ('a' - 'A');
-		    }
-		    if (drive[0] == drive_c) {
-			absolutePath = Tcl_DuplicateObj(useThisCwd);
-			/* We have a refCount on the cwd */
-		    } else {
-			Tcl_DecrRefCount(useThisCwd);
-			useThisCwd = NULL;
-			/* 
-			 * The path is not in the current drive, but
-			 * is volume-relative.  The way Tcl 8.3 handles
-			 * this is that it treats such a path as
-			 * relative to the root of the drive.  We
-			 * therefore behave the same here.
-			 */
-			absolutePath = Tcl_NewStringObj(path, 2);
-		    }
-		    Tcl_IncrRefCount(absolutePath);
-		    Tcl_AppendToObj(absolutePath, "/", 1);
-		    Tcl_AppendToObj(absolutePath, path+2, -1);
-		}
-#endif /* __WIN32__ */
-	    }
-	}
-	/* Already has refCount incremented */
-	fsPathPtr->normPathPtr
-		= TclFSNormalizeAbsolutePath(interp, absolutePath);
-	if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
-		    Tcl_GetString(pathObjPtr))) {
-	    /* 
-	     * The path was already normalized.  
-	     * Get rid of the duplicate.
-	     */
-	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
-	    /* 
-	     * We do *not* increment the refCount for 
-	     * this circular reference 
-	     */
-	    fsPathPtr->normPathPtr = pathObjPtr;
-	}
-	if (useThisCwd != NULL) {
-	    /* This was returned by Tcl_FSJoinToPath above */
-	    Tcl_DecrRefCount(absolutePath);
-	    fsPathPtr->cwdPtr = useThisCwd;
-	}
-    }
-
-    return fsPathPtr->normPathPtr;
-}
 
 /*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSGetInternalRep --
- *
- *      Extract the internal representation of a given path object,
- *      in the given filesystem.  If the path object belongs to a
- *      different filesystem, we return NULL.
- *      
- *      If the internal representation is currently NULL, we attempt
- *      to generate it, by calling the filesystem's 
- *      'Tcl_FSCreateInternalRepProc'.
- *
- * Results:
- *      NULL or a valid internal representation.
- *
- * Side effects:
- *	An attempt may be made to convert the object.
- *
- *---------------------------------------------------------------------------
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
  */
-
-ClientData 
-Tcl_FSGetInternalRep(pathObjPtr, fsPtr)
-    Tcl_Obj* pathObjPtr;
-    Tcl_Filesystem *fsPtr;
-{
-    FsPath *srcFsPathPtr;
-    
-    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
-	return NULL;
-    }
-    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-    
-    /* 
-     * We will only return the native representation for the caller's
-     * filesystem.  Otherwise we will simply return NULL. This means
-     * that there must be a unique bi-directional mapping between paths
-     * and filesystems, and that this mapping will not allow 'remapped'
-     * files -- files which are in one filesystem but mapped into
-     * another.  Another way of putting this is that 'stacked'
-     * filesystems are not allowed.  We recognise that this is a
-     * potentially useful feature for the future.
-     * 
-     * Even something simple like a 'pass through' filesystem which
-     * logs all activity and passes the calls onto the native system
-     * would be nice, but not easily achievable with the current
-     * implementation.
-     */
-    if (srcFsPathPtr->fsRecPtr == NULL) {
-	/* 
-	 * This only usually happens in wrappers like TclpStat which
-	 * create a string object and pass it to TclpObjStat.  Code
-	 * which calls the Tcl_FS..  functions should always have a
-	 * filesystem already set.  Whether this code path is legal or
-	 * not depends on whether we decide to allow external code to
-	 * call the native filesystem directly.  It is at least safer
-	 * to allow this sub-optimal routing.
-	 */
-	Tcl_FSGetFileSystemForPath(pathObjPtr);
-	
-	/* 
-	 * If we fail through here, then the path is probably not a
-	 * valid path in the filesystsem, and is most likely to be a
-	 * use of the empty path "" via a direct call to one of the
-	 * objectified interfaces (e.g. from the Tcl testsuite).
-	 */
-	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-	if (srcFsPathPtr->fsRecPtr == NULL) {
-	    return NULL;
-	}
-    }
-
-    if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
-	/* 
-	 * There is still one possibility we should consider; if the
-	 * file belongs to a different filesystem, perhaps it is
-	 * actually linked through to a file in our own filesystem
-	 * which we do care about.  The way we can check for this
-	 * is we ask what filesystem this path belongs to.
-	 */
-	Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr);
-	if (actualFs == fsPtr) {
-	    return Tcl_FSGetInternalRep(pathObjPtr, fsPtr);
-	}
-	return NULL;
-    }
-
-    if (srcFsPathPtr->nativePathPtr == NULL) {
-	Tcl_FSCreateInternalRepProc *proc;
-	char *nativePathPtr;
-
-	proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
-	if (proc == NULL) {
-	    return NULL;
-	}
-
-	nativePathPtr = (*proc)(pathObjPtr);
-	srcFsPathPtr  = (FsPath*) PATHOBJ(pathObjPtr);
-	srcFsPathPtr->nativePathPtr = nativePathPtr;
-    }
-
-    return srcFsPathPtr->nativePathPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFSEnsureEpochOk --
- *
- *      This will ensure the pathObjPtr is up to date and can be
- *      converted into a "path" type, and that we are able to generate a
- *      complete normalized path which is used to determine the
- *      filesystem match.
- *
- * Results:
- *      Standard Tcl return code.
- *
- * Side effects:
- *	An attempt may be made to convert the object.
- *
- *---------------------------------------------------------------------------
- */
-
-int 
-TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr)
-    Tcl_Obj* pathObjPtr;
-    Tcl_Filesystem **fsPtrPtr;
-{
-    FsPath *srcFsPathPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    /* 
-     * SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE.
-     */
-
-    if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
-	return TCL_ERROR;
-    }
-
-    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-
-    /* 
-     * Check if the filesystem has changed in some way since
-     * this object's internal representation was calculated.
-     */
-    if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
-	/* 
-	 * We have to discard the stale representation and 
-	 * recalculate it 
-	 */
-	if (pathObjPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(pathObjPtr);
-	}
-	FreeFsPathInternalRep(pathObjPtr);
-	pathObjPtr->typePtr = NULL;
-	if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-    }
-    /* Check whether the object is already assigned to a fs */
-    if (srcFsPathPtr->fsRecPtr != NULL) {
-	*fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
-    }
-
-    return TCL_OK;
-}
-
-void 
-TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData) 
-    Tcl_Obj *pathObjPtr;
-    FilesystemRecord *fsRecPtr;
-    ClientData clientData;
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    /* We assume pathObjPtr is already of the correct type */
-    FsPath *srcFsPathPtr;
-    
-    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-    srcFsPathPtr->fsRecPtr = fsRecPtr;
-    srcFsPathPtr->nativePathPtr = clientData;
-    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-    fsRecPtr->fileRefCount++;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_FSEqualPaths --
- *
- *      This function tests whether the two paths given are equal path
- *      objects.  If either or both is NULL, 0 is always returned.
- *
- * Results:
- *      1 or 0.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-
-int 
-Tcl_FSEqualPaths(firstPtr, secondPtr)
-    Tcl_Obj* firstPtr;
-    Tcl_Obj* secondPtr;
-{
-    if (firstPtr == secondPtr) {
-	return 1;
-    } else {
-	char *firstStr, *secondStr;
-	int firstLen, secondLen, tempErrno;
-
-	if (firstPtr == NULL || secondPtr == NULL) {
-	    return 0;
-	}
-	firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
-	secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
-	if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
-	    return 1;
-	}
-	/* 
-	 * Try the most thorough, correct method of comparing fully
-	 * normalized paths
-	 */
-
-	tempErrno = Tcl_GetErrno();
-	firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
-	secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
-	Tcl_SetErrno(tempErrno);
-
-	if (firstPtr == NULL || secondPtr == NULL) {
-	    return 0;
-	}
-	firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
-	secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
-	if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
-	    return 1;
-	}
-    }
-
-    return 0;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * SetFsPathFromAny --
- *
- *      This function tries to convert the given Tcl_Obj to a valid
- *      Tcl path type.
- *      
- *      The filename may begin with "~" (to indicate current user's
- *      home directory) or "~<user>" (to indicate any user's home
- *      directory).
- *
- * Results:
- *      Standard Tcl error code.
- *
- * Side effects:
- *	The old representation may be freed, and new memory allocated.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-SetFsPathFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object to convert. */
-{
-    int len;
-    FsPath *fsPathPtr;
-    Tcl_Obj *transPtr;
-    char *name;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    
-    if (objPtr->typePtr == &tclFsPathType) {
-	return TCL_OK;
-    }
-    
-    /* 
-     * First step is to translate the filename.  This is similar to
-     * Tcl_TranslateFilename, but shouldn't convert everything to
-     * windows backslashes on that platform.  The current
-     * implementation of this piece is a slightly optimised version
-     * of the various Tilde/Split/Join stuff to avoid multiple
-     * split/join operations.
-     * 
-     * We remove any trailing directory separator.
-     * 
-     * However, the split/join routines are quite complex, and
-     * one has to make sure not to break anything on Unix, Win
-     * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
-     * most of the code).
-     */
-    name = Tcl_GetStringFromObj(objPtr,&len);
-
-    /*
-     * Handle tilde substitutions, if needed.
-     */
-    if (name[0] == '~') {
-	char *expandedUser;
-	Tcl_DString temp;
-	int split;
-	char separator='/';
-	
-	split = FindSplitPos(name, &separator);
-	if (split != len) {
-	    /* We have multiple pieces '~user/foo/bar...' */
-	    name[split] = '\0';
-	}
-	/* Do some tilde substitution */
-	if (name[1] == '\0') {
-	    /* We have just '~' */
-	    CONST char *dir;
-	    Tcl_DString dirString;
-	    if (split != len) { name[split] = separator; }
-	    
-	    dir = TclGetEnv("HOME", &dirString);
-	    if (dir == NULL) {
-		if (interp) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendResult(interp, "couldn't find HOME environment ",
-			    "variable to expand path", (char *) NULL);
-		}
-		return TCL_ERROR;
-	    }
-	    Tcl_DStringInit(&temp);
-	    Tcl_JoinPath(1, &dir, &temp);
-	    Tcl_DStringFree(&dirString);
-	} else {
-	    /* We have a user name '~user' */
-	    Tcl_DStringInit(&temp);
-	    if (TclpGetUserHome(name+1, &temp) == NULL) {	
-		if (interp != NULL) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendResult(interp, "user \"", (name+1), 
-				     "\" doesn't exist", (char *) NULL);
-		}
-		Tcl_DStringFree(&temp);
-		if (split != len) { name[split] = separator; }
-		return TCL_ERROR;
-	    }
-	    if (split != len) { name[split] = separator; }
-	}
-	
-	expandedUser = Tcl_DStringValue(&temp);
-	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
-
-	if (split != len) {
-	    /* Join up the tilde substitution with the rest */
-	    if (name[split+1] == separator) {
-
-		/*
-		 * Somewhat tricky case like ~//foo/bar.
-		 * Make use of Split/Join machinery to get it right.
-		 * Assumes all paths beginning with ~ are part of the
-		 * native filesystem.
-		 */
-
-		int objc;
-		Tcl_Obj **objv;
-		Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
-		Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
-		/* Skip '~'.  It's replaced by its expansion */
-		objc--; objv++;
-		while (objc--) {
-		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
-		}
-		Tcl_DecrRefCount(parts);
-	    } else {
-		/* Simple case. "rest" is relative path.  Just join it. */
-		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
-		transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
-	    }
-	}
-	Tcl_DStringFree(&temp);
-    } else {
-	transPtr = Tcl_FSJoinToPath(objPtr,0,NULL);
-    }
-
-    /* 
-     * Now we have a translated filename in 'transPtr'.  This will have
-     * forward slashes on Windows, and will not contain any ~user
-     * sequences.
-     */
-    
-    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
-
-    fsPathPtr->translatedPathPtr = transPtr;
-    Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
-    fsPathPtr->normPathPtr = NULL;
-    fsPathPtr->cwdPtr = NULL;
-    fsPathPtr->nativePathPtr = NULL;
-    fsPathPtr->fsRecPtr = NULL;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    /*
-     * Free old representation before installing our new one.
-     */
-    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
-	(objPtr->typePtr->freeIntRepProc)(objPtr);
-    }
-    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
-    PATHFLAGS(objPtr) = 0;
-    objPtr->typePtr = &tclFsPathType;
-
-    return TCL_OK;
-}
-
-static void
-FreeFsPathInternalRep(pathObjPtr)
-    Tcl_Obj *pathObjPtr;	/* Path object with internal rep to free. */
-{
-    FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
-
-    if (fsPathPtr->translatedPathPtr != NULL) {
-	if (fsPathPtr->translatedPathPtr != pathObjPtr) {
-	    Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
-	}
-    }
-    if (fsPathPtr->normPathPtr != NULL) {
-	if (fsPathPtr->normPathPtr != pathObjPtr) {
-	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
-	}
-	fsPathPtr->normPathPtr = NULL;
-    }
-    if (fsPathPtr->cwdPtr != NULL) {
-	Tcl_DecrRefCount(fsPathPtr->cwdPtr);
-    }
-    if (fsPathPtr->nativePathPtr != NULL) {
-	if (fsPathPtr->fsRecPtr != NULL) {
-	    if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
-		(*fsPathPtr->fsRecPtr->fsPtr
-		   ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
-		fsPathPtr->nativePathPtr = NULL;
-	    }
-	}
-    }
-    if (fsPathPtr->fsRecPtr != NULL) {
-	fsPathPtr->fsRecPtr->fileRefCount--;
-	if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
-	    /* It has been unregistered already, so simply free it */
-	    ckfree((char *)fsPathPtr->fsRecPtr);
-	}
-    }
-
-    ckfree((char*) fsPathPtr);
-}
-
-
-static void
-DupFsPathInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Path obj with internal rep to copy. */
-    Tcl_Obj *copyPtr;		/* Path obj with internal rep to set. */
-{
-    FsPath *srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr);
-    FsPath *copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath));
-      
-    Tcl_FSDupInternalRepProc *dupProc;
-    
-    PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr;
-
-    if (srcFsPathPtr->translatedPathPtr != NULL) {
-	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
-	if (copyFsPathPtr->translatedPathPtr != copyPtr) {
-	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
-	}
-    } else {
-	copyFsPathPtr->translatedPathPtr = NULL;
-    }
-    
-    if (srcFsPathPtr->normPathPtr != NULL) {
-	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
-	if (copyFsPathPtr->normPathPtr != copyPtr) {
-	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
-	}
-    } else {
-	copyFsPathPtr->normPathPtr = NULL;
-    }
-    
-    if (srcFsPathPtr->cwdPtr != NULL) {
-	copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
-	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
-    } else {
-	copyFsPathPtr->cwdPtr = NULL;
-    }
-
-    copyFsPathPtr->flags = srcFsPathPtr->flags;
-    
-    if (srcFsPathPtr->fsRecPtr != NULL 
-      && srcFsPathPtr->nativePathPtr != NULL) {
-	dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
-	if (dupProc != NULL) {
-	    copyFsPathPtr->nativePathPtr = 
-	      (*dupProc)(srcFsPathPtr->nativePathPtr);
-	} else {
-	    copyFsPathPtr->nativePathPtr = NULL;
-	}
-    } else {
-	copyFsPathPtr->nativePathPtr = NULL;
-    }
-    copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
-    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
-    if (copyFsPathPtr->fsRecPtr != NULL) {
-	copyFsPathPtr->fsRecPtr->fileRefCount++;
-    }
-
-    copyPtr->typePtr = &tclFsPathType;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * UpdateStringOfFsPath --
- *
- *      Gives an object a valid string rep.
- *      
- * Results:
- *      None.
- *
- * Side effects:
- *	Memory may be allocated.
- *
- *---------------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfFsPath(objPtr)
-    register Tcl_Obj *objPtr;	/* path obj with string rep to update. */
-{
-    FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
-    CONST char *cwdStr;
-    int cwdLen;
-    Tcl_Obj *copy;
-    
-    if (PATHFLAGS(objPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
-	panic("Called UpdateStringOfFsPath with invalid object");
-    }
-    
-    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
-    Tcl_IncrRefCount(copy);
-    
-    cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
-    /* 
-     * Should we perhaps use 'Tcl_FSPathSeparator'?
-     * But then what about the Windows special case?
-     * Perhaps we should just check if cwd is a root volume.
-     * We should never get cwdLen == 0 in this code path.
-     */
-    switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    if (cwdStr[cwdLen-1] != '/') {
-		Tcl_AppendToObj(copy, "/", 1);
-		cwdLen++;
-	    }
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    /* 
-	     * We need the extra 'cwdLen != 2', and ':' checks because 
-	     * a volume relative path doesn't get a '/'.  For example 
-	     * 'glob C:*cat*.exe' will return 'C:cat32.exe'
-	     */
-	    if (cwdStr[cwdLen-1] != '/'
-		    && cwdStr[cwdLen-1] != '\\') {
-		if (cwdLen != 2 || cwdStr[1] != ':') {
-		    Tcl_AppendToObj(copy, "/", 1);
-		    cwdLen++;
-		}
-	    }
-	    break;
-    }
-    Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
-    objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
-    objPtr->length = cwdLen;
-    copy->bytes = tclEmptyStringRep;
-    copy->length = 0;
-    Tcl_DecrRefCount(copy);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * NativePathInFilesystem --
- *
- *      Any path object is acceptable to the native filesystem, by
- *      default (we will throw errors when illegal paths are actually
- *      tried to be used).
- *      
- *      However, this behavior means the native filesystem must be
- *      the last filesystem in the lookup list (otherwise it will
- *      claim all files belong to it, and other filesystems will
- *      never get a look in).
- *
- * Results:
- *      TCL_OK, to indicate 'yes', -1 to indicate no.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-static int 
-NativePathInFilesystem(pathPtr, clientDataPtr)
-    Tcl_Obj *pathPtr;
-    ClientData *clientDataPtr;
-{
-    /* 
-     * A special case is required to handle the empty path "". 
-     * This is a valid path (i.e. the user should be able
-     * to do 'file exists ""' without throwing an error), but
-     * equally the path doesn't exist.  Those are the semantics
-     * of Tcl (at present anyway), so we have to abide by them
-     * here.
-     */
-    if (pathPtr->typePtr == &tclFsPathType) {
-	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
-	    /* We reject the empty path "" */
-	    return -1;
-	}
-	/* Otherwise there is no way this path can be empty */
-    } else {
-	/* 
-	 * It is somewhat unusual to reach this code path without
-	 * the object being of tclFsPathType.  However, we do
-	 * our best to deal with the situation.
-	 */
-	int len;
-	Tcl_GetStringFromObj(pathPtr,&len);
-	if (len == 0) {
-	    /* We reject the empty path "" */
-	    return -1;
-	}
-    }
-    /* 
-     * Path is of correct type, or is of non-zero length, 
-     * so we accept it.
-     */
-    return TCL_OK;
-}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 0103cdb..6a818f2 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1,36 +1,33 @@
-/* 
+/*
  * tclIndexObj.c --
  *
- *	This file implements objects of type "index".  This object type
- *	is used to lookup a keyword in a table of valid values and cache
- *	the index of the matching entry.
+ *	This file implements objects of type "index". This object type is used
+ *	to lookup a keyword in a table of valid values and cache the index of
+ *	the matching entry.
  *
  * Copyright (c) 1997 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
  */
 
-static int		SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static void		UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void		DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *dupPtr));
-static void		FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int		SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfIndex(Tcl_Obj *objPtr);
+static void		DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void		FreeIndex(Tcl_Obj *objPtr);
 
 /*
- * The structure below defines the index Tcl object type by means of
- * procedures that can be invoked by generic object code.
+ * The structure below defines the index Tcl object type by means of functions
+ * that can be invoked by generic object code.
  */
 
-Tcl_ObjType tclIndexType = {
+static Tcl_ObjType indexType = {
     "index",				/* name */
     FreeIndex,				/* freeIntRepProc */
     DupIndex,				/* dupIntRepProc */
@@ -39,15 +36,15 @@ Tcl_ObjType tclIndexType = {
 };
 
 /*
- * The definition of the internal representation of the "index"
- * object; The internalRep.otherValuePtr field of an object of "index"
- * type will be a pointer to one of these structures.
+ * The definition of the internal representation of the "index" object; The
+ * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
+ * pointer to one of these structures.
  *
  * Keep this structure declaration in sync with tclTestObj.c
  */
 
 typedef struct {
-    VOID *tablePtr;			/* Pointer to the table of strings */
+    void *tablePtr;			/* Pointer to the table of strings */
     int offset;				/* Offset between table entries */
     int index;				/* Selected index into table. */
 } IndexRep;
@@ -55,68 +52,68 @@ typedef struct {
 /*
  * The following macros greatly simplify moving through a table...
  */
-#define STRING_AT(table, offset, index) \
-	(*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
+
+#define STRING_AT(table, offset) \
+	(*((const char *const *)(((char *)(table)) + (offset))))
 #define NEXT_ENTRY(table, offset) \
-	(&(STRING_AT(table, offset, 1)))
+	(&(STRING_AT(table, offset)))
 #define EXPAND_OF(indexRep) \
-	STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
-
+	STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_GetIndexFromObj --
  *
- *	This procedure looks up an object's value in a table of strings
- *	and returns the index of the matching string, if any.
+ *	This function looks up an object's value in a table of strings and
+ *	returns the index of the matching string, if any.
  *
  * Results:
- *
- *	If the value of objPtr is identical to or a unique abbreviation
- *	for one of the entries in objPtr, then the return value is
- *	TCL_OK and the index of the matching entry is stored at
- *	*indexPtr.  If there isn't a proper match, then TCL_ERROR is
- *	returned and an error message is left in interp's result (unless
- *	interp is NULL).  The msg argument is used in the error
- *	message; for example, if msg has the value "option" then the
- *	error message will say something flag 'bad option "foo": must be
+ *	If the value of objPtr is identical to or a unique abbreviation for
+ *	one of the entries in objPtr, then the return value is TCL_OK and the
+ *	index of the matching entry is stored at *indexPtr. If there isn't a
+ *	proper match, then TCL_ERROR is returned and an error message is left
+ *	in interp's result (unless interp is NULL). The msg argument is used
+ *	in the error message; for example, if msg has the value "option" then
+ *	the error message will say something flag 'bad option "foo": must be
  *	...'
  *
  * Side effects:
- *	The result of the lookup is cached as the internal rep of
- *	objPtr, so that repeated lookups can be done quickly.
+ *	The result of the lookup is cached as the internal rep of objPtr, so
+ *	that repeated lookups can be done quickly.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* Object containing the string to lookup. */
-    CONST char **tablePtr;	/* Array of strings to compare against the
+Tcl_GetIndexFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
+    const char **tablePtr,	/* Array of strings to compare against the
 				 * value of objPtr; last entry must be NULL
 				 * and there must not be duplicate entries. */
-    CONST char *msg;		/* Identifying word to use in error messages. */
-    int flags;			/* 0 or TCL_EXACT */
-    int *indexPtr;		/* Place to store resulting integer index. */
+    const char *msg,		/* Identifying word to use in error
+				 * messages. */
+    int flags,			/* 0 or TCL_EXACT */
+    int *indexPtr)		/* Place to store resulting integer index. */
 {
 
     /*
-     * See if there is a valid cached result from a previous lookup
-     * (doing the check here saves the overhead of calling
-     * Tcl_GetIndexFromObjStruct in the common case where the result
-     * is cached).
+     * See if there is a valid cached result from a previous lookup (doing the
+     * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
+     * the common case where the result is cached).
      */
 
-    if (objPtr->typePtr == &tclIndexType) {
-	IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+    if (objPtr->typePtr == &indexType) {
+	IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+
 	/*
-	 * Here's hoping we don't get hit by unfortunate packing
-	 * constraints on odd platforms like a Cray PVP...
+	 * Here's hoping we don't get hit by unfortunate packing constraints
+	 * on odd platforms like a Cray PVP...
 	 */
-	if (indexRep->tablePtr == (VOID *)tablePtr &&
-		indexRep->offset == sizeof(char *)) {
+
+	if (indexRep->tablePtr == (void *) tablePtr
+		&& indexRep->offset == sizeof(char *)) {
 	    *indexPtr = indexRep->index;
 	    return TCL_OK;
 	}
@@ -130,49 +127,46 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
  *
  * Tcl_GetIndexFromObjStruct --
  *
- *	This procedure looks up an object's value given a starting
- *	string and an offset for the amount of space between strings.
- *	This is useful when the strings are embedded in some other
- *	kind of array.
+ *	This function looks up an object's value given a starting string and
+ *	an offset for the amount of space between strings. This is useful when
+ *	the strings are embedded in some other kind of array.
  *
  * Results:
- *
- *	If the value of objPtr is identical to or a unique abbreviation
- *	for one of the entries in objPtr, then the return value is
- *	TCL_OK and the index of the matching entry is stored at
- *	*indexPtr.  If there isn't a proper match, then TCL_ERROR is
- *	returned and an error message is left in interp's result (unless
- *	interp is NULL).  The msg argument is used in the error
- *	message; for example, if msg has the value "option" then the
- *	error message will say something like 'bad option "foo": must be
+ *	If the value of objPtr is identical to or a unique abbreviation for
+ *	one of the entries in objPtr, then the return value is TCL_OK and the
+ *	index of the matching entry is stored at *indexPtr. If there isn't a
+ *	proper match, then TCL_ERROR is returned and an error message is left
+ *	in interp's result (unless interp is NULL). The msg argument is used
+ *	in the error message; for example, if msg has the value "option" then
+ *	the error message will say something like 'bad option "foo": must be
  *	...'
  *
  * Side effects:
- *	The result of the lookup is cached as the internal rep of
- *	objPtr, so that repeated lookups can be done quickly.
+ *	The result of the lookup is cached as the internal rep of objPtr, so
+ *	that repeated lookups can be done quickly.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, 
-	indexPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* Object containing the string to lookup. */
-    CONST VOID *tablePtr;	/* The first string in the table. The second
+Tcl_GetIndexFromObjStruct(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
+    const void *tablePtr,	/* The first string in the table. The second
 				 * string will be at this address plus the
 				 * offset, the third plus the offset again,
-				 * etc. The last entry must be NULL
-				 * and there must not be duplicate entries. */
-    int offset;			/* The number of bytes between entries */
-    CONST char *msg;		/* Identifying word to use in error messages. */
-    int flags;			/* 0 or TCL_EXACT */
-    int *indexPtr;		/* Place to store resulting integer index. */
+				 * etc. The last entry must be NULL and there
+				 * must not be duplicate entries. */
+    int offset,			/* The number of bytes between entries */
+    const char *msg,		/* Identifying word to use in error
+				 * messages. */
+    int flags,			/* 0 or TCL_EXACT */
+    int *indexPtr)		/* Place to store resulting integer index. */
 {
-    int index, i, numAbbrev;
+    int index, idx, numAbbrev;
     char *key, *p1;
-    CONST char *p2;
-    CONST char * CONST *entryPtr;
+    const char *p2;
+    const char *const *entryPtr;
     Tcl_Obj *resultPtr;
     IndexRep *indexRep;
 
@@ -184,8 +178,8 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
      * See if there is a valid cached result from a previous lookup.
      */
 
-    if (objPtr->typePtr == &tclIndexType) {
-	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+    if (objPtr->typePtr == &indexType) {
+	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
 	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
 	    *indexPtr = indexRep->index;
 	    return TCL_OK;
@@ -193,7 +187,7 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
     }
 
     /*
-     * Lookup the value of the object in the table.  Accept unique
+     * Lookup the value of the object in the table. Accept unique
      * abbreviations unless TCL_EXACT is set in flags.
      */
 
@@ -207,63 +201,65 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
      *  - A single abbreviation (allowed depending on flags)
      *  - Several abbreviations (never allowed, but overridden by exact match)
      */
-    for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; 
-	    entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
+
+    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
+	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
 	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
 	    if (*p1 == '\0') {
-		index = i;
+		index = idx;
 		goto done;
 	    }
 	}
 	if (*p1 == '\0') {
 	    /*
-	     * The value is an abbreviation for this entry.  Continue
-	     * checking other entries to make sure it's unique.  If we
-	     * get more than one unique abbreviation, keep searching to
-	     * see if there is an exact match, but remember the number
-	     * of unique abbreviations and don't allow either.
+	     * The value is an abbreviation for this entry. Continue checking
+	     * other entries to make sure it's unique. If we get more than one
+	     * unique abbreviation, keep searching to see if there is an exact
+	     * match, but remember the number of unique abbreviations and
+	     * don't allow either.
 	     */
 
 	    numAbbrev++;
-	    index = i;
+	    index = idx;
 	}
     }
+
     /*
-     * Check if we were instructed to disallow abbreviations. 
+     * Check if we were instructed to disallow abbreviations.
      */
+
     if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) {
 	goto error;
     }
 
-    done:
+  done:
     /*
-     * Cache the found representation.  Note that we want to avoid
-     * allocating a new internal-rep if at all possible since that is
-     * potentially a slow operation.
+     * Cache the found representation. Note that we want to avoid allocating a
+     * new internal-rep if at all possible since that is potentially a slow
+     * operation.
      */
-    if (objPtr->typePtr == &tclIndexType) {
- 	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+
+    if (objPtr->typePtr == &indexType) {
+ 	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
     } else {
- 	if ((objPtr->typePtr != NULL)
-		&& (objPtr->typePtr->freeIntRepProc != NULL)) {
- 	    objPtr->typePtr->freeIntRepProc(objPtr);
- 	}
+	TclFreeIntRep(objPtr);
  	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- 	objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
- 	objPtr->typePtr = &tclIndexType;
+ 	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
+ 	objPtr->typePtr = &indexType;
     }
-    indexRep->tablePtr = (VOID*) tablePtr;
+    indexRep->tablePtr = (void *) tablePtr;
     indexRep->offset = offset;
     indexRep->index = index;
 
     *indexPtr = index;
     return TCL_OK;
 
-    error:
+  error:
     if (interp != NULL) {
 	/*
 	 * Produce a fancy error message.
 	 */
+
 	int count = 0;
 
 	TclNewObj(resultPtr);
@@ -273,21 +269,20 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
 	    entryPtr = NEXT_ENTRY(entryPtr, offset);
 	}
 	Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
-		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"",
-		key, "\": must be ", *entryPtr, (char*)NULL);
+		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key,
+		"\": must be ", *entryPtr, NULL);
 	entryPtr = NEXT_ENTRY(entryPtr, offset);
 	while (*entryPtr != NULL) {
 	    if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
-		Tcl_AppendStringsToObj(resultPtr,
-			(count > 0) ? ", or " : " or ", *entryPtr,
-			(char *) NULL);
+		Tcl_AppendStringsToObj(resultPtr, ((count > 0) ? "," : ""),
+			" or ", *entryPtr, NULL);
 	    } else if (**entryPtr) {
-		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
-			(char *) NULL);
+		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
 		count++;
 	    }
 	    entryPtr = NEXT_ENTRY(entryPtr, offset);
 	}
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
     }
     return TCL_ERROR;
 }
@@ -297,14 +292,14 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
  *
  * SetIndexFromAny --
  *
- *	This procedure is called to convert a Tcl object to index
- *	internal form. However, this doesn't make sense (need to have a
- *	table of keywords in order to do the conversion) so the
- *	procedure always generates an error.
+ *	This function is called to convert a Tcl object to index internal
+ *	form. However, this doesn't make sense (need to have a table of
+ *	keywords in order to do the conversion) so the function always
+ *	generates an error.
  *
  * Results:
- *	The return value is always TCL_ERROR, and an error message is
- *	left in interp's result if interp isn't NULL. 
+ *	The return value is always TCL_ERROR, and an error message is left in
+ *	interp's result if interp isn't NULL.
  *
  * Side effects:
  *	None.
@@ -313,14 +308,14 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
  */
 
 static int
-SetIndexFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
+SetIndexFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     if (interp) {
-    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 	    "can't convert value to index except via Tcl_GetIndexFromObj API",
-	    -1);
+	    -1));
     }
     return TCL_ERROR;
 }
@@ -330,9 +325,8 @@ SetIndexFromAny(interp, objPtr)
  *
  * UpdateStringOfIndex --
  *
- *	This procedure is called to convert a Tcl object from index
- *	internal form to its string form.  No abbreviation is ever
- *	generated.
+ *	This function is called to convert a Tcl object from index internal
+ *	form to its string form. No abbreviation is ever generated.
  *
  * Results:
  *	None.
@@ -344,13 +338,13 @@ SetIndexFromAny(interp, objPtr)
  */
 
 static void
-UpdateStringOfIndex(objPtr)
-    Tcl_Obj *objPtr;
+UpdateStringOfIndex(
+    Tcl_Obj *objPtr)
 {
-    IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+    IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
     register char *buf;
     register unsigned len;
-    register CONST char *indexStr = EXPAND_OF(indexRep);
+    register const char *indexStr = EXPAND_OF(indexRep);
 
     len = strlen(indexStr);
     buf = (char *) ckalloc(len + 1);
@@ -364,29 +358,30 @@ UpdateStringOfIndex(objPtr)
  *
  * DupIndex --
  *
- *	This procedure is called to copy the internal rep of an index
- *	Tcl object from to another object.
+ *	This function is called to copy the internal rep of an index Tcl
+ *	object from to another object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The internal representation of the target object is updated
- *	and the type is set.
+ *	The internal representation of the target object is updated and the
+ *	type is set.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DupIndex(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr, *dupPtr;
+DupIndex(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dupPtr)
 {
-    IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
+    IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
     IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
 
     memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
-    dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
-    dupPtr->typePtr = &tclIndexType;
+    dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
+    dupPtr->typePtr = &indexType;
 }
 
 /*
@@ -394,8 +389,8 @@ DupIndex(srcPtr, dupPtr)
  *
  * FreeIndex --
  *
- *	This procedure is called to delete the internal rep of an index
- *	Tcl object.
+ *	This function is called to delete the internal rep of an index Tcl
+ *	object.
  *
  * Results:
  *	None.
@@ -407,10 +402,11 @@ DupIndex(srcPtr, dupPtr)
  */
 
 static void
-FreeIndex(objPtr)
-    Tcl_Obj *objPtr;
+FreeIndex(
+    Tcl_Obj *objPtr)
 {
-    ckfree((char *) objPtr->internalRep.otherValuePtr);
+    ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -418,70 +414,241 @@ FreeIndex(objPtr)
  *
  * Tcl_WrongNumArgs --
  *
- *	This procedure generates a "wrong # args" error message in an
- *	interpreter.  It is used as a utility function by many command
- *	procedures.
+ *	This function generates a "wrong # args" error message in an
+ *	interpreter. It is used as a utility function by many command
+ *	functions, including the function that implements procedures.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	An error message is generated in interp's result object to
- *	indicate that a command was invoked with the wrong number of
- *	arguments.  The message has the form
+ *	An error message is generated in interp's result object to indicate
+ *	that a command was invoked with the wrong number of arguments. The
+ *	message has the form
  *		wrong # args: should be "foo bar additional stuff"
- *	where "foo" and "bar" are the initial objects in objv (objc
- *	determines how many of these are printed) and "additional stuff"
- *	is the contents of the message argument.
+ *	where "foo" and "bar" are the initial objects in objv (objc determines
+ *	how many of these are printed) and "additional stuff" is the contents
+ *	of the message argument.
+ *
+ *	The message printed is modified somewhat if the command is wrapped
+ *	inside an ensemble. In that case, the error message generated is
+ *	rewritten in such a way that it appears to be generated from the
+ *	user-visible command and not how that command is actually implemented,
+ *	giving a better overall user experience.
+ *
+ *	Internally, the Tcl core may set the flag INTERP_ALTERNATE_WRONG_ARGS
+ *	in the interpreter to generate complex multi-part messages by calling
+ *	this function repeatedly. This allows the code that knows how to
+ *	handle ensemble-related error messages to be kept here while still
+ *	generating suitable error messages for commands like [read] and
+ *	[socket]. Ideally, this would be done through an extra flags argument,
+ *	but that wouldn't be source-compatible with the existing API and it's
+ *	a fairly rare requirement anyway.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_WrongNumArgs(interp, objc, objv, message)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments to print
-					 * from objv. */
-    Tcl_Obj *CONST objv[];		/* Initial argument objects, which
-					 * should be included in the error
-					 * message. */
-    CONST char *message;		/* Error message to print after the
-					 * leading objects in objv. The
-					 * message may be NULL. */
+Tcl_WrongNumArgs(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments to print from objv. */
+    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
+				 * included in the error message. */
+    const char *message)	/* Error message to print after the leading
+				 * objects in objv. The message may be
+				 * NULL. */
 {
     Tcl_Obj *objPtr;
-    int i;
-    register IndexRep *indexRep;
+    int i, len, elemLen, flags;
+    Interp *iPtr = (Interp *) interp;
+    const char *elementStr;
+
+    /*
+     * [incr Tcl] does something fairly horrific when generating error
+     * messages for its ensembles; it passes the whole set of ensemble
+     * arguments as a list in the first argument. This means that this code
+     * causes a problem in iTcl if it attempts to correctly quote all
+     * arguments, which would be the correct thing to do. We work around this
+     * nasty behaviour for now, and hope that we can remove it all in the
+     * future...
+     */
+
+#ifndef AVOID_HACKS_FOR_ITCL
+    int isFirst = 1;		/* Special flag used to inhibit the treating
+				 * of the first word as a list element so the
+				 * hacky way Itcl generates error messages for
+				 * its ensembles will still work. [Bug
+				 * 1066837] */
+#   define MAY_QUOTE_WORD	(!isFirst)
+#   define AFTER_FIRST_WORD	(isFirst = 0)
+#else /* !AVOID_HACKS_FOR_ITCL */
+#   define MAY_QUOTE_WORD	1
+#   define AFTER_FIRST_WORD	(void) 0
+#endif /* AVOID_HACKS_FOR_ITCL */
 
     TclNewObj(objPtr);
-    Tcl_SetObjResult(interp, objPtr);
-    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
+	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
+	Tcl_AppendToObj(objPtr, " or \"", -1);
+    } else {
+	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    }
+
+    /*
+     * Check to see if we are processing an ensemble implementation, and if so
+     * rewrite the results in terms of how the ensemble was invoked.
+     */
+
+    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
+	int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
+	int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
+	Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
+
+	/*
+	 * We only know how to do rewriting if all the replaced objects are
+	 * actually arguments (in objv) to this function. Otherwise it just
+	 * gets too complicated and we'd be better off just giving a slightly
+	 * confusing error message...
+	 */
+
+	if (objc < toSkip) {
+	    goto addNormalArgumentsToMessage;
+	}
+
+	/*
+	 * Strip out the actual arguments that the ensemble inserted.
+	 */
+
+	objv += toSkip;
+	objc -= toSkip;
+
+	/*
+	 * We assume no object is of index type.
+	 */
+
+	for (i=0 ; i<toPrint ; i++) {
+	    /*
+	     * Add the element, quoting it if necessary.
+	     */
+
+	    if (origObjv[i]->typePtr == &indexType) {
+		register IndexRep *indexRep =
+			origObjv[i]->internalRep.twoPtrValue.ptr1;
+
+		elementStr = EXPAND_OF(indexRep);
+		elemLen = strlen(elementStr);
+	    } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
+		register EnsembleCmdRep *ecrPtr =
+			origObjv[i]->internalRep.twoPtrValue.ptr1;
+
+		elementStr = ecrPtr->fullSubcmdName;
+		elemLen = strlen(elementStr);
+	    } else {
+		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
+	    }
+	    flags = 0;
+	    len = TclScanElement(elementStr, elemLen, &flags);
+
+	    if (MAY_QUOTE_WORD && len != elemLen) {
+		char *quotedElementStr = TclStackAlloc(interp,
+			(unsigned)len + 1);
+
+		len = TclConvertElement(elementStr, elemLen,
+			quotedElementStr, flags);
+		Tcl_AppendToObj(objPtr, quotedElementStr, len);
+		TclStackFree(interp, quotedElementStr);
+	    } else {
+		Tcl_AppendToObj(objPtr, elementStr, elemLen);
+	    }
+
+	    AFTER_FIRST_WORD;
+
+	    /*
+	     * Add a space if the word is not the last one (which has a
+	     * moderately complex condition here).
+	     */
+
+	    if (i<toPrint-1 || objc!=0 || message!=NULL) {
+		Tcl_AppendStringsToObj(objPtr, " ", NULL);
+	    }
+	}
+    }
+
+    /*
+     * Now add the arguments (other than those rewritten) that the caller took
+     * from its calling context.
+     */
+
+  addNormalArgumentsToMessage:
     for (i = 0; i < objc; i++) {
 	/*
-	 * If the object is an index type use the index table which allows
-	 * for the correct error message even if the subcommand was
-	 * abbreviated.  Otherwise, just use the string rep.
+	 * If the object is an index type use the index table which allows for
+	 * the correct error message even if the subcommand was abbreviated.
+	 * Otherwise, just use the string rep.
 	 */
-	
-	if (objv[i]->typePtr == &tclIndexType) {
-	    indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
-	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
+
+	if (objv[i]->typePtr == &indexType) {
+	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+
+	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
+	} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
+	    register EnsembleCmdRep *ecrPtr =
+		    objv[i]->internalRep.twoPtrValue.ptr1;
+
+	    Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
 	} else {
-	    Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
-		    (char *) NULL);
+	    /*
+	     * Quote the argument if it contains spaces (Bug 942757).
+	     */
+
+	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
+	    flags = 0;
+	    len = TclScanElement(elementStr, elemLen, &flags);
+
+	    if (MAY_QUOTE_WORD && len != elemLen) {
+		char *quotedElementStr = TclStackAlloc(interp,
+			(unsigned) len + 1);
+
+		len = TclConvertElement(elementStr, elemLen,
+			quotedElementStr, flags);
+		Tcl_AppendToObj(objPtr, quotedElementStr, len);
+		TclStackFree(interp, quotedElementStr);
+	    } else {
+		Tcl_AppendToObj(objPtr, elementStr, elemLen);
+	    }
 	}
 
+	AFTER_FIRST_WORD;
+
 	/*
 	 * Append a space character (" ") if there is more text to follow
 	 * (either another element from objv, or the message string).
 	 */
-	if ((i < (objc - 1)) || message) {
-	    Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+
+	if (i<objc-1 || message!=NULL) {
+	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
 	}
     }
 
-    if (message) {
-	Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
+    /*
+     * Add any trailing message bits and set the resulting string as the
+     * interpreter result. Caller is responsible for reporting this as an
+     * actual error.
+     */
+
+    if (message != NULL) {
+	Tcl_AppendStringsToObj(objPtr, message, NULL);
     }
-    Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+    Tcl_AppendStringsToObj(objPtr, "\"", NULL);
+    Tcl_SetObjResult(interp, objPtr);
+#undef MAY_QUOTE_WORD
+#undef AFTER_FIRST_WORD
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
deleted file mode 100644
index a3a1d6a..0000000
--- a/generic/tclInitScript.h
+++ /dev/null
@@ -1,110 +0,0 @@
-/* 
- * tclInitScript.h --
- *
- *	This file contains Unix & Windows common init script
- *      It is not used on the Mac. (the mac init script is in tclMacInit.c)
- *
- * Copyright (c) 1998 Sun Microsystems, Inc.
- * Copyright (c) 1999 by Scriptics Corporation.
- * All rights reserved.
- */
-
-/*
- * In order to find init.tcl during initialization, the following script
- * is invoked by Tcl_Init().  It looks in several different directories:
- *
- *	$tcl_library		- can specify a primary location, if set
- *				  no other locations will be checked
- *
- *	$env(TCL_LIBRARY)	- highest priority so user can always override
- *				  the search path unless the application has
- *				  specified an exact directory above
- *
- *	$tclDefaultLibrary	- this value is initialized by TclPlatformInit
- *				  from a static C variable that was set at
- *				  compile time
- *
- *	$tcl_libPath		- this value is initialized by a call to
- *				  TclGetLibraryPath called from Tcl_Init.
- *
- * The first directory on this path that contains a valid init.tcl script
- * will be set as the value of tcl_library.
- *
- * Note that this entire search mechanism can be bypassed by defining an
- * alternate tclInit procedure before calling Tcl_Init().
- */
-
-static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
-  proc tclInit {} {\n\
-    global tcl_libPath tcl_library errorInfo\n\
-    global env tclDefaultLibrary\n\
-    rename tclInit {}\n\
-    set errors {}\n\
-    set dirs {}\n\
-    if {[info exists tcl_library]} {\n\
-	lappend dirs $tcl_library\n\
-    } else {\n\
-	if {[info exists env(TCL_LIBRARY)]} {\n\
-	    lappend dirs $env(TCL_LIBRARY)\n\
-	}\n\
-	catch {\n\
-	    lappend dirs $tclDefaultLibrary\n\
-	    unset tclDefaultLibrary\n\
-	}\n\
-        set dirs [concat $dirs $tcl_libPath]\n\
-    }\n\
-    foreach i $dirs {\n\
-	set tcl_library $i\n\
-	set tclfile [file join $i init.tcl]\n\
-	if {[file exists $tclfile]} {\n\
-	    if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
-		return\n\
-	    } else {\n\
-		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
-	    }\n\
-	}\n\
-    }\n\
-    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
-    append msg \"    $dirs\n\n\"\n\
-    append msg \"$errors\n\n\"\n\
-    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
-    error $msg\n\
-  }\n\
-}\n\
-tclInit";
-
-
-/*
- * A pointer to a string that holds an initialization script that if non-NULL
- * is evaluated in Tcl_Init() prior to the the built-in initialization script
- * above.  This variable can be modified by the procedure below.
- */
- 
-static char *          tclPreInitScript = NULL;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetPreInitScript --
- *
- *	This routine is used to change the value of the internal
- *	variable, tclPreInitScript.
- *
- * Results:
- *	Returns the current value of tclPreInitScript.
- *
- * Side effects:
- *	Changes the way Tcl_Init() routine behaves.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclSetPreInitScript (string)
-    char *string;		/* Pointer to a script. */
-{
-    char *prevString = tclPreInitScript;
-    tclPreInitScript = string;
-    return(prevString);
-}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 18d1bdf..102d04b 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -8,6 +8,7 @@
 #
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -27,12 +28,12 @@ interface tclInt
 #declare 0 {
 #    int TclAccess(const char *path, int mode)
 #}
-declare 1 {
-    int TclAccessDeleteProc(TclAccessProc_ *proc)
-}
-declare 2 {
-    int TclAccessInsertProc(TclAccessProc_ *proc)
-}
+#declare 1 {
+#    int TclAccessDeleteProc(TclAccessProc_ *proc)
+#}
+#declare 2 {
+#    int TclAccessInsertProc(TclAccessProc_ *proc)
+#}
 declare 3 {
     void TclAllocateFreeObjects(void)
 }
@@ -71,14 +72,15 @@ declare 11 {
     void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
 }
 declare 12 {
-    void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
-}
-declare 13 {
-    int TclDoGlob(Tcl_Interp *interp, char *separators,
-	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
+    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
 }
+# Removed in 8.5
+#declare 13 {
+#    int TclDoGlob(Tcl_Interp *interp, char *separators,
+#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
+#}
 declare 14 {
-    void TclDumpMemoryInfo(FILE *outFile)
+    int TclDumpMemoryInfo(ClientData clientData, int flags)
 }
 # Removed in 8.1:
 #  declare 15 {
@@ -87,7 +89,7 @@ declare 14 {
 declare 16 {
     void TclExprFloatError(Tcl_Interp *interp, double value)
 }
-# Removed in 8.4:
+# Removed in 8.4
 #declare 17 {
 #    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
 #}
@@ -111,6 +113,7 @@ declare 22 {
 declare 23 {
     Proc *TclFindProc(Interp *iPtr, const char *procName)
 }
+# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
 declare 24 {
     int TclFormatInt(char *buffer, long n)
 }
@@ -121,10 +124,11 @@ declare 25 {
 #  declare 26 {
 #      char *TclGetCwd(Tcl_Interp *interp)
 #  }
-declare 27 {
-    int TclGetDate(char *p, Tcl_WideInt now, long zone,
-	    Tcl_WideInt *timePtr)
-}
+# Removed in 8.5
+#declare 27 {
+#    int TclGetDate(char *p, unsigned long now, long zone,
+#	    unsigned long *timePtr)
+#}
 declare 28 {
     Tcl_Channel TclpGetDefaultStdChannel(int type)
 }
@@ -138,15 +142,16 @@ declare 28 {
 #      char *TclGetEnv(const char *name)
 #  }
 declare 31 {
-    char *TclGetExtension(char *name)
+    const char *TclGetExtension(const char *name)
 }
 declare 32 {
     int TclGetFrame(Tcl_Interp *interp, const char *str,
 	    CallFrame **framePtrPtr)
 }
-declare 33 {
-    TclCmdProcType TclGetInterpProc(void)
-}
+# Removed in Tcl 8.5
+#declare 33 {
+#    TclCmdProcType TclGetInterpProc(void)
+#}
 declare 34 {
     int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
 	    int endValue, int *indexPtr)
@@ -180,9 +185,11 @@ declare 41 {
 declare 42 {
     char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
 }
-declare 43 {
-    int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
-}
+# Removed in Tcl 8.5a2
+#declare 43 {
+#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
+#	    int flags)
+#}
 declare 44 {
     int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
 }
@@ -202,10 +209,10 @@ declare 46 {
 #    Tcl_Obj *TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex,
 #	    long incrAmount)
 #}
-declare 49 {
-    Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
-	    Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
-}
+#declare 49 {
+#    Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+#	    Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
+#}
 declare 50 {
     void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
 	    Namespace *nsPtr)
@@ -213,9 +220,11 @@ declare 50 {
 declare 51 {
     int TclInterpInit(Tcl_Interp *interp)
 }
-declare 52 {
-    int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
-}
+# Removed in Tcl 8.5a2
+#declare 52 {
+#    int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
+#	    int flags)
+#}
 declare 53 {
     int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
 	    int argc, CONST84 char **argv)
@@ -264,16 +273,17 @@ declare 64 {
     int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
 	    int flags)
 }
-declare 65 {
-    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
-	    Tcl_Obj *const objv[], int flags)
-}
-declare 66 {
-    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
-}
-declare 67 {
-    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
-}
+# Removed in Tcl 8.5a2
+#declare 65 {
+#    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
+#	    Tcl_Obj *const objv[], int flags)
+#}
+#declare 66 {
+#    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
+#}
+#declare 67 {
+#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
+#}
 # Replaced by Tcl_FSAccess in 8.4:
 #declare 68 {
 #    int TclpAccess(const char *path, int mode)
@@ -309,7 +319,7 @@ declare 77 {
     void TclpGetTime(Tcl_Time *time)
 }
 declare 78 {
-    int TclpGetTimeZone(Tcl_WideInt time)
+    int TclpGetTimeZone(unsigned long time)
 }
 # Replaced by Tcl_FSListVolumes in 8.4:
 #declare 79 {
@@ -369,17 +379,18 @@ declare 92 {
 declare 93 {
     void TclProcDeleteProc(ClientData clientData)
 }
-declare 94 {
-    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
-	    int argc, CONST84 char **argv)
-}
+# Removed in Tcl 8.5:
+#declare 94 {
+#    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
+#	    int argc, const char **argv)
+#}
 # Replaced by Tcl_FSStat in 8.4:
 #declare 95 {
 #    int TclpStat(const char *path, Tcl_StatBuf *buf)
 #}
 declare 96 {
-    int TclRenameCommand(Tcl_Interp *interp, char *oldName,
-            char *newName)
+    int TclRenameCommand(Tcl_Interp *interp, const char *oldName,
+            const char *newName)
 }
 declare 97 {
     void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
@@ -404,7 +415,7 @@ declare 102 {
     void TclSetupEnv(Tcl_Interp *interp)
 }
 declare 103 {
-    int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto,
+    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
 	    int *portPtr)
 }
 declare 104 {
@@ -414,12 +425,12 @@ declare 104 {
 #declare 105 {
 #    int TclStat(const char *path, Tcl_StatBuf *buf)
 #}
-declare 106 {
-    int TclStatDeleteProc(TclStatProc_ *proc)
-}
-declare 107 {
-    int TclStatInsertProc(TclStatProc_ *proc)
-}
+#declare 106 {
+#    int TclStatDeleteProc(TclStatProc_ *proc)
+#}
+#declare 107 {
+#    int TclStatInsertProc(TclStatProc_ *proc)
+#}
 declare 108 {
     void TclTeardownNamespace(Namespace *nsPtr)
 }
@@ -521,22 +532,33 @@ declare 132 {
     int TclpHasSockets(Tcl_Interp *interp)
 }
 declare 133 {
-    struct tm *TclpGetDate(TclpTime_t time, int useGMT)
-}
-declare 134 {
-    size_t TclpStrftime(char *s, size_t maxsize, const char *format,
-	    const struct tm *t, int useGMT)
-}
-declare 135 {
-    int TclpCheckStackSpace(void)
+    struct tm *TclpGetDate(const time_t *time, int useGMT)
 }
+# Removed in 8.5
+#declare 134 {
+#    size_t TclpStrftime(char *s, size_t maxsize, const char *format,
+#	    const struct tm *t, int useGMT)
+#}
+#declare 135 {
+#    int TclpCheckStackSpace(void)
+#}
+
+# Added in 8.1:
 
+#declare 137 {
+#   int TclpChdir(const char *dirName)
+#}
 declare 138 {
     CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
 }
-declare 140 {
-    int TclLooksLikeInt(const char *bytes, int length)
-}
+#declare 139 {
+#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
+#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
+#	    Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
+#}
+#declare 140 {
+#    int TclLooksLikeInt(const char *bytes, int length)
+#}
 # This is used by TclX, but should otherwise be considered private
 declare 141 {
     CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
@@ -569,7 +591,7 @@ declare 149 {
     void TclHandleRelease(TclHandle handle)
 }
 
-# Added in 8.2:
+# Added for Tcl 8.2
 
 declare 150 {
     int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
@@ -585,7 +607,7 @@ declare 153 {
     Tcl_Obj *TclGetLibraryPath(void)
 }
 
-# moved to tclTest.c (static) in 8.3.2:
+# moved to tclTest.c (static) in 8.3.2/8.4a2
 #declare 154 {
 #    int TclTestChannelCmd(ClientData clientData,
 #    Tcl_Interp *interp, int argc, char **argv)
@@ -676,28 +698,252 @@ declare 172 {
     int TclInThreadExit(void)
 }
 
-# Added in 8.4.2:
+# added for 8.4.2
 
 declare 173 {
     int TclUniCharMatch(const Tcl_UniChar *string, int strLen,
-	    const Tcl_UniChar *pattern, int ptnLen, int nocase)
+	    const Tcl_UniChar *pattern, int ptnLen, int flags)
+}
+
+# added for 8.4.3
+
+#declare 174 {
+#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
+#}
+
+# Factoring out of trace code
+
+declare 175 {
+    int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr,
+	    const char *part1, const char *part2, int flags, int leaveErrMsg)
+}
+declare 176 {
+    void TclCleanupVar(Var *varPtr, Var *arrayPtr)
+}
+declare 177 {
+    void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
+	    const char *operation, const char *reason)
 }
+declare 178 {
+    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
+}
+declare 179 {
+    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
+}
+
+# REMOVED
+# Allocate lists without copying arrays
+# declare 180 {
+#    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
+# }
+#declare 181 {
+#    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
+#	    const char *file, int line)
+#}
 
 # TclpGmtime and TclpLocaltime promoted to the generic interface from unix
 
 declare 182 {
-     struct tm *TclpLocaltime(TclpTime_t_CONST clock)
+     struct tm *TclpLocaltime(const time_t *clock)
 }
 declare 183 {
-     struct tm *TclpGmtime(TclpTime_t_CONST clock)
+     struct tm *TclpGmtime(const time_t *clock)
 }
 
-declare 199 {
-    int TclMatchIsTrivial(const char *pattern)
+# For the new "Thread Storage" subsystem.
+
+### REMOVED on grounds it should never have been exposed. All these
+### functions are now either static in tclThreadStorage.c or
+### MODULE_SCOPE.
+# declare 184 {
+#      void TclThreadStorageLockInit(void)
+# }
+# declare 185 {
+#      void TclThreadStorageLock(void)
+# }
+# declare 186 {
+#      void TclThreadStorageUnlock(void)
+# }
+# declare 187 {
+#      void TclThreadStoragePrint(FILE *outFile, int flags)
+# }
+# declare 188 {
+#      Tcl_HashTable *TclThreadStorageGetHashTable(Tcl_ThreadId id)
+# }
+# declare 189 {
+#      Tcl_HashTable *TclThreadStorageInit(Tcl_ThreadId id, void *reserved)
+# }
+# declare 190 {
+#      void TclThreadStorageDataKeyInit(Tcl_ThreadDataKey *keyPtr)
+# }
+# declare 191 {
+#      void *TclThreadStorageDataKeyGet(Tcl_ThreadDataKey *keyPtr)
+# }
+# declare 192 {
+#      void TclThreadStorageDataKeySet(Tcl_ThreadDataKey *keyPtr, void *data)
+# }
+# declare 193 {
+#      void TclFinalizeThreadStorageThread(Tcl_ThreadId id)
+# }
+# declare 194 {
+#      void TclFinalizeThreadStorage(void)
+# }
+# declare 195 {
+#      void TclFinalizeThreadStorageData(Tcl_ThreadDataKey *keyPtr)
+# }
+# declare 196 {
+#      void TclFinalizeThreadStorageDataKey(Tcl_ThreadDataKey *keyPtr)
+# }
+
+#
+# Added in tcl8.5a5 for compiler/executor experimentation.
+# Disabled in Tcl 8.5.1; experiments terminated. :/
+#
+#declare 197 {
+#    int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+#		        const CmdFrame *invoker, int word)
+#}
+declare 198 {
+    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    CallFrame **framePtrPtr)
+}
+
+#declare 199 {
+#    int TclMatchIsTrivial(const char *pattern)
+#}
+
+# 200-208 exported for use by the test suite [Bug 1054748]
+declare 200 {
+    int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive,
+	Tcl_Obj **errorPtr)
+}
+declare 201 {
+    int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
+	Tcl_Obj **errorPtr)
+}
+declare 202 {
+    int TclpObjCreateDirectory(Tcl_Obj *pathPtr)
+}
+declare 203 {
+    int TclpObjDeleteFile(Tcl_Obj *pathPtr)
+}
+declare 204 {
+    int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+}
+declare 205 {
+    int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+}
+declare 206 {
+    int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
+}
+declare 207 {
+    int TclpObjAccess(Tcl_Obj *pathPtr, int mode)
+}
+declare 208 {
+    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
+	    Tcl_Obj *pathPtr, int mode, int permissions)
+}
+# Made public by TIP 258
+#declare 209 {
+#    Tcl_Obj *TclGetEncodingSearchPath(void)
+#}
+#declare 210 {
+#    int TclSetEncodingSearchPath(Tcl_Obj *searchPath)
+#}
+#declare 211 {
+#    const char *TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
+#}
+declare 212 {
+    void TclpFindExecutable(const char *argv0)
+}
+declare 213 {
+    Tcl_Obj *TclGetObjNameOfExecutable(void)
+}
+declare 214 {
+    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
+}
+declare 215 {
+    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
+}
+declare 216 {
+    void TclStackFree(Tcl_Interp *interp, void *freePtr)
+}
+declare 217 {
+    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
+            Tcl_Namespace *namespacePtr, int isProcCallFrame)
+}
+declare 218 {
+    void TclPopStackFrame(Tcl_Interp *interp)
+}
+
+# for use in tclTest.c
+declare 224 {
+    TclPlatformType *TclGetPlatform(void)
+}
+
+#
+declare 225 {
+    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
+	    int keyc, Tcl_Obj *const keyv[], int flags)
+}
+declare 226 {
+    int TclObjBeingDeleted(Tcl_Obj *objPtr)
+}
+declare 227 {
+    void TclSetNsPath(Namespace *nsPtr, int pathLength,
+            Tcl_Namespace *pathAry[])
+}
+declare 228 {
+    int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
+             int skip, ProcErrorProc errorProc)
+}
+declare 229 {
+    int	TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
+	    const char *myName, int myFlags, int index)
+}
+declare 230 {
+    Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+	    const char *part2, int flags, const char *msg,
+	    const int createPart1, const int createPart2, Var **arrayPtrPtr)
+}
+declare 231 {
+    int	TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    Tcl_Namespace **nsPtrPtr)
+}
+
+# Bits and pieces of TIP#280's guts
+declare 232 {
+    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
+	    const CmdFrame *invoker, int word)
+}
+declare 233 {
+    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
+}
+
+# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
+declare 234 {
+    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
+             int *newPtr)
+}
+declare 235 {
+    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
+}
+
+
+# TIP 337 made this one public
+declare 236 {
+    void TclBackgroundException(Tcl_Interp *interp, int code)
+}
+
+# Tcl_Obj leak detection support.
+declare 243 {
+    void TclDbDumpActiveObjects(FILE *outFile)
 }
 
 declare 249 {
-    void TclUnusedStubEntry(void)
+    char *TclDoubleDigits(double dv, int ndigits, int flags,
+			  int *decpt, int *signum, char **endPtr)
 }
 
 ##############################################################################
@@ -752,7 +998,7 @@ declare 9 win {
 declare 10 win {
     Tcl_DirEntry *TclpReaddir(DIR *dir)
 }
-# Removed in 8.3.1 (for Win32s only):
+# Removed in 8.3.1 (for Win32s only)
 #declare 10 win {
 #    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
 #}
@@ -788,6 +1034,11 @@ declare 16 win {
 #  declare 17 win {
 #      char *TclpGetTZName(void)
 #  }
+# new for 8.5.12+ Cygwin only
+declare 17 win {
+    int TclUnixCopyFile(const char *src, const char *dst,
+	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
 declare 18 win {
     TclFile TclpMakeFile(Tcl_Channel channel, int direction)
 }
@@ -801,7 +1052,7 @@ declare 20 win {
 declare 21 win {
     char *TclpInetNtoa(struct in_addr addr)
 }
-# Removed in 8.4:
+# removed permanently for 8.4
 #declare 21 win {
 #    void TclpAsyncMark(Tcl_AsyncHandler async)
 #}
@@ -816,24 +1067,28 @@ declare 23 win {
 declare 24 win {
     char *TclWinNoBackslash(char *path)
 }
-declare 25 win {
-    TclPlatformType *TclWinGetPlatform(void)
-}
+# replaced by generic TclGetPlatform
+#declare 25 win {
+#    TclPlatformType *TclWinGetPlatform(void)
+#}
 declare 26 win {
     void TclWinSetInterfaces(int wide)
 }
 
-# Added in 8.3.3:
+# Added in Tcl 8.3.3 / 8.4
 
 declare 27 win {
     void TclWinFlushDirtyChannels(void)
 }
 
-# Added in 8.4.2:
+# Added in 8.4.2
 
 declare 28 win {
     void TclWinResetInterfaces(void)
 }
+declare 29 win {
+    int TclWinCPUID(unsigned int index, unsigned int *regs)
+}
 
 ################################
 # Unix specific functions
@@ -886,15 +1141,46 @@ declare 10 unix {
 # Slots 11 and 12 are forwarders for functions that were promoted to
 # generic Stubs
 declare 11 unix {
-    struct tm *TclpLocaltime_unix(TclpTime_t_CONST clock)
+    struct tm *TclpLocaltime_unix(const time_t *clock)
 }
 declare 12 unix {
-    struct tm *TclpGmtime_unix(TclpTime_t_CONST clock)
+    struct tm *TclpGmtime_unix(const time_t *clock)
 }
 declare 13 unix {
     char *TclpInetNtoa(struct in_addr addr)
 }
-declare 29 {win unix} {
+
+# Added in 8.5:
+
+declare 14 unix {
+    int TclUnixCopyFile(const char *src, const char *dst,
+	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
+
+################################
+# Mac OS X specific functions
+
+declare 15 macosx {
+    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
+	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
+}
+declare 16 macosx {
+    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
+	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
+}
+declare 17 macosx {
+    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
+	    const Tcl_StatBuf *statBufPtr)
+}
+declare 18 macosx {
+    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
+	    const char *fileName, Tcl_StatBuf *statBufPtr,
+	    Tcl_GlobTypeData *types)
+}
+declare 19 macosx {
+    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
+}
+declare 29 unix {
     int TclWinCPUID(unsigned int index, unsigned int *regs)
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a9a876e..d5a479b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -10,35 +10,34 @@
  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #ifndef _TCLINT
 #define _TCLINT
 
 /*
- * Common include files needed by most of the Tcl source files are
- * included here, so that system-dependent personalizations for the
- * include files only have to be made in once place.  This results
- * in a few extra includes, but greater modularity.  The order of
- * the three groups of #includes is important.	For example, stdio.h
- * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
- * needed by stdlib.h in some configurations.
+ * Some numerics configuration options.
  */
 
-#ifndef _TCL
-#include "tcl.h"
-#endif
+#undef NO_WIDE_TYPE
+#undef ACCEPT_NAN
+
+/*
+ * Common include files needed by most of the Tcl source files are included
+ * here, so that system-dependent personalizations for the include files only
+ * have to be made in once place. This results in a few extra includes, but
+ * greater modularity. The order of the three groups of #includes is
+ * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_
+ * declaration in tcl.h is needed by stdlib.h in some configurations.
+ */
+
+#include "tclPort.h"
 
 #include <stdio.h>
 
 #include <ctype.h>
-#ifdef NO_LIMITS_H
-#   include "../compat/limits.h"
-#else
-#   include <limits.h>
-#endif
 #ifdef NO_STDLIB_H
 #   include "../compat/stdlib.h"
 #else
@@ -49,9 +48,14 @@
 #else
 #include <string.h>
 #endif
+#ifdef STDC_HEADERS
+#include <stddef.h>
+#else
+typedef int ptrdiff_t;
+#endif
 
 /*
- * Ensure WORDS_BIGENDIAN is defined correcly:
+ * Ensure WORDS_BIGENDIAN is defined correctly:
  * Needs to happen here in addition to configure to work with fat compiles on
  * Darwin (where configure runs only once for multiple architectures).
  */
@@ -64,15 +68,15 @@
 #endif
 #ifdef BYTE_ORDER
 #    ifdef BIG_ENDIAN
-#        if BYTE_ORDER == BIG_ENDIAN
-#            undef WORDS_BIGENDIAN
-#            define WORDS_BIGENDIAN 1
-#        endif
+#	 if BYTE_ORDER == BIG_ENDIAN
+#	     undef WORDS_BIGENDIAN
+#	     define WORDS_BIGENDIAN 1
+#	 endif
 #    endif
 #    ifdef LITTLE_ENDIAN
-#        if BYTE_ORDER == LITTLE_ENDIAN
-#            undef WORDS_BIGENDIAN
-#        endif
+#	 if BYTE_ORDER == LITTLE_ENDIAN
+#	     undef WORDS_BIGENDIAN
+#	 endif
 #    endif
 #endif
 
@@ -89,66 +93,83 @@
 #   endif
 #endif
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-# define TCL_STORAGE_CLASS DLLEXPORT
-#else
-# ifdef USE_TCL_STUBS
-#  define TCL_STORAGE_CLASS
-# else
-#  define TCL_STORAGE_CLASS DLLIMPORT
-# endif
+/*
+ * When Tcl_WideInt and long are the same type, there's no value in
+ * having a tclWideIntType separate from the tclIntType.
+ */
+#ifdef TCL_WIDE_INT_IS_LONG
+#define NO_WIDE_TYPE
+#endif
+
+/*
+ * Macros used to cast between pointers and integers (e.g. when storing an int
+ * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
+ * to/from pointer from/to integer of different size".
+ */
+
+#if !defined(INT2PTR) && !defined(PTR2INT)
+#   if defined(HAVE_INTPTR_T) || defined(intptr_t)
+#	define INT2PTR(p) ((void *)(intptr_t)(p))
+#	define PTR2INT(p) ((int)(intptr_t)(p))
+#   else
+#	define INT2PTR(p) ((void *)(p))
+#	define PTR2INT(p) ((int)(p))
+#   endif
+#endif
+#if !defined(UINT2PTR) && !defined(PTR2UINT)
+#   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
+#	define UINT2PTR(p) ((void *)(uintptr_t)(p))
+#	define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+#   else
+#	define UINT2PTR(p) ((void *)(p))
+#	define PTR2UINT(p) ((unsigned int)(p))
+#   endif
 #endif
 
 /*
- * The following procedures allow namespaces to be customized to
- * support special name resolution rules for commands/variables.
- * 
+ * The following procedures allow namespaces to be customized to support
+ * special name resolution rules for commands/variables.
  */
 
 struct Tcl_ResolvedVarInfo;
 
-typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
-    Tcl_Interp* interp, struct Tcl_ResolvedVarInfo *vinfoPtr));
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc)(Tcl_Interp *interp,
+	struct Tcl_ResolvedVarInfo *vinfoPtr);
 
-typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((
-    struct Tcl_ResolvedVarInfo *vinfoPtr));
+typedef void (Tcl_ResolveVarDeleteProc)(struct Tcl_ResolvedVarInfo *vinfoPtr);
 
 /*
  * The following structure encapsulates the routines needed to resolve a
- * variable reference at runtime.  Any variable specific state will typically
+ * variable reference at runtime. Any variable specific state will typically
  * be appended to this structure.
  */
 
-
 typedef struct Tcl_ResolvedVarInfo {
     Tcl_ResolveRuntimeVarProc *fetchProc;
     Tcl_ResolveVarDeleteProc *deleteProc;
 } Tcl_ResolvedVarInfo;
 
+typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
+	CONST84 char *name, int length, Tcl_Namespace *context,
+	Tcl_ResolvedVarInfo **rPtr);
 
+typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
+	Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
 
-typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
-    Tcl_Interp* interp, CONST84 char* name, int length,
-    Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
-
-typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
-    Tcl_Interp* interp, CONST84 char* name, Tcl_Namespace *context,
-    int flags, Tcl_Var *rPtr));
+typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
+	Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
 
-typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
-    CONST84 char* name, Tcl_Namespace *context, int flags,
-    Tcl_Command *rPtr));
- 
 typedef struct Tcl_ResolverInfo {
-    Tcl_ResolveCmdProc *cmdResProc;	/* Procedure handling command name
-					 * resolution. */
-    Tcl_ResolveVarProc *varResProc;	/* Procedure handling variable name
-					 * resolution for variables that
-					 * can only be handled at runtime. */
+    Tcl_ResolveCmdProc *cmdResProc;
+				/* Procedure handling command name
+				 * resolution. */
+    Tcl_ResolveVarProc *varResProc;
+				/* Procedure handling variable name resolution
+				 * for variables that can only be handled at
+				 * runtime. */
     Tcl_ResolveCompiledVarProc *compiledVarResProc;
-					/* Procedure handling variable name
-					 * resolution at compile time. */
+				/* Procedure handling variable name resolution
+				 * at compile time. */
 } Tcl_ResolverInfo;
 
 /*
@@ -157,427 +178,550 @@ typedef struct Tcl_ResolverInfo {
  *----------------------------------------------------------------
  */
 
+typedef struct Tcl_Ensemble Tcl_Ensemble;
+typedef struct NamespacePathEntry NamespacePathEntry;
+
+/*
+ * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
+ * field added at the end: in this way variables can find their namespace
+ * without having to copy a pointer in their struct: they can access it via
+ * their hPtr->tablePtr.
+ */
+
+typedef struct TclVarHashTable {
+    Tcl_HashTable table;
+    struct Namespace *nsPtr;
+} TclVarHashTable;
+
+/*
+ * This is for itcl - it likes to search our varTables directly :(
+ */
+
+#define TclVarHashFindVar(tablePtr, key) \
+    TclVarHashCreateVar((tablePtr), (key), NULL)
+
+
 /*
  * The structure below defines a namespace.
  * Note: the first five fields must match exactly the fields in a
- * Tcl_Namespace structure (see tcl.h). If you change one, be sure to
- * change the other.
+ * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change
+ * the other.
  */
 
 typedef struct Namespace {
-    char *name;			 /* The namespace's simple (unqualified)
-				  * name. This contains no ::'s. The name of
-				  * the global namespace is "" although "::"
-				  * is an synonym. */
-    char *fullName;		 /* The namespace's fully qualified name.
-				  * This starts with ::. */
-    ClientData clientData;	 /* An arbitrary value associated with this
-				  * namespace. */
+    char *name;			/* The namespace's simple (unqualified) name.
+				 * This contains no ::'s. The name of the
+				 * global namespace is "" although "::" is an
+				 * synonym. */
+    char *fullName;		/* The namespace's fully qualified name. This
+				 * starts with ::. */
+    ClientData clientData;	/* An arbitrary value associated with this
+				 * namespace. */
     Tcl_NamespaceDeleteProc *deleteProc;
-				 /* Procedure invoked when deleting the
-				  * namespace to, e.g., free clientData. */
-    struct Namespace *parentPtr; /* Points to the namespace that contains
-				  * this one. NULL if this is the global
-				  * namespace. */
-    Tcl_HashTable childTable;	 /* Contains any child namespaces. Indexed
-				  * by strings; values have type
-				  * (Namespace *). */
-    long nsId;			 /* Unique id for the namespace. */
-    Tcl_Interp *interp;		 /* The interpreter containing this
-				  * namespace. */
-    int flags;			 /* OR-ed combination of the namespace
-				  * status flags NS_DYING and NS_DEAD
-				  * listed below. */
-    int activationCount;	 /* Number of "activations" or active call
-				  * frames for this namespace that are on
-				  * the Tcl call stack. The namespace won't
-				  * be freed until activationCount becomes
-				  * zero. */
-    int refCount;		 /* Count of references by namespaceName *
-				  * objects. The namespace can't be freed
-				  * until refCount becomes zero. */
-    Tcl_HashTable cmdTable;	 /* Contains all the commands currently
-				  * registered in the namespace. Indexed by
-				  * strings; values have type (Command *).
-				  * Commands imported by Tcl_Import have
-				  * Command structures that point (via an
-				  * ImportedCmdRef structure) to the
-				  * Command structure in the source
-				  * namespace's command table. */
-    Tcl_HashTable varTable;	 /* Contains all the (global) variables
-				  * currently in this namespace. Indexed
-				  * by strings; values have type (Var *). */
-    char **exportArrayPtr;	 /* Points to an array of string patterns
-				  * specifying which commands are exported.
-				  * A pattern may include "string match"
-				  * style wildcard characters to specify
-				  * multiple commands; however, no namespace
-				  * qualifiers are allowed. NULL if no
-				  * export patterns are registered. */
-    int numExportPatterns;	 /* Number of export patterns currently
-				  * registered using "namespace export". */
-    int maxExportPatterns;	 /* Mumber of export patterns for which
-				  * space is currently allocated. */
-    int cmdRefEpoch;		 /* Incremented if a newly added command
-				  * shadows a command for which this
-				  * namespace has already cached a Command *
-				  * pointer; this causes all its cached
-				  * Command* pointers to be invalidated. */
-    int resolverEpoch;		 /* Incremented whenever (a) the name resolution
-				  * rules change for this namespace or (b) a 
-				  * newly added command shadows a command that
-				  * is compiled to bytecodes.
-				  * This invalidates all byte codes compiled
-				  * in the namespace, causing the code to be
-				  * recompiled under the new rules.*/
+				/* Procedure invoked when deleting the
+				 * namespace to, e.g., free clientData. */
+    struct Namespace *parentPtr;/* Points to the namespace that contains this
+				 * one. NULL if this is the global
+				 * namespace. */
+    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
+				 * strings; values have type (Namespace *). */
+    long nsId;			/* Unique id for the namespace. */
+    Tcl_Interp *interp;		/* The interpreter containing this
+				 * namespace. */
+    int flags;			/* OR-ed combination of the namespace status
+				 * flags NS_DYING and NS_DEAD listed below. */
+    int activationCount;	/* Number of "activations" or active call
+				 * frames for this namespace that are on the
+				 * Tcl call stack. The namespace won't be
+				 * freed until activationCount becomes zero. */
+    int refCount;		/* Count of references by namespaceName
+				 * objects. The namespace can't be freed until
+				 * refCount becomes zero. */
+    Tcl_HashTable cmdTable;	/* Contains all the commands currently
+				 * registered in the namespace. Indexed by
+				 * strings; values have type (Command *).
+				 * Commands imported by Tcl_Import have
+				 * Command structures that point (via an
+				 * ImportedCmdRef structure) to the Command
+				 * structure in the source namespace's command
+				 * table. */
+    TclVarHashTable varTable;	/* Contains all the (global) variables
+				 * currently in this namespace. Indexed by
+				 * strings; values have type (Var *). */
+    char **exportArrayPtr;	/* Points to an array of string patterns
+				 * specifying which commands are exported. A
+				 * pattern may include "string match" style
+				 * wildcard characters to specify multiple
+				 * commands; however, no namespace qualifiers
+				 * are allowed. NULL if no export patterns are
+				 * registered. */
+    int numExportPatterns;	/* Number of export patterns currently
+				 * registered using "namespace export". */
+    int maxExportPatterns;	/* Mumber of export patterns for which space
+				 * is currently allocated. */
+    int cmdRefEpoch;		/* Incremented if a newly added command
+				 * shadows a command for which this namespace
+				 * has already cached a Command* pointer; this
+				 * causes all its cached Command* pointers to
+				 * be invalidated. */
+    int resolverEpoch;		/* Incremented whenever (a) the name
+				 * resolution rules change for this namespace
+				 * or (b) a newly added command shadows a
+				 * command that is compiled to bytecodes. This
+				 * invalidates all byte codes compiled in the
+				 * namespace, causing the code to be
+				 * recompiled under the new rules.*/
     Tcl_ResolveCmdProc *cmdResProc;
-				 /* If non-null, this procedure overrides
-				  * the usual command resolution mechanism
-				  * in Tcl.  This procedure is invoked
-				  * within Tcl_FindCommand to resolve all
-				  * command references within the namespace. */
+				/* If non-null, this procedure overrides the
+				 * usual command resolution mechanism in Tcl.
+				 * This procedure is invoked within
+				 * Tcl_FindCommand to resolve all command
+				 * references within the namespace. */
     Tcl_ResolveVarProc *varResProc;
-				 /* If non-null, this procedure overrides
-				  * the usual variable resolution mechanism
-				  * in Tcl.  This procedure is invoked
-				  * within Tcl_FindNamespaceVar to resolve all
-				  * variable references within the namespace
-				  * at runtime. */
+				/* If non-null, this procedure overrides the
+				 * usual variable resolution mechanism in Tcl.
+				 * This procedure is invoked within
+				 * Tcl_FindNamespaceVar to resolve all
+				 * variable references within the namespace at
+				 * runtime. */
     Tcl_ResolveCompiledVarProc *compiledVarResProc;
-				 /* If non-null, this procedure overrides
-				  * the usual variable resolution mechanism
-				  * in Tcl.  This procedure is invoked
-				  * within LookupCompiledLocal to resolve
-				  * variable references within the namespace
-				  * at compile time. */
+				/* If non-null, this procedure overrides the
+				 * usual variable resolution mechanism in Tcl.
+				 * This procedure is invoked within
+				 * LookupCompiledLocal to resolve variable
+				 * references within the namespace at compile
+				 * time. */
+    int exportLookupEpoch;	/* Incremented whenever a command is added to
+				 * a namespace, removed from a namespace or
+				 * the exports of a namespace are changed.
+				 * Allows TIP#112-driven command lists to be
+				 * validated efficiently. */
+    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
+				 * of the ensembles that are implemented on
+				 * top of this namespace. */
+    Tcl_Obj *unknownHandlerPtr;	/* A script fragment to be used when command
+				 * resolution in this namespace fails. TIP
+				 * 181. */
+    int commandPathLength;	/* The length of the explicit path. */
+    NamespacePathEntry *commandPathArray;
+				/* The explicit path of the namespace as an
+				 * array. */
+    NamespacePathEntry *commandPathSourceList;
+				/* Linked list of path entries that point to
+				 * this namespace. */
 } Namespace;
 
 /*
+ * An entry on a namespace's command resolution path.
+ */
+
+struct NamespacePathEntry {
+    Namespace *nsPtr;		/* What does this path entry point to? If it
+				 * is NULL, this path entry points is
+				 * redundant and should be skipped. */
+    Namespace *creatorNsPtr;	/* Where does this path entry point from? This
+				 * allows for efficient invalidation of
+				 * references when the path entry's target
+				 * updates its current list of defined
+				 * commands. */
+    NamespacePathEntry *prevPtr, *nextPtr;
+				/* Linked list pointers or NULL at either end
+				 * of the list that hangs off Namespace's
+				 * commandPathSourceList field. */
+};
+
+/*
  * Flags used to represent the status of a namespace:
  *
  * NS_DYING -	1 means Tcl_DeleteNamespace has been called to delete the
  *		namespace but there are still active call frames on the Tcl
  *		stack that refer to the namespace. When the last call frame
  *		referring to it has been popped, it's variables and command
- *		will be destroyed and it will be marked "dead" (NS_DEAD).
- *		The namespace can no longer be looked up by name.
+ *		will be destroyed and it will be marked "dead" (NS_DEAD). The
+ *		namespace can no longer be looked up by name.
  * NS_DEAD -	1 means Tcl_DeleteNamespace has been called to delete the
- *		namespace and no call frames still refer to it. Its
- *		variables and command have already been destroyed. This bit
- *		allows the namespace resolution code to recognize that the
- *		namespace is "deleted". When the last namespaceName object
- *		in any byte code code unit that refers to the namespace has
- *		been freed (i.e., when the namespace's refCount is 0), the
- *		namespace's storage will be freed.
+ *		namespace and no call frames still refer to it. Its variables
+ *		and command have already been destroyed. This bit allows the
+ *		namespace resolution code to recognize that the namespace is
+ *		"deleted". When the last namespaceName object in any byte code
+ *		unit that refers to the namespace has been freed (i.e., when
+ *		the namespace's refCount is 0), the namespace's storage will
+ *		be freed.
  * NS_KILLED    1 means that TclTeardownNamespace has already been called on
  *              this namespace and it should not be called again [Bug 1355942]
  */
 
 #define NS_DYING	0x01
 #define NS_DEAD		0x02
-#define NS_KILLED       0x04
+#define NS_KILLED	0x04
+
+/*
+ * Flags passed to TclGetNamespaceForQualName:
+ *
+ * TCL_GLOBAL_ONLY		- (see tcl.h) Look only in the global ns.
+ * TCL_NAMESPACE_ONLY		- (see tcl.h) Look only in the context ns.
+ * TCL_CREATE_NS_IF_UNKNOWN	- Create unknown namespaces.
+ * TCL_FIND_ONLY_NS		- The name sought is a namespace name.
+ */
+
+#define TCL_CREATE_NS_IF_UNKNOWN	0x800
+#define TCL_FIND_ONLY_NS		0x1000
+
+/*
+ * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
+ * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
+ * referring to the same subcommand, even where one is a duplicate of another.
+ */
+
+typedef struct {
+    Namespace *nsPtr;		/* The namespace backing the ensemble which
+				 * this is a subcommand of. */
+    int epoch;			/* Used to confirm when the data in this
+				 * really structure matches up with the
+				 * ensemble. */
+    Tcl_Command token;		/* Reference to the comamnd for which this
+				 * structure is a cache of the resolution. */
+    char *fullSubcmdName;	/* The full (local) name of the subcommand,
+				 * allocated with ckalloc(). */
+    Tcl_Obj *realPrefixObj;	/* Object containing the prefix words of the
+				 * command that implements this ensemble
+				 * subcommand. */
+} EnsembleCmdRep;
 
 /*
- * Flag passed to TclGetNamespaceForQualName to have it create all namespace
- * components of a namespace-qualified name that cannot be found. The new
- * namespaces are created within their specified parent. Note that this
- * flag's value must not conflict with the values of the flags
- * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, and FIND_ONLY_NS (defined in
- * tclNamesp.c).
+ * Flag to enable bytecode compilation of an ensemble.
  */
 
-#define CREATE_NS_IF_UNKNOWN 0x800
+#define ENSEMBLE_COMPILE 0x4
 
 /*
  *----------------------------------------------------------------
- * Data structures related to variables.   These are used primarily
- * in tclVar.c
+ * Data structures related to variables. These are used primarily in tclVar.c
  *----------------------------------------------------------------
  */
 
 /*
- * The following structure defines a variable trace, which is used to
- * invoke a specific C procedure whenever certain operations are performed
- * on a variable.
+ * The following structure defines a variable trace, which is used to invoke a
+ * specific C procedure whenever certain operations are performed on a
+ * variable.
  */
 
 typedef struct VarTrace {
-    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
-				 * by flags are performed on variable. */
+    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
+				 * flags are performed on variable. */
     ClientData clientData;	/* Argument to pass to proc. */
     int flags;			/* What events the trace procedure is
-				 * interested in:  OR-ed combination of
+				 * interested in: OR-ed combination of
 				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
 				 * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */
-    struct VarTrace *nextPtr;	/* Next in list of traces associated with
-				 * a particular variable. */
+    struct VarTrace *nextPtr;	/* Next in list of traces associated with a
+				 * particular variable. */
 } VarTrace;
 
 /*
- * The following structure defines a command trace, which is used to
- * invoke a specific C procedure whenever certain operations are performed
- * on a command.
+ * The following structure defines a command trace, which is used to invoke a
+ * specific C procedure whenever certain operations are performed on a
+ * command.
  */
 
 typedef struct CommandTrace {
-    Tcl_CommandTraceProc *traceProc;/* Procedure to call when operations given
-				     * by flags are performed on command. */
-    ClientData clientData;	    /* Argument to pass to proc. */
-    int flags;			    /* What events the trace procedure is
-				     * interested in:  OR-ed combination of
-				     * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
-    struct CommandTrace *nextPtr;   /* Next in list of traces associated with
-				     * a particular command. */
-    int refCount;                   /* Used to ensure this structure is
-                                     * not deleted too early.  Keeps track
-                                     * of how many pieces of code have
-                                     * a pointer to this structure. */
+    Tcl_CommandTraceProc *traceProc;
+				/* Procedure to call when operations given by
+				 * flags are performed on command. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    int flags;			/* What events the trace procedure is
+				 * interested in: OR-ed combination of
+				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+    struct CommandTrace *nextPtr;
+				/* Next in list of traces associated with a
+				 * particular command. */
+    int refCount;		/* Used to ensure this structure is not
+				 * deleted too early. Keeps track of how many
+				 * pieces of code have a pointer to this
+				 * structure. */
 } CommandTrace;
 
 /*
- * When a command trace is active (i.e. its associated procedure is
- * executing), one of the following structures is linked into a list
- * associated with the command's interpreter.  The information in
- * the structure is needed in order for Tcl to behave reasonably
- * if traces are deleted while traces are active.
+ * When a command trace is active (i.e. its associated procedure is executing)
+ * one of the following structures is linked into a list associated with the
+ * command's interpreter. The information in the structure is needed in order
+ * for Tcl to behave reasonably if traces are deleted while traces are active.
  */
 
 typedef struct ActiveCommandTrace {
     struct Command *cmdPtr;	/* Command that's being traced. */
     struct ActiveCommandTrace *nextPtr;
-				/* Next in list of all active command
-				 * traces for the interpreter, or NULL
-				 * if no more. */
-    CommandTrace *nextTracePtr;	/* Next trace to check after current
-				 * trace procedure returns;  if this
-				 * trace gets deleted, must update pointer
-				 * to avoid using free'd memory. */
-    int reverseScan;		/* Boolean set true when the traces
-				 * are scanning in reverse order. */
+				/* Next in list of all active command traces
+				 * for the interpreter, or NULL if no more. */
+    CommandTrace *nextTracePtr;	/* Next trace to check after current trace
+				 * procedure returns; if this trace gets
+				 * deleted, must update pointer to avoid using
+				 * free'd memory. */
+    int reverseScan;		/* Boolean set true when traces are scanning
+				 * in reverse order. */
 } ActiveCommandTrace;
 
 /*
  * When a variable trace is active (i.e. its associated procedure is
- * executing), one of the following structures is linked into a list
- * associated with the variable's interpreter.	The information in
- * the structure is needed in order for Tcl to behave reasonably
- * if traces are deleted while traces are active.
+ * executing) one of the following structures is linked into a list associated
+ * with the variable's interpreter. The information in the structure is needed
+ * in order for Tcl to behave reasonably if traces are deleted while traces
+ * are active.
  */
 
 typedef struct ActiveVarTrace {
     struct Var *varPtr;		/* Variable that's being traced. */
     struct ActiveVarTrace *nextPtr;
-				/* Next in list of all active variable
-				 * traces for the interpreter, or NULL
-				 * if no more. */
-    VarTrace *nextTracePtr;	/* Next trace to check after current
-				 * trace procedure returns;  if this
-				 * trace gets deleted, must update pointer
-				 * to avoid using free'd memory. */
+				/* Next in list of all active variable traces
+				 * for the interpreter, or NULL if no more. */
+    VarTrace *nextTracePtr;	/* Next trace to check after current trace
+				 * procedure returns; if this trace gets
+				 * deleted, must update pointer to avoid using
+				 * free'd memory. */
 } ActiveVarTrace;
 
 /*
- * The following structure describes an enumerative search in progress on
- * an array variable;  this are invoked with options to the "array"
- * command.
+ * The following structure describes an enumerative search in progress on an
+ * array variable; this are invoked with options to the "array" command.
  */
 
 typedef struct ArraySearch {
     int id;			/* Integer id used to distinguish among
-				 * multiple concurrent searches for the
-				 * same array. */
+				 * multiple concurrent searches for the same
+				 * array. */
     struct Var *varPtr;		/* Pointer to array variable that's being
 				 * searched. */
-    Tcl_HashSearch search;	/* Info kept by the hash module about
-				 * progress through the array. */
-    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element
-				 * to be enumerated (it's leftover from
-				 * the Tcl_FirstHashEntry call or from
-				 * an "array anymore" command).	 NULL
-				 * means must call Tcl_NextHashEntry
-				 * to get value to return. */
-    struct ArraySearch *nextPtr;/* Next in list of all active searches
-				 * for this variable, or NULL if this is
-				 * the last one. */
+    Tcl_HashSearch search;	/* Info kept by the hash module about progress
+				 * through the array. */
+    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
+				 * be enumerated (it's leftover from the
+				 * Tcl_FirstHashEntry call or from an "array
+				 * anymore" command). NULL means must call
+				 * Tcl_NextHashEntry to get value to
+				 * return. */
+    struct ArraySearch *nextPtr;/* Next in list of all active searches for
+				 * this variable, or NULL if this is the last
+				 * one. */
 } ArraySearch;
 
 /*
- * The structure below defines a variable, which associates a string name
- * with a Tcl_Obj value. These structures are kept in procedure call frames
- * (for local variables recognized by the compiler) or in the heap (for
- * global variables and any variable not known to the compiler). For each
- * Var structure in the heap, a hash table entry holds the variable name and
- * a pointer to the Var structure.
+ * The structure below defines a variable, which associates a string name with
+ * a Tcl_Obj value. These structures are kept in procedure call frames (for
+ * local variables recognized by the compiler) or in the heap (for global
+ * variables and any variable not known to the compiler). For each Var
+ * structure in the heap, a hash table entry holds the variable name and a
+ * pointer to the Var structure.
  */
 
 typedef struct Var {
+    int flags;			/* Miscellaneous bits of information about
+				 * variable. See below for definitions. */
     union {
-	Tcl_Obj *objPtr;	/* The variable's object value. Used for 
+	Tcl_Obj *objPtr;	/* The variable's object value. Used for
 				 * scalar variables and array elements. */
-	Tcl_HashTable *tablePtr;/* For array variables, this points to
-				 * information about the hash table used
-				 * to implement the associative array. 
-				 * Points to malloc-ed data. */
-	struct Var *linkPtr;	/* If this is a global variable being
-				 * referred to in a procedure, or a variable
-				 * created by "upvar", this field points to
-				 * the referenced variable's Var struct. */
+	TclVarHashTable *tablePtr;/* For array variables, this points to
+				 * information about the hash table used to
+				 * implement the associative array. Points to
+				 * ckalloc-ed data. */
+	struct Var *linkPtr;	/* If this is a global variable being referred
+				 * to in a procedure, or a variable created by
+				 * "upvar", this field points to the
+				 * referenced variable's Var struct. */
     } value;
-    char *name;			/* NULL if the variable is in a hashtable,
-				 * otherwise points to the variable's
-				 * name. It is used, e.g., by TclLookupVar
-				 * and "info locals". The storage for the
-				 * characters of the name is not owned by
-				 * the Var and must not be freed when
-				 * freeing the Var. */
-    Namespace *nsPtr;		/* Points to the namespace that contains
-				 * this variable or NULL if the variable is
-				 * a local variable in a Tcl procedure. */
-    Tcl_HashEntry *hPtr;	/* If variable is in a hashtable, either the
-				 * hash table entry that refers to this
-				 * variable or NULL if the variable has been
-				 * detached from its hash table (e.g. an
-				 * array is deleted, but some of its
-				 * elements are still referred to in
-				 * upvars). NULL if the variable is not in a
-				 * hashtable. This is used to delete an
-				 * variable from its hashtable if it is no
-				 * longer needed. */
-    int refCount;		/* Counts number of active uses of this
-				 * variable, not including its entry in the
-				 * call frame or the hash table: 1 for each
-				 * additional variable whose linkPtr points
-				 * here, 1 for each nested trace active on
-				 * variable, and 1 if the variable is a 
-				 * namespace variable. This record can't be
-				 * deleted until refCount becomes 0. */
-    VarTrace *tracePtr;		/* First in list of all traces set for this
-				 * variable. */
-    ArraySearch *searchPtr;	/* First in list of all searches active
-				 * for this variable, or NULL if none. */
-    int flags;			/* Miscellaneous bits of information about
-				 * variable. See below for definitions. */
 } Var;
 
-/*
- * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK) are mutually exclusive and give the "type" of the variable.
- * VAR_UNDEFINED is independent of the variable's type. 
+typedef struct VarInHash {
+    Var var;
+    int refCount;		/* Counts number of active uses of this
+				 * variable: 1 for the entry in the hash
+				 * table, 1 for each additional variable whose
+				 * linkPtr points here, 1 for each nested
+				 * trace active on variable, and 1 if the
+				 * variable is a namespace variable. This
+				 * record can't be deleted until refCount
+				 * becomes 0. */
+    Tcl_HashEntry entry;	/* The hash table entry that refers to this
+				 * variable. This is used to find the name of
+				 * the variable and to delete it from its
+				 * hashtable if it is no longer needed. It
+				 * also holds the variable's name. */
+} VarInHash;
+
+/*
+ * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
+ * mutually exclusive and give the "type" of the variable. If none is set,
+ * this is a scalar variable.
+ *
+ * VAR_ARRAY -			1 means this is an array variable rather than
+ *				a scalar variable or link. The "tablePtr"
+ *				field points to the array's hashtable for its
+ *				elements.
+ * VAR_LINK -			1 means this Var structure contains a pointer
+ *				to another Var structure that either has the
+ *				real value or is itself another VAR_LINK
+ *				pointer. Variables like this come about
+ *				through "upvar" and "global" commands, or
+ *				through references to variables in enclosing
+ *				namespaces.
+ *
+ * Flags that indicate the type and status of storage; none is set for
+ * compiled local variables (Var structs).
  *
- * VAR_SCALAR -			1 means this is a scalar variable and not
- *				an array or link. The "objPtr" field points
- *				to the variable's value, a Tcl object.
- * VAR_ARRAY -			1 means this is an array variable rather
- *				than a scalar variable or link. The
- *				"tablePtr" field points to the array's
- *				hashtable for its elements.
- * VAR_LINK -			1 means this Var structure contains a
- *				pointer to another Var structure that
- *				either has the real value or is itself
- *				another VAR_LINK pointer. Variables like
- *				this come about through "upvar" and "global"
- *				commands, or through references to variables
- *				in enclosing namespaces.
- * VAR_UNDEFINED -		1 means that the variable is in the process
- *				of being deleted. An undefined variable
- *				logically does not exist and survives only
- *				while it has a trace, or if it is a global
- *				variable currently being used by some
- *				procedure.
  * VAR_IN_HASHTABLE -		1 means this variable is in a hashtable and
- *				the Var structure is malloced. 0 if it is
- *				a local variable that was assigned a slot
- *				in a procedure frame by	the compiler so the
- *				Var storage is part of the call frame.
- * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
- *				underway for a read or write access, so
- *				new read or write accesses should not cause
- *				trace procedures to be called and the
- *				variable can't be deleted.
+ *				the Var structure is malloced. 0 if it is a
+ *				local variable that was assigned a slot in a
+ *				procedure frame by the compiler so the Var
+ *				storage is part of the call frame.
+ * VAR_DEAD_HASH		1 means that this var's entry in the hashtable
+ *				has already been deleted.
  * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
- *				element, so it is not legal for it to be
- *				an array itself (the VAR_ARRAY flag had
- *				better not be set).
- * VAR_NAMESPACE_VAR -		1 means that this variable was declared
- *				as a namespace variable. This flag ensures
- *				it persists until its namespace is
- *				destroyed or until the variable is unset;
- *				it will persist even if it has not been
- *				initialized and is marked undefined.
- *				The variable's refCount is incremented to
- *				reflect the "reference" from its namespace.
+ *				element, so it is not legal for it to be an
+ *				array itself (the VAR_ARRAY flag had better
+ *				not be set).
+ * VAR_NAMESPACE_VAR -		1 means that this variable was declared as a
+ *				namespace variable. This flag ensures it
+ *				persists until its namespace is destroyed or
+ *				until the variable is unset; it will persist
+ *				even if it has not been initialized and is
+ *				marked undefined. The variable's refCount is
+ *				incremented to reflect the "reference" from
+ *				its namespace.
+ *
+ * Flag values relating to the variable's trace and search status.
+ *
+ * VAR_TRACED_READ
+ * VAR_TRACED_WRITE
+ * VAR_TRACED_UNSET
+ * VAR_TRACED_ARRAY
+ * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
+ *				underway for a read or write access, so new
+ *				read or write accesses should not cause trace
+ *				procedures to be called and the variable can't
+ *				be deleted.
+ * VAR_SEARCH_ACTIVE
  *
- * The following additional flags are used with the CompiledLocal type
- * defined below:
+ * The following additional flags are used with the CompiledLocal type defined
+ * below:
  *
  * VAR_ARGUMENT -		1 means that this variable holds a procedure
- *				argument. 
+ *				argument.
  * VAR_TEMPORARY -		1 if the local variable is an anonymous
  *				temporary variable. Temporaries have a NULL
  *				name.
  * VAR_RESOLVED -		1 if name resolution has been done for this
  *				variable.
+ * VAR_IS_ARGS			1 if this variable is the last argument and is
+ *				named "args".
+ */
+
+/*
+ * FLAGS RENUMBERED: everything breaks already, make things simpler.
+ *
+ * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to
+ * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c
+ *
+ * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
+ * in precompiled scripts keep working.
  */
 
-#define VAR_SCALAR		0x1
-#define VAR_ARRAY		0x2
-#define VAR_LINK		0x4
-#define VAR_UNDEFINED		0x8
-#define VAR_IN_HASHTABLE	0x10
-#define VAR_TRACE_ACTIVE	0x20
-#define VAR_ARRAY_ELEMENT	0x40
-#define VAR_NAMESPACE_VAR	0x80
+/* Type of value (0 is scalar) */
+#define VAR_ARRAY		0x1
+#define VAR_LINK		0x2
+
+/* Type of storage (0 is compiled local) */
+#define VAR_IN_HASHTABLE	0x4
+#define VAR_DEAD_HASH		0x8
+#define VAR_ARRAY_ELEMENT	0x1000
+#define VAR_NAMESPACE_VAR	0x80	/* KEEP OLD VALUE for Itcl */
+
+#define VAR_ALL_HASH \
+	(VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT)
 
-#define VAR_ARGUMENT		0x100
-#define VAR_TEMPORARY		0x200
-#define VAR_RESOLVED		0x400	
+/* Trace and search state. */
+
+#define VAR_TRACED_READ		0x10	/* TCL_TRACE_READS */
+#define VAR_TRACED_WRITE	0x20	/* TCL_TRACE_WRITES */
+#define VAR_TRACED_UNSET	0x40	/* TCL_TRACE_UNSETS */
+#define VAR_TRACED_ARRAY	0x800	/* TCL_TRACE_ARRAY */
+#define VAR_TRACE_ACTIVE	0x2000
+#define VAR_SEARCH_ACTIVE	0x4000
+#define VAR_ALL_TRACES \
+	(VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
+
+/* Special handling on initialisation (only CompiledLocal). */
+#define VAR_ARGUMENT		0x100	/* KEEP OLD VALUE! See tclProc.c */
+#define VAR_TEMPORARY		0x200	/* KEEP OLD VALUE! See tclProc.c */
+#define VAR_IS_ARGS		0x400
+#define VAR_RESOLVED		0x8000
 
 /*
  * Macros to ensure that various flag bits are set properly for variables.
  * The ANSI C "prototypes" for these macros are:
  *
- * EXTERN void	TclSetVarScalar _ANSI_ARGS_((Var *varPtr));
- * EXTERN void	TclSetVarArray _ANSI_ARGS_((Var *varPtr));
- * EXTERN void	TclSetVarLink _ANSI_ARGS_((Var *varPtr));
- * EXTERN void	TclSetVarArrayElement _ANSI_ARGS_((Var *varPtr));
- * EXTERN void	TclSetVarUndefined _ANSI_ARGS_((Var *varPtr));
- * EXTERN void	TclClearVarUndefined _ANSI_ARGS_((Var *varPtr));
+ * MODULE_SCOPE void	TclSetVarScalar(Var *varPtr);
+ * MODULE_SCOPE void	TclSetVarArray(Var *varPtr);
+ * MODULE_SCOPE void	TclSetVarLink(Var *varPtr);
+ * MODULE_SCOPE void	TclSetVarArrayElement(Var *varPtr);
+ * MODULE_SCOPE void	TclSetVarUndefined(Var *varPtr);
+ * MODULE_SCOPE void	TclClearVarUndefined(Var *varPtr);
  */
 
 #define TclSetVarScalar(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK)
 
 #define TclSetVarArray(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY
 
 #define TclSetVarLink(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK
 
 #define TclSetVarArrayElement(varPtr) \
     (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
 
 #define TclSetVarUndefined(varPtr) \
-    (varPtr)->flags |= VAR_UNDEFINED
+    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\
+    (varPtr)->value.objPtr = NULL
+
+#define TclClearVarUndefined(varPtr)
+
+#define TclSetVarTraceActive(varPtr) \
+    (varPtr)->flags |= VAR_TRACE_ACTIVE
 
-#define TclClearVarUndefined(varPtr) \
-    (varPtr)->flags &= ~VAR_UNDEFINED
+#define TclClearVarTraceActive(varPtr) \
+    (varPtr)->flags &= ~VAR_TRACE_ACTIVE
+
+#define TclSetVarNamespaceVar(varPtr) \
+    if (!TclIsVarNamespaceVar(varPtr)) {\
+	(varPtr)->flags |= VAR_NAMESPACE_VAR;\
+	if (TclIsVarInHash(varPtr)) {\
+	    ((VarInHash *)(varPtr))->refCount++;\
+	}\
+    }
+
+#define TclClearVarNamespaceVar(varPtr) \
+    if (TclIsVarNamespaceVar(varPtr)) {\
+	(varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
+	if (TclIsVarInHash(varPtr)) {\
+	    ((VarInHash *)(varPtr))->refCount--;\
+	}\
+    }
 
 /*
  * Macros to read various flag bits of variables.
  * The ANSI C "prototypes" for these macros are:
  *
- * EXTERN int	TclIsVarScalar _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarLink _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarArray _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarUndefined _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarArrayElement _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarTemporary _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarArgument _ANSI_ARGS_((Var *varPtr));
- * EXTERN int	TclIsVarResolved _ANSI_ARGS_((Var *varPtr));
- */
-    
+ * MODULE_SCOPE int	TclIsVarScalar(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
+ * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);
+ */
+
 #define TclIsVarScalar(varPtr) \
-    ((varPtr)->flags & VAR_SCALAR)
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
 
 #define TclIsVarLink(varPtr) \
     ((varPtr)->flags & VAR_LINK)
@@ -586,24 +730,74 @@ typedef struct Var {
     ((varPtr)->flags & VAR_ARRAY)
 
 #define TclIsVarUndefined(varPtr) \
-    ((varPtr)->flags & VAR_UNDEFINED)
+    ((varPtr)->value.objPtr == NULL)
 
 #define TclIsVarArrayElement(varPtr) \
     ((varPtr)->flags & VAR_ARRAY_ELEMENT)
 
+#define TclIsVarNamespaceVar(varPtr) \
+    ((varPtr)->flags & VAR_NAMESPACE_VAR)
+
 #define TclIsVarTemporary(varPtr) \
     ((varPtr)->flags & VAR_TEMPORARY)
-    
+
 #define TclIsVarArgument(varPtr) \
     ((varPtr)->flags & VAR_ARGUMENT)
-    
+
 #define TclIsVarResolved(varPtr) \
     ((varPtr)->flags & VAR_RESOLVED)
 
+#define TclIsVarTraceActive(varPtr) \
+    ((varPtr)->flags & VAR_TRACE_ACTIVE)
+
+#define TclIsVarTraced(varPtr) \
+    ((varPtr)->flags & VAR_ALL_TRACES)
+
+#define TclIsVarInHash(varPtr) \
+    ((varPtr)->flags & VAR_IN_HASHTABLE)
+
+#define TclIsVarDeadHash(varPtr) \
+    ((varPtr)->flags & VAR_DEAD_HASH)
+
+#define TclGetVarNsPtr(varPtr) \
+    (TclIsVarInHash(varPtr) \
+	? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
+	: NULL)
+
+#define VarHashRefCount(varPtr) \
+    ((VarInHash *) (varPtr))->refCount
+
+/*
+ * Macros for direct variable access by TEBC.
+ */
+
+#define TclIsVarDirectReadable(varPtr) \
+    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
+    &&  (varPtr)->value.objPtr)
+
+#define TclIsVarDirectWritable(varPtr) \
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))
+
+#define TclIsVarDirectModifyable(varPtr) \
+    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
+    &&  (varPtr)->value.objPtr)
+
+#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
+    (TclIsVarDirectReadable(varPtr) &&\
+	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
+
+#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
+    (TclIsVarDirectWritable(varPtr) &&\
+	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))
+
+#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \
+    (TclIsVarDirectModifyable(varPtr) &&\
+	(!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
+
 /*
  *----------------------------------------------------------------
- * Data structures related to procedures.  These are used primarily
- * in tclProc.c, tclCompile.c, and tclExecute.c.
+ * Data structures related to procedures. These are used primarily in
+ * tclProc.c, tclCompile.c, and tclExecute.c.
  *----------------------------------------------------------------
  */
 
@@ -616,32 +810,31 @@ struct Command;
 
 /*
  * The variable-length structure below describes a local variable of a
- * procedure that was recognized by the compiler. These variables have a
- * name, an element in the array of compiler-assigned local variables in the
+ * procedure that was recognized by the compiler. These variables have a name,
+ * an element in the array of compiler-assigned local variables in the
  * procedure's call frame, and various other items of information. If the
- * local variable is a formal argument, it may also have a default value.
- * The compiler can't recognize local variables whose names are
- * expressions (these names are only known at runtime when the expressions
- * are evaluated) or local variables that are created as a result of an
- * "upvar" or "uplevel" command. These other local variables are kept
- * separately in a hash table in the call frame.
+ * local variable is a formal argument, it may also have a default value. The
+ * compiler can't recognize local variables whose names are expressions (these
+ * names are only known at runtime when the expressions are evaluated) or
+ * local variables that are created as a result of an "upvar" or "uplevel"
+ * command. These other local variables are kept separately in a hash table in
+ * the call frame.
  */
 
 typedef struct CompiledLocal {
     struct CompiledLocal *nextPtr;
-				/* Next compiler-recognized local variable
-				 * for this procedure, or NULL if this is
-				 * the last local. */
+				/* Next compiler-recognized local variable for
+				 * this procedure, or NULL if this is the last
+				 * local. */
     int nameLength;		/* The number of characters in local
-				 * variable's name. Used to speed up
-				 * variable lookups. */
+				 * variable's name. Used to speed up variable
+				 * lookups. */
     int frameIndex;		/* Index in the array of compiler-assigned
 				 * variables in the procedure call frame. */
     int flags;			/* Flag bits for the local variable. Same as
 				 * the flags for the Var structure above,
-				 * although only VAR_SCALAR, VAR_ARRAY, 
-				 * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and
-				 * VAR_RESOLVED make sense. */
+				 * although only VAR_ARGUMENT, VAR_TEMPORARY,
+				 * and VAR_RESOLVED make sense. */
     Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
 				 * argument, if any. NULL if not an argument
 				 * or, if an argument, no default value. */
@@ -649,277 +842,306 @@ typedef struct CompiledLocal {
 				/* Customized variable resolution info
 				 * supplied by the Tcl_ResolveCompiledVarProc
 				 * associated with a namespace. Each variable
-				 * is marked by a unique ClientData tag
-				 * during compilation, and that same tag
-				 * is used to find the variable at runtime. */
-    char name[4];		/* Name of the local variable starts here.
-				 * If the name is NULL, this will just be
-				 * '\0'. The actual size of this field will
-				 * be large enough to hold the name. MUST
-				 * BE THE LAST FIELD IN THE STRUCTURE! */
+				 * is marked by a unique ClientData tag during
+				 * compilation, and that same tag is used to
+				 * find the variable at runtime. */
+    char name[4];		/* Name of the local variable starts here. If
+				 * the name is NULL, this will just be '\0'.
+				 * The actual size of this field will be large
+				 * enough to hold the name. MUST BE THE LAST
+				 * FIELD IN THE STRUCTURE! */
 } CompiledLocal;
 
 /*
  * The structure below defines a command procedure, which consists of a
- * collection of Tcl commands plus information about arguments and other
- * local variables recognized at compile time.
+ * collection of Tcl commands plus information about arguments and other local
+ * variables recognized at compile time.
  */
 
 typedef struct Proc {
-    struct Interp *iPtr;	  /* Interpreter for which this command
-				   * is defined. */
-    int refCount;		  /* Reference count: 1 if still present
-				   * in command table plus 1 for each call
-				   * to the procedure that is currently
-				   * active. This structure can be freed
-				   * when refCount becomes zero. */
-    struct Command *cmdPtr;	  /* Points to the Command structure for
-				   * this procedure. This is used to get
-				   * the namespace in which to execute
-				   * the procedure. */
-    Tcl_Obj *bodyPtr;		  /* Points to the ByteCode object for
-				   * procedure's body command. */
-    int numArgs;		  /* Number of formal parameters. */
-    int numCompiledLocals;	  /* Count of local variables recognized by
-				   * the compiler including arguments and
-				   * temporaries. */
-    CompiledLocal *firstLocalPtr; /* Pointer to first of the procedure's
-				   * compiler-allocated local variables, or
-				   * NULL if none. The first numArgs entries
-				   * in this list describe the procedure's
-				   * formal arguments. */
-    CompiledLocal *lastLocalPtr;  /* Pointer to the last allocated local
-				   * variable or NULL if none. This has
-				   * frame index (numCompiledLocals-1). */
+    struct Interp *iPtr;	/* Interpreter for which this command is
+				 * defined. */
+    int refCount;		/* Reference count: 1 if still present in
+				 * command table plus 1 for each call to the
+				 * procedure that is currently active. This
+				 * structure can be freed when refCount
+				 * becomes zero. */
+    struct Command *cmdPtr;	/* Points to the Command structure for this
+				 * procedure. This is used to get the
+				 * namespace in which to execute the
+				 * procedure. */
+    Tcl_Obj *bodyPtr;		/* Points to the ByteCode object for
+				 * procedure's body command. */
+    int numArgs;		/* Number of formal parameters. */
+    int numCompiledLocals;	/* Count of local variables recognized by the
+				 * compiler including arguments and
+				 * temporaries. */
+    CompiledLocal *firstLocalPtr;
+				/* Pointer to first of the procedure's
+				 * compiler-allocated local variables, or NULL
+				 * if none. The first numArgs entries in this
+				 * list describe the procedure's formal
+				 * arguments. */
+    CompiledLocal *lastLocalPtr;/* Pointer to the last allocated local
+				 * variable or NULL if none. This has frame
+				 * index (numCompiledLocals-1). */
 } Proc;
 
 /*
- * The structure below defines a command trace.	 This is used to allow Tcl
+ * The type of functions called to process errors found during the execution
+ * of a procedure (or lambda term or ...).
+ */
+
+typedef void (*ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
+
+/*
+ * The structure below defines a command trace. This is used to allow Tcl
  * clients to find out whenever a command is about to be executed.
  */
 
 typedef struct Trace {
-    int level;			/* Only trace commands at nesting level
-				 * less than or equal to this. */
+    int level;			/* Only trace commands at nesting level less
+				 * than or equal to this. */
     Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
     ClientData clientData;	/* Arbitrary value to pass to proc. */
     struct Trace *nextPtr;	/* Next in list of traces for this interp. */
     int flags;			/* Flags governing the trace - see
-				 * Tcl_CreateObjTrace for details */
-    Tcl_CmdObjTraceDeleteProc* delProc;
-				/* Procedure to call when trace is deleted */
+				 * Tcl_CreateObjTrace for details. */
+    Tcl_CmdObjTraceDeleteProc *delProc;
+				/* Procedure to call when trace is deleted. */
 } Trace;
 
 /*
- * When an interpreter trace is active (i.e. its associated procedure
- * is executing), one of the following structures is linked into a list
- * associated with the interpreter.  The information in the structure
- * is needed in order for Tcl to behave reasonably if traces are
- * deleted while traces are active.
+ * When an interpreter trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the interpreter. The information in the structure is needed
+ * in order for Tcl to behave reasonably if traces are deleted while traces
+ * are active.
  */
 
 typedef struct ActiveInterpTrace {
     struct ActiveInterpTrace *nextPtr;
-				/* Next in list of all active command
-				 * traces for the interpreter, or NULL
-				 * if no more. */
-    Trace *nextTracePtr;	/* Next trace to check after current
-				 * trace procedure returns;  if this
-				 * trace gets deleted, must update pointer
-				 * to avoid using free'd memory. */
-    int reverseScan;		/* Boolean set true when the traces
-				 * are scanning in reverse order. */
+				/* Next in list of all active command traces
+				 * for the interpreter, or NULL if no more. */
+    Trace *nextTracePtr;	/* Next trace to check after current trace
+				 * procedure returns; if this trace gets
+				 * deleted, must update pointer to avoid using
+				 * free'd memory. */
+    int reverseScan;		/* Boolean set true when traces are scanning
+				 * in reverse order. */
 } ActiveInterpTrace;
 
 /*
- * The structure below defines an entry in the assocData hash table which
- * is associated with an interpreter. The entry contains a pointer to a
- * function to call when the interpreter is deleted, and a pointer to
- * a user-defined piece of data.
+ * Flag values designating types of execution traces. See tclTrace.c for
+ * related flag values.
+ *
+ * TCL_TRACE_ENTER_EXEC		- triggers enter/enterstep traces.
+ * 				- passed to Tcl_CreateObjTrace to set up
+ *				  "enterstep" traces.
+ * TCL_TRACE_LEAVE_EXEC		- triggers leave/leavestep traces.
+ * 				- passed to Tcl_CreateObjTrace to set up
+ *				  "leavestep" traces.
+ */
+
+#define TCL_TRACE_ENTER_EXEC	1
+#define TCL_TRACE_LEAVE_EXEC	2
+
+/*
+ * The structure below defines an entry in the assocData hash table which is
+ * associated with an interpreter. The entry contains a pointer to a function
+ * to call when the interpreter is deleted, and a pointer to a user-defined
+ * piece of data.
  */
 
 typedef struct AssocData {
     Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
     ClientData clientData;	/* Value to pass to proc. */
-} AssocData;	
+} AssocData;
 
 /*
  * The structure below defines a call frame. A call frame defines a naming
- * context for a procedure call: its local naming scope (for local
- * variables) and its global naming scope (a namespace, perhaps the global
- * :: namespace). A call frame can also define the naming context for a
- * namespace eval or namespace inscope command: the namespace in which the
- * command's code should execute. The Tcl_CallFrame structures exist only
- * while procedures or namespace eval/inscope's are being executed, and
- * provide a kind of Tcl call stack.
- * 
+ * context for a procedure call: its local naming scope (for local variables)
+ * and its global naming scope (a namespace, perhaps the global :: namespace).
+ * A call frame can also define the naming context for a namespace eval or
+ * namespace inscope command: the namespace in which the command's code should
+ * execute. The Tcl_CallFrame structures exist only while procedures or
+ * namespace eval/inscope's are being executed, and provide a kind of Tcl call
+ * stack.
+ *
  * WARNING!! The structure definition must be kept consistent with the
  * Tcl_CallFrame structure in tcl.h. If you change one, change the other.
  */
 
+/*
+ * Will be grown to contain: pointers to the varnames (allocated at the end),
+ * plus the init values for each variable (suitable to be memcopied on init)
+ */
+
+typedef struct LocalCache {
+    int refCount;
+    int numVars;
+    Tcl_Obj *varName0;
+} LocalCache;
+
+#define localName(framePtr, i) \
+    ((&((framePtr)->localCachePtr->varName0))[(i)])
+
+MODULE_SCOPE void	TclFreeLocalCache(Tcl_Interp *interp,
+			    LocalCache *localCachePtr);
+
 typedef struct CallFrame {
     Namespace *nsPtr;		/* Points to the namespace used to resolve
 				 * commands and global variables. */
-    int isProcCallFrame;	/* If nonzero, the frame was pushed to
-				 * execute a Tcl procedure and may have
-				 * local vars. If 0, the frame was pushed
-				 * to execute a namespace command and var
-				 * references are treated as references to
-				 * namespace vars; varTablePtr and
-				 * compiledLocals are ignored. */
-    int objc;			/* This and objv below describe the
-				 * arguments for this procedure call. */
-    Tcl_Obj *CONST *objv;	/* Array of argument objects. */
+    int isProcCallFrame;	/* If 0, the frame was pushed to execute a
+				 * namespace command and var references are
+				 * treated as references to namespace vars;
+				 * varTablePtr and compiledLocals are ignored.
+				 * If FRAME_IS_PROC is set, the frame was
+				 * pushed to execute a Tcl procedure and may
+				 * have local vars. */
+    int objc;			/* This and objv below describe the arguments
+				 * for this procedure call. */
+    Tcl_Obj *const *objv;	/* Array of argument objects. */
     struct CallFrame *callerPtr;
 				/* Value of interp->framePtr when this
-				 * procedure was invoked (i.e. next higher
-				 * in stack of all active procedures). */
+				 * procedure was invoked (i.e. next higher in
+				 * stack of all active procedures). */
     struct CallFrame *callerVarPtr;
 				/* Value of interp->varFramePtr when this
 				 * procedure was invoked (i.e. determines
-				 * variable scoping within caller). Same
-				 * as callerPtr unless an "uplevel" command
-				 * or something equivalent was active in
-				 * the caller). */
+				 * variable scoping within caller). Same as
+				 * callerPtr unless an "uplevel" command or
+				 * something equivalent was active in the
+				 * caller). */
     int level;			/* Level of this procedure, for "uplevel"
 				 * purposes (i.e. corresponds to nesting of
 				 * callerVarPtr's, not callerPtr's). 1 for
 				 * outermost procedure, 0 for top-level. */
-    Proc *procPtr;		/* Points to the structure defining the
-				 * called procedure. Used to get information
-				 * such as the number of compiled local
-				 * variables (local variables assigned
-				 * entries ["slots"] in the compiledLocals
-				 * array below). */
-    Tcl_HashTable *varTablePtr;	/* Hash table containing local variables not
+    Proc *procPtr;		/* Points to the structure defining the called
+				 * procedure. Used to get information such as
+				 * the number of compiled local variables
+				 * (local variables assigned entries ["slots"]
+				 * in the compiledLocals array below). */
+    TclVarHashTable *varTablePtr;
+				/* Hash table containing local variables not
 				 * recognized by the compiler, or created at
 				 * execution time through, e.g., upvar.
 				 * Initially NULL and created if needed. */
-    int numCompiledLocals;	/* Count of local variables recognized by
-				 * the compiler including arguments. */
-    Var* compiledLocals;	/* Points to the array of local variables
+    int numCompiledLocals;	/* Count of local variables recognized by the
+				 * compiler including arguments. */
+    Var *compiledLocals;	/* Points to the array of local variables
 				 * recognized by the compiler. The compiler
 				 * emits code that refers to these variables
 				 * using an index into this array. */
+    ClientData clientData;	/* Pointer to some context that is used by
+				 * object systems. The meaning of the contents
+				 * of this field is defined by the code that
+				 * sets it, and it should only ever be set by
+				 * the code that is pushing the frame. In that
+				 * case, the code that sets it should also
+				 * have some means of discovering what the
+				 * meaning of the value is, which we do not
+				 * specify. */
+    LocalCache *localCachePtr;
 } CallFrame;
 
-#ifdef TCL_TIP280
+#define FRAME_IS_PROC	0x1
+#define FRAME_IS_LAMBDA 0x2
+
 /*
  * TIP #280
- * The structure below defines a command frame. A command frame
- * provides location information for all commands executing a tcl
- * script (source, eval, uplevel, procedure bodies, ...). The runtime
- * structure essentially contains the stack trace as it would be if
- * the currently executing command were to throw an error.
+ * The structure below defines a command frame. A command frame provides
+ * location information for all commands executing a tcl script (source, eval,
+ * uplevel, procedure bodies, ...). The runtime structure essentially contains
+ * the stack trace as it would be if the currently executing command were to
+ * throw an error.
  *
- * For commands where it makes sense it refers to the associated
- * CallFrame as well.
+ * For commands where it makes sense it refers to the associated CallFrame as
+ * well.
  *
- * The structures are chained in a single list, with the top of the
- * stack anchored in the Interp structure.
+ * The structures are chained in a single list, with the top of the stack
+ * anchored in the Interp structure.
  *
- * Instances can be allocated on the C stack, or the heap, the former
- * making cleanup a bit simpler.
+ * Instances can be allocated on the C stack, or the heap, the former making
+ * cleanup a bit simpler.
  */
 
 typedef struct CmdFrame {
-  /* General data. Always available. */
-
-  int              type;     /* Values see below */
-  int              level;    /* #Frames in stack, prevent O(n) scan of list */
-  int*             line;     /* Lines the words of the command start on */
-  int              nline;
-
-  CallFrame*       framePtr; /* Procedure activation record, may be NULL */
-  struct CmdFrame* nextPtr;  /* Link to calling frame */
-
-  /* Data needed for Eval vs TEBC
-   *
-   * EXECUTION CONTEXTS and usage of CmdFrame
-   *
-   * Field      TEBC            EvalEx          EvalObjEx
-   * =======    ====            ======          =========
-   * level      yes             yes             yes
-   * type       BC/PREBC        SRC/EVAL        EVAL_LIST
-   * line0      yes             yes             yes
-   * framePtr   yes             yes             yes
-   * =======    ====            ======          =========
-   *
-   * =======    ====            ======          ========= union data
-   * line1      -               yes             -
-   * line3      -               yes             -
-   * path       -               yes             -
-   * -------    ----            ------          ---------
-   * codePtr    yes             -               -
-   * pc         yes             -               -
-   * =======    ====            ======          =========
-   *
-   * =======    ====            ======          ========= | union cmd
-   * listPtr    -               -               yes       |
-   * -------    ----            ------          --------- |
-   * cmd        yes             yes             -         |
-   * cmdlen     yes             yes             -         |
-   * -------    ----            ------          --------- |
-   */
-
-  union {
-    struct {
-      Tcl_Obj*     path;     /* Path of the sourced file the command
-			      * is in. */
-    } eval;
-    struct {
-      CONST void*  codePtr;  /* Byte code currently executed */
-      CONST char*  pc;       /* and instruction pointer.     */
-    } tebc;
-  } data;
+    /*
+     * General data. Always available.
+     */
 
-  union {
-    struct {
-      CONST char*  cmd;      /* The executed command, if possible */
-      int          len;      /* And its length */
-    } str;
-    Tcl_Obj*       listPtr;  /* Tcl_EvalObjEx, cmd list */
-  } cmd;
+    int type;			/* Values see below. */
+    int level;			/* Number of frames in stack, prevent O(n)
+				 * scan of list. */
+    int *line;			/* Lines the words of the command start on. */
+    int nline;
+    CallFrame *framePtr;	/* Procedure activation record, may be
+				 * NULL. */
+    struct CmdFrame *nextPtr;	/* Link to calling frame. */
+    /*
+     * Data needed for Eval vs TEBC
+     *
+     * EXECUTION CONTEXTS and usage of CmdFrame
+     *
+     * Field	  TEBC		  EvalEx	  EvalObjEx
+     * =======	  ====		  ======	  =========
+     * level	  yes		  yes		  yes
+     * type	  BC/PREBC	  SRC/EVAL	  EVAL_LIST
+     * line0	  yes		  yes		  yes
+     * framePtr	  yes		  yes		  yes
+     * =======	  ====		  ======	  =========
+     *
+     * =======	  ====		  ======	  ========= union data
+     * line1	  -		  yes		  -
+     * line3	  -		  yes		  -
+     * path	  -		  yes		  -
+     * -------	  ----		  ------	  ---------
+     * codePtr	  yes		  -		  -
+     * pc	  yes		  -		  -
+     * =======	  ====		  ======	  =========
+     *
+     * =======	  ====		  ======	  ========= | union cmd
+     * listPtr	  -		  -		  yes	    |
+     * -------	  ----		  ------	  --------- |
+     * cmd	  yes		  yes		  -	    |
+     * cmdlen	  yes		  yes		  -	    |
+     * -------	  ----		  ------	  --------- |
+     */
 
+    union {
+	struct {
+	    Tcl_Obj *path;	/* Path of the sourced file the command is
+				 * in. */
+	} eval;
+	struct {
+	    const void *codePtr;/* Byte code currently executed... */
+	    const char *pc;	/* ... and instruction pointer. */
+	} tebc;
+    } data;
+    union {
+	struct {
+	    const char *cmd;	/* The executed command, if possible... */
+	    int len;		/* ... and its length. */
+	} str;
+	Tcl_Obj *listPtr;	/* Tcl_EvalObjEx, cmd list. */
+    } cmd;
 } CmdFrame;
 
-/* The following macros define the allowed values for the type field
- * of the CmdFrame structure above. Some of the values occur only in
- * the extended location data referenced via the 'baseLocPtr'.
- *
- * TCL_LOCATION_EVAL      : Frame is for a script evaluated by EvalEx.
- * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
- *                          optimization path of EvalObjEx.
- * TCL_LOCATION_BC        : Frame is for bytecode. 
- * TCL_LOCATION_PREBC     : Frame is for precompiled bytecode.
- * TCL_LOCATION_SOURCE    : Frame is for a script evaluated by EvalEx,
- *                          from a sourced file.
- * TCL_LOCATION_PROC      : Frame is for bytecode of a procedure.
- *
- * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and
- * _PROC types, per the context of the byte code in execution.
- */
-
-#define TCL_LOCATION_EVAL      (0) /* Location in a dynamic eval script */
-#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, list-path */
-#define TCL_LOCATION_BC        (2) /* Location in byte code */
-#define TCL_LOCATION_PREBC     (3) /* Location in precompiled byte code, no location */
-#define TCL_LOCATION_SOURCE    (4) /* Location in a file */
-#define TCL_LOCATION_PROC      (5) /* Location in a dynamic proc */
-
-#define TCL_LOCATION_LAST      (6) /* Number of values in the enum */
-
 typedef struct CFWord {
-  CmdFrame* framePtr;  /* CmdFrame to acess */
-  int       word;      /* Index of the word in the command */
-  int       refCount;  /* #times the word is on the stack */
+    CmdFrame *framePtr;		/* CmdFrame to access. */
+    int word;			/* Index of the word in the command. */
+    int refCount;		/* Number of times the word is on the
+				 * stack. */
 } CFWord;
 
 typedef struct CFWordBC {
-    CmdFrame* framePtr;  /* CmdFrame to acess */
-    int pc;   /* Instruction pointer of a command in ExtCmdLoc.loc[.] */
-    int word; /* Index of word in ExtCmdLoc.loc[cmd]->{line,literal}[.] */
-    struct CFWordBC* prevPtr;
+    CmdFrame *framePtr;		/* CmdFrame to access. */
+    int pc;			/* Instruction pointer of a command in
+				 * ExtCmdLoc.loc[.] */
+    int word;			/* Index of word in
+				 * ExtCmdLoc.loc[cmd]->line[.] */
+    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
 } CFWordBC;
 
 /*
@@ -932,96 +1154,125 @@ typedef struct CFWordBC {
  * tracking.
  *
  * These structures are allocated and filled by both the function
- * EvalTokensStandard() in the file "tclBasic.c" and its caller EvalEx(), and
- * stored in the thread-global hashtable "lineCLPtr" in file "tclObj.c". They
- * are used by the functions TclSetByteCodeFromAny() and TclCompileScript(),
- * both found in the file "tclCompile.c". Their memory is released by the
- * function TclFreeObj(), in the file "tclObj.c", and also by the function
- * TclThreadFinalizeObjects(), in the same file.
+ * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
+ * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
+ * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
+ * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
+ * released by the function TclFreeObj(), in the file "tclObj.c", and also by
+ * the function TclThreadFinalizeObjects(), in the same file.
  */
 
-#define CLL_END (-1)
+#define CLL_END		(-1)
 
 typedef struct ContLineLoc {
-  int num;      /* Number of entries in loc, not counting the final -1
-		 * marker entry */
-  int loc[1];   /* Table of locations, as character offsets. The table is
-		 * allocated as part of the structure, i.e. the loc array
-		 * extends behind the nominal end of the structure. An entry
-		 * containing the value CLL_END is put after the last
-		 * location, as end-marker/sentinel. */
+    int num;			/* Number of entries in loc, not counting the
+				 * final -1 marker entry. */
+    int loc[1];			/* Table of locations, as character offsets.
+				 * The table is allocated as part of the
+				 * structure, extending behind the nominal end
+				 * of the structure. An entry containing the
+				 * value -1 is put after the last location, as
+				 * end-marker/sentinel. */
 } ContLineLoc;
 
-#endif /* TCL_TIP280 */
+/*
+ * The following macros define the allowed values for the type field of the
+ * CmdFrame structure above. Some of the values occur only in the extended
+ * location data referenced via the 'baseLocPtr'.
+ *
+ * TCL_LOCATION_EVAL	  : Frame is for a script evaluated by EvalEx.
+ * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
+ *			    optimization path of EvalObjEx.
+ * TCL_LOCATION_BC	  : Frame is for bytecode.
+ * TCL_LOCATION_PREBC	  : Frame is for precompiled bytecode.
+ * TCL_LOCATION_SOURCE	  : Frame is for a script evaluated by EvalEx, from a
+ *			    sourced file.
+ * TCL_LOCATION_PROC	  : Frame is for bytecode of a procedure.
+ *
+ * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
+ * types, per the context of the byte code in execution.
+ */
+
+#define TCL_LOCATION_EVAL	(0) /* Location in a dynamic eval script. */
+#define TCL_LOCATION_EVAL_LIST	(1) /* Location in a dynamic eval script,
+				     * list-path. */
+#define TCL_LOCATION_BC		(2) /* Location in byte code. */
+#define TCL_LOCATION_PREBC	(3) /* Location in precompiled byte code, no
+				     * location. */
+#define TCL_LOCATION_SOURCE	(4) /* Location in a file. */
+#define TCL_LOCATION_PROC	(5) /* Location in a dynamic proc. */
+#define TCL_LOCATION_LAST	(6) /* Number of values in the enum. */
+
+/*
+ * Structure passed to describe procedure-like "procedures" that are not
+ * procedures (e.g. a lambda) so that their details can be reported correctly
+ * by [info frame]. Contains a sub-structure for each extra field.
+ */
+
+typedef Tcl_Obj *(*GetFrameInfoValueProc)(ClientData clientData);
+typedef struct {
+    const char *name;		/* Name of this field. */
+    GetFrameInfoValueProc proc;	/* Function to generate a Tcl_Obj* from the
+				 * clientData, or just use the clientData
+				 * directly (after casting) if NULL. */
+    ClientData clientData;	/* Context for above function, or Tcl_Obj* if
+				 * proc field is NULL. */
+} ExtraFrameInfoField;
+typedef struct {
+    int length;			/* Length of array. */
+    ExtraFrameInfoField fields[2];
+				/* Really as long as necessary, but this is
+				 * long enough for nearly anything. */
+} ExtraFrameInfo;
 
 /*
  *----------------------------------------------------------------
- * Data structures and procedures related to TclHandles, which
- * are a very lightweight method of preserving enough information
- * to determine if an arbitrary malloc'd block has been deleted.
+ * Data structures and procedures related to TclHandles, which are a very
+ * lightweight method of preserving enough information to determine if an
+ * arbitrary malloc'd block has been deleted.
  *----------------------------------------------------------------
  */
 
-typedef VOID **TclHandle;
+typedef void **TclHandle;
 
 /*
  *----------------------------------------------------------------
- * Data structures related to expressions.  These are used only in
- * tclExpr.c.
+ * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use
+ * only by Expect. It will probably go away in a later release.
  *----------------------------------------------------------------
  */
 
-/*
- * The data structure below defines a math function (e.g. sin or hypot)
- * for use in Tcl expressions.
- */
-
-#define MAX_MATH_ARGS 5
-typedef struct MathFunc {
-    int builtinFuncIndex;	/* If this is a builtin math function, its
-				 * index in the array of builtin functions.
-				 * (tclCompilation.h lists these indices.)
-				 * The value is -1 if this is a new function
-				 * defined by Tcl_CreateMathFunc. The value
-				 * is also -1 if a builtin function is
-				 * replaced by a Tcl_CreateMathFunc call. */
-    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.
-				 * NULL if isBuiltinFunc is 1. */
-    ClientData clientData;	/* Additional argument to pass to the
-				 * function when invoking it. NULL if
-				 * isBuiltinFunc is 1. */
-} MathFunc;
+#define TCL_REG_BOSONLY 002000	/* Prepend \A to pattern so it only matches at
+				 * the beginning of the string. */
 
 /*
  * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet
- * when threads are used, or an emulation if there are no threads.  These
- * are really internal and Tcl clients should use Tcl_GetThreadData.
+ * when threads are used, or an emulation if there are no threads. These are
+ * really internal and Tcl clients should use Tcl_GetThreadData.
  */
 
-EXTERN VOID *TclThreadDataKeyGet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr));
-EXTERN void TclThreadDataKeySet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr, VOID *data));
+MODULE_SCOPE void *	TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
+MODULE_SCOPE void	TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
+			    void *data);
 
 /*
  * This is a convenience macro used to initialize a thread local storage ptr.
  */
-#define TCL_TSD_INIT(keyPtr)	(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
 
+#define TCL_TSD_INIT(keyPtr) \
+  (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
 
 /*
  *----------------------------------------------------------------
- * Data structures related to bytecode compilation and execution.
- * These are used primarily in tclCompile.c, tclExecute.c, and
- * tclBasic.c.
+ * Data structures related to bytecode compilation and execution. These are
+ * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c.
  *----------------------------------------------------------------
  */
 
 /*
  * Forward declaration to prevent errors when the forward references to
- * Tcl_Parse and CompileEnv are encountered in the procedure type
- * CompileProc declared below.
+ * Tcl_Parse and CompileEnv are encountered in the procedure type CompileProc
+ * declared below.
  */
 
 struct CompileEnv;
@@ -1029,62 +1280,72 @@ struct CompileEnv;
 /*
  * The type of procedures called by the Tcl bytecode compiler to compile
  * commands. Pointers to these procedures are kept in the Command structure
- * describing each command. When a CompileProc returns, the interpreter's
- * result is set to error information, if any. In addition, the CompileProc
- * returns an integer value, which is one of the following:
+ * describing each command. The integer value returned by a CompileProc must
+ * be one of the following:
  *
  * TCL_OK		Compilation completed normally.
- * TCL_ERROR		Compilation failed because of an error;
- *			the interpreter's result describes what went wrong.
- * TCL_OUT_LINE_COMPILE	Compilation failed because, e.g., the command is
- *			too complex for effective inline compilation. The
- *			CompileProc believes the command is legal but 
- *			should be compiled "out of line" by emitting code
- *			to invoke its command procedure at runtime.
+ * TCL_ERROR 		Compilation could not be completed. This can be just a
+ * 			judgment by the CompileProc that the command is too
+ * 			complex to compile effectively, or it can indicate
+ * 			that in the current state of the interp, the command
+ * 			would raise an error. The bytecode compiler will not
+ * 			do any error reporting at compiler time. Error
+ * 			reporting is deferred until the actual runtime,
+ * 			because by then changes in the interp state may allow
+ * 			the command to be successfully evaluated.
+ * TCL_OUT_LINE_COMPILE	A source-compatible alias for TCL_ERROR, kept for the
+ * 			sake of old code only.
  */
 
-#define TCL_OUT_LINE_COMPILE	(TCL_CONTINUE + 1)
+#define TCL_OUT_LINE_COMPILE	TCL_ERROR
 
-typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));
+typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
+	struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
 
 /*
  * The type of procedure called from the compilation hook point in
  * SetByteCodeFromAny.
  */
 
-typedef int (CompileHookProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	struct CompileEnv *compEnvPtr, ClientData clientData));
+typedef int (CompileHookProc)(Tcl_Interp *interp,
+	struct CompileEnv *compEnvPtr, ClientData clientData);
+
+/*
+ * The data structure for a (linked list of) execution stacks.
+ */
+
+typedef struct ExecStack {
+    struct ExecStack *prevPtr;
+    struct ExecStack *nextPtr;
+    Tcl_Obj **markerPtr;
+    Tcl_Obj **endPtr;
+    Tcl_Obj **tosPtr;
+    Tcl_Obj *stackWords[1];
+} ExecStack;
 
 /*
  * The data structure defining the execution environment for ByteCode's.
- * There is one ExecEnv structure per Tcl interpreter. It holds the
- * evaluation stack that holds command operands and results. The stack grows
- * towards increasing addresses. The "stackTop" member is cached by
- * TclExecuteByteCode in a local variable: it must be set before calling
- * TclExecuteByteCode and will be restored by TclExecuteByteCode before it
- * returns.
+ * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
+ * stack that holds command operands and results. The stack grows towards
+ * increasing addresses. The member stackPtr points to the stackItems of the
+ * currently active execution stack.
  */
 
 typedef struct ExecEnv {
-    Tcl_Obj **stackPtr;		/* Points to the first item in the
-				 * evaluation stack on the heap. */
-    int stackTop;		/* Index of current top of stack; -1 when
-				 * the stack is empty. */
-    int stackEnd;		/* Index of last usable item in stack. */
-    Tcl_Obj *errorInfo;
-    Tcl_Obj *errorCode;
+    ExecStack *execStackPtr;	/* Points to the first item in the evaluation
+				 * stack on the heap. */
+    Tcl_Obj *constants[2];	/* Pointers to constant "0" and "1" objs. */
 } ExecEnv;
 
 /*
  * The definitions for the LiteralTable and LiteralEntry structures. Each
  * interpreter contains a LiteralTable. It is used to reduce the storage
  * needed for all the Tcl objects that hold the literals of scripts compiled
- * by the interpreter. A literal's object is shared by all the ByteCodes
- * that refer to the literal. Each distinct literal has one LiteralEntry
- * entry in the LiteralTable. A literal table is a specialized hash table
- * that is indexed by the literal's string representation, which may contain
- * null characters.
+ * by the interpreter. A literal's object is shared by all the ByteCodes that
+ * refer to the literal. Each distinct literal has one LiteralEntry entry in
+ * the LiteralTable. A literal table is a specialized hash table that is
+ * indexed by the literal's string representation, which may contain null
+ * characters.
  *
  * Note that we reduce the space needed for literals by sharing literal
  * objects both within a ByteCode (each ByteCode contains a local
@@ -1093,37 +1354,36 @@ typedef struct ExecEnv {
  */
 
 typedef struct LiteralEntry {
-    struct LiteralEntry *nextPtr;	/* Points to next entry in this
-					 * hash bucket or NULL if end of
-					 * chain. */
-    Tcl_Obj *objPtr;			/* Points to Tcl object that
-					 * holds the literal's bytes and
-					 * length. */
-    int refCount;			/* If in an interpreter's global
-					 * literal table, the number of
-					 * ByteCode structures that share
-					 * the literal object; the literal
-					 * entry can be freed when refCount
-					 * drops to 0. If in a local literal
-					 * table, -1. */
+    struct LiteralEntry *nextPtr;
+				/* Points to next entry in this hash bucket or
+				 * NULL if end of chain. */
+    Tcl_Obj *objPtr;		/* Points to Tcl object that holds the
+				 * literal's bytes and length. */
+    int refCount;		/* If in an interpreter's global literal
+				 * table, the number of ByteCode structures
+				 * that share the literal object; the literal
+				 * entry can be freed when refCount drops to
+				 * 0. If in a local literal table, -1. */
+    Namespace *nsPtr;		/* Namespace in which this literal is used. We
+				 * try to avoid sharing literal non-FQ command
+				 * names among different namespaces to reduce
+				 * shimmering. */
 } LiteralEntry;
 
 typedef struct LiteralTable {
-    LiteralEntry **buckets;		/* Pointer to bucket array. Each
-					 * element points to first entry in
-					 * bucket's hash chain, or NULL. */
+    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
+				 * points to first entry in bucket's hash
+				 * chain, or NULL. */
     LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
-					/* Bucket array used for small
-					 * tables to avoid mallocs and
-					 * frees. */
-    int numBuckets;			/* Total number of buckets allocated
-					 * at **buckets. */
-    int numEntries;			/* Total number of entries present
-					 * in table. */
-    int rebuildSize;			/* Enlarge table when numEntries
-					 * gets to be this large. */
-    int mask;				/* Mask value used in hashing
-					 * function. */
+				/* Bucket array used for small tables to avoid
+				 * mallocs and frees. */
+    int numBuckets;		/* Total number of buckets allocated at
+				 * **buckets. */
+    int numEntries;		/* Total number of entries present in
+				 * table. */
+    int rebuildSize;		/* Enlarge table when numEntries gets to be
+				 * this large. */
+    int mask;			/* Mask value used in hashing function. */
 } LiteralTable;
 
 /*
@@ -1134,36 +1394,49 @@ typedef struct LiteralTable {
 
 #ifdef TCL_COMPILE_STATS
 typedef struct ByteCodeStats {
-    long numExecutions;		  /* Number of ByteCodes executed. */
-    long numCompilations;	  /* Number of ByteCodes created. */
-    long numByteCodesFreed;	  /* Number of ByteCodes destroyed. */
-    long instructionCount[256];	  /* Number of times each instruction was
-				   * executed. */
-
-    double totalSrcBytes;	  /* Total source bytes ever compiled. */
-    double totalByteCodeBytes;	  /* Total bytes for all ByteCodes. */
-    double currentSrcBytes;	  /* Src bytes for all current ByteCodes. */
-    double currentByteCodeBytes;  /* Code bytes in all current ByteCodes. */
-
-    long srcCount[32];		  /* Source size distribution: # of srcs of
-				   * size [2**(n-1)..2**n), n in [0..32). */
-    long byteCodeCount[32];	  /* ByteCode size distribution. */
-    long lifetimeCount[32];	  /* ByteCode lifetime distribution (ms). */
-    
-    double currentInstBytes;	  /* Instruction bytes-current ByteCodes. */
-    double currentLitBytes;	  /* Current literal bytes. */
-    double currentExceptBytes;	  /* Current exception table bytes. */
-    double currentAuxBytes;	  /* Current auxiliary information bytes. */
-    double currentCmdMapBytes;	  /* Current src<->code map bytes. */
-    
-    long numLiteralsCreated;	  /* Total literal objects ever compiled. */
-    double totalLitStringBytes;	  /* Total string bytes in all literals. */
-    double currentLitStringBytes; /* String bytes in current literals. */
-    long literalCount[32];	  /* Distribution of literal string sizes. */
+    long numExecutions;		/* Number of ByteCodes executed. */
+    long numCompilations;	/* Number of ByteCodes created. */
+    long numByteCodesFreed;	/* Number of ByteCodes destroyed. */
+    long instructionCount[256];	/* Number of times each instruction was
+				 * executed. */
+
+    double totalSrcBytes;	/* Total source bytes ever compiled. */
+    double totalByteCodeBytes;	/* Total bytes for all ByteCodes. */
+    double currentSrcBytes;	/* Src bytes for all current ByteCodes. */
+    double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */
+
+    long srcCount[32];		/* Source size distribution: # of srcs of
+				 * size [2**(n-1)..2**n), n in [0..32). */
+    long byteCodeCount[32];	/* ByteCode size distribution. */
+    long lifetimeCount[32];	/* ByteCode lifetime distribution (ms). */
+
+    double currentInstBytes;	/* Instruction bytes-current ByteCodes. */
+    double currentLitBytes;	/* Current literal bytes. */
+    double currentExceptBytes;	/* Current exception table bytes. */
+    double currentAuxBytes;	/* Current auxiliary information bytes. */
+    double currentCmdMapBytes;	/* Current src<->code map bytes. */
+
+    long numLiteralsCreated;	/* Total literal objects ever compiled. */
+    double totalLitStringBytes;	/* Total string bytes in all literals. */
+    double currentLitStringBytes;
+				/* String bytes in current literals. */
+    long literalCount[32];	/* Distribution of literal string sizes. */
 } ByteCodeStats;
 #endif /* TCL_COMPILE_STATS */
 
 /*
+ * Structure used in implementation of those core ensembles which are
+ * partially compiled. Used as an array of these, with a terminating field
+ * whose 'name' is NULL.
+ */
+
+typedef struct {
+    const char *name;		/* The name of the subcommand. */
+    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
+    CompileProc *compileProc;	/* The compiler for the subcommand. */
+} EnsembleImplMap;
+
+/*
  *----------------------------------------------------------------
  * Data structures related to commands.
  *----------------------------------------------------------------
@@ -1171,11 +1444,12 @@ typedef struct ByteCodeStats {
 
 /*
  * An imported command is created in an namespace when it imports a "real"
- * command from another namespace. An imported command has a Command
- * structure that points (via its ClientData value) to the "real" Command
- * structure in the source namespace's command table. The real command
- * records all the imported commands that refer to it in a list of ImportRef
- * structures so that they can be deleted when the real command is deleted.  */
+ * command from another namespace. An imported command has a Command structure
+ * that points (via its ClientData value) to the "real" Command structure in
+ * the source namespace's command table. The real command records all the
+ * imported commands that refer to it in a list of ImportRef structures so
+ * that they can be deleted when the real command is deleted.
+ */
 
 typedef struct ImportRef {
     struct Command *importedCmdPtr;
@@ -1183,11 +1457,11 @@ typedef struct ImportRef {
 				 * an importing namespace; this command
 				 * redirects its invocations to the "real"
 				 * command. */
-    struct ImportRef *nextPtr;	/* Next element on the linked list of
-				 * imported commands that refer to the
-				 * "real" command. The real command deletes
-				 * these imported commands on this list when
-				 * it is deleted. */
+    struct ImportRef *nextPtr;	/* Next element on the linked list of imported
+				 * commands that refer to the "real" command.
+				 * The real command deletes these imported
+				 * commands on this list when it is
+				 * deleted. */
 } ImportRef;
 
 /*
@@ -1200,35 +1474,34 @@ typedef struct ImportedCmdData {
     struct Command *realCmdPtr;	/* "Real" command that this imported command
 				 * refers to. */
     struct Command *selfPtr;	/* Pointer to this imported command. Needed
-				 * only when deleting it in order to remove
-				 * it from the real command's linked list of
+				 * only when deleting it in order to remove it
+				 * from the real command's linked list of
 				 * imported commands that refer to it. */
 } ImportedCmdData;
 
 /*
- * A Command structure exists for each command in a namespace. The
- * Tcl_Command opaque type actually refers to these structures.
+ * A Command structure exists for each command in a namespace. The Tcl_Command
+ * opaque type actually refers to these structures.
  */
 
 typedef struct Command {
-    Tcl_HashEntry *hPtr;	/* Pointer to the hash table entry that
-				 * refers to this command. The hash table is
-				 * either a namespace's command table or an
+    Tcl_HashEntry *hPtr;	/* Pointer to the hash table entry that refers
+				 * to this command. The hash table is either a
+				 * namespace's command table or an
 				 * interpreter's hidden command table. This
 				 * pointer is used to get a command's name
 				 * from its Tcl_Command handle. NULL means
-				 * that the hash table entry has been
-				 * removed already (this can happen if
-				 * deleteProc causes the command to be
-				 * deleted or recreated). */
+				 * that the hash table entry has been removed
+				 * already (this can happen if deleteProc
+				 * causes the command to be deleted or
+				 * recreated). */
     Namespace *nsPtr;		/* Points to the namespace containing this
 				 * command. */
     int refCount;		/* 1 if in command hashtable plus 1 for each
 				 * reference from a CmdName Tcl object
-				 * representing a command's name in a
-				 * ByteCode instruction sequence. This
-				 * structure can be freed when refCount
-				 * becomes zero. */
+				 * representing a command's name in a ByteCode
+				 * instruction sequence. This structure can be
+				 * freed when refCount becomes zero. */
     int cmdEpoch;		/* Incremented to invalidate any references
 				 * that point to this command when it is
 				 * renamed, deleted, hidden, or exposed. */
@@ -1239,45 +1512,46 @@ typedef struct Command {
     Tcl_CmdProc *proc;		/* String-based command procedure. */
     ClientData clientData;	/* Arbitrary value passed to string proc. */
     Tcl_CmdDeleteProc *deleteProc;
-				/* Procedure invoked when deleting command
-				 * to, e.g., free all client data. */
+				/* Procedure invoked when deleting command to,
+				 * e.g., free all client data. */
     ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
     int flags;			/* Miscellaneous bits of information about
 				 * command. See below for definitions. */
     ImportRef *importRefPtr;	/* List of each imported Command created in
 				 * another namespace when this command is
-				 * imported. These imported commands
-				 * redirect invocations back to this
-				 * command. The list is used to remove all
-				 * those imported commands when deleting
-				 * this "real" command. */
+				 * imported. These imported commands redirect
+				 * invocations back to this command. The list
+				 * is used to remove all those imported
+				 * commands when deleting this "real"
+				 * command. */
     CommandTrace *tracePtr;	/* First in list of all traces set for this
 				 * command. */
 } Command;
 
 /*
- * Flag bits for commands. 
+ * Flag bits for commands.
  *
- * CMD_IS_DELETED -		Means that the command is in the process
- *                              of being deleted (its deleteProc is
- *                              currently executing). Other attempts to
- *                              delete the command should be ignored.
+ * CMD_IS_DELETED -		Means that the command is in the process of
+ *				being deleted (its deleteProc is currently
+ *				executing). Other attempts to delete the
+ *				command should be ignored.
  * CMD_TRACE_ACTIVE -		1 means that trace processing is currently
- *				underway for a rename/delete change.
- *				See the two flags below for which is
- *				currently being processed.
- * CMD_HAS_EXEC_TRACES -	1 means that this command has at least
- *                              one execution trace (as opposed to simple
- *                              delete/rename traces) in its tracePtr list.
- * TCL_TRACE_RENAME -           A rename trace is in progress. Further
- *                              recursive renames will not be traced.
- * TCL_TRACE_DELETE -           A delete trace is in progress. Further 
- *                              recursive deletes will not be traced.
+ *				underway for a rename/delete change. See the
+ *				two flags below for which is currently being
+ *				processed.
+ * CMD_HAS_EXEC_TRACES -	1 means that this command has at least one
+ *				execution trace (as opposed to simple
+ *				delete/rename traces) in its tracePtr list.
+ * TCL_TRACE_RENAME -		A rename trace is in progress. Further
+ *				recursive renames will not be traced.
+ * TCL_TRACE_DELETE -		A delete trace is in progress. Further
+ *				recursive deletes will not be traced.
  * (these last two flags are defined in tcl.h)
  */
-#define CMD_IS_DELETED		0x1
-#define CMD_TRACE_ACTIVE	0x2
-#define CMD_HAS_EXEC_TRACES	0x4
+
+#define CMD_IS_DELETED		    0x1
+#define CMD_TRACE_ACTIVE	    0x2
+#define CMD_HAS_EXEC_TRACES	    0x4
 
 /*
  *----------------------------------------------------------------
@@ -1286,12 +1560,11 @@ typedef struct Command {
  */
 
 /*
- * The interpreter keeps a linked list of name resolution schemes.
- * The scheme for a namespace is consulted first, followed by the
- * list of schemes in an interpreter, followed by the default
- * name resolution in Tcl.  Schemes are added/removed from the
- * interpreter's list by calling Tcl_AddInterpResolver and
- * Tcl_RemoveInterpResolver.
+ * The interpreter keeps a linked list of name resolution schemes. The scheme
+ * for a namespace is consulted first, followed by the list of schemes in an
+ * interpreter, followed by the default name resolution in Tcl. Schemes are
+ * added/removed from the interpreter's list by calling Tcl_AddInterpResolver
+ * and Tcl_RemoveInterpResolver.
  */
 
 typedef struct ResolverScheme {
@@ -1300,18 +1573,23 @@ typedef struct ResolverScheme {
 				/* Procedure handling command name
 				 * resolution. */
     Tcl_ResolveVarProc *varResProc;
-				/* Procedure handling variable name
-				 * resolution for variables that
-				 * can only be handled at runtime. */
+				/* Procedure handling variable name resolution
+				 * for variables that can only be handled at
+				 * runtime. */
     Tcl_ResolveCompiledVarProc *compiledVarResProc;
-				/* Procedure handling variable name
-				 * resolution at compile time. */
+				/* Procedure handling variable name resolution
+				 * at compile time. */
 
     struct ResolverScheme *nextPtr;
 				/* Pointer to next record in linked list. */
 } ResolverScheme;
 
-#ifdef TCL_TIP268
+/*
+ * Forward declaration of the TIP#143 limit handler structure.
+ */
+
+typedef struct LimitHandler LimitHandler;
+
 /*
  * TIP #268.
  * Values for the selection mode, i.e the package require preferences.
@@ -1320,24 +1598,21 @@ typedef struct ResolverScheme {
 enum PkgPreferOptions {
     PKG_PREFER_LATEST, PKG_PREFER_STABLE
 };
-#endif
 
 /*
  *----------------------------------------------------------------
- * This structure defines an interpreter, which is a collection of
- * commands plus other state information related to interpreting
- * commands, such as variable storage. Primary responsibility for
- * this data structure is in tclBasic.c, but almost every Tcl
- * source file uses something in here.
+ * This structure defines an interpreter, which is a collection of commands
+ * plus other state information related to interpreting commands, such as
+ * variable storage. Primary responsibility for this data structure is in
+ * tclBasic.c, but almost every Tcl source file uses something in here.
  *----------------------------------------------------------------
  */
 
 typedef struct Interp {
-
     /*
-     * Note:  the first three fields must match exactly the fields in
-     * a Tcl_Interp struct (see tcl.h).	 If you change one, be sure to
-     * change the other.
+     * Note: the first three fields must match exactly the fields in a
+     * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
+     * other.
      *
      * The interpreter's result is held in both the string and the
      * objResultPtr fields. These fields hold, respectively, the result's
@@ -1346,106 +1621,97 @@ typedef struct Interp {
      * The two fields are kept consistent unless some C code sets
      * interp->result directly. Programs should not access result and
      * objResultPtr directly; instead, they should always get and set the
-     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult,
-     * and Tcl_GetStringResult. See the SetResult man page for details.
+     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
+     * Tcl_GetStringResult. See the SetResult man page for details.
      */
 
     char *result;		/* If the last command returned a string
 				 * result, this points to it. Should not be
 				 * accessed directly; see comment above. */
     Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
-				 * allocated. TCL_DYNAMIC means string
-				 * result was allocated with ckalloc and
-				 * should be freed with ckfree. Other values
-				 * give address of procedure to invoke to
-				 * free the string result. Tcl_Eval must
-				 * free it before executing next command. */
-    int errorLine;		/* When TCL_ERROR is returned, this gives
-				 * the line number in the command where the
-				 * error occurred (1 means first line). */
+				 * allocated. TCL_DYNAMIC means string result
+				 * was allocated with ckalloc and should be
+				 * freed with ckfree. Other values give
+				 * address of procedure to invoke to free the
+				 * string result. Tcl_Eval must free it before
+				 * executing next command. */
+    int errorLine;		/* When TCL_ERROR is returned, this gives the
+				 * line number in the command where the error
+				 * occurred (1 means first line). */
     struct TclStubs *stubTable;
-				/* Pointer to the exported Tcl stub table.
-				 * On previous versions of Tcl this is a
-				 * pointer to the objResultPtr or a pointer
-				 * to a buckets array in a hash table. We
-				 * therefore have to do some careful checking
-				 * before we can use this. */
+				/* Pointer to the exported Tcl stub table. On
+				 * previous versions of Tcl this is a pointer
+				 * to the objResultPtr or a pointer to a
+				 * buckets array in a hash table. We therefore
+				 * have to do some careful checking before we
+				 * can use this. */
 
     TclHandle handle;		/* Handle used to keep track of when this
 				 * interp is deleted. */
 
     Namespace *globalNsPtr;	/* The interpreter's global namespace. */
     Tcl_HashTable *hiddenCmdTablePtr;
-				/* Hash table used by tclBasic.c to keep
-				 * track of hidden commands on a per-interp
+				/* Hash table used by tclBasic.c to keep track
+				 * of hidden commands on a per-interp
 				 * basis. */
     ClientData interpInfo;	/* Information used by tclInterp.c to keep
-				 * track of master/slave interps on
-				 * a per-interp basis. */
-    Tcl_HashTable mathFuncTable;/* Contains all the math functions currently
-				 * defined for the interpreter.	 Indexed by
-				 * strings (function names); values have
-				 * type (MathFunc *). */
-
-
+				 * track of master/slave interps on a
+				 * per-interp basis. */
+    Tcl_HashTable unused2;	/* No longer used (was mathFuncTable) */
 
     /*
-     * Information related to procedures and variables. See tclProc.c
-     * and tclVar.c for usage.
+     * Information related to procedures and variables. See tclProc.c and
+     * tclVar.c for usage.
      */
 
     int numLevels;		/* Keeps track of how many nested calls to
 				 * Tcl_Eval are in progress for this
-				 * interpreter.	 It's used to delay deletion
-				 * of the table until all Tcl_Eval
-				 * invocations are completed. */
+				 * interpreter. It's used to delay deletion of
+				 * the table until all Tcl_Eval invocations
+				 * are completed. */
     int maxNestingDepth;	/* If numLevels exceeds this value then Tcl
 				 * assumes that infinite recursion has
 				 * occurred and it generates an error. */
     CallFrame *framePtr;	/* Points to top-most in stack of all nested
-				 * procedure invocations.  NULL means there
-				 * are no active procedures. */
+				 * procedure invocations. */
     CallFrame *varFramePtr;	/* Points to the call frame whose variables
 				 * are currently in use (same as framePtr
 				 * unless an "uplevel" command is
-				 * executing). NULL means no procedure is
-				 * active or "uplevel 0" is executing. */
+				 * executing). */
     ActiveVarTrace *activeVarTracePtr;
-				/* First in list of active traces for
-				 * interp, or NULL if no active traces. */
-    int returnCode;		/* Completion code to return if current
-				 * procedure exits with TCL_RETURN code. */
-    char *errorInfo;		/* Value to store in errorInfo if returnCode
-				 * is TCL_ERROR.  Malloc'ed, may be NULL */
-    char *errorCode;		/* Value to store in errorCode if returnCode
-				 * is TCL_ERROR.  Malloc'ed, may be NULL */
+				/* First in list of active traces for interp,
+				 * or NULL if no active traces. */
+    int returnCode;		/* [return -code] parameter. */
+    CallFrame *rootFramePtr;	/* Global frame pointer for this
+				 * interpreter. */
+    Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
+				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
 
     /*
-     * Information used by Tcl_AppendResult to keep track of partial
-     * results.	 See Tcl_AppendResult code for details.
+     * Information used by Tcl_AppendResult to keep track of partial results.
+     * See Tcl_AppendResult code for details.
      */
 
-    char *appendResult;		/* Storage space for results generated
-				 * by Tcl_AppendResult.	 Malloc-ed.  NULL
-				 * means not yet allocated. */
+    char *appendResult;		/* Storage space for results generated by
+				 * Tcl_AppendResult. Ckalloc-ed. NULL means
+				 * not yet allocated. */
     int appendAvl;		/* Total amount of space available at
 				 * partialResult. */
-    int appendUsed;		/* Number of non-null bytes currently
-				 * stored at partialResult. */
+    int appendUsed;		/* Number of non-null bytes currently stored
+				 * at partialResult. */
 
     /*
-     * Information about packages.  Used only in tclPkg.c.
+     * Information about packages. Used only in tclPkg.c.
      */
 
-    Tcl_HashTable packageTable;	/* Describes all of the packages loaded
-				 * in or available to this interpreter.
-				 * Keys are package names, values are
-				 * (Package *) pointers. */
-    char *packageUnknown;	/* Command to invoke during "package
-				 * require" commands for packages that
-				 * aren't described in packageTable. 
-				 * Malloc'ed, may be NULL. */
-
+    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
+				 * available to this interpreter. Keys are
+				 * package names, values are (Package *)
+				 * pointers. */
+    char *packageUnknown;	/* Command to invoke during "package require"
+				 * commands for packages that aren't described
+				 * in packageTable. Ckalloc'ed, may be
+				 * NULL. */
     /*
      * Miscellaneous information:
      */
@@ -1454,44 +1720,42 @@ typedef struct Interp {
 				 * has been called for this interpreter. */
     int evalFlags;		/* Flags to control next call to Tcl_Eval.
 				 * Normally zero, but may be set before
-				 * calling Tcl_Eval.  See below for valid
+				 * calling Tcl_Eval. See below for valid
 				 * values. */
-    int termOffset;		/* Offset of character just after last one
-				 * compiled or executed by Tcl_EvalObj. */
-    LiteralTable literalTable;	/* Contains LiteralEntry's describing all
-				 * Tcl objects holding literals of scripts
-				 * compiled by the interpreter. Indexed by
-				 * the string representations of literals.
-				 * Used to avoid creating duplicate
-				 * objects. */
-    int compileEpoch;		/* Holds the current "compilation epoch"
-				 * for this interpreter. This is
-				 * incremented to invalidate existing
-				 * ByteCodes when, e.g., a command with a
-				 * compile procedure is redefined. */
-    Proc *compiledProcPtr;	/* If a procedure is being compiled, a
-				 * pointer to its Proc structure; otherwise,
-				 * this is NULL. Set by ObjInterpProc in
-				 * tclProc.c and used by tclCompile.c to
-				 * process local variables appropriately. */
+    int unused1;		/* No longer used (was termOffset) */
+    LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
+				 * objects holding literals of scripts
+				 * compiled by the interpreter. Indexed by the
+				 * string representations of literals. Used to
+				 * avoid creating duplicate objects. */
+    int compileEpoch;		/* Holds the current "compilation epoch" for
+				 * this interpreter. This is incremented to
+				 * invalidate existing ByteCodes when, e.g., a
+				 * command with a compile procedure is
+				 * redefined. */
+    Proc *compiledProcPtr;	/* If a procedure is being compiled, a pointer
+				 * to its Proc structure; otherwise, this is
+				 * NULL. Set by ObjInterpProc in tclProc.c and
+				 * used by tclCompile.c to process local
+				 * variables appropriately. */
     ResolverScheme *resolverPtr;
 				/* Linked list of name resolution schemes
-				 * added to this interpreter.  Schemes
-				 * are added/removed by calling
+				 * added to this interpreter. Schemes are
+				 * added and removed by calling
 				 * Tcl_AddInterpResolvers and
-				 * Tcl_RemoveInterpResolver. */
+				 * Tcl_RemoveInterpResolver respectively. */
     Tcl_Obj *scriptFile;	/* NULL means there is no nested source
-				 * command active;  otherwise this points to
+				 * command active; otherwise this points to
 				 * pathPtr of the file being sourced. */
-    int flags;			/* Various flag bits.  See below. */
+    int flags;			/* Various flag bits. See below. */
     long randSeed;		/* Seed used for rand() function. */
     Trace *tracePtr;		/* List of traces for this interpreter. */
-    Tcl_HashTable *assocData;	/* Hash table for associating data with
-				 * this interpreter. Cleaned up when
-				 * this interpreter is deleted. */
+    Tcl_HashTable *assocData;	/* Hash table for associating data with this
+				 * interpreter. Cleaned up when this
+				 * interpreter is deleted. */
     struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
-				 * execution. Contains a pointer to the
-				 * Tcl evaluation stack. */
+				 * execution. Contains a pointer to the Tcl
+				 * evaluation stack. */
     Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
 				 * string. Returned by Tcl_ObjSetVar2 when
 				 * variable traces change a variable in a
@@ -1501,67 +1765,137 @@ typedef struct Interp {
     Tcl_Obj *objResultPtr;	/* If the last command returned an object
 				 * result, this points to it. Should not be
 				 * accessed directly; see comment above. */
-    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter */
+    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */
 
     ActiveCommandTrace *activeCmdTracePtr;
 				/* First in list of active command traces for
 				 * interp, or NULL if no active traces. */
     ActiveInterpTrace *activeInterpTracePtr;
-				/* First in list of active traces for
-				 * interp, or NULL if no active traces. */
+				/* First in list of active traces for interp,
+				 * or NULL if no active traces. */
 
-    int tracesForbiddingInline; /* Count of traces (in the list headed by
+    int tracesForbiddingInline;	/* Count of traces (in the list headed by
 				 * tracePtr) that forbid inline bytecode
-				 * compilation */
-#ifdef TCL_TIP280
-    /* TIP #280 */
-    CmdFrame* cmdFramePtr;      /* Points to the command frame containing
-				 * the location information for the current
+				 * compilation. */
+
+    /*
+     * Fields used to manage extensible return options (TIP 90).
+     */
+
+    Tcl_Obj *returnOpts;	/* A dictionary holding the options to the
+				 * last [return] command. */
+
+    Tcl_Obj *errorInfo;		/* errorInfo value (now as a Tcl_Obj). */
+    Tcl_Obj *eiVar;		/* cached ref to ::errorInfo variable. */
+    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj). */
+    Tcl_Obj *ecVar;		/* cached ref to ::errorInfo variable. */
+    int returnLevel;		/* [return -level] parameter. */
+
+    /*
+     * Resource limiting framework support (TIP#143).
+     */
+
+    struct {
+	int active;		/* Flag values defining which limits have been
+				 * set. */
+	int granularityTicker;	/* Counter used to determine how often to
+				 * check the limits. */
+	int exceeded;		/* Which limits have been exceeded, described
+				 * as flag values the same as the 'active'
+				 * field. */
+
+	int cmdCount;		/* Limit for how many commands to execute in
+				 * the interpreter. */
+	LimitHandler *cmdHandlers;
+				/* Handlers to execute when the limit is
+				 * reached. */
+	int cmdGranularity;	/* Mod factor used to determine how often to
+				 * evaluate the limit check. */
+
+	Tcl_Time time;		/* Time limit for execution within the
+				 * interpreter. */
+	LimitHandler *timeHandlers;
+				/* Handlers to execute when the limit is
+				 * reached. */
+	int timeGranularity;	/* Mod factor used to determine how often to
+				 * evaluate the limit check. */
+	Tcl_TimerToken timeEvent;
+				/* Handle for a timer callback that will occur
+				 * when the time-limit is exceeded. */
+
+	Tcl_HashTable callbacks;/* Mapping from (interp,type) pair to data
+				 * used to install a limit handler callback to
+				 * run in _this_ interp when the limit is
+				 * exceeded. */
+    } limit;
+
+    /*
+     * Information for improved default error generation from ensembles
+     * (TIP#112).
+     */
+
+    struct {
+	Tcl_Obj *const *sourceObjs;
+				/* What arguments were actually input into the
+				 * *root* ensemble command? (Nested ensembles
+				 * don't rewrite this.) NULL if we're not
+				 * processing an ensemble. */
+	int numRemovedObjs;	/* How many arguments have been stripped off
+				 * because of ensemble processing. */
+	int numInsertedObjs;	/* How many of the current arguments were
+				 * inserted by an ensemble. */
+    } ensembleRewrite;
+
+    /*
+     * TIP #219: Global info for the I/O system.
+     */
+
+    Tcl_Obj *chanMsg;		/* Error message set by channel drivers, for
+				 * the propagation of arbitrary Tcl errors.
+				 * This information, if present (chanMsg not
+				 * NULL), takes precedence over a POSIX error
+				 * code returned by a channel operation. */
+
+    /*
+     * Source code origin information (TIP #280).
+     */
+
+    CmdFrame *cmdFramePtr;	/* Points to the command frame containing the
+				 * location information for the current
 				 * command. */
-    CONST CmdFrame* invokeCmdFramePtr; /* Points to the command frame which is the
-				  * invoking context of the bytecode compiler.
-				  * NULL when the byte code compiler is not
-				  * active */
-    int invokeWord;             /* Index of the word in the command which
+    const CmdFrame *invokeCmdFramePtr;
+				/* Points to the command frame which is the
+				 * invoking context of the bytecode compiler.
+				 * NULL when the byte code compiler is not
+				 * active. */
+    int invokeWord;		/* Index of the word in the command which
 				 * is getting compiled. */
-    Tcl_HashTable* linePBodyPtr;
-                                /* This table remembers for each
-				 * statically defined procedure the
-				 * location information for its
-				 * body. It is keyed by the address of
-				 * the Proc structure for a procedure.
-				 * The values are "struct CmdFrame*".
-				 */
-    Tcl_HashTable* lineBCPtr;
-                                /* This table remembers for each
-				 * ByteCode object the location
-				 * information for its body. It is
-				 * keyed by the address of the Proc
-				 * structure for a procedure. The
-				 * values are "struct ExtCmdLoc*" (See
-				 * tclCompile.h).
-				 */
-    Tcl_HashTable* lineLABCPtr;
-    Tcl_HashTable* lineLAPtr;
-                                /* This table remembers for each
-				 * argument of a command on the
-				 * execution stack the index of the
-				 * argument in the command, and the
-				 * location data of the command. It is
-				 * keyed by the address of the Tcl_Obj
-				 * containing the argument. The values
-				 * are "struct CFWord*" (See
-				 * tclBasic.c). This allows commands
-				 * like uplevel, eval, etc. to find
-				 * location information for their
-				 * arguments, if they are a proper
-				 * literal argument to an invoking
-				 * command. Alt view: An index to the
-				 * CmdFrame stack keyed by command
-				 * argument holders.
-				 */
-    ContLineLoc* scriptCLLocPtr;
-                                /* This table points to the location data for
+    Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
+				 * defined procedure the location information
+				 * for its body. It is keyed by the address of
+				 * the Proc structure for a procedure. The
+				 * values are "struct CmdFrame*". */
+    Tcl_HashTable *lineBCPtr;	/* This table remembers for each ByteCode
+				 * object the location information for its
+				 * body. It is keyed by the address of the
+				 * Proc structure for a procedure. The values
+				 * are "struct ExtCmdLoc*". (See
+				 * tclCompile.h) */
+    Tcl_HashTable *lineLABCPtr;
+    Tcl_HashTable *lineLAPtr;	/* This table remembers for each argument of a
+				 * command on the execution stack the index of
+				 * the argument in the command, and the
+				 * location data of the command. It is keyed
+				 * by the address of the Tcl_Obj containing
+				 * the argument. The values are "struct
+				 * CFWord*" (See tclBasic.c). This allows
+				 * commands like uplevel, eval, etc. to find
+				 * location information for their arguments,
+				 * if they are a proper literal argument to an
+				 * invoking command. Alt view: An index to the
+				 * CmdFrame stack keyed by command argument
+				 * holders. */
+    ContLineLoc *scriptCLLocPtr;/* This table points to the location data for
 				 * invisible continuation lines in the script,
 				 * if any. This pointer is set by the function
 				 * TclEvalObjEx() in file "tclBasic.c", and
@@ -1570,43 +1904,114 @@ typedef struct Interp {
 				 * execution what CompileEnv.clLoc does for
 				 * the bytecode compiler.
 				 */
-#endif
-#ifdef TCL_TIP268
     /*
-     * TIP #268.
-     * The currently active selection mode,
-     * i.e the package require preferences.
+     * TIP #268. The currently active selection mode, i.e. the package require
+     * preferences.
      */
 
-    int packagePrefer;          /* Current package selection mode. */
-#endif
+    int packagePrefer;		/* Current package selection mode. */
+
+    /*
+     * Hashtables for variable traces and searches.
+     */
+
+    Tcl_HashTable varTraces;	/* Hashtable holding the start of a variable's
+				 * active trace list; varPtr is the key. */
+    Tcl_HashTable varSearches;	/* Hashtable holding the start of a variable's
+				 * active searches list; varPtr is the key. */
+    /*
+     * The thread-specific data ekeko: cache pointers or values that
+     *  (a) do not change during the thread's lifetime
+     *  (b) require access to TSD to determine at runtime
+     *  (c) are accessed very often (e.g., at each command call)
+     *
+     * Note that these are the same for all interps in the same thread. They
+     * just have to be initialised for the thread's master interp, slaves
+     * inherit the value.
+     *
+     * They are used by the macros defined below.
+     */
+
+    void *allocCache;
+    void *pendingObjDataPtr;	/* Pointer to the Cache and PendingObjData
+				 * structs for this interp's thread; see
+				 * tclObj.c and tclThreadAlloc.c */
+    int *asyncReadyPtr;		/* Pointer to the asyncReady indicator for
+				 * this interp's thread; see tclAsync.c */
+    int *stackBound;		/* Pointer to the limit stack address
+				 * allowable for invoking a new command
+				 * without "risking" a C-stack overflow; see
+				 * TclpCheckStackSpace in the platform's
+				 * directory. */
+
+
+#ifdef TCL_COMPILE_STATS
     /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
      */
 
-#ifdef TCL_COMPILE_STATS
-    ByteCodeStats stats;	/* Holds compilation and execution
-				 * statistics for this interpreter. */
-#endif /* TCL_COMPILE_STATS */	  
+    ByteCodeStats stats;	/* Holds compilation and execution statistics
+				 * for this interpreter. */
+#endif /* TCL_COMPILE_STATS */
 } Interp;
 
 /*
+ * Macros that use the TSD-ekeko.
+ */
+
+#define TclAsyncReady(iPtr) \
+    *((iPtr)->asyncReadyPtr)
+
+/*
+ * General list of interpreters. Doubly linked for easier removal of items
+ * deep in the list.
+ */
+
+typedef struct InterpList {
+    Interp *interpPtr;
+    struct InterpList *prevPtr;
+    struct InterpList *nextPtr;
+} InterpList;
+
+/*
+ * Macros for splicing into and out of doubly linked lists. They assume
+ * existence of struct items 'prevPtr' and 'nextPtr'.
+ *
+ * a = element to add or remove.
+ * b = list head.
+ *
+ * TclSpliceIn adds to the head of the list.
+ */
+
+#define TclSpliceIn(a,b)			\
+    (a)->nextPtr = (b);				\
+    if ((b) != NULL) {				\
+	(b)->prevPtr = (a);			\
+    }						\
+    (a)->prevPtr = NULL, (b) = (a);
+
+#define TclSpliceOut(a,b)			\
+    if ((a)->prevPtr != NULL) {			\
+	(a)->prevPtr->nextPtr = (a)->nextPtr;	\
+    } else {					\
+	(b) = (a)->nextPtr;			\
+    }						\
+    if ((a)->nextPtr != NULL) {			\
+	(a)->nextPtr->prevPtr = (a)->prevPtr;	\
+    }
+
+/*
  * EvalFlag bits for Interp structures:
  *
- * TCL_BRACKET_TERM	1 means that the current script is terminated by
- *			a close bracket rather than the end of the string.
- * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
- *			a code other than TCL_OK or TCL_ERROR;	0 means
- *			codes other than these should be turned into errors.
- */
-
-#define TCL_BRACKET_TERM	  1
-#define TCL_ALLOW_EXCEPTIONS	  4
-#ifdef TCL_TIP280
-#define TCL_EVAL_FILE             2
-#define TCL_EVAL_CTX              8
-#endif
+ * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with a
+ *			code other than TCL_OK or TCL_ERROR; 0 means codes
+ *			other than these should be turned into errors.
+ */
+
+#define TCL_ALLOW_EXCEPTIONS	4
+#define TCL_EVAL_FILE		2
+#define TCL_EVAL_CTX		8
 
 /*
  * Flag bits for Interp structures:
@@ -1615,115 +2020,155 @@ typedef struct Interp {
  *			don't process any more commands for it, and destroy
  *			the structure as soon as all nested invocations of
  *			Tcl_Eval are done.
- * ERR_IN_PROGRESS:	Non-zero means an error unwind is already in
- *			progress. Zero means a command proc has been
- *			invoked since last error occured.
- * ERR_ALREADY_LOGGED:	Non-zero means information has already been logged
- *			in $errorInfo for the current Tcl_Eval instance,
- *			so Tcl_Eval needn't log it (used to implement the
- *			"error message log" command).
- * ERROR_CODE_SET:	Non-zero means that Tcl_SetErrorCode has been
- *			called to record information for the current
- *			error.	Zero means Tcl_Eval must clear the
- *			errorCode variable if an error is returned.
- * EXPR_INITIALIZED:	Non-zero means initialization specific to
- *			expressions has	been carried out.
- * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler
- *			should not compile any commands into an inline
- *			sequence of instructions. This is set 1, for
- *			example, when command traces are requested.
- * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the
- *			interp has not be initialized.	This is set 1
- *			when we first use the rand() or srand() functions.
- * SAFE_INTERP:		Non zero means that the current interp is a
- *			safe interp (ie it has only the safe commands
- *			installed, less priviledge than a regular interp).
- * USE_EVAL_DIRECT:	Non-zero means don't use the compiler or byte-code
- *			interpreter; instead, have Tcl_EvalObj call
- *			Tcl_EvalEx. Used primarily for testing the
- *			new parser.
+ * ERR_ALREADY_LOGGED:	Non-zero means information has already been logged in
+ *			iPtr->errorInfo for the current Tcl_Eval instance, so
+ *			Tcl_Eval needn't log it (used to implement the "error
+ *			message log" command).
+ * DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler should
+ *			not compile any commands into an inline sequence of
+ *			instructions. This is set 1, for example, when command
+ *			traces are requested.
+ * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp
+ *			has not be initialized. This is set 1 when we first
+ *			use the rand() or srand() functions.
+ * SAFE_INTERP:		Non zero means that the current interp is a safe
+ *			interp (i.e. it has only the safe commands installed,
+ *			less priviledge than a regular interp).
+ * INTERP_DEBUG_FRAME:	Used for switching on various extra interpreter
+ *			debug/info mechanisms (e.g. info frame eval/uplevel
+ *			tracing) which are performance intensive.
  * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
  *			active; so no further trace callbacks should be
  *			invoked.
+ * INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms
+ *			of the wrong-num-args string in Tcl_WrongNumArgs.
+ *			Makes it append instead of replacing and uses
+ *			different intermediate text.
+ *
+ * WARNING: For the sake of some extensions that have made use of former
+ * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS)
+ * or 8 (formerly ERROR_CODE_SET).
  */
 
-#define DELETED				    1
-#define ERR_IN_PROGRESS			    2
-#define ERR_ALREADY_LOGGED		    4
-#define ERROR_CODE_SET			    8
-#define EXPR_INITIALIZED		 0x10
-#define DONT_COMPILE_CMDS_INLINE	 0x20
-#define RAND_SEED_INITIALIZED		 0x40
-#define SAFE_INTERP			 0x80
-#define USE_EVAL_DIRECT			0x100
-#define INTERP_TRACE_IN_PROGRESS	0x200
+#define DELETED				     1
+#define ERR_ALREADY_LOGGED		     4
+#define INTERP_DEBUG_FRAME		  0x10
+#define DONT_COMPILE_CMDS_INLINE	  0x20
+#define RAND_SEED_INITIALIZED		  0x40
+#define SAFE_INTERP			  0x80
+#define INTERP_TRACE_IN_PROGRESS	 0x200
+#define INTERP_ALTERNATE_WRONG_ARGS	 0x400
+#define ERR_LEGACY_COPY			 0x800
 
 /*
- * Maximum number of levels of nesting permitted in Tcl commands (used
- * to catch infinite recursion).
+ * Maximum number of levels of nesting permitted in Tcl commands (used to
+ * catch infinite recursion).
  */
 
 #define MAX_NESTING_DEPTH	1000
 
 /*
- * The macro below is used to modify a "char" value (e.g. by casting
- * it to an unsigned character) so that it can be used safely with
- * macros such as isspace.
+ * TIP#143 limit handler internal representation.
+ */
+
+struct LimitHandler {
+    int flags;			/* The state of this particular handler. */
+    Tcl_LimitHandlerProc *handlerProc;
+				/* The handler callback. */
+    ClientData clientData;	/* Opaque argument to the handler callback. */
+    Tcl_LimitHandlerDeleteProc *deleteProc;
+				/* How to delete the clientData. */
+    LimitHandler *prevPtr;	/* Previous item in linked list of
+				 * handlers. */
+    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
+};
+
+/*
+ * Values for the LimitHandler flags field.
+ *	LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
+ *		processed; handlers are never to be entered reentrantly.
+ *	LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
+ *		should not normally be observed because when a handler is
+ *		deleted it is also spliced out of the list of handlers, but
+ *		even so we will be careful.
+ */
+
+#define LIMIT_HANDLER_ACTIVE	0x01
+#define LIMIT_HANDLER_DELETED	0x02
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting it to an
+ * unsigned character) so that it can be used safely with macros such as
+ * isspace.
  */
 
 #define UCHAR(c) ((unsigned char) (c))
 
 /*
+ * This macro is used to properly align the memory allocated by Tcl, giving
+ * the same alignment as the native malloc.
+ */
+
+#if defined(__APPLE__)
+#define TCL_ALLOCALIGN	16
+#else
+#define TCL_ALLOCALIGN	(2*sizeof(void *))
+#endif
+
+/*
  * This macro is used to determine the offset needed to safely allocate any
  * data structure in memory. Given a starting offset or size, it "rounds up"
  * or "aligns" the offset to the next 8-byte boundary so that any data
  * structure can be placed at the resulting offset without fear of an
  * alignment error.
  *
- * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce
- * the wrong result on platforms that allocate addresses that are divisible
- * by 4 or 2. Only use it for offsets or sizes.
+ * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce the
+ * wrong result on platforms that allocate addresses that are divisible by 4
+ * or 2. Only use it for offsets or sizes.
+ *
+ * This macro is only used by tclCompile.c in the core (Bug 926445). It
+ * however not be made file static, as extensions that touch bytecodes
+ * (notably tbcload) require it.
  */
 
 #define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
 
 /*
- * The following enum values are used to specify the runtime platform
- * setting of the tclPlatform variable.
+ * The following enum values are used to specify the runtime platform setting
+ * of the tclPlatform variable.
  */
 
 typedef enum {
-    TCL_PLATFORM_UNIX,		/* Any Unix-like OS. */
-    TCL_PLATFORM_WINDOWS=2	/* Any Microsoft Windows OS. */
+    TCL_PLATFORM_UNIX = 0,	/* Any Unix-like OS. */
+    TCL_PLATFORM_WINDOWS = 2	/* Any Microsoft Windows OS. */
 } TclPlatformType;
 
 /*
- *  The following enum values are used to indicate the translation
- *  of a Tcl channel.  Declared here so that each platform can define
- *  TCL_PLATFORM_TRANSLATION to the native translation on that platform
+ * The following enum values are used to indicate the translation of a Tcl
+ * channel. Declared here so that each platform can define
+ * TCL_PLATFORM_TRANSLATION to the native translation on that platform.
  */
 
 typedef enum TclEolTranslation {
-    TCL_TRANSLATE_AUTO,                 /* Eol == \r, \n and \r\n. */
-    TCL_TRANSLATE_CR,                   /* Eol == \r. */
-    TCL_TRANSLATE_LF,                   /* Eol == \n. */
-    TCL_TRANSLATE_CRLF                  /* Eol == \r\n. */
+    TCL_TRANSLATE_AUTO,		/* Eol == \r, \n and \r\n. */
+    TCL_TRANSLATE_CR,		/* Eol == \r. */
+    TCL_TRANSLATE_LF,		/* Eol == \n. */
+    TCL_TRANSLATE_CRLF		/* Eol == \r\n. */
 } TclEolTranslation;
 
 /*
  * Flags for TclInvoke:
  *
- * TCL_INVOKE_HIDDEN		Invoke a hidden command; if not set,
- *				invokes an exposed command.
- * TCL_INVOKE_NO_UNKNOWN	If set, "unknown" is not invoked if
- *				the command to be invoked is not found.
- *				Only has an effect if invoking an exposed
- *				command, i.e. if TCL_INVOKE_HIDDEN is not
- *				also set.
- * TCL_INVOKE_NO_TRACEBACK	Does not record traceback information if
- *				the invoked command returns an error.  Used
- *				if the caller plans on recording its own
- *				traceback information.
+ * TCL_INVOKE_HIDDEN		Invoke a hidden command; if not set, invokes
+ *				an exposed command.
+ * TCL_INVOKE_NO_UNKNOWN	If set, "unknown" is not invoked if the
+ *				command to be invoked is not found. Only has
+ *				an effect if invoking an exposed command,
+ *				i.e. if TCL_INVOKE_HIDDEN is not also set.
+ * TCL_INVOKE_NO_TRACEBACK	Does not record traceback information if the
+ *				invoked command returns an error. Used if the
+ *				caller plans on recording its own traceback
+ *				information.
  */
 
 #define	TCL_INVOKE_HIDDEN	(1<<0)
@@ -1731,62 +2176,176 @@ typedef enum TclEolTranslation {
 #define TCL_INVOKE_NO_TRACEBACK	(1<<2)
 
 /*
- * The structure used as the internal representation of Tcl list
- * objects. This is an array of pointers to the element objects. This array
- * is grown (reallocated and copied) as necessary to hold all the list's
- * element pointers. The array might contain more slots than currently used
- * to hold all element pointers. This is done to make append operations
+ * The structure used as the internal representation of Tcl list objects. This
+ * struct is grown (reallocated and copied) as necessary to hold all the
+ * list's element pointers. The struct might contain more slots than currently
+ * used to hold all element pointers. This is done to make append operations
  * faster.
  */
 
 typedef struct List {
+    int refCount;
     int maxElemCount;		/* Total number of element array slots. */
     int elemCount;		/* Current number of list elements. */
-    Tcl_Obj **elements;		/* Array of pointers to element objects. */
+    int canonicalFlag;		/* Set if the string representation was
+				 * derived from the list representation. May
+				 * be ignored if there is no string rep at
+				 * all.*/
+    Tcl_Obj *elements;		/* First list element; the struct is grown to
+				 * accomodate all elements. */
 } List;
 
+#define LIST_MAX \
+	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
+
+/*
+ * Macro used to get the elements of a list object.
+ */
+
+#define ListRepPtr(listPtr) \
+    ((List *) (listPtr)->internalRep.twoPtrValue.ptr1)
+
+#define ListSetIntRep(objPtr, listRepPtr) \
+    (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
+    (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
+    (listRepPtr)->refCount++, \
+    (objPtr)->typePtr = &tclListType
+
+#define ListObjGetElements(listPtr, objc, objv) \
+    ((objv) = &(ListRepPtr(listPtr)->elements), \
+     (objc) = ListRepPtr(listPtr)->elemCount)
+
+#define ListObjLength(listPtr, len) \
+    ((len) = ListRepPtr(listPtr)->elemCount)
+
+#define ListObjIsCanonical(listPtr) \
+    (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag)
+
+#define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
+    (((listPtr)->typePtr == &tclListType) \
+	    ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\
+	    : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)))
+
+#define TclListObjLength(interp, listPtr, lenPtr) \
+    (((listPtr)->typePtr == &tclListType) \
+	    ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
+	    : Tcl_ListObjLength((interp), (listPtr), (lenPtr)))
+
+#define TclListObjIsCanonical(listPtr) \
+    (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
+
+/*
+ * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
+ * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
+ *
+ * WARNING: these macros eval their args more than once.
+ */
+
+#define TclGetLongFromObj(interp, objPtr, longPtr) \
+    (((objPtr)->typePtr == &tclIntType)	\
+	    ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
+
+#if (LONG_MAX == INT_MAX)
+#define TclGetIntFromObj(interp, objPtr, intPtr) \
+    (((objPtr)->typePtr == &tclIntType)	\
+	    ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
+#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
+    (((objPtr)->typePtr == &tclIntType)	\
+	    ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
+#else
+#define TclGetIntFromObj(interp, objPtr, intPtr) \
+    Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
+#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr)	\
+    TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
+#endif
+
+/*
+ * Flag values for TclTraceDictPath().
+ *
+ * DICT_PATH_READ indicates that all entries on the path must exist but no
+ * updates will be needed.
+ *
+ * DICT_PATH_UPDATE indicates that we are going to be doing an update at the
+ * tip of the path, so duplication of shared objects should be done along the
+ * way.
+ *
+ * DICT_PATH_EXISTS indicates that we are performing an existance test and a
+ * lookup failure should therefore not be an error. If (and only if) this flag
+ * is set, TclTraceDictPath() will return the special value
+ * DICT_PATH_NON_EXISTENT if the path is not traceable.
+ *
+ * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set)
+ * indicates that we are to create non-existant dictionaries on the path.
+ */
+
+#define DICT_PATH_READ		0
+#define DICT_PATH_UPDATE	1
+#define DICT_PATH_EXISTS	2
+#define DICT_PATH_CREATE	5
+
+#define DICT_PATH_NON_EXISTENT	((Tcl_Obj *) (void *) 1)
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to the filesystem internals
+ *----------------------------------------------------------------
+ */
+
+/*
+ * The version_2 filesystem is private to Tcl. As and when these changes have
+ * been thoroughly tested and investigated a new public filesystem interface
+ * will be released. The aim is more versatile virtual filesystem interfaces,
+ * more efficiency in 'path' manipulation and usage, and cleaner filesystem
+ * code internally.
+ */
+
+#define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
+typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
 
 /*
- * The following types are used for getting and storing platform-specific
- * file attributes in tclFCmd.c and the various platform-versions of
- * that file. This is done to have as much common code as possible
- * in the file attributes code. For more information about the callbacks,
- * see TclFileAttrsCmd in tclFCmd.c.
+ * The following types are used for getting and storing platform-specific file
+ * attributes in tclFCmd.c and the various platform-versions of that file.
+ * This is done to have as much common code as possible in the file attributes
+ * code. For more information about the callbacks, see TclFileAttrsCmd in
+ * tclFCmd.c.
  */
 
-typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr));
-typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr));
+typedef int (TclGetFileAttrProc)(Tcl_Interp *interp, int objIndex,
+	Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr);
+typedef int (TclSetFileAttrProc)(Tcl_Interp *interp, int objIndex,
+	Tcl_Obj *fileName, Tcl_Obj *attrObjPtr);
 
 typedef struct TclFileAttrProcs {
-    TclGetFileAttrProc *getProc;	/* The procedure for getting attrs. */
-    TclSetFileAttrProc *setProc;	/* The procedure for setting attrs. */
+    TclGetFileAttrProc *getProc;/* The procedure for getting attrs. */
+    TclSetFileAttrProc *setProc;/* The procedure for setting attrs. */
 } TclFileAttrProcs;
 
 /*
  * Opaque handle used in pipeline routines to encapsulate platform-dependent
- * state. 
+ * state.
  */
 
 typedef struct TclFile_ *TclFile;
-    
-/*
- * Opaque names for platform specific types.
- */
-
-typedef struct TclpTime_t_    *TclpTime_t;
-typedef struct TclpTime_t_    *CONST TclpTime_t_CONST;
 
 /*
- * The "globParameters" argument of the function TclGlob is an
- * or'ed combination of the following values:
+ * The "globParameters" argument of the function TclGlob is an or'ed
+ * combination of the following values:
  */
 
-#define TCL_GLOBMODE_NO_COMPLAIN      1
-#define TCL_GLOBMODE_JOIN             2
-#define TCL_GLOBMODE_DIR              4
-#define TCL_GLOBMODE_TAILS            8
+#define TCL_GLOBMODE_NO_COMPLAIN	1
+#define TCL_GLOBMODE_JOIN		2
+#define TCL_GLOBMODE_DIR		4
+#define TCL_GLOBMODE_TAILS		8
+
+typedef enum Tcl_PathPart {
+    TCL_PATH_DIRNAME,
+    TCL_PATH_TAIL,
+    TCL_PATH_EXTENSION,
+    TCL_PATH_ROOT
+} Tcl_PathPart;
 
 /*
  *----------------------------------------------------------------
@@ -1794,12 +2353,10 @@ typedef struct TclpTime_t_    *CONST TclpTime_t_CONST;
  *----------------------------------------------------------------
  */
 
-typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, Tcl_StatBuf *buf));
-typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode));
-typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
-	CONST char *fileName, CONST char *modeString,
-	int permissions));
-
+typedef int (TclStatProc_)(CONST char *path, struct stat *buf);
+typedef int (TclAccessProc_)(CONST char *path, int mode);
+typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
+	CONST char *fileName, CONST char *modeString, int permissions);
 
 /*
  *----------------------------------------------------------------
@@ -1812,324 +2369,463 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
 
 /*
  *----------------------------------------------------------------
+ * Data structures for process-global values.
+ *----------------------------------------------------------------
+ */
+
+typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
+	Tcl_Encoding *encodingPtr);
+
+/*
+ * A ProcessGlobalValue struct exists for each internal value in Tcl that is
+ * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
+ * the value, and the master is kept as a counted string, with epoch and mutex
+ * control. Each ProcessGlobalValue struct should be a static variable in some
+ * file.
+ */
+
+typedef struct ProcessGlobalValue {
+    int epoch;			/* Epoch counter to detect changes in the
+				 * master value. */
+    int numBytes;		/* Length of the master string. */
+    char *value;		/* The master string value. */
+    Tcl_Encoding encoding;	/* system encoding when master string was
+				 * initialized. */
+    TclInitProcessGlobalValueProc *proc;
+    				/* A procedure to initialize the master string
+				 * copy when a "get" request comes in before
+				 * any "set" request has been received. */
+    Tcl_Mutex mutex;		/* Enforce orderly access from multiple
+				 * threads. */
+    Tcl_ThreadDataKey key;	/* Key for per-thread data holding the
+				 * (Tcl_Obj) copy for each thread. */
+} ProcessGlobalValue;
+
+/*
+ *----------------------------------------------------------------------
+ * Flags for TclParseNumber
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_PARSE_DECIMAL_ONLY		1
+				/* Leading zero doesn't denote octal or
+				 * hex. */
+#define TCL_PARSE_OCTAL_ONLY		2
+				/* Parse octal even without prefix. */
+#define TCL_PARSE_HEXADECIMAL_ONLY	4
+				/* Parse hexadecimal even without prefix. */
+#define TCL_PARSE_INTEGER_ONLY		8
+				/* Disable floating point parsing. */
+#define TCL_PARSE_SCAN_PREFIXES		16
+				/* Use [scan] rules dealing with 0?
+				 * prefixes. */
+#define TCL_PARSE_NO_WHITESPACE		32
+				/* Reject leading/trailing whitespace. */
+
+/*
+ *----------------------------------------------------------------------
+ * Type values TclGetNumberFromObj
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_NUMBER_LONG		1
+#define TCL_NUMBER_WIDE		2
+#define TCL_NUMBER_BIG		3
+#define TCL_NUMBER_DOUBLE	4
+#define TCL_NUMBER_NAN		5
+
+/*
+ *----------------------------------------------------------------
  * Variables shared among Tcl modules but not used by the outside world.
  *----------------------------------------------------------------
  */
 
-extern Tcl_Time			tclBlockTime;
-extern int			tclBlockTimeSet;
-extern char *			tclExecutableName;
-extern char *			tclNativeExecutableName;
-extern char *			tclDefaultEncodingDir;
-extern Tcl_ChannelType		tclFileChannelType;
-extern char *			tclMemDumpFileName;
-extern TclPlatformType		tclPlatform;
-extern Tcl_NotifierProcs	tclOriginalNotifier;
+MODULE_SCOPE char *tclNativeExecutableName;
+MODULE_SCOPE int tclFindExecutableSearchDone;
+MODULE_SCOPE char *tclMemDumpFileName;
+MODULE_SCOPE TclPlatformType tclPlatform;
+MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier;
+
+/*
+ * TIP #233 (Virtualized Time)
+ * Data for the time hooks, if any.
+ */
+
+MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
+MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
+MODULE_SCOPE ClientData tclTimeClientData;
 
 /*
  * Variables denoting the Tcl object types defined in the core.
  */
 
-extern Tcl_ObjType	tclBooleanType;
-extern Tcl_ObjType	tclByteArrayType;
-extern Tcl_ObjType	tclByteCodeType;
-extern Tcl_ObjType	tclDoubleType;
-extern Tcl_ObjType	tclEndOffsetType;
-extern Tcl_ObjType	tclIntType;
-extern Tcl_ObjType	tclListType;
-extern Tcl_ObjType	tclProcBodyType;
-extern Tcl_ObjType	tclStringType;
-extern Tcl_ObjType	tclArraySearchType;
-extern Tcl_ObjType	tclIndexType;
-extern Tcl_ObjType	tclNsNameType;
-extern Tcl_ObjType	tclWideIntType;
+MODULE_SCOPE Tcl_ObjType tclBignumType;
+MODULE_SCOPE Tcl_ObjType tclBooleanType;
+MODULE_SCOPE Tcl_ObjType tclByteArrayType;
+MODULE_SCOPE Tcl_ObjType tclByteCodeType;
+MODULE_SCOPE Tcl_ObjType tclDoubleType;
+MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
+MODULE_SCOPE Tcl_ObjType tclIntType;
+MODULE_SCOPE Tcl_ObjType tclListType;
+MODULE_SCOPE Tcl_ObjType tclDictType;
+MODULE_SCOPE Tcl_ObjType tclProcBodyType;
+MODULE_SCOPE Tcl_ObjType tclStringType;
+MODULE_SCOPE Tcl_ObjType tclArraySearchType;
+MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType;
+#ifndef NO_WIDE_TYPE
+MODULE_SCOPE Tcl_ObjType tclWideIntType;
+#endif
+MODULE_SCOPE Tcl_ObjType tclRegexpType;
 
 /*
  * Variables denoting the hash key types defined in the core.
  */
 
-extern Tcl_HashKeyType tclArrayHashKeyType;
-extern Tcl_HashKeyType tclOneWordHashKeyType;
-extern Tcl_HashKeyType tclStringHashKeyType;
-extern Tcl_HashKeyType tclObjHashKeyType;
+MODULE_SCOPE Tcl_HashKeyType tclArrayHashKeyType;
+MODULE_SCOPE Tcl_HashKeyType tclOneWordHashKeyType;
+MODULE_SCOPE Tcl_HashKeyType tclStringHashKeyType;
+MODULE_SCOPE Tcl_HashKeyType tclObjHashKeyType;
 
 /*
  * The head of the list of free Tcl objects, and the total number of Tcl
  * objects ever allocated and freed.
  */
 
-extern Tcl_Obj *	tclFreeObjList;
+MODULE_SCOPE Tcl_Obj *	tclFreeObjList;
 
 #ifdef TCL_COMPILE_STATS
-extern long		tclObjsAlloced;
-extern long		tclObjsFreed;
+MODULE_SCOPE long	tclObjsAlloced;
+MODULE_SCOPE long	tclObjsFreed;
 #define TCL_MAX_SHARED_OBJ_STATS 5
-extern long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
+MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
 #endif /* TCL_COMPILE_STATS */
 
 /*
- * Pointer to a heap-allocated string of length zero that the Tcl core uses
- * as the value of an empty string representation for an object. This value
- * is shared by all new objects allocated by Tcl_NewObj.
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses as
+ * the value of an empty string representation for an object. This value is
+ * shared by all new objects allocated by Tcl_NewObj.
  */
 
-extern char *		tclEmptyStringRep;
-extern char		tclEmptyString;
+MODULE_SCOPE char *	tclEmptyStringRep;
+MODULE_SCOPE char	tclEmptyString;
+
+/* Flags for conversion of doubles to digit strings */
+
+#define TCL_DD_SHORTEST 		0x4
+				/* Use the shortest possible string */
+#define TCL_DD_STEELE   		0x5
+				/* Use the original Steele&White algorithm */
+#define TCL_DD_E_FORMAT 		0x2
+				/* Use a fixed-length string of digits,
+				 * suitable for E format*/
+#define TCL_DD_F_FORMAT 		0x3
+				/* Use a fixed number of digits after the
+				 * decimal point, suitable for F format */
+
+#define TCL_DD_SHORTEN_FLAG 		0x4
+				/* Allow return of a shorter digit string
+				 * if it converts losslessly */
+#define TCL_DD_NO_QUICK 		0x8
+				/* Debug flag: forbid quick FP conversion */
+
+#define TCL_DD_CONVERSION_TYPE_MASK	0x3
+				/* Mask to isolate the conversion type */
+#define TCL_DD_STEELE0 			0x1
+				/* 'Steele&White' after masking */
+#define TCL_DD_SHORTEST0		0x0
+				/* 'Shortest possible' after masking */
 
 /*
  *----------------------------------------------------------------
- * Procedures shared among Tcl modules but not used by the outside
- * world:
+ * Procedures shared among Tcl modules but not used by the outside world:
  *----------------------------------------------------------------
  */
 
-#ifdef TCL_TIP280
-EXTERN void             TclAdvanceLines _ANSI_ARGS_((int* line, CONST char* start,
-						     CONST char* end));
-EXTERN void             TclAdvanceContinuations _ANSI_ARGS_((int* line, int** next,
-						     int loc));
-EXTERN ContLineLoc*     TclContinuationsEnter _ANSI_ARGS_((Tcl_Obj* objPtr, int num,
-							   int* loc));
-EXTERN void             TclContinuationsEnterDerived _ANSI_ARGS_((Tcl_Obj* objPtr,
-								  int start, int* clNext));
-EXTERN ContLineLoc*     TclContinuationsGet _ANSI_ARGS_((Tcl_Obj* objPtr));
-
-EXTERN void         TclContinuationsCopy _ANSI_ARGS_((Tcl_Obj* objPtr, Tcl_Obj* originObjPtr));
-
+MODULE_SCOPE void       TclAdvanceContinuations(int* line, int** next, int loc);
+MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
+			    const char *end);
+MODULE_SCOPE void       TclArgumentEnter(Tcl_Interp* interp,
+			    Tcl_Obj* objv[], int objc, CmdFrame* cf);
+MODULE_SCOPE void       TclArgumentRelease(Tcl_Interp* interp,
+			    Tcl_Obj* objv[], int objc);
+MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
+			    CmdFrame **cfPtrPtr, int *wordPtr);
+MODULE_SCOPE void       TclArgumentBCEnter(Tcl_Interp *interp,
+			    Tcl_Obj* objv[], int objc,
+			    void *codePtr, CmdFrame *cfPtr, int pc);
+MODULE_SCOPE void       TclArgumentBCRelease(Tcl_Interp *interp,
+			    Tcl_Obj *objv[], int objc,
+			    void *codePtr, int pc);
+MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
+			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
+MODULE_SCOPE double	TclBignumToDouble(mp_int *bignum);
+MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
+			    int strLen, const unsigned char *pattern,
+			    int ptnLen, int flags);
+MODULE_SCOPE double	TclCeil(mp_int *a);
+MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp, const char *value);
+MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
+			    Tcl_Channel chan);
+MODULE_SCOPE ContLineLoc* TclContinuationsEnter(Tcl_Obj *objPtr, int num,
+			    int *loc);
+MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
+			    int start, int *clNext);
+MODULE_SCOPE ContLineLoc* TclContinuationsGet(Tcl_Obj *objPtr);
+MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
+			    Tcl_Obj *originObjPtr);
+MODULE_SCOPE int	TclConvertElement(CONST char *src, int length,
+			    char *dst, int flags);
+MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
+/* TIP #280 - Modified token based evulation, with line information. */
+MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
+			    int numBytes, int flags, int line,
+			    int *clNextOuter, CONST char *outerScript);
+MODULE_SCOPE int	TclFileAttrsCmd(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclFileCopyCmd(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclFileDeleteCmd(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclFileMakeDirsCmd(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclFileRenameCmd(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
+			    ClientData clientData);
+MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
+			    ClientData clientData);
+MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
+MODULE_SCOPE void	TclFinalizeAsync(void);
+MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
+MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
+MODULE_SCOPE void	TclFinalizeEnvironment(void);
+MODULE_SCOPE void	TclFinalizeExecution(void);
+MODULE_SCOPE void	TclFinalizeIOSubsystem(void);
+MODULE_SCOPE void	TclFinalizeFilesystem(void);
+MODULE_SCOPE void	TclResetFilesystem(void);
+MODULE_SCOPE void	TclFinalizeLoad(void);
+MODULE_SCOPE void	TclFinalizeLock(void);
+MODULE_SCOPE void	TclFinalizeMemorySubsystem(void);
+MODULE_SCOPE void	TclFinalizeNotifier(void);
+MODULE_SCOPE void	TclFinalizeObjects(void);
+MODULE_SCOPE void	TclFinalizePreserve(void);
+MODULE_SCOPE void	TclFinalizeSynchronization(void);
+MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void	TclFinalizeThreadData(void);
+MODULE_SCOPE void	TclFinalizeThreadObjects(void);
+MODULE_SCOPE double	TclFloor(mp_int *a);
+MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
+MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
+			    const char *attributeName, int *indexPtr);
+MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
+MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
+MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
+MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
+			    int *modePtr, int flags);
+MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
+			    int *typePtr);
+MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
+			    const char *modeString, int *seekFlagPtr,
+			    int *binaryPtr);
+MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
+MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
+MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
+			    Tcl_Obj *unquotedPrefix, int globFlags,
+			    Tcl_GlobTypeData *types);
+MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+			    Tcl_Obj *incrPtr);
+MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
+MODULE_SCOPE int	TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
+MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE void	TclInitAlloc(void);
+MODULE_SCOPE void	TclInitDbCkalloc(void);
+MODULE_SCOPE void	TclInitDoubleConversion(void);
+MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
+			    Tcl_Interp *interp);
+MODULE_SCOPE void	TclInitEncodingSubsystem(void);
+MODULE_SCOPE void	TclInitIOSubsystem(void);
+MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
+MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
+MODULE_SCOPE void	TclInitNotifier(void);
+MODULE_SCOPE void	TclInitObjSubsystem(void);
+MODULE_SCOPE void	TclInitSubsystems(void);
+MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
+MODULE_SCOPE int	TclIsLocalScalar(const char *src, int len);
+MODULE_SCOPE int	TclIsSpaceProc(char byte);
+MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
+MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
+MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    int indexCount, Tcl_Obj *const indexArray[]);
+/* TIP #280 */
+MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
+			    int *lines, Tcl_Obj *const *elems);
+MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+MODULE_SCOPE int	TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    int symc, const char *symbols[],
+			    Tcl_PackageInitProc **procPtrs[],
+			    Tcl_LoadHandle *handlePtr,
+			    ClientData *clientDataPtr,
+			    Tcl_FSUnloadFileProc **unloadProcPtr);
+MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    int indexCount, Tcl_Obj *const indexArray[],
+			    Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
+			    const EnsembleImplMap map[]);
+MODULE_SCOPE int	TclMaxListLength(CONST char *bytes, int numBytes,
+			    CONST char **endPtr);
+MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
+			    int *codePtr, int *levelPtr);
+MODULE_SCOPE int	TclNokia770Doubles();
+MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, const char *operation,
+			    const char *reason, int index);
+MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[],
+			    Tcl_Namespace *nsPtr, int flags);
+MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
+MODULE_SCOPE int	TclParseBackslash(const char *src,
+			    int numBytes, int *readPtr, char *dst);
+MODULE_SCOPE int	TclParseHex(const char *src, int numBytes,
+			    Tcl_UniChar *resultPtr);
+MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    const char *expected, const char *bytes,
+			    int numBytes, const char **endPtrPtr, int flags);
+MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
+			    int numBytes, Tcl_Parse *parsePtr);
+MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
+MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
+			    int code, int level, Tcl_Obj *returnOpts);
+#ifndef TCL_NO_STACK_CHECK
+MODULE_SCOPE int        TclpGetCStackParams(int **stackBoundPtr);
 #endif
-EXTERN int		TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
-EXTERN int		TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *value));
-EXTERN void		TclDeleteNamespaceVars _ANSI_ARGS_((Namespace *nsPtr));
-
-#ifdef TCL_TIP280
-EXTERN int              TclEvalObjEx _ANSI_ARGS_((Tcl_Interp *interp,
-						  register Tcl_Obj *objPtr,
-						  int flags,
-						  CONST CmdFrame* invoker,
-						  int word));
-
-EXTERN void TclArgumentEnter   _ANSI_ARGS_((Tcl_Interp* interp,
-					    Tcl_Obj* objv[], int objc, CmdFrame* cf));
-EXTERN void TclArgumentRelease _ANSI_ARGS_((Tcl_Interp* interp,
-					    Tcl_Obj* objv[], int objc));
-EXTERN void TclArgumentBCEnter _ANSI_ARGS_((Tcl_Interp* interp,
-					    Tcl_Obj* objv[], int objc,
-					    void* codePtr, CmdFrame* cfPtr, int pc));
-EXTERN void TclArgumentBCRelease _ANSI_ARGS_((Tcl_Interp* interp,
-					      Tcl_Obj* objv[], int objc,
-					      void* codePtr, int pc));
-
-EXTERN void TclArgumentGet     _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj,
-					    CmdFrame** cfPtrPtr, int* wordPtr));
-#endif
-
-EXTERN void		TclExpandTokenArray _ANSI_ARGS_((
-			    Tcl_Parse *parsePtr));
-EXTERN int		TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-EXTERN int		TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp, 
-			    int objc, Tcl_Obj *CONST objv[])) ;
-EXTERN int		TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-EXTERN int		TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[])) ;
-EXTERN int		TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[])) ;
-EXTERN void		TclCreateLateExitHandler (Tcl_ExitProc * proc,
-						   ClientData clientData);
-EXTERN void		TclDeleteLateExitHandler (Tcl_ExitProc * proc,
-						   ClientData clientData);
-EXTERN void		TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeAsync _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeCompilation _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeEnvironment _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeExecution _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeIOSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeFilesystem _ANSI_ARGS_((void));
-EXTERN void		TclResetFilesystem _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeLoad _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeLock _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeNotifier _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeObjects _ANSI_ARGS_((void));
-EXTERN void		TclFinalizePreserve _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeSynchronization _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeThreadAlloc _ANSI_ARGS_((void));
-EXTERN void		TclFinalizeThreadData _ANSI_ARGS_((void));
-EXTERN int		TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr));
-#ifdef TCL_TIP280
-EXTERN void             TclGetSrcInfoForPc _ANSI_ARGS_((CmdFrame* cfPtr));
+MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
+MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
+			    int len);
+MODULE_SCOPE int	TclpDeleteFile(const char *path);
+MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
+MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
+MODULE_SCOPE void	TclpFinalizePipes(void);
+MODULE_SCOPE void	TclpFinalizeSockets(void);
+MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
+			    Tcl_ThreadCreateProc proc, ClientData clientData,
+			    int stackSize, int flags);
+MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
+MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
+			    int *lengthPtr, Tcl_Encoding *encodingPtr);
+MODULE_SCOPE void	TclpInitLock(void);
+MODULE_SCOPE void	TclpInitPlatform(void);
+MODULE_SCOPE void	TclpInitUnlock(void);
+MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
+MODULE_SCOPE void	TclpMasterLock(void);
+MODULE_SCOPE void	TclpMasterUnlock(void);
+MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
+			    Tcl_DString *dirPtr, char *pattern, char *tail);
+MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr, int nextCheckpoint);
+MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
+MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
+MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
+			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
+MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
+			    Tcl_Obj *source, Tcl_Obj *target);
+MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
+			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
+			    const char *pattern, Tcl_GlobTypeData *types);
+MODULE_SCOPE ClientData	TclpGetNativeCwd(ClientData clientData);
+MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
+MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+			    int linkType);
+MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
+MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    Tcl_PathPart portion);
+#ifndef TclpPanic
+MODULE_SCOPE void	TclpPanic(const char *format, ...);
 #endif
-EXTERN int		TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *pattern, Tcl_Obj *unquotedPrefix, 
-			    int globFlags, Tcl_GlobTypeData* types));
-EXTERN void		TclInitAlloc _ANSI_ARGS_((void));
-EXTERN void		TclInitDbCkalloc _ANSI_ARGS_((void));
-EXTERN void		TclInitEncodingSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclInitIOSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclInitNamespaceSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclInitNotifier _ANSI_ARGS_((void));
-EXTERN void		TclInitObjSubsystem _ANSI_ARGS_((void));
-EXTERN void		TclInitSubsystems _ANSI_ARGS_((CONST char *argv0));
-EXTERN int		TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
-			    int len));
-EXTERN int              TclJoinThread _ANSI_ARGS_((Tcl_ThreadId id,
-			    int* result));
-EXTERN Tcl_Obj *	TclLindexList _ANSI_ARGS_((Tcl_Interp* interp,
-						   Tcl_Obj* listPtr,
-						   Tcl_Obj* argPtr ));
-EXTERN Tcl_Obj *	TclLindexFlat _ANSI_ARGS_((Tcl_Interp* interp,
-						   Tcl_Obj* listPtr,
-						   int indexCount,
-						   Tcl_Obj *CONST indexArray[]
-						   ));
-EXTERN Tcl_Obj *	TclLsetList _ANSI_ARGS_((Tcl_Interp* interp,
-						 Tcl_Obj* listPtr,
-						 Tcl_Obj* indexPtr,
-						 Tcl_Obj* valuePtr  
-						 ));
-EXTERN Tcl_Obj *	TclLsetFlat _ANSI_ARGS_((Tcl_Interp* interp,
-						 Tcl_Obj* listPtr,
-						 int indexCount,
-						 Tcl_Obj *CONST indexArray[],
-						 Tcl_Obj* valuePtr
-						 ));
-EXTERN int              TclParseBackslash _ANSI_ARGS_((CONST char *src,
-                            int numBytes, int *readPtr, char *dst));
-EXTERN int		TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes,
-                            Tcl_UniChar *resultPtr));
-EXTERN int		TclParseInteger _ANSI_ARGS_((CONST char *string,
-			    int numBytes));
-EXTERN int		TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
-			    int numBytes, Tcl_Parse *parsePtr, char *typePtr));
-#ifdef TCL_TIP280
-EXTERN int              TclWordKnownAtCompileTime _ANSI_ARGS_((Tcl_Token* token));
+MODULE_SCOPE char *	TclpReadlink(const char *fileName,
+			    Tcl_DString *linkPtr);
+#ifndef TclpReleaseFile
+MODULE_SCOPE void	TclpReleaseFile(TclFile file);
 #endif
-EXTERN int		TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename,
-			    int mode));
-EXTERN int              TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-			    Tcl_StatBuf *buf));
-EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
-EXTERN Tcl_Obj*         TclpTempFileName _ANSI_ARGS_((void));
-EXTERN Tcl_Obj*         TclNewFSPathObj _ANSI_ARGS_((Tcl_Obj *dirPtr, 
-			    CONST char *addStrRep, int len));
-EXTERN int              TclpDeleteFile _ANSI_ARGS_((CONST char *path));
-EXTERN void		TclpFinalizeCondition _ANSI_ARGS_((
-			    Tcl_Condition *condPtr));
-EXTERN void		TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
-EXTERN void		TclpFinalizePipes _ANSI_ARGS_((void));
-EXTERN void		TclpFinalizeSockets _ANSI_ARGS_((void));
-EXTERN void		TclpFinalizeThreadData _ANSI_ARGS_((
-			    Tcl_ThreadDataKey *keyPtr));
-EXTERN void		TclpFinalizeThreadDataKey _ANSI_ARGS_((
-			    Tcl_ThreadDataKey *keyPtr));
-EXTERN char *		TclpFindExecutable _ANSI_ARGS_((
-			    CONST char *argv0));
-EXTERN int		TclpFindVariable _ANSI_ARGS_((CONST char *name,
-			    int *lengthPtr));
-EXTERN int		TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0));
-EXTERN void		TclpInitLock _ANSI_ARGS_((void));
-EXTERN void		TclpInitPlatform _ANSI_ARGS_((void));
-EXTERN void		TclpInitUnlock _ANSI_ARGS_((void));
-EXTERN int              TclpLoadFile _ANSI_ARGS_((Tcl_Interp *interp, 
-				Tcl_Obj *pathPtr,
-				CONST char *sym1, CONST char *sym2, 
-				Tcl_PackageInitProc **proc1Ptr,
-				Tcl_PackageInitProc **proc2Ptr, 
-				ClientData *clientDataPtr,
-				Tcl_FSUnloadFileProc **unloadProcPtr));
-EXTERN Tcl_Obj*		TclpObjListVolumes _ANSI_ARGS_((void));
-EXTERN void		TclpMasterLock _ANSI_ARGS_((void));
-EXTERN void		TclpMasterUnlock _ANSI_ARGS_((void));
-EXTERN int		TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *separators, Tcl_DString *dirPtr,
-			    char *pattern, char *tail));
-EXTERN int              TclpObjNormalizePath _ANSI_ARGS_((Tcl_Interp *interp, 
-			    Tcl_Obj *pathPtr, int nextCheckpoint));
-EXTERN int		TclpObjCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
-EXTERN void             TclpNativeJoinPath _ANSI_ARGS_((Tcl_Obj *prefix, 
-							char *joining));
-EXTERN Tcl_Obj*         TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-							 int *lenPtr));
-EXTERN Tcl_PathType     TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
-			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
-EXTERN int 		TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp, 
-			    Tcl_Obj *source, Tcl_Obj *target));
-EXTERN int		TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
-EXTERN int		TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
-				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
-EXTERN int		TclpObjCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
-				Tcl_Obj *destPathPtr));
-EXTERN int		TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-				int recursive, Tcl_Obj **errorPtr));
-EXTERN int		TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
-				Tcl_Obj *destPathPtr));
-EXTERN int		TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, 
-			        Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, 
-				CONST char *pattern, Tcl_GlobTypeData *types));
-EXTERN Tcl_Obj*		TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
-EXTERN Tcl_Obj*		TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-				Tcl_Obj *toPtr, int linkType));
-EXTERN int		TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
-EXTERN Tcl_Obj*         TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, 
-						    Tcl_Obj*pathPtr));
-EXTERN int		TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
-EXTERN Tcl_Channel	TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, int mode,
-			    int permissions));
-EXTERN void		TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
-			    format));
-EXTERN char *		TclpReadlink _ANSI_ARGS_((CONST char *fileName,
-			    Tcl_DString *linkPtr));
-EXTERN void		TclpReleaseFile _ANSI_ARGS_((TclFile file));
-EXTERN void		TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void		TclpUnloadFile _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
-EXTERN VOID *		TclpThreadDataKeyGet _ANSI_ARGS_((
-			    Tcl_ThreadDataKey *keyPtr));
-EXTERN void		TclpThreadDataKeyInit _ANSI_ARGS_((
-			    Tcl_ThreadDataKey *keyPtr));
-EXTERN void		TclpThreadDataKeySet _ANSI_ARGS_((
-			    Tcl_ThreadDataKey *keyPtr, VOID *data));
-EXTERN int		TclpThreadCreate _ANSI_ARGS_((
-			    Tcl_ThreadId *idPtr,
-			    Tcl_ThreadCreateProc proc,
-			    ClientData clientData,
-			    int stackSize, int flags));
-EXTERN void		TclpThreadExit _ANSI_ARGS_((int status));
-EXTERN void		TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
-EXTERN void		TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
-EXTERN VOID             TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id));
-EXTERN void		TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
-EXTERN VOID             TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
-			     int result));
-EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
-			    int result, Tcl_Interp *targetInterp));
-EXTERN Tcl_Obj*         TclpNativeToNormalized 
-                            _ANSI_ARGS_((ClientData clientData));
-EXTERN Tcl_Obj*	        TclpFilesystemPathType
-					_ANSI_ARGS_((Tcl_Obj* pathObjPtr));
-EXTERN Tcl_PackageInitProc* TclpFindSymbol _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_LoadHandle loadHandle, CONST char *symbol));
-EXTERN int              TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp, 
-			    Tcl_Obj *pathPtr, 
-	                    Tcl_LoadHandle *loadHandle, 
-		            Tcl_FSUnloadFileProc **unloadProcPtr));
-EXTERN int              TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,
-					       struct utimbuf *tval));
-
+MODULE_SCOPE void	TclpSetInterfaces(void);
+MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
+MODULE_SCOPE void	TclpUnloadFile(Tcl_LoadHandle loadHandle);
+MODULE_SCOPE void *	TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
+MODULE_SCOPE void	TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
+			    void *data);
+MODULE_SCOPE void	TclpThreadExit(int status);
+MODULE_SCOPE size_t	TclpThreadGetStackSize(void);
+MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
+MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
+MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
+MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
+MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
+			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
+MODULE_SCOPE int	TclScanElement(CONST char *string, int length,
+			    int *flagPtr);
+MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
+			    Tcl_Obj *cmdPrefix);
+MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
+			    mp_int *bignumValue);
+MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Command *cmdPtr);
+MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
+			    Tcl_Obj *newValue, Tcl_Encoding encoding);
+MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
+MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
+			    int numBytes);
+MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
+			    const char *pattern, int ptnLen, int flags);
+MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
+			    Tcl_Obj *patternObj, int flags);
+MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
+MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
+			    int count, int *tokensLeftPtr, int line,
+			    int *clNextOuter, CONST char *outerScript);
+MODULE_SCOPE void	TclTransferResult(Tcl_Interp *sourceInterp, int result,
+			    Tcl_Interp *targetInterp);
+MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
+			    const char *trim, int numTrim);
+MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
+			    const char *trim, int numTrim);
+MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
+MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
+MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp,
+			    Tcl_LoadHandle loadHandle, const char *symbol);
+MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    Tcl_LoadHandle *loadHandle,
+			    Tcl_FSUnloadFileProc **unloadProcPtr);
+MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
 #ifdef TCL_LOAD_FROM_MEMORY
-EXTERN void*	        TclpLoadMemoryGetBuffer _ANSI_ARGS_((
-			    Tcl_Interp *interp, int size));
-EXTERN int	        TclpLoadMemory _ANSI_ARGS_((Tcl_Interp *interp, 
-			    void *buffer, int size, int codeSize, 
-			    Tcl_LoadHandle *loadHandle, 
-			    Tcl_FSUnloadFileProc **unloadProcPtr));
+MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
+MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
+			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
+			    Tcl_FSUnloadFileProc **unloadProcPtr);
+#endif
+MODULE_SCOPE void	TclInitThreadStorage(void);
+MODULE_SCOPE void	TclpFinalizeThreadDataThread(void);
+MODULE_SCOPE void	TclFinalizeThreadStorage(void);
+#ifdef TCL_WIDE_CLICKS
+MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
+MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
 #endif
+MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
 
 /*
  *----------------------------------------------------------------
@@ -2137,160 +2833,266 @@ EXTERN int	        TclpLoadMemory _ANSI_ARGS_((Tcl_Interp *interp,
  *----------------------------------------------------------------
  */
 
-EXTERN int	Tcl_AfterObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_AppendObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ArrayObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_BinaryObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_BreakObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_CaseObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_CatchObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_CdObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ClockObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_CloseObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ContinueObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_EncodingObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_EofObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ErrorObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_EvalObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ExecObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ExitObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ExprObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FblockedObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FconfigureObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FcopyObjCmd _ANSI_ARGS_((ClientData dummy,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FileObjCmd _ANSI_ARGS_((ClientData dummy,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FileEventObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FlushObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ForObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ForeachObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_FormatObjCmd _ANSI_ARGS_((ClientData dummy,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_GetsObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_GlobalObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_GlobObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_IfObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_IncrObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_InfoObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_InterpObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LindexObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LinsertObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LlengthObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ListObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LoadObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LsetObjCmd _ANSI_ARGS_((ClientData clientData,
-                    Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_OpenObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_PackageObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_PidObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_PutsObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_PwdObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ReadObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_RegexpObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_RegsubObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_RenameObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ReturnObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_ScanObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SeekObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SetObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SplitObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SocketObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SourceObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_StringObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SubstObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_SwitchObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_TellObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_TraceObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_UpdateObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_UplevelObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_UpvarObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_VariableObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_VwaitObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+MODULE_SCOPE int	Tcl_AfterObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_AppendObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ApplyObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ArrayObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_BinaryObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_CdObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclChanPostEventObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
+MODULE_SCOPE int	TclClockOldscanObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_CloseObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ConcatObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ContinueObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
+			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
+			    ClientData clientData);
+MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ErrorObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_EvalObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ExecObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ExitObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ExprObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FblockedObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FconfigureObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FileObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FlushObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ForObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ForeachObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_FormatObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_GetsObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_GlobalObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_GlobObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_IncrObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	Tcl_InterpObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_JoinObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LappendObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LassignObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LindexObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LinsertObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LreverseObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LsearchObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_NamespaceObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_OpenObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_PidObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_PutsObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_PwdObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ReadObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_RegexpObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_RegsubObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_RenameObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ReturnObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ScanObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SeekObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SetObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SplitObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SocketObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SourceObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	Tcl_SubstObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_UpdateObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_UplevelObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_UpvarObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_VariableObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_VwaitObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 
 /*
  *----------------------------------------------------------------
@@ -2298,88 +3100,327 @@ EXTERN int	Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData,
  *----------------------------------------------------------------
  */
 
-EXTERN int	TclCompileAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileListCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileLsetCmd _ANSI_ARGS_((Tcl_Interp* interp,
-		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
-EXTERN int	TclCompileRegexpCmd _ANSI_ARGS_((Tcl_Interp* interp,
-		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
-EXTERN int	TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-
-/*
- * Functions defined in generic/tclVar.c and currenttly exported only 
- * for use by the bytecode compiler and engine. Some of these could later 
- * be placed in the public interface.
- */
-
-EXTERN Var *	TclLookupArrayElement _ANSI_ARGS_((Tcl_Interp *interp,
-		    CONST char *arrayName, CONST char *elName, CONST int flags,
-		    CONST char *msg, CONST int createPart1,
-		    CONST int createPart2, Var *arrayPtr));	
-EXTERN Var *    TclObjLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Obj *part1Ptr, CONST char *part2, int flags,
-		    CONST char *msg, CONST int createPart1,
-		    CONST int createPart2, Var **arrayPtrPtr));
-EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
-		    Var *arrayPtr, CONST char *part1, CONST char *part2,
-		    CONST int flags));
-EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
-		    Var *arrayPtr, CONST char *part1, CONST char *part2,
-		    Tcl_Obj *newValuePtr, CONST int flags));
-EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
-		    Var *arrayPtr, CONST char *part1, CONST char *part2,
-		    CONST long i, CONST int flags));
+MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBreakCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileCatchCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileContinueCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictAppendCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictSetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictUpdateCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileEnsemble(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileExprCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileForCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileForeachCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileGlobalCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileIfCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoExistsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileIncrCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLappendCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileListCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLlengthCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLsetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileRegexpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileReturnCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileSetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringCmpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringEqualCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringLenCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileSwitchCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileUpvarCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileVariableCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileWhileCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+
+MODULE_SCOPE int	TclInvertOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileInvertOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclNotOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileNotOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclAddOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileAddOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclMulOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileMulOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclAndOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileAndOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclOrOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileOrOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclXorOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileXorOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclPowOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompilePowOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclLshiftOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileLshiftOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclRshiftOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileRshiftOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclModOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileModOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclNeqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileNeqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclStrneqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileStrneqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclInOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileInOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclNiOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileNiOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclMinusOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileMinusOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclDivOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclLessOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclLeqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileLeqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclGreaterOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileGreaterOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclGeqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileGeqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclEqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclStreqOpCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+
+/*
+ * Functions defined in generic/tclVar.c and currenttly exported only for use
+ * by the bytecode compiler and engine. Some of these could later be placed in
+ * the public interface.
+ */
+
+MODULE_SCOPE Var *	TclObjLookupVarEx(Tcl_Interp * interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags,
+			    const char *msg, const int createPart1,
+			    const int createPart2, Var **arrayPtrPtr);
+MODULE_SCOPE Var *	TclLookupArrayElement(Tcl_Interp *interp,
+			    Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
+			    const int flags, const char *msg,
+			    const int createPart1, const int createPart2,
+			    Var *arrayPtr, int index);
+MODULE_SCOPE Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp,
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, const int flags, int index);
+MODULE_SCOPE Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp,
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
+			    const int flags, int index);
+MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar(Tcl_Interp *interp,
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
+			    const int flags, int index);
+MODULE_SCOPE int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
+			    Tcl_Obj *myNamePtr, int myFlags, int index);
+MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
+
+/*
+ * The new extended interface to the variable traces.
+ */
+
+MODULE_SCOPE int	TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
+			    Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+			    int flags, int leaveErrMsg, int index);
+
+/*
+ * So tclObj.c and tclDictObj.c can share these implementations.
+ */
+
+MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
+MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
 
 /*
  *----------------------------------------------------------------
  * Macros used by the Tcl core to create and release Tcl objects.
  * TclNewObj(objPtr) creates a new object denoting an empty string.
- * TclDecrRefCount(objPtr) decrements the object's reference count,
- * and frees the object if its reference count is zero.
- * These macros are inline versions of Tcl_NewObj() and
- * Tcl_DecrRefCount(). Notice that the names differ in not having
- * a "_" after the "Tcl". Notice also that these macros reference
- * their argument more than once, so you should avoid calling them
- * with an expression that is expensive to compute or has
- * side effects. The ANSI C "prototypes" for these macros are:
+ * TclDecrRefCount(objPtr) decrements the object's reference count, and frees
+ * the object if its reference count is zero. These macros are inline versions
+ * of Tcl_NewObj() and Tcl_DecrRefCount(). Notice that the names differ in not
+ * having a "_" after the "Tcl". Notice also that these macros reference their
+ * argument more than once, so you should avoid calling them with an
+ * expression that is expensive to compute or has side effects. The ANSI C
+ * "prototypes" for these macros are:
  *
- * EXTERN void	TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
- * EXTERN void	TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ * MODULE_SCOPE void	TclNewObj(Tcl_Obj *objPtr);
+ * MODULE_SCOPE void	TclDecrRefCount(Tcl_Obj *objPtr);
  *
- * These macros are defined in terms of two macros that depend on 
- * memory allocator in use: TclAllocObjStorage, TclFreeObjStorage.
- * They are defined below.
+ * These macros are defined in terms of two macros that depend on memory
+ * allocator in use: TclAllocObjStorage, TclFreeObjStorage. They are defined
+ * below.
  *----------------------------------------------------------------
  */
 
@@ -2406,94 +3447,78 @@ EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
 #  define TclIncrObjsFreed()
 #endif /* TCL_COMPILE_STATS */
 
-#define TclNewObj(objPtr) \
-    TclAllocObjStorage(objPtr); \
+#ifndef TCL_MEM_DEBUG
+# define TclNewObj(objPtr) \
     TclIncrObjsAllocated(); \
+    TclAllocObjStorage(objPtr); \
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
     TCL_DTRACE_OBJ_CREATE(objPtr)
 
-
-#ifdef TCL_MEM_DEBUG
-#   define TclDecrRefCount(objPtr) \
-	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
-#else
-#   define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount <= 0) { \
-	TCL_DTRACE_OBJ_FREE(objPtr); \
-	if (((objPtr)->typePtr != NULL) \
-		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
-	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
-	} \
-	if (((objPtr)->bytes != NULL) \
-		&& ((objPtr)->bytes != tclEmptyStringRep)) { \
-	    ckfree((char *) (objPtr)->bytes); \
+/*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering) with
+ * 'length == -1'.
+ * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
+ */
+
+# define TclDecrRefCount(objPtr) \
+    if (--(objPtr)->refCount > 0) ; else { \
+	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
+	    TCL_DTRACE_OBJ_FREE(objPtr); \
+	    if ((objPtr)->bytes \
+		    && ((objPtr)->bytes != tclEmptyStringRep)) { \
+		ckfree((char *) (objPtr)->bytes); \
+	    } \
+	    (objPtr)->length = -1; \
+	    TclFreeObjStorage(objPtr); \
+	    TclIncrObjsFreed(); \
+	} else { \
+	    TclFreeObj(objPtr); \
 	} \
-        TclFreeObjStorage(objPtr); \
-	TclIncrObjsFreed(); \
     }
-#endif
-
-#ifdef TCL_MEM_DEBUG
-#  define TclAllocObjStorage(objPtr) \
-       (objPtr) = (Tcl_Obj *) \
-           Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__)
 
-#  define TclFreeObjStorage(objPtr) \
-       if ((objPtr)->refCount < -1) { \
-           panic("Reference count for %lx was negative: %s line %d", \
-	           (objPtr), __FILE__, __LINE__); \
-       } \
-       ckfree((char *) (objPtr))
-     
-#  define TclDbNewObj(objPtr, file, line) \
-       (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
-       (objPtr)->refCount = 0; \
-       (objPtr)->bytes    = tclEmptyStringRep; \
-       (objPtr)->length   = 0; \
-       (objPtr)->typePtr  = NULL; \
-       TclIncrObjsAllocated(); \
-       TCL_DTRACE_OBJ_CREATE(objPtr)
-
-     
-#elif defined(PURIFY)
+#if defined(PURIFY)
 
 /*
  * The PURIFY mode is like the regular mode, but instead of doing block
  * Tcl_Obj allocation and keeping a freed list for efficiency, it always
- * allocates and frees a single Tcl_Obj so that tools like Purify can
- * better track memory leaks
+ * allocates and frees a single Tcl_Obj so that tools like Purify can better
+ * track memory leaks.
  */
 
 #  define TclAllocObjStorage(objPtr) \
-       (objPtr) = (Tcl_Obj *) Tcl_Ckalloc(sizeof(Tcl_Obj))
+	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
 
 #  define TclFreeObjStorage(objPtr) \
-       ckfree((char *) (objPtr))
+	ckfree((char *) (objPtr))
 
+#undef USE_THREAD_ALLOC
 #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
 
 /*
- * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's
- * from per-thread caches.
+ * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
+ * per-thread caches.
  */
 
-EXTERN Tcl_Obj *TclThreadAllocObj _ANSI_ARGS_((void));
-EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
-EXTERN void TclFreeAllocCache _ANSI_ARGS_((void *));
-EXTERN void TclpFreeAllocMutex _ANSI_ARGS_((Tcl_Mutex* mutex));
-EXTERN void TclpFreeAllocCache _ANSI_ARGS_((void *));
-
+MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
+MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
+MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
+MODULE_SCOPE void	TclFreeAllocCache(void *);
+MODULE_SCOPE void *	TclpGetAllocCache(void);
+MODULE_SCOPE void	TclpSetAllocCache(void *);
+MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
+MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
 #  define TclAllocObjStorage(objPtr) \
-       (objPtr) = TclThreadAllocObj()
+	(objPtr) = TclThreadAllocObj()
 
 #  define TclFreeObjStorage(objPtr) \
-       TclThreadFreeObj((objPtr))
+	TclThreadFreeObj((objPtr))
 
-#else /* not TCL_MEM_DEBUG */
+#else /* not PURIFY or USE_THREAD_ALLOC */
 
 #if defined(USE_TCLALLOC) && USE_TCLALLOC
     MODULE_SCOPE void TclFinalizeAllocSubsystem();
@@ -2504,38 +3529,60 @@ EXTERN void TclpFreeAllocCache _ANSI_ARGS_((void *));
 
 #ifdef TCL_THREADS
 /* declared in tclObj.c */
-extern Tcl_Mutex tclObjMutex;
+MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 #endif
 
 #  define TclAllocObjStorage(objPtr) \
-       Tcl_MutexLock(&tclObjMutex); \
-       if (tclFreeObjList == NULL) { \
-	   TclAllocateFreeObjects(); \
-       } \
-       (objPtr) = tclFreeObjList; \
-       tclFreeObjList = (Tcl_Obj *) \
-	   tclFreeObjList->internalRep.otherValuePtr; \
-       Tcl_MutexUnlock(&tclObjMutex)
+	Tcl_MutexLock(&tclObjMutex); \
+	if (tclFreeObjList == NULL) { \
+	    TclAllocateFreeObjects(); \
+	} \
+	(objPtr) = tclFreeObjList; \
+	tclFreeObjList = (Tcl_Obj *) \
+		tclFreeObjList->internalRep.twoPtrValue.ptr1; \
+	Tcl_MutexUnlock(&tclObjMutex)
 
 #  define TclFreeObjStorage(objPtr) \
-       Tcl_MutexLock(&tclObjMutex); \
-       (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
-       tclFreeObjList = (objPtr); \
-       Tcl_MutexUnlock(&tclObjMutex)
+	Tcl_MutexLock(&tclObjMutex); \
+	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
+	tclFreeObjList = (objPtr); \
+	Tcl_MutexUnlock(&tclObjMutex)
+#endif
+
+#else /* TCL_MEM_DEBUG */
+MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
+			    int line);
+
+# define TclDbNewObj(objPtr, file, line) \
+    TclIncrObjsAllocated(); \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+    TclDbInitNewObj((objPtr), (file), (line)); \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
+
+# define TclNewObj(objPtr) \
+    TclDbNewObj(objPtr, __FILE__, __LINE__);
+
+# define TclDecrRefCount(objPtr) \
+    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+
+# define TclNewListObjDirect(objc, objv) \
+    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)
 
+#undef USE_THREAD_ALLOC
 #endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------
- * Macro used by the Tcl core to set a Tcl_Obj's string representation
- * to a copy of the "len" bytes starting at "bytePtr". This code
- * works even if the byte array contains NULLs as long as the length
- * is correct. Because "len" is referenced multiple times, it should
- * be as simple an expression as possible. The ANSI C "prototype" for
- * this macro is:
+ * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
+ * copy of the "len" bytes starting at "bytePtr". This code works even if the
+ * byte array contains NULLs as long as the length is correct. Because "len"
+ * is referenced multiple times, it should be as simple an expression as
+ * possible. The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
  *
- * EXTERN void	TclInitStringRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- *		    char *bytePtr, int len));
+ * This macro should only be called on an unshared objPtr where
+ *  objPtr->typePtr->freeIntRepProc == NULL
  *----------------------------------------------------------------
  */
 
@@ -2545,7 +3592,7 @@ extern Tcl_Mutex tclObjMutex;
 	(objPtr)->length = 0; \
     } else { \
 	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
-	memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
+	memcpy((void *) (objPtr)->bytes, (void *) (bytePtr), \
 		(unsigned) (len)); \
 	(objPtr)->bytes[len] = '\0'; \
 	(objPtr)->length = (len); \
@@ -2553,80 +3600,400 @@ extern Tcl_Mutex tclObjMutex;
 
 /*
  *----------------------------------------------------------------
- * Macro used by the Tcl core to get the string representation's
- * byte array pointer from a Tcl_Obj. This is an inline version
- * of Tcl_GetString(). The macro's expression result is the string
- * rep's byte pointer which might be NULL. The bytes referenced by 
- * this pointer must not be modified by the caller.
- * The ANSI C "prototype" for this macro is:
+ * Macro used by the Tcl core to get the string representation's byte array
+ * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
+ * macro's expression result is the string rep's byte pointer which might be
+ * NULL. The bytes referenced by this pointer must not be modified by the
+ * caller. The ANSI C "prototype" for this macro is:
  *
- * EXTERN char *  TclGetString _ANSI_ARGS_((Tcl_Obj *objPtr));
+ * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
  *----------------------------------------------------------------
  */
 
 #define TclGetString(objPtr) \
     ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
 
+#define TclGetStringFromObj(objPtr, lenPtr) \
+    ((objPtr)->bytes \
+	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\
+	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))
+
 /*
  *----------------------------------------------------------------
- * Macro used by the Tcl core to get a Tcl_WideInt value out of
- * a Tcl_Obj of the "wideInt" type.  Different implementation on
- * different platforms depending whether TCL_WIDE_INT_IS_LONG.
+ * Macro used by the Tcl core to clean out an object's internal
+ * representation. Does not actually reset the rep's bytes. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void	TclFreeIntRep(Tcl_Obj *objPtr);
  *----------------------------------------------------------------
  */
 
-#ifdef TCL_WIDE_INT_IS_LONG
-#    define TclGetWide(resultVar, objPtr) \
-	(resultVar) = (objPtr)->internalRep.longValue
-#    define TclGetLongFromWide(resultVar, objPtr) \
-	(resultVar) = (objPtr)->internalRep.longValue
-#else
-#    define TclGetWide(resultVar, objPtr) \
-	(resultVar) = (objPtr)->internalRep.wideValue
-#    define TclGetLongFromWide(resultVar, objPtr) \
-	(resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue)
-#endif
+#define TclFreeIntRep(objPtr) \
+    if ((objPtr)->typePtr != NULL && \
+	    (objPtr)->typePtr->freeIntRepProc != NULL) { \
+	(objPtr)->typePtr->freeIntRepProc(objPtr); \
+    }
 
 /*
  *----------------------------------------------------------------
- * Macro used by the Tcl core get a unicode char from a utf string.
- * It checks to see if we have a one-byte utf char before calling
- * the real Tcl_UtfToUniChar, as this will save a lot of time for
- * primarily ascii string handling. The macro's expression result
- * is 1 for the 1-byte case or the result of Tcl_UtfToUniChar.
+ * Macro used by the Tcl core to clean out an object's string representation.
  * The ANSI C "prototype" for this macro is:
  *
- * EXTERN int TclUtfToUniChar _ANSI_ARGS_((CONST char *string,
- *					   Tcl_UniChar *ch));
+ * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclInvalidateStringRep(objPtr) \
+    if (objPtr->bytes != NULL) { \
+	if (objPtr->bytes != tclEmptyStringRep) { \
+	    ckfree((char *) objPtr->bytes); \
+	} \
+	objPtr->bytes = NULL; \
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
+ * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void	TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
+ *				int available, int append,
+ *				Tcl_Token *staticPtr);
+ * MODULE_SCOPE void	TclGrowParseTokenArray(Tcl_Parse *parsePtr,
+ *				int append);
+ *----------------------------------------------------------------
+ */
+
+#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
+#define TCL_MIN_TOKEN_GROWTH 50
+#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
+{									\
+    int needed = (used) + (append);					\
+    if (needed > TCL_MAX_TOKENS) {					\
+	Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded",	\
+		TCL_MAX_TOKENS);					\
+    }									\
+    if (needed > (available)) {						\
+	int allocated = 2 * needed;					\
+	Tcl_Token *oldPtr = (tokenPtr);					\
+	Tcl_Token *newPtr;						\
+	if (oldPtr == (staticPtr)) {					\
+	    oldPtr = NULL;						\
+	}								\
+	if (allocated > TCL_MAX_TOKENS) {				\
+	    allocated = TCL_MAX_TOKENS;					\
+	}								\
+	newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
+		(unsigned int) (allocated * sizeof(Tcl_Token)));	\
+	if (newPtr == NULL) {						\
+	    allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
+	    if (allocated > TCL_MAX_TOKENS) {				\
+		allocated = TCL_MAX_TOKENS;				\
+	    }								\
+	    newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr,		\
+		    (unsigned int) (allocated * sizeof(Tcl_Token)));	\
+	}								\
+	(available) = allocated;					\
+	if (oldPtr == NULL) {						\
+	    memcpy((VOID *) newPtr, (VOID *) staticPtr,			\
+		    (size_t) ((used) * sizeof(Tcl_Token)));		\
+	}								\
+	(tokenPtr) = newPtr;						\
+    }									\
+}
+
+#define TclGrowParseTokenArray(parsePtr, append)			\
+    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
+	    (parsePtr)->tokensAvailable, (append),			\
+	    (parsePtr)->staticTokens)
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core get a unicode char from a utf string. It checks
+ * to see if we have a one-byte utf char before calling the real
+ * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII
+ * string handling. The macro's expression result is 1 for the 1-byte case or
+ * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclUtfToUniChar(const char *string, Tcl_UniChar *ch);
  *----------------------------------------------------------------
  */
 
 #define TclUtfToUniChar(str, chPtr) \
-	((((unsigned char) *(str)) < 0xC0) ? \
-	    ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
+	((((unsigned char) *(str)) < 0xC0) ?		\
+	    ((*(chPtr) = (Tcl_UniChar) *(str)), 1)	\
 	    : Tcl_UtfToUniChar(str, chPtr))
 
 /*
  *----------------------------------------------------------------
- * Macro used by the Tcl core to compare Unicode strings.  On
- * big-endian systems we can use the more efficient memcmp, but
- * this would not be lexically correct on little-endian systems.
- * The ANSI C "prototype" for this macro is:
+ * Macro used by the Tcl core to compare Unicode strings. On big-endian
+ * systems we can use the more efficient memcmp, but this would not be
+ * lexically correct on little-endian systems. The ANSI C "prototype" for
+ * this macro is:
  *
- * EXTERN int TclUniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *cs,
- *         CONST Tcl_UniChar *ct, unsigned long n));
+ * MODULE_SCOPE int	TclUniCharNcmp(const Tcl_UniChar *cs,
+ *			    const Tcl_UniChar *ct, unsigned long n);
  *----------------------------------------------------------------
  */
+
 #ifdef WORDS_BIGENDIAN
 #   define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
 #else /* !WORDS_BIGENDIAN */
 #   define TclUniCharNcmp Tcl_UniCharNcmp
 #endif /* WORDS_BIGENDIAN */
 
-#include "tclIntDecls.h"
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to increment a namespace's export export epoch
+ * counter. The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclInvalidateNsCmdLookup(nsPtr) \
+    if ((nsPtr)->numExportPatterns) {		\
+	(nsPtr)->exportLookupEpoch++;		\
+    }						\
+    if ((nsPtr)->commandPathLength) {		\
+	(nsPtr)->cmdRefEpoch++;			\
+    }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Core procedures added to libtommath for bignum manipulation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int	TclTommath_Init(Tcl_Interp *interp);
+MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
+MODULE_SCOPE void	TclBNInitBignumFromWideInt(mp_int *bignum,
+			    Tcl_WideInt initVal);
+MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
+			    Tcl_WideUInt initVal);
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to check whether a pattern has any characters
+ * special to [string match]. The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);
+ *----------------------------------------------------------------
+ */
+
+#define TclMatchIsTrivial(pattern)	strpbrk((pattern), "*[?\\") == NULL
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to set a Tcl_Obj's numeric representation
+ * avoiding the corresponding function calls in time critical parts of the
+ * core. They should only be called on unshared objects. The ANSI C
+ * "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE void	TclSetIntObj(Tcl_Obj *objPtr, int intValue);
+ * MODULE_SCOPE void	TclSetLongObj(Tcl_Obj *objPtr, long longValue);
+ * MODULE_SCOPE void	TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue);
+ * MODULE_SCOPE void	TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
+ * MODULE_SCOPE void	TclSetDoubleObj(Tcl_Obj *objPtr, double d);
+ *----------------------------------------------------------------
+ */
+
+#define TclSetIntObj(objPtr, i) \
+    TclInvalidateStringRep(objPtr);\
+    TclFreeIntRep(objPtr); \
+    (objPtr)->internalRep.longValue = (long)(i); \
+    (objPtr)->typePtr = &tclIntType
+
+#define TclSetLongObj(objPtr, l) \
+    TclSetIntObj((objPtr), (l))
+
+/*
+ * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
+ * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
+ * The only "boolean" Tcl_Obj's shall be those holding the cached boolean
+ * value of strings like: "yes", "no", "true", "false", "on", "off".
+ */
+
+#define TclSetBooleanObj(objPtr, b) \
+    TclSetIntObj((objPtr), ((b)? 1 : 0));
+
+#ifndef NO_WIDE_TYPE
+#define TclSetWideIntObj(objPtr, w) \
+    TclInvalidateStringRep(objPtr);\
+    TclFreeIntRep(objPtr); \
+    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
+    (objPtr)->typePtr = &tclWideIntType
+#endif
+
+#define TclSetDoubleObj(objPtr, d) \
+    TclInvalidateStringRep(objPtr);\
+    TclFreeIntRep(objPtr); \
+    (objPtr)->internalRep.doubleValue = (double)(d); \
+    (objPtr)->typePtr = &tclDoubleType
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to create and initialise objects of standard
+ * types, avoiding the corresponding function calls in time critical parts of
+ * the core. The ANSI C "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, int i);
+ * MODULE_SCOPE void	TclNewLongObj(Tcl_Obj *objPtr, long l);
+ * MODULE_SCOPE void	TclNewBooleanObj(Tcl_Obj *objPtr, int b);
+ * MODULE_SCOPE void	TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
+ * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
+ * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
+ * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
+ *
+ *----------------------------------------------------------------
+ */
+
+#ifndef TCL_MEM_DEBUG
+#define TclNewIntObj(objPtr, i) \
+    TclIncrObjsAllocated(); \
+    TclAllocObjStorage(objPtr); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes = NULL; \
+    (objPtr)->internalRep.longValue = (long)(i); \
+    (objPtr)->typePtr = &tclIntType; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
+
+#define TclNewLongObj(objPtr, l) \
+    TclNewIntObj((objPtr), (l))
+
+/*
+ * NOTE: There is to be no such thing as a "pure" boolean.
+ * See comment above TclSetBooleanObj macro above.
+ */
+#define TclNewBooleanObj(objPtr, b) \
+    TclNewIntObj((objPtr), ((b)? 1 : 0))
+
+#define TclNewDoubleObj(objPtr, d) \
+    TclIncrObjsAllocated(); \
+    TclAllocObjStorage(objPtr); \
+    (objPtr)->refCount = 0; \
+    (objPtr)->bytes = NULL; \
+    (objPtr)->internalRep.doubleValue = (double)(d); \
+    (objPtr)->typePtr = &tclDoubleType; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
+
+#define TclNewStringObj(objPtr, s, len) \
+    TclIncrObjsAllocated(); \
+    TclAllocObjStorage(objPtr); \
+    (objPtr)->refCount = 0; \
+    TclInitStringRep((objPtr), (s), (len));\
+    (objPtr)->typePtr = NULL; \
+    TCL_DTRACE_OBJ_CREATE(objPtr)
+
+#else /* TCL_MEM_DEBUG */
+#define TclNewIntObj(objPtr, i) \
+    (objPtr) = Tcl_NewIntObj(i)
+
+#define TclNewLongObj(objPtr, l) \
+    (objPtr) = Tcl_NewLongObj(l)
+
+#define TclNewBooleanObj(objPtr, b) \
+    (objPtr) = Tcl_NewBooleanObj(b)
+
+#define TclNewDoubleObj(objPtr, d) \
+    (objPtr) = Tcl_NewDoubleObj(d)
+
+#define TclNewStringObj(objPtr, s, len) \
+    (objPtr) = Tcl_NewStringObj((s), (len))
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ * The sLiteral argument *must* be a string literal; the incantation with
+ * sizeof(sLiteral "") will fail to compile otherwise.
+ */
+#define TclNewLiteralStringObj(objPtr, sLiteral) \
+    TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+
+/*
+ *----------------------------------------------------------------
+ * Macros used by the Tcl core to test for some special double values.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE int	TclIsInfinite(double d);
+ * MODULE_SCOPE int	TclIsNaN(double d);
+ */
 
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
+#ifdef _MSC_VER
+#    define TclIsInfinite(d)	(!(_finite((d))))
+#    define TclIsNaN(d)		(_isnan((d)))
+#else
+#    define TclIsInfinite(d)	((d) > DBL_MAX || (d) < -DBL_MAX)
+#    ifdef NO_ISNAN
+#	 define TclIsNaN(d)	((d) != (d))
+#    else
+#	 define TclIsNaN(d)	(isnan(d))
+#    endif
+#endif
+
+/*
+ * ----------------------------------------------------------------------
+ * Macro to use to find the offset of a field in a structure. Computes number
+ * of bytes from beginning of structure to a given field.
+ */
+
+#ifdef offsetof
+#define TclOffset(type, field) ((int) offsetof(type, field))
+#else
+#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field))
+#endif
+
+/*
+ *----------------------------------------------------------------
+ * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
+ */
+
+#define TclGetCurrentNamespace(interp) \
+    (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr
+
+#define TclGetGlobalNamespace(interp) \
+    (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr
+
+/*
+ *----------------------------------------------------------------
+ * Inline version of TclCleanupCommand; still need the function as it is in
+ * the internal stubs, but the core can use the macro instead.
+ */
+
+#define TclCleanupCommandMacro(cmdPtr) \
+    if (--(cmdPtr)->refCount <= 0) { \
+	ckfree((char *) (cmdPtr));\
+    }
+
+/*
+ *----------------------------------------------------------------
+ * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
+ * of calls out of the critical path. Note that this code isn't particularly
+ * readable; the non-inline version (in tclInterp.c) is much easier to
+ * understand. Note also that these macros takes different args (iPtr->limit)
+ * to the non-inline version.
+ */
+
+#define TclLimitExceeded(limit) ((limit).exceeded != 0)
+
+#define TclLimitReady(limit)						\
+    (((limit).active == 0) ? 0 :					\
+    (++(limit).granularityTicker,					\
+    ((((limit).active & TCL_LIMIT_COMMANDS) &&				\
+	    (((limit).cmdGranularity == 1) ||				\
+	    ((limit).granularityTicker % (limit).cmdGranularity == 0)))	\
+	    ? 1 :							\
+    (((limit).active & TCL_LIMIT_TIME) &&				\
+	    (((limit).timeGranularity == 1) ||				\
+	    ((limit).granularityTicker % (limit).timeGranularity == 0)))\
+	    ? 1 : 0)))
+
+
+#include "tclIntDecls.h"
+#include "tclIntPlatDecls.h"
+#include "tclTomMathDecls.h"
 
 #endif /* _TCLINT */
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 3bb9795..1dc797a 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -15,6 +15,33 @@
 #ifndef _TCLINTDECLS
 #define _TCLINTDECLS
 
+#include "tclPort.h"
+
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
+/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
+#undef Tcl_CreateNamespace
+#undef Tcl_DeleteNamespace
+#undef Tcl_AppendExportList
+#undef Tcl_Export
+#undef Tcl_Import
+#undef Tcl_ForgetImport
+#undef Tcl_GetCurrentNamespace
+#undef Tcl_GetGlobalNamespace
+#undef Tcl_FindNamespace
+#undef Tcl_FindCommand
+#undef Tcl_GetCommandFromObj
+#undef Tcl_GetCommandFullName
+
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -28,466 +55,784 @@
  */
 
 /* Slot 0 is reserved */
-/* 1 */
-EXTERN int		TclAccessDeleteProc _ANSI_ARGS_((
-				TclAccessProc_ *proc));
-/* 2 */
-EXTERN int		TclAccessInsertProc _ANSI_ARGS_((
-				TclAccessProc_ *proc));
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
+#ifndef TclAllocateFreeObjects_TCL_DECLARED
+#define TclAllocateFreeObjects_TCL_DECLARED
 /* 3 */
-EXTERN void		TclAllocateFreeObjects _ANSI_ARGS_((void));
+EXTERN void		TclAllocateFreeObjects(void);
+#endif
 /* Slot 4 is reserved */
+#ifndef TclCleanupChildren_TCL_DECLARED
+#define TclCleanupChildren_TCL_DECLARED
 /* 5 */
-EXTERN int		TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
-				int numPids, Tcl_Pid *pidPtr,
-				Tcl_Channel errorChan));
+EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
+				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
+#endif
+#ifndef TclCleanupCommand_TCL_DECLARED
+#define TclCleanupCommand_TCL_DECLARED
 /* 6 */
-EXTERN void		TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
+EXTERN void		TclCleanupCommand(Command *cmdPtr);
+#endif
+#ifndef TclCopyAndCollapse_TCL_DECLARED
+#define TclCopyAndCollapse_TCL_DECLARED
 /* 7 */
-EXTERN int		TclCopyAndCollapse _ANSI_ARGS_((int count,
-				CONST char *src, char *dst));
+EXTERN int		TclCopyAndCollapse(int count, CONST char *src,
+				char *dst);
+#endif
+#ifndef TclCopyChannel_TCL_DECLARED
+#define TclCopyChannel_TCL_DECLARED
 /* 8 */
-EXTERN int		TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		TclCopyChannel(Tcl_Interp *interp,
 				Tcl_Channel inChan, Tcl_Channel outChan,
-				int toRead, Tcl_Obj *cmdPtr));
+				int toRead, Tcl_Obj *cmdPtr);
+#endif
+#ifndef TclCreatePipeline_TCL_DECLARED
+#define TclCreatePipeline_TCL_DECLARED
 /* 9 */
-EXTERN int		TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
-				int argc, CONST char **argv,
-				Tcl_Pid **pidArrayPtr, TclFile *inPipePtr,
-				TclFile *outPipePtr, TclFile *errFilePtr));
+EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
+				CONST char **argv, Tcl_Pid **pidArrayPtr,
+				TclFile *inPipePtr, TclFile *outPipePtr,
+				TclFile *errFilePtr);
+#endif
+#ifndef TclCreateProc_TCL_DECLARED
+#define TclCreateProc_TCL_DECLARED
 /* 10 */
-EXTERN int		TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
-				Namespace *nsPtr, CONST char *procName,
-				Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
-				Proc **procPtrPtr));
+EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
+				CONST char *procName, Tcl_Obj *argsPtr,
+				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
+#endif
+#ifndef TclDeleteCompiledLocalVars_TCL_DECLARED
+#define TclDeleteCompiledLocalVars_TCL_DECLARED
 /* 11 */
-EXTERN void		TclDeleteCompiledLocalVars _ANSI_ARGS_((Interp *iPtr,
-				CallFrame *framePtr));
+EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
+				CallFrame *framePtr);
+#endif
+#ifndef TclDeleteVars_TCL_DECLARED
+#define TclDeleteVars_TCL_DECLARED
 /* 12 */
-EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
-				Tcl_HashTable *tablePtr));
-/* 13 */
-EXTERN int		TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
-				char *separators, Tcl_DString *headPtr,
-				char *tail, Tcl_GlobTypeData *types));
+EXTERN void		TclDeleteVars(Interp *iPtr,
+				TclVarHashTable *tablePtr);
+#endif
+/* Slot 13 is reserved */
+#ifndef TclDumpMemoryInfo_TCL_DECLARED
+#define TclDumpMemoryInfo_TCL_DECLARED
 /* 14 */
-EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
+EXTERN int		TclDumpMemoryInfo(ClientData clientData, int flags);
+#endif
 /* Slot 15 is reserved */
+#ifndef TclExprFloatError_TCL_DECLARED
+#define TclExprFloatError_TCL_DECLARED
 /* 16 */
-EXTERN void		TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
-				double value));
+EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
+#endif
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
+#ifndef TclFindElement_TCL_DECLARED
+#define TclFindElement_TCL_DECLARED
 /* 22 */
-EXTERN int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		TclFindElement(Tcl_Interp *interp,
 				CONST char *listStr, int listLength,
 				CONST char **elementPtr,
 				CONST char **nextPtr, int *sizePtr,
-				int *bracePtr));
+				int *bracePtr);
+#endif
+#ifndef TclFindProc_TCL_DECLARED
+#define TclFindProc_TCL_DECLARED
 /* 23 */
-EXTERN Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,
-				CONST char *procName));
+EXTERN Proc *		TclFindProc(Interp *iPtr, CONST char *procName);
+#endif
+#ifndef TclFormatInt_TCL_DECLARED
+#define TclFormatInt_TCL_DECLARED
 /* 24 */
-EXTERN int		TclFormatInt _ANSI_ARGS_((char *buffer, long n));
+EXTERN int		TclFormatInt(char *buffer, long n);
+#endif
+#ifndef TclFreePackageInfo_TCL_DECLARED
+#define TclFreePackageInfo_TCL_DECLARED
 /* 25 */
-EXTERN void		TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
+EXTERN void		TclFreePackageInfo(Interp *iPtr);
+#endif
 /* Slot 26 is reserved */
-/* 27 */
-EXTERN int		TclGetDate _ANSI_ARGS_((char *p, Tcl_WideInt now,
-				long zone, Tcl_WideInt *timePtr));
+/* Slot 27 is reserved */
+#ifndef TclpGetDefaultStdChannel_TCL_DECLARED
+#define TclpGetDefaultStdChannel_TCL_DECLARED
 /* 28 */
-EXTERN Tcl_Channel	TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
+EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
+#endif
 /* Slot 29 is reserved */
 /* Slot 30 is reserved */
+#ifndef TclGetExtension_TCL_DECLARED
+#define TclGetExtension_TCL_DECLARED
 /* 31 */
-EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
+EXTERN CONST char *	TclGetExtension(CONST char *name);
+#endif
+#ifndef TclGetFrame_TCL_DECLARED
+#define TclGetFrame_TCL_DECLARED
 /* 32 */
-EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *str, CallFrame **framePtrPtr));
-/* 33 */
-EXTERN TclCmdProcType	TclGetInterpProc _ANSI_ARGS_((void));
+EXTERN int		TclGetFrame(Tcl_Interp *interp, CONST char *str,
+				CallFrame **framePtrPtr);
+#endif
+/* Slot 33 is reserved */
+#ifndef TclGetIntForIndex_TCL_DECLARED
+#define TclGetIntForIndex_TCL_DECLARED
 /* 34 */
-EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int endValue, int *indexPtr));
+EXTERN int		TclGetIntForIndex(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int endValue, int *indexPtr);
+#endif
 /* Slot 35 is reserved */
+#ifndef TclGetLong_TCL_DECLARED
+#define TclGetLong_TCL_DECLARED
 /* 36 */
-EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *str, long *longPtr));
+EXTERN int		TclGetLong(Tcl_Interp *interp, CONST char *str,
+				long *longPtr);
+#endif
+#ifndef TclGetLoadedPackages_TCL_DECLARED
+#define TclGetLoadedPackages_TCL_DECLARED
 /* 37 */
-EXTERN int		TclGetLoadedPackages _ANSI_ARGS_((Tcl_Interp *interp,
-				char *targetName));
+EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
+				char *targetName);
+#endif
+#ifndef TclGetNamespaceForQualName_TCL_DECLARED
+#define TclGetNamespaceForQualName_TCL_DECLARED
 /* 38 */
-EXTERN int		TclGetNamespaceForQualName _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *qualName,
-				Namespace *cxtNsPtr, int flags,
-				Namespace **nsPtrPtr,
+EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
+				CONST char *qualName, Namespace *cxtNsPtr,
+				int flags, Namespace **nsPtrPtr,
 				Namespace **altNsPtrPtr,
 				Namespace **actualCxtPtrPtr,
-				CONST char **simpleNamePtr));
+				CONST char **simpleNamePtr);
+#endif
+#ifndef TclGetObjInterpProc_TCL_DECLARED
+#define TclGetObjInterpProc_TCL_DECLARED
 /* 39 */
-EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
+EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
+#endif
+#ifndef TclGetOpenMode_TCL_DECLARED
+#define TclGetOpenMode_TCL_DECLARED
 /* 40 */
-EXTERN int		TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *str, int *seekFlagPtr));
+EXTERN int		TclGetOpenMode(Tcl_Interp *interp, CONST char *str,
+				int *seekFlagPtr);
+#endif
+#ifndef TclGetOriginalCommand_TCL_DECLARED
+#define TclGetOriginalCommand_TCL_DECLARED
 /* 41 */
-EXTERN Tcl_Command	TclGetOriginalCommand _ANSI_ARGS_((
-				Tcl_Command command));
+EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
+#endif
+#ifndef TclpGetUserHome_TCL_DECLARED
+#define TclpGetUserHome_TCL_DECLARED
 /* 42 */
-EXTERN char *		TclpGetUserHome _ANSI_ARGS_((CONST char *name,
-				Tcl_DString *bufferPtr));
-/* 43 */
-EXTERN int		TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
-				int argc, CONST84 char **argv, int flags));
+EXTERN char *		TclpGetUserHome(CONST char *name,
+				Tcl_DString *bufferPtr);
+#endif
+/* Slot 43 is reserved */
+#ifndef TclGuessPackageName_TCL_DECLARED
+#define TclGuessPackageName_TCL_DECLARED
 /* 44 */
-EXTERN int		TclGuessPackageName _ANSI_ARGS_((
-				CONST char *fileName, Tcl_DString *bufPtr));
+EXTERN int		TclGuessPackageName(CONST char *fileName,
+				Tcl_DString *bufPtr);
+#endif
+#ifndef TclHideUnsafeCommands_TCL_DECLARED
+#define TclHideUnsafeCommands_TCL_DECLARED
 /* 45 */
-EXTERN int		TclHideUnsafeCommands _ANSI_ARGS_((
-				Tcl_Interp *interp));
+EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
+#endif
+#ifndef TclInExit_TCL_DECLARED
+#define TclInExit_TCL_DECLARED
 /* 46 */
-EXTERN int		TclInExit _ANSI_ARGS_((void));
+EXTERN int		TclInExit(void);
+#endif
 /* Slot 47 is reserved */
 /* Slot 48 is reserved */
-/* 49 */
-EXTERN Tcl_Obj *	TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
-				long incrAmount, int part1NotParsed));
+/* Slot 49 is reserved */
+#ifndef TclInitCompiledLocals_TCL_DECLARED
+#define TclInitCompiledLocals_TCL_DECLARED
 /* 50 */
-EXTERN void		TclInitCompiledLocals _ANSI_ARGS_((
-				Tcl_Interp *interp, CallFrame *framePtr,
-				Namespace *nsPtr));
+EXTERN void		TclInitCompiledLocals(Tcl_Interp *interp,
+				CallFrame *framePtr, Namespace *nsPtr);
+#endif
+#ifndef TclInterpInit_TCL_DECLARED
+#define TclInterpInit_TCL_DECLARED
 /* 51 */
-EXTERN int		TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
-/* 52 */
-EXTERN int		TclInvoke _ANSI_ARGS_((Tcl_Interp *interp, int argc,
-				CONST84 char **argv, int flags));
+EXTERN int		TclInterpInit(Tcl_Interp *interp);
+#endif
+/* Slot 52 is reserved */
+#ifndef TclInvokeObjectCommand_TCL_DECLARED
+#define TclInvokeObjectCommand_TCL_DECLARED
 /* 53 */
-EXTERN int		TclInvokeObjectCommand _ANSI_ARGS_((
-				ClientData clientData, Tcl_Interp *interp,
-				int argc, CONST84 char **argv));
+EXTERN int		TclInvokeObjectCommand(ClientData clientData,
+				Tcl_Interp *interp, int argc,
+				CONST84 char **argv);
+#endif
+#ifndef TclInvokeStringCommand_TCL_DECLARED
+#define TclInvokeStringCommand_TCL_DECLARED
 /* 54 */
-EXTERN int		TclInvokeStringCommand _ANSI_ARGS_((
-				ClientData clientData, Tcl_Interp *interp,
-				int objc, Tcl_Obj *CONST objv[]));
+EXTERN int		TclInvokeStringCommand(ClientData clientData,
+				Tcl_Interp *interp, int objc,
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef TclIsProc_TCL_DECLARED
+#define TclIsProc_TCL_DECLARED
 /* 55 */
-EXTERN Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
+EXTERN Proc *		TclIsProc(Command *cmdPtr);
+#endif
 /* Slot 56 is reserved */
 /* Slot 57 is reserved */
+#ifndef TclLookupVar_TCL_DECLARED
+#define TclLookupVar_TCL_DECLARED
 /* 58 */
-EXTERN Var *		TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
-				int flags, CONST char *msg, int createPart1,
-				int createPart2, Var **arrayPtrPtr));
+EXTERN Var *		TclLookupVar(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, int flags,
+				CONST char *msg, int createPart1,
+				int createPart2, Var **arrayPtrPtr);
+#endif
 /* Slot 59 is reserved */
+#ifndef TclNeedSpace_TCL_DECLARED
+#define TclNeedSpace_TCL_DECLARED
 /* 60 */
-EXTERN int		TclNeedSpace _ANSI_ARGS_((CONST char *start,
-				CONST char *end));
+EXTERN int		TclNeedSpace(CONST char *start, CONST char *end);
+#endif
+#ifndef TclNewProcBodyObj_TCL_DECLARED
+#define TclNewProcBodyObj_TCL_DECLARED
 /* 61 */
-EXTERN Tcl_Obj *	TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
+EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
+#endif
+#ifndef TclObjCommandComplete_TCL_DECLARED
+#define TclObjCommandComplete_TCL_DECLARED
 /* 62 */
-EXTERN int		TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
+EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
+#endif
+#ifndef TclObjInterpProc_TCL_DECLARED
+#define TclObjInterpProc_TCL_DECLARED
 /* 63 */
-EXTERN int		TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
+EXTERN int		TclObjInterpProc(ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[]));
+				Tcl_Obj *CONST objv[]);
+#endif
+#ifndef TclObjInvoke_TCL_DECLARED
+#define TclObjInvoke_TCL_DECLARED
 /* 64 */
-EXTERN int		TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
-				int objc, Tcl_Obj *CONST objv[], int flags));
-/* 65 */
-EXTERN int		TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
-				int objc, Tcl_Obj *CONST objv[], int flags));
-/* 66 */
-EXTERN int		TclOpenFileChannelDeleteProc _ANSI_ARGS_((
-				TclOpenFileChannelProc_ *proc));
-/* 67 */
-EXTERN int		TclOpenFileChannelInsertProc _ANSI_ARGS_((
-				TclOpenFileChannelProc_ *proc));
+EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
+				Tcl_Obj *CONST objv[], int flags);
+#endif
+/* Slot 65 is reserved */
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
 /* Slot 68 is reserved */
+#ifndef TclpAlloc_TCL_DECLARED
+#define TclpAlloc_TCL_DECLARED
 /* 69 */
-EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
+EXTERN char *		TclpAlloc(unsigned int size);
+#endif
 /* Slot 70 is reserved */
 /* Slot 71 is reserved */
 /* Slot 72 is reserved */
 /* Slot 73 is reserved */
+#ifndef TclpFree_TCL_DECLARED
+#define TclpFree_TCL_DECLARED
 /* 74 */
-EXTERN void		TclpFree _ANSI_ARGS_((char *ptr));
+EXTERN void		TclpFree(char *ptr);
+#endif
+#ifndef TclpGetClicks_TCL_DECLARED
+#define TclpGetClicks_TCL_DECLARED
 /* 75 */
-EXTERN unsigned long	TclpGetClicks _ANSI_ARGS_((void));
+EXTERN unsigned long	TclpGetClicks(void);
+#endif
+#ifndef TclpGetSeconds_TCL_DECLARED
+#define TclpGetSeconds_TCL_DECLARED
 /* 76 */
-EXTERN unsigned long	TclpGetSeconds _ANSI_ARGS_((void));
+EXTERN unsigned long	TclpGetSeconds(void);
+#endif
+#ifndef TclpGetTime_TCL_DECLARED
+#define TclpGetTime_TCL_DECLARED
 /* 77 */
-EXTERN void		TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
+EXTERN void		TclpGetTime(Tcl_Time *time);
+#endif
+#ifndef TclpGetTimeZone_TCL_DECLARED
+#define TclpGetTimeZone_TCL_DECLARED
 /* 78 */
-EXTERN int		TclpGetTimeZone _ANSI_ARGS_((Tcl_WideInt time));
+EXTERN int		TclpGetTimeZone(unsigned long time);
+#endif
 /* Slot 79 is reserved */
 /* Slot 80 is reserved */
+#ifndef TclpRealloc_TCL_DECLARED
+#define TclpRealloc_TCL_DECLARED
 /* 81 */
-EXTERN char *		TclpRealloc _ANSI_ARGS_((char *ptr,
-				unsigned int size));
+EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
+#endif
 /* Slot 82 is reserved */
 /* Slot 83 is reserved */
 /* Slot 84 is reserved */
 /* Slot 85 is reserved */
 /* Slot 86 is reserved */
 /* Slot 87 is reserved */
+#ifndef TclPrecTraceProc_TCL_DECLARED
+#define TclPrecTraceProc_TCL_DECLARED
 /* 88 */
-EXTERN char *		TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
+EXTERN char *		TclPrecTraceProc(ClientData clientData,
 				Tcl_Interp *interp, CONST char *name1,
-				CONST char *name2, int flags));
+				CONST char *name2, int flags);
+#endif
+#ifndef TclPreventAliasLoop_TCL_DECLARED
+#define TclPreventAliasLoop_TCL_DECLARED
 /* 89 */
-EXTERN int		TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Interp *cmdInterp, Tcl_Command cmd));
+EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
+				Tcl_Interp *cmdInterp, Tcl_Command cmd);
+#endif
 /* Slot 90 is reserved */
+#ifndef TclProcCleanupProc_TCL_DECLARED
+#define TclProcCleanupProc_TCL_DECLARED
 /* 91 */
-EXTERN void		TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
+EXTERN void		TclProcCleanupProc(Proc *procPtr);
+#endif
+#ifndef TclProcCompileProc_TCL_DECLARED
+#define TclProcCompileProc_TCL_DECLARED
 /* 92 */
-EXTERN int		TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
-				Proc *procPtr, Tcl_Obj *bodyPtr,
-				Namespace *nsPtr, CONST char *description,
-				CONST char *procName));
+EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
+				Tcl_Obj *bodyPtr, Namespace *nsPtr,
+				CONST char *description,
+				CONST char *procName);
+#endif
+#ifndef TclProcDeleteProc_TCL_DECLARED
+#define TclProcDeleteProc_TCL_DECLARED
 /* 93 */
-EXTERN void		TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
-/* 94 */
-EXTERN int		TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
-				Tcl_Interp *interp, int argc,
-				CONST84 char **argv));
+EXTERN void		TclProcDeleteProc(ClientData clientData);
+#endif
+/* Slot 94 is reserved */
 /* Slot 95 is reserved */
+#ifndef TclRenameCommand_TCL_DECLARED
+#define TclRenameCommand_TCL_DECLARED
 /* 96 */
-EXTERN int		TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
-				char *oldName, char *newName));
+EXTERN int		TclRenameCommand(Tcl_Interp *interp,
+				CONST char *oldName, CONST char *newName);
+#endif
+#ifndef TclResetShadowedCmdRefs_TCL_DECLARED
+#define TclResetShadowedCmdRefs_TCL_DECLARED
 /* 97 */
-EXTERN void		TclResetShadowedCmdRefs _ANSI_ARGS_((
-				Tcl_Interp *interp, Command *newCmdPtr));
+EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
+				Command *newCmdPtr);
+#endif
+#ifndef TclServiceIdle_TCL_DECLARED
+#define TclServiceIdle_TCL_DECLARED
 /* 98 */
-EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
+EXTERN int		TclServiceIdle(void);
+#endif
 /* Slot 99 is reserved */
 /* Slot 100 is reserved */
+#ifndef TclSetPreInitScript_TCL_DECLARED
+#define TclSetPreInitScript_TCL_DECLARED
 /* 101 */
-EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
+EXTERN char *		TclSetPreInitScript(char *string);
+#endif
+#ifndef TclSetupEnv_TCL_DECLARED
+#define TclSetupEnv_TCL_DECLARED
 /* 102 */
-EXTERN void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		TclSetupEnv(Tcl_Interp *interp);
+#endif
+#ifndef TclSockGetPort_TCL_DECLARED
+#define TclSockGetPort_TCL_DECLARED
 /* 103 */
-EXTERN int		TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
-				char *str, char *proto, int *portPtr));
+EXTERN int		TclSockGetPort(Tcl_Interp *interp, CONST char *str,
+				CONST char *proto, int *portPtr);
+#endif
+#ifndef TclSockMinimumBuffersOld_TCL_DECLARED
+#define TclSockMinimumBuffersOld_TCL_DECLARED
 /* 104 */
-EXTERN int		TclSockMinimumBuffersOld _ANSI_ARGS_((int sock,
-				int size));
+EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
+#endif
 /* Slot 105 is reserved */
-/* 106 */
-EXTERN int		TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
-/* 107 */
-EXTERN int		TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
+/* Slot 106 is reserved */
+/* Slot 107 is reserved */
+#ifndef TclTeardownNamespace_TCL_DECLARED
+#define TclTeardownNamespace_TCL_DECLARED
 /* 108 */
-EXTERN void		TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
+EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
+#endif
+#ifndef TclUpdateReturnInfo_TCL_DECLARED
+#define TclUpdateReturnInfo_TCL_DECLARED
 /* 109 */
-EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
+EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
+#endif
+#ifndef TclSockMinimumBuffers_TCL_DECLARED
+#define TclSockMinimumBuffers_TCL_DECLARED
 /* 110 */
-EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((VOID *sock,
-				int size));
+EXTERN int		TclSockMinimumBuffers(VOID *sock, int size);
+#endif
+#ifndef Tcl_AddInterpResolvers_TCL_DECLARED
+#define Tcl_AddInterpResolvers_TCL_DECLARED
 /* 111 */
-EXTERN void		Tcl_AddInterpResolvers _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name,
+EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
+				CONST char *name,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
-				Tcl_ResolveCompiledVarProc *compiledVarProc));
+				Tcl_ResolveCompiledVarProc *compiledVarProc);
+#endif
+#ifndef Tcl_AppendExportList_TCL_DECLARED
+#define Tcl_AppendExportList_TCL_DECLARED
 /* 112 */
-EXTERN int		Tcl_AppendExportList _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr));
+EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_CreateNamespace_TCL_DECLARED
+#define Tcl_CreateNamespace_TCL_DECLARED
 /* 113 */
-EXTERN Tcl_Namespace *	Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
 				CONST char *name, ClientData clientData,
-				Tcl_NamespaceDeleteProc *deleteProc));
+				Tcl_NamespaceDeleteProc *deleteProc);
+#endif
+#ifndef Tcl_DeleteNamespace_TCL_DECLARED
+#define Tcl_DeleteNamespace_TCL_DECLARED
 /* 114 */
-EXTERN void		Tcl_DeleteNamespace _ANSI_ARGS_((
-				Tcl_Namespace *nsPtr));
+EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
+#endif
+#ifndef Tcl_Export_TCL_DECLARED
+#define Tcl_Export_TCL_DECLARED
 /* 115 */
-EXTERN int		Tcl_Export _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, CONST char *pattern,
-				int resetListFirst));
+EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+				CONST char *pattern, int resetListFirst);
+#endif
+#ifndef Tcl_FindCommand_TCL_DECLARED
+#define Tcl_FindCommand_TCL_DECLARED
 /* 116 */
-EXTERN Tcl_Command	Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *name,
-				Tcl_Namespace *contextNsPtr, int flags));
+EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags);
+#endif
+#ifndef Tcl_FindNamespace_TCL_DECLARED
+#define Tcl_FindNamespace_TCL_DECLARED
 /* 117 */
-EXTERN Tcl_Namespace *	Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
 				CONST char *name,
-				Tcl_Namespace *contextNsPtr, int flags));
+				Tcl_Namespace *contextNsPtr, int flags);
+#endif
+#ifndef Tcl_GetInterpResolvers_TCL_DECLARED
+#define Tcl_GetInterpResolvers_TCL_DECLARED
 /* 118 */
-EXTERN int		Tcl_GetInterpResolvers _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name,
-				Tcl_ResolverInfo *resInfo));
+EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
+				CONST char *name, Tcl_ResolverInfo *resInfo);
+#endif
+#ifndef Tcl_GetNamespaceResolvers_TCL_DECLARED
+#define Tcl_GetNamespaceResolvers_TCL_DECLARED
 /* 119 */
-EXTERN int		Tcl_GetNamespaceResolvers _ANSI_ARGS_((
+EXTERN int		Tcl_GetNamespaceResolvers(
 				Tcl_Namespace *namespacePtr,
-				Tcl_ResolverInfo *resInfo));
+				Tcl_ResolverInfo *resInfo);
+#endif
+#ifndef Tcl_FindNamespaceVar_TCL_DECLARED
+#define Tcl_FindNamespaceVar_TCL_DECLARED
 /* 120 */
-EXTERN Tcl_Var		Tcl_FindNamespaceVar _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
 				CONST char *name,
-				Tcl_Namespace *contextNsPtr, int flags));
+				Tcl_Namespace *contextNsPtr, int flags);
+#endif
+#ifndef Tcl_ForgetImport_TCL_DECLARED
+#define Tcl_ForgetImport_TCL_DECLARED
 /* 121 */
-EXTERN int		Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, CONST char *pattern));
+EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, CONST char *pattern);
+#endif
+#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
+#define Tcl_GetCommandFromObj_TCL_DECLARED
 /* 122 */
-EXTERN Tcl_Command	Tcl_GetCommandFromObj _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr));
+EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetCommandFullName_TCL_DECLARED
+#define Tcl_GetCommandFullName_TCL_DECLARED
 /* 123 */
-EXTERN void		Tcl_GetCommandFullName _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Command command,
-				Tcl_Obj *objPtr));
+EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
+				Tcl_Command command, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
+#define Tcl_GetCurrentNamespace_TCL_DECLARED
 /* 124 */
-EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace _ANSI_ARGS_((
-				Tcl_Interp *interp));
+EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
+#define Tcl_GetGlobalNamespace_TCL_DECLARED
 /* 125 */
-EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace _ANSI_ARGS_((
-				Tcl_Interp *interp));
+EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_GetVariableFullName_TCL_DECLARED
+#define Tcl_GetVariableFullName_TCL_DECLARED
 /* 126 */
-EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Var variable,
-				Tcl_Obj *objPtr));
+EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
+				Tcl_Var variable, Tcl_Obj *objPtr);
+#endif
+#ifndef Tcl_Import_TCL_DECLARED
+#define Tcl_Import_TCL_DECLARED
 /* 127 */
-EXTERN int		Tcl_Import _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, CONST char *pattern,
-				int allowOverwrite));
+EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+				CONST char *pattern, int allowOverwrite);
+#endif
+#ifndef Tcl_PopCallFrame_TCL_DECLARED
+#define Tcl_PopCallFrame_TCL_DECLARED
 /* 128 */
-EXTERN void		Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
+#endif
+#ifndef Tcl_PushCallFrame_TCL_DECLARED
+#define Tcl_PushCallFrame_TCL_DECLARED
 /* 129 */
-EXTERN int		Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
 				Tcl_CallFrame *framePtr,
-				Tcl_Namespace *nsPtr, int isProcCallFrame));
+				Tcl_Namespace *nsPtr, int isProcCallFrame);
+#endif
+#ifndef Tcl_RemoveInterpResolvers_TCL_DECLARED
+#define Tcl_RemoveInterpResolvers_TCL_DECLARED
 /* 130 */
-EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *name));
+EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
+				CONST char *name);
+#endif
+#ifndef Tcl_SetNamespaceResolvers_TCL_DECLARED
+#define Tcl_SetNamespaceResolvers_TCL_DECLARED
 /* 131 */
-EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
+EXTERN void		Tcl_SetNamespaceResolvers(
 				Tcl_Namespace *namespacePtr,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
-				Tcl_ResolveCompiledVarProc *compiledVarProc));
+				Tcl_ResolveCompiledVarProc *compiledVarProc);
+#endif
+#ifndef TclpHasSockets_TCL_DECLARED
+#define TclpHasSockets_TCL_DECLARED
 /* 132 */
-EXTERN int		TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		TclpHasSockets(Tcl_Interp *interp);
+#endif
+#ifndef TclpGetDate_TCL_DECLARED
+#define TclpGetDate_TCL_DECLARED
 /* 133 */
-EXTERN struct tm *	TclpGetDate _ANSI_ARGS_((TclpTime_t time, int useGMT));
-/* 134 */
-EXTERN size_t		TclpStrftime _ANSI_ARGS_((char *s, size_t maxsize,
-				CONST char *format, CONST struct tm *t,
-				int useGMT));
-/* 135 */
-EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
+EXTERN struct tm *	TclpGetDate(CONST time_t *time, int useGMT);
+#endif
+/* Slot 134 is reserved */
+/* Slot 135 is reserved */
 /* Slot 136 is reserved */
 /* Slot 137 is reserved */
+#ifndef TclGetEnv_TCL_DECLARED
+#define TclGetEnv_TCL_DECLARED
 /* 138 */
-EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char *name,
-				Tcl_DString *valuePtr));
+EXTERN CONST84_RETURN char * TclGetEnv(CONST char *name,
+				Tcl_DString *valuePtr);
+#endif
 /* Slot 139 is reserved */
-/* 140 */
-EXTERN int		TclLooksLikeInt _ANSI_ARGS_((CONST char *bytes,
-				int length));
+/* Slot 140 is reserved */
+#ifndef TclpGetCwd_TCL_DECLARED
+#define TclpGetCwd_TCL_DECLARED
 /* 141 */
-EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_DString *cwdPtr));
+EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
+				Tcl_DString *cwdPtr);
+#endif
+#ifndef TclSetByteCodeFromAny_TCL_DECLARED
+#define TclSetByteCodeFromAny_TCL_DECLARED
 /* 142 */
-EXTERN int		TclSetByteCodeFromAny _ANSI_ARGS_((
-				Tcl_Interp *interp, Tcl_Obj *objPtr,
-				CompileHookProc *hookProc,
-				ClientData clientData));
+EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, CompileHookProc *hookProc,
+				ClientData clientData);
+#endif
+#ifndef TclAddLiteralObj_TCL_DECLARED
+#define TclAddLiteralObj_TCL_DECLARED
 /* 143 */
-EXTERN int		TclAddLiteralObj _ANSI_ARGS_((
-				struct CompileEnv *envPtr, Tcl_Obj *objPtr,
-				LiteralEntry **litPtrPtr));
+EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
+				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
+#endif
+#ifndef TclHideLiteral_TCL_DECLARED
+#define TclHideLiteral_TCL_DECLARED
 /* 144 */
-EXTERN void		TclHideLiteral _ANSI_ARGS_((Tcl_Interp *interp,
-				struct CompileEnv *envPtr, int index));
+EXTERN void		TclHideLiteral(Tcl_Interp *interp,
+				struct CompileEnv *envPtr, int index);
+#endif
+#ifndef TclGetAuxDataType_TCL_DECLARED
+#define TclGetAuxDataType_TCL_DECLARED
 /* 145 */
-EXTERN struct AuxDataType * TclGetAuxDataType _ANSI_ARGS_((char *typeName));
+EXTERN struct AuxDataType * TclGetAuxDataType(char *typeName);
+#endif
+#ifndef TclHandleCreate_TCL_DECLARED
+#define TclHandleCreate_TCL_DECLARED
 /* 146 */
-EXTERN TclHandle	TclHandleCreate _ANSI_ARGS_((VOID *ptr));
+EXTERN TclHandle	TclHandleCreate(VOID *ptr);
+#endif
+#ifndef TclHandleFree_TCL_DECLARED
+#define TclHandleFree_TCL_DECLARED
 /* 147 */
-EXTERN void		TclHandleFree _ANSI_ARGS_((TclHandle handle));
+EXTERN void		TclHandleFree(TclHandle handle);
+#endif
+#ifndef TclHandlePreserve_TCL_DECLARED
+#define TclHandlePreserve_TCL_DECLARED
 /* 148 */
-EXTERN TclHandle	TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
+EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
+#endif
+#ifndef TclHandleRelease_TCL_DECLARED
+#define TclHandleRelease_TCL_DECLARED
 /* 149 */
-EXTERN void		TclHandleRelease _ANSI_ARGS_((TclHandle handle));
+EXTERN void		TclHandleRelease(TclHandle handle);
+#endif
+#ifndef TclRegAbout_TCL_DECLARED
+#define TclRegAbout_TCL_DECLARED
 /* 150 */
-EXTERN int		TclRegAbout _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_RegExp re));
+EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
+#endif
+#ifndef TclRegExpRangeUniChar_TCL_DECLARED
+#define TclRegExpRangeUniChar_TCL_DECLARED
 /* 151 */
-EXTERN void		TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
-				int index, int *startPtr, int *endPtr));
+EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
+				int *startPtr, int *endPtr);
+#endif
+#ifndef TclSetLibraryPath_TCL_DECLARED
+#define TclSetLibraryPath_TCL_DECLARED
 /* 152 */
-EXTERN void		TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
+#endif
+#ifndef TclGetLibraryPath_TCL_DECLARED
+#define TclGetLibraryPath_TCL_DECLARED
 /* 153 */
-EXTERN Tcl_Obj *	TclGetLibraryPath _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclGetLibraryPath(void);
+#endif
 /* Slot 154 is reserved */
 /* Slot 155 is reserved */
+#ifndef TclRegError_TCL_DECLARED
+#define TclRegError_TCL_DECLARED
 /* 156 */
-EXTERN void		TclRegError _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *msg, int status));
+EXTERN void		TclRegError(Tcl_Interp *interp, CONST char *msg,
+				int status);
+#endif
+#ifndef TclVarTraceExists_TCL_DECLARED
+#define TclVarTraceExists_TCL_DECLARED
 /* 157 */
-EXTERN Var *		TclVarTraceExists _ANSI_ARGS_((Tcl_Interp *interp,
-				CONST char *varName));
+EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
+				CONST char *varName);
+#endif
+#ifndef TclSetStartupScriptFileName_TCL_DECLARED
+#define TclSetStartupScriptFileName_TCL_DECLARED
 /* 158 */
-EXTERN void		TclSetStartupScriptFileName _ANSI_ARGS_((
-				CONST char *filename));
+EXTERN void		TclSetStartupScriptFileName(CONST char *filename);
+#endif
+#ifndef TclGetStartupScriptFileName_TCL_DECLARED
+#define TclGetStartupScriptFileName_TCL_DECLARED
 /* 159 */
-EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * TclGetStartupScriptFileName(void);
+#endif
 /* Slot 160 is reserved */
+#ifndef TclChannelTransform_TCL_DECLARED
+#define TclChannelTransform_TCL_DECLARED
 /* 161 */
-EXTERN int		TclChannelTransform _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan, Tcl_Obj *cmdObjPtr));
+EXTERN int		TclChannelTransform(Tcl_Interp *interp,
+				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
+#endif
+#ifndef TclChannelEventScriptInvoker_TCL_DECLARED
+#define TclChannelEventScriptInvoker_TCL_DECLARED
 /* 162 */
-EXTERN void		TclChannelEventScriptInvoker _ANSI_ARGS_((
-				ClientData clientData, int flags));
+EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
+				int flags);
+#endif
+#ifndef TclGetInstructionTable_TCL_DECLARED
+#define TclGetInstructionTable_TCL_DECLARED
 /* 163 */
-EXTERN VOID *		TclGetInstructionTable _ANSI_ARGS_((void));
+EXTERN VOID *		TclGetInstructionTable(void);
+#endif
+#ifndef TclExpandCodeArray_TCL_DECLARED
+#define TclExpandCodeArray_TCL_DECLARED
 /* 164 */
-EXTERN void		TclExpandCodeArray _ANSI_ARGS_((VOID *envPtr));
+EXTERN void		TclExpandCodeArray(VOID *envPtr);
+#endif
+#ifndef TclpSetInitialEncodings_TCL_DECLARED
+#define TclpSetInitialEncodings_TCL_DECLARED
 /* 165 */
-EXTERN void		TclpSetInitialEncodings _ANSI_ARGS_((void));
+EXTERN void		TclpSetInitialEncodings(void);
+#endif
+#ifndef TclListObjSetElement_TCL_DECLARED
+#define TclListObjSetElement_TCL_DECLARED
 /* 166 */
-EXTERN int		TclListObjSetElement _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
-				Tcl_Obj *valuePtr));
+				Tcl_Obj *valuePtr);
+#endif
+#ifndef TclSetStartupScriptPath_TCL_DECLARED
+#define TclSetStartupScriptPath_TCL_DECLARED
 /* 167 */
-EXTERN void		TclSetStartupScriptPath _ANSI_ARGS_((
-				Tcl_Obj *pathPtr));
+EXTERN void		TclSetStartupScriptPath(Tcl_Obj *pathPtr);
+#endif
+#ifndef TclGetStartupScriptPath_TCL_DECLARED
+#define TclGetStartupScriptPath_TCL_DECLARED
 /* 168 */
-EXTERN Tcl_Obj *	TclGetStartupScriptPath _ANSI_ARGS_((void));
+EXTERN Tcl_Obj *	TclGetStartupScriptPath(void);
+#endif
+#ifndef TclpUtfNcmp2_TCL_DECLARED
+#define TclpUtfNcmp2_TCL_DECLARED
 /* 169 */
-EXTERN int		TclpUtfNcmp2 _ANSI_ARGS_((CONST char *s1,
-				CONST char *s2, unsigned long n));
+EXTERN int		TclpUtfNcmp2(CONST char *s1, CONST char *s2,
+				unsigned long n);
+#endif
+#ifndef TclCheckInterpTraces_TCL_DECLARED
+#define TclCheckInterpTraces_TCL_DECLARED
 /* 170 */
-EXTERN int		TclCheckInterpTraces _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
 				CONST char *command, int numChars,
 				Command *cmdPtr, int result, int traceFlags,
-				int objc, Tcl_Obj *CONST objv[]));
+				int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef TclCheckExecutionTraces_TCL_DECLARED
+#define TclCheckExecutionTraces_TCL_DECLARED
 /* 171 */
-EXTERN int		TclCheckExecutionTraces _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *command,
-				int numChars, Command *cmdPtr, int result,
-				int traceFlags, int objc,
-				Tcl_Obj *CONST objv[]));
+EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
+				CONST char *command, int numChars,
+				Command *cmdPtr, int result, int traceFlags,
+				int objc, Tcl_Obj *CONST objv[]);
+#endif
+#ifndef TclInThreadExit_TCL_DECLARED
+#define TclInThreadExit_TCL_DECLARED
 /* 172 */
-EXTERN int		TclInThreadExit _ANSI_ARGS_((void));
+EXTERN int		TclInThreadExit(void);
+#endif
+#ifndef TclUniCharMatch_TCL_DECLARED
+#define TclUniCharMatch_TCL_DECLARED
 /* 173 */
-EXTERN int		TclUniCharMatch _ANSI_ARGS_((
-				CONST Tcl_UniChar *string, int strLen,
-				CONST Tcl_UniChar *pattern, int ptnLen,
-				int nocase));
+EXTERN int		TclUniCharMatch(CONST Tcl_UniChar *string,
+				int strLen, CONST Tcl_UniChar *pattern,
+				int ptnLen, int flags);
+#endif
 /* Slot 174 is reserved */
-/* Slot 175 is reserved */
-/* Slot 176 is reserved */
-/* Slot 177 is reserved */
-/* Slot 178 is reserved */
-/* Slot 179 is reserved */
+#ifndef TclCallVarTraces_TCL_DECLARED
+#define TclCallVarTraces_TCL_DECLARED
+/* 175 */
+EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
+				Var *varPtr, CONST char *part1,
+				CONST char *part2, int flags,
+				int leaveErrMsg);
+#endif
+#ifndef TclCleanupVar_TCL_DECLARED
+#define TclCleanupVar_TCL_DECLARED
+/* 176 */
+EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
+#endif
+#ifndef TclVarErrMsg_TCL_DECLARED
+#define TclVarErrMsg_TCL_DECLARED
+/* 177 */
+EXTERN void		TclVarErrMsg(Tcl_Interp *interp, CONST char *part1,
+				CONST char *part2, CONST char *operation,
+				CONST char *reason);
+#endif
+#ifndef Tcl_SetStartupScript_TCL_DECLARED
+#define Tcl_SetStartupScript_TCL_DECLARED
+/* 178 */
+EXTERN void		Tcl_SetStartupScript(Tcl_Obj *pathPtr,
+				CONST char *encodingName);
+#endif
+#ifndef Tcl_GetStartupScript_TCL_DECLARED
+#define Tcl_GetStartupScript_TCL_DECLARED
+/* 179 */
+EXTERN Tcl_Obj *	Tcl_GetStartupScript(CONST char **encodingNamePtr);
+#endif
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
+#ifndef TclpLocaltime_TCL_DECLARED
+#define TclpLocaltime_TCL_DECLARED
 /* 182 */
-EXTERN struct tm *	TclpLocaltime _ANSI_ARGS_((TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpLocaltime(CONST time_t *clock);
+#endif
+#ifndef TclpGmtime_TCL_DECLARED
+#define TclpGmtime_TCL_DECLARED
 /* 183 */
-EXTERN struct tm *	TclpGmtime _ANSI_ARGS_((TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpGmtime(CONST time_t *clock);
+#endif
 /* Slot 184 is reserved */
 /* Slot 185 is reserved */
 /* Slot 186 is reserved */
@@ -502,249 +847,400 @@ EXTERN struct tm *	TclpGmtime _ANSI_ARGS_((TclpTime_t_CONST clock));
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-/* Slot 198 is reserved */
-/* 199 */
-EXTERN int		TclMatchIsTrivial _ANSI_ARGS_((CONST char *pattern));
-/* Slot 200 is reserved */
-/* Slot 201 is reserved */
-/* Slot 202 is reserved */
-/* Slot 203 is reserved */
-/* Slot 204 is reserved */
-/* Slot 205 is reserved */
-/* Slot 206 is reserved */
-/* Slot 207 is reserved */
-/* Slot 208 is reserved */
+#ifndef TclObjGetFrame_TCL_DECLARED
+#define TclObjGetFrame_TCL_DECLARED
+/* 198 */
+EXTERN int		TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				CallFrame **framePtrPtr);
+#endif
+/* Slot 199 is reserved */
+#ifndef TclpObjRemoveDirectory_TCL_DECLARED
+#define TclpObjRemoveDirectory_TCL_DECLARED
+/* 200 */
+EXTERN int		TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
+				int recursive, Tcl_Obj **errorPtr);
+#endif
+#ifndef TclpObjCopyDirectory_TCL_DECLARED
+#define TclpObjCopyDirectory_TCL_DECLARED
+/* 201 */
+EXTERN int		TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
+#endif
+#ifndef TclpObjCreateDirectory_TCL_DECLARED
+#define TclpObjCreateDirectory_TCL_DECLARED
+/* 202 */
+EXTERN int		TclpObjCreateDirectory(Tcl_Obj *pathPtr);
+#endif
+#ifndef TclpObjDeleteFile_TCL_DECLARED
+#define TclpObjDeleteFile_TCL_DECLARED
+/* 203 */
+EXTERN int		TclpObjDeleteFile(Tcl_Obj *pathPtr);
+#endif
+#ifndef TclpObjCopyFile_TCL_DECLARED
+#define TclpObjCopyFile_TCL_DECLARED
+/* 204 */
+EXTERN int		TclpObjCopyFile(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr);
+#endif
+#ifndef TclpObjRenameFile_TCL_DECLARED
+#define TclpObjRenameFile_TCL_DECLARED
+/* 205 */
+EXTERN int		TclpObjRenameFile(Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr);
+#endif
+#ifndef TclpObjStat_TCL_DECLARED
+#define TclpObjStat_TCL_DECLARED
+/* 206 */
+EXTERN int		TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+#endif
+#ifndef TclpObjAccess_TCL_DECLARED
+#define TclpObjAccess_TCL_DECLARED
+/* 207 */
+EXTERN int		TclpObjAccess(Tcl_Obj *pathPtr, int mode);
+#endif
+#ifndef TclpOpenFileChannel_TCL_DECLARED
+#define TclpOpenFileChannel_TCL_DECLARED
+/* 208 */
+EXTERN Tcl_Channel	TclpOpenFileChannel(Tcl_Interp *interp,
+				Tcl_Obj *pathPtr, int mode, int permissions);
+#endif
 /* Slot 209 is reserved */
 /* Slot 210 is reserved */
 /* Slot 211 is reserved */
-/* Slot 212 is reserved */
-/* Slot 213 is reserved */
-/* Slot 214 is reserved */
-/* Slot 215 is reserved */
-/* Slot 216 is reserved */
-/* Slot 217 is reserved */
-/* Slot 218 is reserved */
+#ifndef TclpFindExecutable_TCL_DECLARED
+#define TclpFindExecutable_TCL_DECLARED
+/* 212 */
+EXTERN void		TclpFindExecutable(CONST char *argv0);
+#endif
+#ifndef TclGetObjNameOfExecutable_TCL_DECLARED
+#define TclGetObjNameOfExecutable_TCL_DECLARED
+/* 213 */
+EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
+#endif
+#ifndef TclSetObjNameOfExecutable_TCL_DECLARED
+#define TclSetObjNameOfExecutable_TCL_DECLARED
+/* 214 */
+EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
+				Tcl_Encoding encoding);
+#endif
+#ifndef TclStackAlloc_TCL_DECLARED
+#define TclStackAlloc_TCL_DECLARED
+/* 215 */
+EXTERN VOID *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
+#endif
+#ifndef TclStackFree_TCL_DECLARED
+#define TclStackFree_TCL_DECLARED
+/* 216 */
+EXTERN void		TclStackFree(Tcl_Interp *interp, VOID *freePtr);
+#endif
+#ifndef TclPushStackFrame_TCL_DECLARED
+#define TclPushStackFrame_TCL_DECLARED
+/* 217 */
+EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
+				Tcl_CallFrame **framePtrPtr,
+				Tcl_Namespace *namespacePtr,
+				int isProcCallFrame);
+#endif
+#ifndef TclPopStackFrame_TCL_DECLARED
+#define TclPopStackFrame_TCL_DECLARED
+/* 218 */
+EXTERN void		TclPopStackFrame(Tcl_Interp *interp);
+#endif
 /* Slot 219 is reserved */
 /* Slot 220 is reserved */
 /* Slot 221 is reserved */
 /* Slot 222 is reserved */
 /* Slot 223 is reserved */
-/* Slot 224 is reserved */
-/* Slot 225 is reserved */
-/* Slot 226 is reserved */
-/* Slot 227 is reserved */
-/* Slot 228 is reserved */
-/* Slot 229 is reserved */
-/* Slot 230 is reserved */
-/* Slot 231 is reserved */
-/* Slot 232 is reserved */
-/* Slot 233 is reserved */
-/* Slot 234 is reserved */
-/* Slot 235 is reserved */
-/* Slot 236 is reserved */
+#ifndef TclGetPlatform_TCL_DECLARED
+#define TclGetPlatform_TCL_DECLARED
+/* 224 */
+EXTERN TclPlatformType * TclGetPlatform(void);
+#endif
+#ifndef TclTraceDictPath_TCL_DECLARED
+#define TclTraceDictPath_TCL_DECLARED
+/* 225 */
+EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
+				Tcl_Obj *rootPtr, int keyc,
+				Tcl_Obj *CONST keyv[], int flags);
+#endif
+#ifndef TclObjBeingDeleted_TCL_DECLARED
+#define TclObjBeingDeleted_TCL_DECLARED
+/* 226 */
+EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
+#endif
+#ifndef TclSetNsPath_TCL_DECLARED
+#define TclSetNsPath_TCL_DECLARED
+/* 227 */
+EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
+				Tcl_Namespace *pathAry[]);
+#endif
+#ifndef TclObjInterpProcCore_TCL_DECLARED
+#define TclObjInterpProcCore_TCL_DECLARED
+/* 228 */
+EXTERN int		TclObjInterpProcCore(register Tcl_Interp *interp,
+				Tcl_Obj *procNameObj, int skip,
+				ProcErrorProc errorProc);
+#endif
+#ifndef TclPtrMakeUpvar_TCL_DECLARED
+#define TclPtrMakeUpvar_TCL_DECLARED
+/* 229 */
+EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
+				CONST char *myName, int myFlags, int index);
+#endif
+#ifndef TclObjLookupVar_TCL_DECLARED
+#define TclObjLookupVar_TCL_DECLARED
+/* 230 */
+EXTERN Var *		TclObjLookupVar(Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, CONST char *part2,
+				int flags, CONST char *msg,
+				CONST int createPart1, CONST int createPart2,
+				Var **arrayPtrPtr);
+#endif
+#ifndef TclGetNamespaceFromObj_TCL_DECLARED
+#define TclGetNamespaceFromObj_TCL_DECLARED
+/* 231 */
+EXTERN int		TclGetNamespaceFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
+#endif
+#ifndef TclEvalObjEx_TCL_DECLARED
+#define TclEvalObjEx_TCL_DECLARED
+/* 232 */
+EXTERN int		TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
+				int flags, CONST CmdFrame *invoker, int word);
+#endif
+#ifndef TclGetSrcInfoForPc_TCL_DECLARED
+#define TclGetSrcInfoForPc_TCL_DECLARED
+/* 233 */
+EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
+#endif
+#ifndef TclVarHashCreateVar_TCL_DECLARED
+#define TclVarHashCreateVar_TCL_DECLARED
+/* 234 */
+EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
+				CONST char *key, int *newPtr);
+#endif
+#ifndef TclInitVarHashTable_TCL_DECLARED
+#define TclInitVarHashTable_TCL_DECLARED
+/* 235 */
+EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
+				Namespace *nsPtr);
+#endif
+#ifndef TclBackgroundException_TCL_DECLARED
+#define TclBackgroundException_TCL_DECLARED
+/* 236 */
+EXTERN void		TclBackgroundException(Tcl_Interp *interp, int code);
+#endif
 /* Slot 237 is reserved */
 /* Slot 238 is reserved */
 /* Slot 239 is reserved */
 /* Slot 240 is reserved */
 /* Slot 241 is reserved */
 /* Slot 242 is reserved */
-/* Slot 243 is reserved */
+#ifndef TclDbDumpActiveObjects_TCL_DECLARED
+#define TclDbDumpActiveObjects_TCL_DECLARED
+/* 243 */
+EXTERN void		TclDbDumpActiveObjects(FILE *outFile);
+#endif
 /* Slot 244 is reserved */
 /* Slot 245 is reserved */
 /* Slot 246 is reserved */
 /* Slot 247 is reserved */
 /* Slot 248 is reserved */
+#ifndef TclDoubleDigits_TCL_DECLARED
+#define TclDoubleDigits_TCL_DECLARED
 /* 249 */
-EXTERN void		TclUnusedStubEntry _ANSI_ARGS_((void));
+EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
+				int *decpt, int *signum, char **endPtr);
+#endif
 
 typedef struct TclIntStubs {
     int magic;
     struct TclIntStubHooks *hooks;
 
     VOID *reserved0;
-    int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ *proc)); /* 1 */
-    int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ *proc)); /* 2 */
-    void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
+    VOID *reserved1;
+    VOID *reserved2;
+    void (*tclAllocateFreeObjects) (void); /* 3 */
     VOID *reserved4;
-    int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan)); /* 5 */
-    void (*tclCleanupCommand) _ANSI_ARGS_((Command *cmdPtr)); /* 6 */
-    int (*tclCopyAndCollapse) _ANSI_ARGS_((int count, CONST char *src, char *dst)); /* 7 */
-    int (*tclCopyChannel) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)); /* 8 */
-    int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr)); /* 9 */
-    int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)); /* 10 */
-    void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp *iPtr, CallFrame *framePtr)); /* 11 */
-    void (*tclDeleteVars) _ANSI_ARGS_((Interp *iPtr, Tcl_HashTable *tablePtr)); /* 12 */
-    int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)); /* 13 */
-    void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE *outFile)); /* 14 */
+    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
+    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
+    int (*tclCopyAndCollapse) (int count, CONST char *src, char *dst); /* 7 */
+    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
+    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
+    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
+    void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
+    void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
+    VOID *reserved13;
+    int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
     VOID *reserved15;
-    void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp *interp, double value)); /* 16 */
+    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
     VOID *reserved17;
     VOID *reserved18;
     VOID *reserved19;
     VOID *reserved20;
     VOID *reserved21;
-    int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr)); /* 22 */
-    Proc * (*tclFindProc) _ANSI_ARGS_((Interp *iPtr, CONST char *procName)); /* 23 */
-    int (*tclFormatInt) _ANSI_ARGS_((char *buffer, long n)); /* 24 */
-    void (*tclFreePackageInfo) _ANSI_ARGS_((Interp *iPtr)); /* 25 */
+    int (*tclFindElement) (Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
+    Proc * (*tclFindProc) (Interp *iPtr, CONST char *procName); /* 23 */
+    int (*tclFormatInt) (char *buffer, long n); /* 24 */
+    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
     VOID *reserved26;
-    int (*tclGetDate) _ANSI_ARGS_((char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr)); /* 27 */
-    Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
+    VOID *reserved27;
+    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
     VOID *reserved29;
     VOID *reserved30;
-    char * (*tclGetExtension) _ANSI_ARGS_((char *name)); /* 31 */
-    int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr)); /* 32 */
-    TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
-    int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr)); /* 34 */
+    CONST char * (*tclGetExtension) (CONST char *name); /* 31 */
+    int (*tclGetFrame) (Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr); /* 32 */
+    VOID *reserved33;
+    int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
     VOID *reserved35;
-    int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *str, long *longPtr)); /* 36 */
-    int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp *interp, char *targetName)); /* 37 */
-    int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr)); /* 38 */
-    TclObjCmdProcType (*tclGetObjInterpProc) _ANSI_ARGS_((void)); /* 39 */
-    int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *str, int *seekFlagPtr)); /* 40 */
-    Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */
-    char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char *name, Tcl_DString *bufferPtr)); /* 42 */
-    int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)); /* 43 */
-    int (*tclGuessPackageName) _ANSI_ARGS_((CONST char *fileName, Tcl_DString *bufPtr)); /* 44 */
-    int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp *interp)); /* 45 */
-    int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */
+    int (*tclGetLong) (Tcl_Interp *interp, CONST char *str, long *longPtr); /* 36 */
+    int (*tclGetLoadedPackages) (Tcl_Interp *interp, char *targetName); /* 37 */
+    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr); /* 38 */
+    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
+    int (*tclGetOpenMode) (Tcl_Interp *interp, CONST char *str, int *seekFlagPtr); /* 40 */
+    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
+    char * (*tclpGetUserHome) (CONST char *name, Tcl_DString *bufferPtr); /* 42 */
+    VOID *reserved43;
+    int (*tclGuessPackageName) (CONST char *fileName, Tcl_DString *bufPtr); /* 44 */
+    int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
+    int (*tclInExit) (void); /* 46 */
     VOID *reserved47;
     VOID *reserved48;
-    Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */
-    void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr)); /* 50 */
-    int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp *interp)); /* 51 */
-    int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)); /* 52 */
-    int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv)); /* 53 */
-    int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */
-    Proc * (*tclIsProc) _ANSI_ARGS_((Command *cmdPtr)); /* 55 */
+    VOID *reserved49;
+    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
+    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
+    VOID *reserved52;
+    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
+    int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 54 */
+    Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
     VOID *reserved56;
     VOID *reserved57;
-    Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr)); /* 58 */
+    Var * (*tclLookupVar) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
     VOID *reserved59;
-    int (*tclNeedSpace) _ANSI_ARGS_((CONST char *start, CONST char *end)); /* 60 */
-    Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc *procPtr)); /* 61 */
-    int (*tclObjCommandComplete) _ANSI_ARGS_((Tcl_Obj *cmdPtr)); /* 62 */
-    int (*tclObjInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* 63 */
-    int (*tclObjInvoke) _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 64 */
-    int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */
-    int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ *proc)); /* 66 */
-    int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ *proc)); /* 67 */
+    int (*tclNeedSpace) (CONST char *start, CONST char *end); /* 60 */
+    Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
+    int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
+    int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 63 */
+    int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags); /* 64 */
+    VOID *reserved65;
+    VOID *reserved66;
+    VOID *reserved67;
     VOID *reserved68;
-    char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */
+    char * (*tclpAlloc) (unsigned int size); /* 69 */
     VOID *reserved70;
     VOID *reserved71;
     VOID *reserved72;
     VOID *reserved73;
-    void (*tclpFree) _ANSI_ARGS_((char *ptr)); /* 74 */
-    unsigned long (*tclpGetClicks) _ANSI_ARGS_((void)); /* 75 */
-    unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */
-    void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time *time)); /* 77 */
-    int (*tclpGetTimeZone) _ANSI_ARGS_((Tcl_WideInt time)); /* 78 */
+    void (*tclpFree) (char *ptr); /* 74 */
+    unsigned long (*tclpGetClicks) (void); /* 75 */
+    unsigned long (*tclpGetSeconds) (void); /* 76 */
+    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
+    int (*tclpGetTimeZone) (unsigned long time); /* 78 */
     VOID *reserved79;
     VOID *reserved80;
-    char * (*tclpRealloc) _ANSI_ARGS_((char *ptr, unsigned int size)); /* 81 */
+    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
     VOID *reserved82;
     VOID *reserved83;
     VOID *reserved84;
     VOID *reserved85;
     VOID *reserved86;
     VOID *reserved87;
-    char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)); /* 88 */
-    int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd)); /* 89 */
+    char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags); /* 88 */
+    int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
     VOID *reserved90;
-    void (*tclProcCleanupProc) _ANSI_ARGS_((Proc *procPtr)); /* 91 */
-    int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName)); /* 92 */
-    void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */
-    int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv)); /* 94 */
+    void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
+    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName); /* 92 */
+    void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
+    VOID *reserved94;
     VOID *reserved95;
-    int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp *interp, char *oldName, char *newName)); /* 96 */
-    void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp *interp, Command *newCmdPtr)); /* 97 */
-    int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */
+    int (*tclRenameCommand) (Tcl_Interp *interp, CONST char *oldName, CONST char *newName); /* 96 */
+    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
+    int (*tclServiceIdle) (void); /* 98 */
     VOID *reserved99;
     VOID *reserved100;
-    char * (*tclSetPreInitScript) _ANSI_ARGS_((char *string)); /* 101 */
-    void (*tclSetupEnv) _ANSI_ARGS_((Tcl_Interp *interp)); /* 102 */
-    int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp *interp, char *str, char *proto, int *portPtr)); /* 103 */
-    int (*tclSockMinimumBuffersOld) _ANSI_ARGS_((int sock, int size)); /* 104 */
+    char * (*tclSetPreInitScript) (char *string); /* 101 */
+    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
+    int (*tclSockGetPort) (Tcl_Interp *interp, CONST char *str, CONST char *proto, int *portPtr); /* 103 */
+    int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
     VOID *reserved105;
-    int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ *proc)); /* 106 */
-    int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ *proc)); /* 107 */
-    void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace *nsPtr)); /* 108 */
-    int (*tclUpdateReturnInfo) _ANSI_ARGS_((Interp *iPtr)); /* 109 */
-    int (*tclSockMinimumBuffers) _ANSI_ARGS_((VOID *sock, int size)); /* 110 */
-    void (*tcl_AddInterpResolvers) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc)); /* 111 */
-    int (*tcl_AppendExportList) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr)); /* 112 */
-    Tcl_Namespace * (*tcl_CreateNamespace) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)); /* 113 */
-    void (*tcl_DeleteNamespace) _ANSI_ARGS_((Tcl_Namespace *nsPtr)); /* 114 */
-    int (*tcl_Export) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst)); /* 115 */
-    Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)); /* 116 */
-    Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)); /* 117 */
-    int (*tcl_GetInterpResolvers) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo)); /* 118 */
-    int (*tcl_GetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo)); /* 119 */
-    Tcl_Var (*tcl_FindNamespaceVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)); /* 120 */
-    int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern)); /* 121 */
-    Tcl_Command (*tcl_GetCommandFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* 122 */
-    void (*tcl_GetCommandFullName) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr)); /* 123 */
-    Tcl_Namespace * (*tcl_GetCurrentNamespace) _ANSI_ARGS_((Tcl_Interp *interp)); /* 124 */
-    Tcl_Namespace * (*tcl_GetGlobalNamespace) _ANSI_ARGS_((Tcl_Interp *interp)); /* 125 */
-    void (*tcl_GetVariableFullName) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr)); /* 126 */
-    int (*tcl_Import) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite)); /* 127 */
-    void (*tcl_PopCallFrame) _ANSI_ARGS_((Tcl_Interp *interp)); /* 128 */
-    int (*tcl_PushCallFrame) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame)); /* 129 */
-    int (*tcl_RemoveInterpResolvers) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name)); /* 130 */
-    void (*tcl_SetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc)); /* 131 */
-    int (*tclpHasSockets) _ANSI_ARGS_((Tcl_Interp *interp)); /* 132 */
-    struct tm * (*tclpGetDate) _ANSI_ARGS_((TclpTime_t time, int useGMT)); /* 133 */
-    size_t (*tclpStrftime) _ANSI_ARGS_((char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT)); /* 134 */
-    int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */
+    VOID *reserved106;
+    VOID *reserved107;
+    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
+    int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
+    int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */
+    void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
+    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
+    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
+    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
+    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst); /* 115 */
+    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
+    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
+    int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo); /* 118 */
+    int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
+    Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
+    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern); /* 121 */
+    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
+    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
+    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
+    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
+    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
+    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite); /* 127 */
+    void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
+    int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
+    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, CONST char *name); /* 130 */
+    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
+    int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
+    struct tm * (*tclpGetDate) (CONST time_t *time, int useGMT); /* 133 */
+    VOID *reserved134;
+    VOID *reserved135;
     VOID *reserved136;
     VOID *reserved137;
-    CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((CONST char *name, Tcl_DString *valuePtr)); /* 138 */
+    CONST84_RETURN char * (*tclGetEnv) (CONST char *name, Tcl_DString *valuePtr); /* 138 */
     VOID *reserved139;
-    int (*tclLooksLikeInt) _ANSI_ARGS_((CONST char *bytes, int length)); /* 140 */
-    CONST84_RETURN char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *cwdPtr)); /* 141 */
-    int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData)); /* 142 */
-    int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr)); /* 143 */
-    void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp *interp, struct CompileEnv *envPtr, int index)); /* 144 */
-    struct AuxDataType * (*tclGetAuxDataType) _ANSI_ARGS_((char *typeName)); /* 145 */
-    TclHandle (*tclHandleCreate) _ANSI_ARGS_((VOID *ptr)); /* 146 */
-    void (*tclHandleFree) _ANSI_ARGS_((TclHandle handle)); /* 147 */
-    TclHandle (*tclHandlePreserve) _ANSI_ARGS_((TclHandle handle)); /* 148 */
-    void (*tclHandleRelease) _ANSI_ARGS_((TclHandle handle)); /* 149 */
-    int (*tclRegAbout) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_RegExp re)); /* 150 */
-    void (*tclRegExpRangeUniChar) _ANSI_ARGS_((Tcl_RegExp re, int index, int *startPtr, int *endPtr)); /* 151 */
-    void (*tclSetLibraryPath) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 152 */
-    Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */
+    VOID *reserved140;
+    CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
+    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
+    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
+    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
+    struct AuxDataType * (*tclGetAuxDataType) (char *typeName); /* 145 */
+    TclHandle (*tclHandleCreate) (VOID *ptr); /* 146 */
+    void (*tclHandleFree) (TclHandle handle); /* 147 */
+    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
+    void (*tclHandleRelease) (TclHandle handle); /* 149 */
+    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
+    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
+    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
+    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
     VOID *reserved154;
     VOID *reserved155;
-    void (*tclRegError) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *msg, int status)); /* 156 */
-    Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName)); /* 157 */
-    void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char *filename)); /* 158 */
-    CONST84_RETURN char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+    void (*tclRegError) (Tcl_Interp *interp, CONST char *msg, int status); /* 156 */
+    Var * (*tclVarTraceExists) (Tcl_Interp *interp, CONST char *varName); /* 157 */
+    void (*tclSetStartupScriptFileName) (CONST char *filename); /* 158 */
+    CONST84_RETURN char * (*tclGetStartupScriptFileName) (void); /* 159 */
     VOID *reserved160;
-    int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr)); /* 161 */
-    void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
-    VOID * (*tclGetInstructionTable) _ANSI_ARGS_((void)); /* 163 */
-    void (*tclExpandCodeArray) _ANSI_ARGS_((VOID *envPtr)); /* 164 */
-    void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 165 */
-    int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr)); /* 166 */
-    void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* 167 */
-    Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */
-    int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char *s1, CONST char *s2, unsigned long n)); /* 169 */
-    int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */
-    int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */
-    int (*tclInThreadExit) _ANSI_ARGS_((void)); /* 172 */
-    int (*tclUniCharMatch) _ANSI_ARGS_((CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase)); /* 173 */
+    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
+    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
+    VOID * (*tclGetInstructionTable) (void); /* 163 */
+    void (*tclExpandCodeArray) (VOID *envPtr); /* 164 */
+    void (*tclpSetInitialEncodings) (void); /* 165 */
+    int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
+    void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
+    Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
+    int (*tclpUtfNcmp2) (CONST char *s1, CONST char *s2, unsigned long n); /* 169 */
+    int (*tclCheckInterpTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 170 */
+    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 171 */
+    int (*tclInThreadExit) (void); /* 172 */
+    int (*tclUniCharMatch) (CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
     VOID *reserved174;
-    VOID *reserved175;
-    VOID *reserved176;
-    VOID *reserved177;
-    VOID *reserved178;
-    VOID *reserved179;
+    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, int leaveErrMsg); /* 175 */
+    void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
+    void (*tclVarErrMsg) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason); /* 177 */
+    void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, CONST char *encodingName); /* 178 */
+    Tcl_Obj * (*tcl_GetStartupScript) (CONST char **encodingNamePtr); /* 179 */
     VOID *reserved180;
     VOID *reserved181;
-    struct tm * (*tclpLocaltime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 182 */
-    struct tm * (*tclpGmtime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 183 */
+    struct tm * (*tclpLocaltime) (CONST time_t *clock); /* 182 */
+    struct tm * (*tclpGmtime) (CONST time_t *clock); /* 183 */
     VOID *reserved184;
     VOID *reserved185;
     VOID *reserved186;
@@ -759,58 +1255,58 @@ typedef struct TclIntStubs {
     VOID *reserved195;
     VOID *reserved196;
     VOID *reserved197;
-    VOID *reserved198;
-    int (*tclMatchIsTrivial) _ANSI_ARGS_((CONST char *pattern)); /* 199 */
-    VOID *reserved200;
-    VOID *reserved201;
-    VOID *reserved202;
-    VOID *reserved203;
-    VOID *reserved204;
-    VOID *reserved205;
-    VOID *reserved206;
-    VOID *reserved207;
-    VOID *reserved208;
+    int (*tclObjGetFrame) (Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* 198 */
+    VOID *reserved199;
+    int (*tclpObjRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 200 */
+    int (*tclpObjCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 201 */
+    int (*tclpObjCreateDirectory) (Tcl_Obj *pathPtr); /* 202 */
+    int (*tclpObjDeleteFile) (Tcl_Obj *pathPtr); /* 203 */
+    int (*tclpObjCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 204 */
+    int (*tclpObjRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */
+    int (*tclpObjStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 206 */
+    int (*tclpObjAccess) (Tcl_Obj *pathPtr, int mode); /* 207 */
+    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
     VOID *reserved209;
     VOID *reserved210;
     VOID *reserved211;
-    VOID *reserved212;
-    VOID *reserved213;
-    VOID *reserved214;
-    VOID *reserved215;
-    VOID *reserved216;
-    VOID *reserved217;
-    VOID *reserved218;
+    void (*tclpFindExecutable) (CONST char *argv0); /* 212 */
+    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
+    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
+    VOID * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
+    void (*tclStackFree) (Tcl_Interp *interp, VOID *freePtr); /* 216 */
+    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
+    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
     VOID *reserved219;
     VOID *reserved220;
     VOID *reserved221;
     VOID *reserved222;
     VOID *reserved223;
-    VOID *reserved224;
-    VOID *reserved225;
-    VOID *reserved226;
-    VOID *reserved227;
-    VOID *reserved228;
-    VOID *reserved229;
-    VOID *reserved230;
-    VOID *reserved231;
-    VOID *reserved232;
-    VOID *reserved233;
-    VOID *reserved234;
-    VOID *reserved235;
-    VOID *reserved236;
+    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
+    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags); /* 225 */
+    int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
+    void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
+    int (*tclObjInterpProcCore) (register Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc errorProc); /* 228 */
+    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, CONST char *myName, int myFlags, int index); /* 229 */
+    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr); /* 230 */
+    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
+    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, CONST CmdFrame *invoker, int word); /* 232 */
+    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
+    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, CONST char *key, int *newPtr); /* 234 */
+    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
+    void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
     VOID *reserved237;
     VOID *reserved238;
     VOID *reserved239;
     VOID *reserved240;
     VOID *reserved241;
     VOID *reserved242;
-    VOID *reserved243;
+    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
     VOID *reserved244;
     VOID *reserved245;
     VOID *reserved246;
     VOID *reserved247;
     VOID *reserved248;
-    void (*tclUnusedStubEntry) _ANSI_ARGS_((void)); /* 249 */
+    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -828,14 +1324,8 @@ extern TclIntStubs *tclIntStubsPtr;
  */
 
 /* Slot 0 is reserved */
-#ifndef TclAccessDeleteProc
-#define TclAccessDeleteProc \
-	(tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
-#endif
-#ifndef TclAccessInsertProc
-#define TclAccessInsertProc \
-	(tclIntStubsPtr->tclAccessInsertProc) /* 2 */
-#endif
+/* Slot 1 is reserved */
+/* Slot 2 is reserved */
 #ifndef TclAllocateFreeObjects
 #define TclAllocateFreeObjects \
 	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
@@ -873,10 +1363,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclDeleteVars \
 	(tclIntStubsPtr->tclDeleteVars) /* 12 */
 #endif
-#ifndef TclDoGlob
-#define TclDoGlob \
-	(tclIntStubsPtr->tclDoGlob) /* 13 */
-#endif
+/* Slot 13 is reserved */
 #ifndef TclDumpMemoryInfo
 #define TclDumpMemoryInfo \
 	(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
@@ -908,10 +1395,7 @@ extern TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclFreePackageInfo) /* 25 */
 #endif
 /* Slot 26 is reserved */
-#ifndef TclGetDate
-#define TclGetDate \
-	(tclIntStubsPtr->tclGetDate) /* 27 */
-#endif
+/* Slot 27 is reserved */
 #ifndef TclpGetDefaultStdChannel
 #define TclpGetDefaultStdChannel \
 	(tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
@@ -926,10 +1410,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclGetFrame \
 	(tclIntStubsPtr->tclGetFrame) /* 32 */
 #endif
-#ifndef TclGetInterpProc
-#define TclGetInterpProc \
-	(tclIntStubsPtr->tclGetInterpProc) /* 33 */
-#endif
+/* Slot 33 is reserved */
 #ifndef TclGetIntForIndex
 #define TclGetIntForIndex \
 	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
@@ -963,10 +1444,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclpGetUserHome \
 	(tclIntStubsPtr->tclpGetUserHome) /* 42 */
 #endif
-#ifndef TclGlobalInvoke
-#define TclGlobalInvoke \
-	(tclIntStubsPtr->tclGlobalInvoke) /* 43 */
-#endif
+/* Slot 43 is reserved */
 #ifndef TclGuessPackageName
 #define TclGuessPackageName \
 	(tclIntStubsPtr->tclGuessPackageName) /* 44 */
@@ -981,10 +1459,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #endif
 /* Slot 47 is reserved */
 /* Slot 48 is reserved */
-#ifndef TclIncrVar2
-#define TclIncrVar2 \
-	(tclIntStubsPtr->tclIncrVar2) /* 49 */
-#endif
+/* Slot 49 is reserved */
 #ifndef TclInitCompiledLocals
 #define TclInitCompiledLocals \
 	(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
@@ -993,10 +1468,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclInterpInit \
 	(tclIntStubsPtr->tclInterpInit) /* 51 */
 #endif
-#ifndef TclInvoke
-#define TclInvoke \
-	(tclIntStubsPtr->tclInvoke) /* 52 */
-#endif
+/* Slot 52 is reserved */
 #ifndef TclInvokeObjectCommand
 #define TclInvokeObjectCommand \
 	(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
@@ -1036,18 +1508,9 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclObjInvoke \
 	(tclIntStubsPtr->tclObjInvoke) /* 64 */
 #endif
-#ifndef TclObjInvokeGlobal
-#define TclObjInvokeGlobal \
-	(tclIntStubsPtr->tclObjInvokeGlobal) /* 65 */
-#endif
-#ifndef TclOpenFileChannelDeleteProc
-#define TclOpenFileChannelDeleteProc \
-	(tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */
-#endif
-#ifndef TclOpenFileChannelInsertProc
-#define TclOpenFileChannelInsertProc \
-	(tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */
-#endif
+/* Slot 65 is reserved */
+/* Slot 66 is reserved */
+/* Slot 67 is reserved */
 /* Slot 68 is reserved */
 #ifndef TclpAlloc
 #define TclpAlloc \
@@ -1110,10 +1573,7 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclProcDeleteProc \
 	(tclIntStubsPtr->tclProcDeleteProc) /* 93 */
 #endif
-#ifndef TclProcInterpProc
-#define TclProcInterpProc \
-	(tclIntStubsPtr->tclProcInterpProc) /* 94 */
-#endif
+/* Slot 94 is reserved */
 /* Slot 95 is reserved */
 #ifndef TclRenameCommand
 #define TclRenameCommand \
@@ -1146,14 +1606,8 @@ extern TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
 #endif
 /* Slot 105 is reserved */
-#ifndef TclStatDeleteProc
-#define TclStatDeleteProc \
-	(tclIntStubsPtr->tclStatDeleteProc) /* 106 */
-#endif
-#ifndef TclStatInsertProc
-#define TclStatInsertProc \
-	(tclIntStubsPtr->tclStatInsertProc) /* 107 */
-#endif
+/* Slot 106 is reserved */
+/* Slot 107 is reserved */
 #ifndef TclTeardownNamespace
 #define TclTeardownNamespace \
 	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
@@ -1258,14 +1712,8 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclpGetDate \
 	(tclIntStubsPtr->tclpGetDate) /* 133 */
 #endif
-#ifndef TclpStrftime
-#define TclpStrftime \
-	(tclIntStubsPtr->tclpStrftime) /* 134 */
-#endif
-#ifndef TclpCheckStackSpace
-#define TclpCheckStackSpace \
-	(tclIntStubsPtr->tclpCheckStackSpace) /* 135 */
-#endif
+/* Slot 134 is reserved */
+/* Slot 135 is reserved */
 /* Slot 136 is reserved */
 /* Slot 137 is reserved */
 #ifndef TclGetEnv
@@ -1273,10 +1721,7 @@ extern TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclGetEnv) /* 138 */
 #endif
 /* Slot 139 is reserved */
-#ifndef TclLooksLikeInt
-#define TclLooksLikeInt \
-	(tclIntStubsPtr->tclLooksLikeInt) /* 140 */
-#endif
+/* Slot 140 is reserved */
 #ifndef TclpGetCwd
 #define TclpGetCwd \
 	(tclIntStubsPtr->tclpGetCwd) /* 141 */
@@ -1401,11 +1846,26 @@ extern TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclUniCharMatch) /* 173 */
 #endif
 /* Slot 174 is reserved */
-/* Slot 175 is reserved */
-/* Slot 176 is reserved */
-/* Slot 177 is reserved */
-/* Slot 178 is reserved */
-/* Slot 179 is reserved */
+#ifndef TclCallVarTraces
+#define TclCallVarTraces \
+	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
+#endif
+#ifndef TclCleanupVar
+#define TclCleanupVar \
+	(tclIntStubsPtr->tclCleanupVar) /* 176 */
+#endif
+#ifndef TclVarErrMsg
+#define TclVarErrMsg \
+	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
+#endif
+#ifndef Tcl_SetStartupScript
+#define Tcl_SetStartupScript \
+	(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
+#endif
+#ifndef Tcl_GetStartupScript
+#define Tcl_GetStartupScript \
+	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
+#endif
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
 #ifndef TclpLocaltime
@@ -1430,63 +1890,153 @@ extern TclIntStubs *tclIntStubsPtr;
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-/* Slot 198 is reserved */
-#ifndef TclMatchIsTrivial
-#define TclMatchIsTrivial \
-	(tclIntStubsPtr->tclMatchIsTrivial) /* 199 */
-#endif
-/* Slot 200 is reserved */
-/* Slot 201 is reserved */
-/* Slot 202 is reserved */
-/* Slot 203 is reserved */
-/* Slot 204 is reserved */
-/* Slot 205 is reserved */
-/* Slot 206 is reserved */
-/* Slot 207 is reserved */
-/* Slot 208 is reserved */
+#ifndef TclObjGetFrame
+#define TclObjGetFrame \
+	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
+#endif
+/* Slot 199 is reserved */
+#ifndef TclpObjRemoveDirectory
+#define TclpObjRemoveDirectory \
+	(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
+#endif
+#ifndef TclpObjCopyDirectory
+#define TclpObjCopyDirectory \
+	(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */
+#endif
+#ifndef TclpObjCreateDirectory
+#define TclpObjCreateDirectory \
+	(tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */
+#endif
+#ifndef TclpObjDeleteFile
+#define TclpObjDeleteFile \
+	(tclIntStubsPtr->tclpObjDeleteFile) /* 203 */
+#endif
+#ifndef TclpObjCopyFile
+#define TclpObjCopyFile \
+	(tclIntStubsPtr->tclpObjCopyFile) /* 204 */
+#endif
+#ifndef TclpObjRenameFile
+#define TclpObjRenameFile \
+	(tclIntStubsPtr->tclpObjRenameFile) /* 205 */
+#endif
+#ifndef TclpObjStat
+#define TclpObjStat \
+	(tclIntStubsPtr->tclpObjStat) /* 206 */
+#endif
+#ifndef TclpObjAccess
+#define TclpObjAccess \
+	(tclIntStubsPtr->tclpObjAccess) /* 207 */
+#endif
+#ifndef TclpOpenFileChannel
+#define TclpOpenFileChannel \
+	(tclIntStubsPtr->tclpOpenFileChannel) /* 208 */
+#endif
 /* Slot 209 is reserved */
 /* Slot 210 is reserved */
 /* Slot 211 is reserved */
-/* Slot 212 is reserved */
-/* Slot 213 is reserved */
-/* Slot 214 is reserved */
-/* Slot 215 is reserved */
-/* Slot 216 is reserved */
-/* Slot 217 is reserved */
-/* Slot 218 is reserved */
+#ifndef TclpFindExecutable
+#define TclpFindExecutable \
+	(tclIntStubsPtr->tclpFindExecutable) /* 212 */
+#endif
+#ifndef TclGetObjNameOfExecutable
+#define TclGetObjNameOfExecutable \
+	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
+#endif
+#ifndef TclSetObjNameOfExecutable
+#define TclSetObjNameOfExecutable \
+	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
+#endif
+#ifndef TclStackAlloc
+#define TclStackAlloc \
+	(tclIntStubsPtr->tclStackAlloc) /* 215 */
+#endif
+#ifndef TclStackFree
+#define TclStackFree \
+	(tclIntStubsPtr->tclStackFree) /* 216 */
+#endif
+#ifndef TclPushStackFrame
+#define TclPushStackFrame \
+	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
+#endif
+#ifndef TclPopStackFrame
+#define TclPopStackFrame \
+	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
+#endif
 /* Slot 219 is reserved */
 /* Slot 220 is reserved */
 /* Slot 221 is reserved */
 /* Slot 222 is reserved */
 /* Slot 223 is reserved */
-/* Slot 224 is reserved */
-/* Slot 225 is reserved */
-/* Slot 226 is reserved */
-/* Slot 227 is reserved */
-/* Slot 228 is reserved */
-/* Slot 229 is reserved */
-/* Slot 230 is reserved */
-/* Slot 231 is reserved */
-/* Slot 232 is reserved */
-/* Slot 233 is reserved */
-/* Slot 234 is reserved */
-/* Slot 235 is reserved */
-/* Slot 236 is reserved */
+#ifndef TclGetPlatform
+#define TclGetPlatform \
+	(tclIntStubsPtr->tclGetPlatform) /* 224 */
+#endif
+#ifndef TclTraceDictPath
+#define TclTraceDictPath \
+	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
+#endif
+#ifndef TclObjBeingDeleted
+#define TclObjBeingDeleted \
+	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
+#endif
+#ifndef TclSetNsPath
+#define TclSetNsPath \
+	(tclIntStubsPtr->tclSetNsPath) /* 227 */
+#endif
+#ifndef TclObjInterpProcCore
+#define TclObjInterpProcCore \
+	(tclIntStubsPtr->tclObjInterpProcCore) /* 228 */
+#endif
+#ifndef TclPtrMakeUpvar
+#define TclPtrMakeUpvar \
+	(tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
+#endif
+#ifndef TclObjLookupVar
+#define TclObjLookupVar \
+	(tclIntStubsPtr->tclObjLookupVar) /* 230 */
+#endif
+#ifndef TclGetNamespaceFromObj
+#define TclGetNamespaceFromObj \
+	(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
+#endif
+#ifndef TclEvalObjEx
+#define TclEvalObjEx \
+	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
+#endif
+#ifndef TclGetSrcInfoForPc
+#define TclGetSrcInfoForPc \
+	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
+#endif
+#ifndef TclVarHashCreateVar
+#define TclVarHashCreateVar \
+	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
+#endif
+#ifndef TclInitVarHashTable
+#define TclInitVarHashTable \
+	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
+#endif
+#ifndef TclBackgroundException
+#define TclBackgroundException \
+	(tclIntStubsPtr->tclBackgroundException) /* 236 */
+#endif
 /* Slot 237 is reserved */
 /* Slot 238 is reserved */
 /* Slot 239 is reserved */
 /* Slot 240 is reserved */
 /* Slot 241 is reserved */
 /* Slot 242 is reserved */
-/* Slot 243 is reserved */
+#ifndef TclDbDumpActiveObjects
+#define TclDbDumpActiveObjects \
+	(tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */
+#endif
 /* Slot 244 is reserved */
 /* Slot 245 is reserved */
 /* Slot 246 is reserved */
 /* Slot 247 is reserved */
 /* Slot 248 is reserved */
-#ifndef TclUnusedStubEntry
-#define TclUnusedStubEntry \
-	(tclIntStubsPtr->tclUnusedStubEntry) /* 249 */
+#ifndef TclDoubleDigits
+#define TclDoubleDigits \
+	(tclIntStubsPtr->tclDoubleDigits) /* 249 */
 #endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
@@ -1496,8 +2046,49 @@ extern TclIntStubs *tclIntStubsPtr;
 #if !defined(_WIN64)
 /* See bug 510001: TclSockMinimumBuffers needs plat imp */
 #   undef TclSockMinimumBuffers
-#   define TclSockMinimumBuffers(a,b) TclSockMinimumBuffersOld((int)(a),b)
+#   define TclSockMinimumBuffers(a,b) TclSockMinimumBuffersOld(PTR2INT(a),b)
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+#   undef Tcl_CreateNamespace
+#   define Tcl_CreateNamespace \
+	   (tclStubsPtr->tcl_CreateNamespace) /* 506 */
+#   undef Tcl_DeleteNamespace
+#   define Tcl_DeleteNamespace \
+	   (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+#   undef Tcl_AppendExportList
+#   define Tcl_AppendExportList \
+	   (tclStubsPtr->tcl_AppendExportList) /* 508 */
+#   undef Tcl_Export
+#   define Tcl_Export \
+	   (tclStubsPtr->tcl_Export) /* 509 */
+#   undef Tcl_Import
+#   define Tcl_Import \
+	   (tclStubsPtr->tcl_Import) /* 510 */
+#   undef Tcl_ForgetImport
+#   define Tcl_ForgetImport \
+	   (tclStubsPtr->tcl_ForgetImport) /* 511 */
+#   undef Tcl_GetCurrentNamespace
+#   define Tcl_GetCurrentNamespace \
+	   (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+#   undef Tcl_GetGlobalNamespace
+#   define Tcl_GetGlobalNamespace \
+	   (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+#   undef Tcl_FindNamespace
+#   define Tcl_FindNamespace \
+	   (tclStubsPtr->tcl_FindNamespace) /* 514 */
+#   undef Tcl_FindCommand
+#   define Tcl_FindCommand \
+	   (tclStubsPtr->tcl_FindCommand) /* 515 */
+#   undef Tcl_GetCommandFromObj
+#   define Tcl_GetCommandFromObj \
+	   (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+#   undef Tcl_GetCommandFullName
+#   define Tcl_GetCommandFullName \
+	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
 #endif
-#undef TclUnusedStubEntry
 
 #endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index dcd9a4d..1e68c9c 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -18,6 +18,17 @@
 #   define DIR void
 #endif
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -31,46 +42,85 @@
  */
 
 #if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#ifndef TclGetAndDetachPids_TCL_DECLARED
+#define TclGetAndDetachPids_TCL_DECLARED
 /* 0 */
-EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef TclpCloseFile_TCL_DECLARED
+#define TclpCloseFile_TCL_DECLARED
 /* 1 */
-EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
+EXTERN int		TclpCloseFile(TclFile file);
+#endif
+#ifndef TclpCreateCommandChannel_TCL_DECLARED
+#define TclpCreateCommandChannel_TCL_DECLARED
 /* 2 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
-				TclFile readFile, TclFile writeFile,
-				TclFile errorFile, int numPids,
-				Tcl_Pid *pidPtr));
+EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
+				TclFile writeFile, TclFile errorFile,
+				int numPids, Tcl_Pid *pidPtr);
+#endif
+#ifndef TclpCreatePipe_TCL_DECLARED
+#define TclpCreatePipe_TCL_DECLARED
 /* 3 */
-EXTERN int		TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
-				TclFile *writePipe));
+EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+#endif
+#ifndef TclpCreateProcess_TCL_DECLARED
+#define TclpCreateProcess_TCL_DECLARED
 /* 4 */
-EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
-				int argc, CONST char **argv,
-				TclFile inputFile, TclFile outputFile,
-				TclFile errorFile, Tcl_Pid *pidPtr));
+EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
+				CONST char **argv, TclFile inputFile,
+				TclFile outputFile, TclFile errorFile,
+				Tcl_Pid *pidPtr);
+#endif
 /* Slot 5 is reserved */
+#ifndef TclpMakeFile_TCL_DECLARED
+#define TclpMakeFile_TCL_DECLARED
 /* 6 */
-EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
-				int direction));
+EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
+#endif
+#ifndef TclpOpenFile_TCL_DECLARED
+#define TclpOpenFile_TCL_DECLARED
 /* 7 */
-EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((CONST char *fname,
-				int mode));
+EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
+#endif
+#ifndef TclUnixWaitForFile_TCL_DECLARED
+#define TclUnixWaitForFile_TCL_DECLARED
 /* 8 */
-EXTERN int		TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
-				int timeout));
+EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
+#endif
+#ifndef TclpCreateTempFile_TCL_DECLARED
+#define TclpCreateTempFile_TCL_DECLARED
 /* 9 */
-EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((CONST char *contents));
+EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
+#endif
+#ifndef TclpReaddir_TCL_DECLARED
+#define TclpReaddir_TCL_DECLARED
 /* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir _ANSI_ARGS_((DIR *dir));
+EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
+#endif
+#ifndef TclpLocaltime_unix_TCL_DECLARED
+#define TclpLocaltime_unix_TCL_DECLARED
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix _ANSI_ARGS_((
-				TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
+#endif
+#ifndef TclpGmtime_unix_TCL_DECLARED
+#define TclpGmtime_unix_TCL_DECLARED
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
+#endif
+#ifndef TclpInetNtoa_TCL_DECLARED
+#define TclpInetNtoa_TCL_DECLARED
 /* 13 */
-EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
-/* Slot 14 is reserved */
+EXTERN char *		TclpInetNtoa(struct in_addr addr);
+#endif
+#ifndef TclUnixCopyFile_TCL_DECLARED
+#define TclUnixCopyFile_TCL_DECLARED
+/* 14 */
+EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
+				CONST Tcl_StatBuf *statBufPtr,
+				int dontCopyAtts);
+#endif
 /* Slot 15 is reserved */
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
@@ -85,133 +135,286 @@ EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
+#ifndef TclWinCPUID_TCL_DECLARED
+#define TclWinCPUID_TCL_DECLARED
 /* 29 */
-EXTERN int		TclWinCPUID _ANSI_ARGS_((unsigned int index,
-				unsigned int *regs));
+EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
+#endif
 #endif /* UNIX */
 #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#ifndef TclWinConvertError_TCL_DECLARED
+#define TclWinConvertError_TCL_DECLARED
 /* 0 */
-EXTERN void		TclWinConvertError _ANSI_ARGS_((DWORD errCode));
+EXTERN void		TclWinConvertError(DWORD errCode);
+#endif
+#ifndef TclWinConvertWSAError_TCL_DECLARED
+#define TclWinConvertWSAError_TCL_DECLARED
 /* 1 */
-EXTERN void		TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
+EXTERN void		TclWinConvertWSAError(DWORD errCode);
+#endif
+#ifndef TclWinGetServByName_TCL_DECLARED
+#define TclWinGetServByName_TCL_DECLARED
 /* 2 */
-EXTERN struct servent *	 TclWinGetServByName _ANSI_ARGS_((CONST char *nm,
-				CONST char *proto));
+EXTERN struct servent *	 TclWinGetServByName(CONST char *nm,
+				CONST char *proto);
+#endif
+#ifndef TclWinGetSockOpt_TCL_DECLARED
+#define TclWinGetSockOpt_TCL_DECLARED
 /* 3 */
-EXTERN int		TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
-				int optname, char *optval, int *optlen));
+EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
+				char *optval, int *optlen);
+#endif
+#ifndef TclWinGetTclInstance_TCL_DECLARED
+#define TclWinGetTclInstance_TCL_DECLARED
 /* 4 */
-EXTERN HINSTANCE	TclWinGetTclInstance _ANSI_ARGS_((void));
+EXTERN HINSTANCE	TclWinGetTclInstance(void);
+#endif
+#ifndef TclUnixWaitForFile_TCL_DECLARED
+#define TclUnixWaitForFile_TCL_DECLARED
 /* 5 */
-EXTERN int		TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
-				int timeout));
+EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
+#endif
+#ifndef TclWinNToHS_TCL_DECLARED
+#define TclWinNToHS_TCL_DECLARED
 /* 6 */
-EXTERN unsigned short	TclWinNToHS _ANSI_ARGS_((unsigned short ns));
+EXTERN unsigned short	TclWinNToHS(unsigned short ns);
+#endif
+#ifndef TclWinSetSockOpt_TCL_DECLARED
+#define TclWinSetSockOpt_TCL_DECLARED
 /* 7 */
-EXTERN int		TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
-				int optname, CONST char *optval, int optlen));
+EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
+				CONST char *optval, int optlen);
+#endif
+#ifndef TclpGetPid_TCL_DECLARED
+#define TclpGetPid_TCL_DECLARED
 /* 8 */
-EXTERN int		TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
+EXTERN int		TclpGetPid(Tcl_Pid pid);
+#endif
+#ifndef TclWinGetPlatformId_TCL_DECLARED
+#define TclWinGetPlatformId_TCL_DECLARED
 /* 9 */
-EXTERN int		TclWinGetPlatformId _ANSI_ARGS_((void));
+EXTERN int		TclWinGetPlatformId(void);
+#endif
+#ifndef TclpReaddir_TCL_DECLARED
+#define TclpReaddir_TCL_DECLARED
 /* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir _ANSI_ARGS_((DIR *dir));
+EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
+#endif
+#ifndef TclGetAndDetachPids_TCL_DECLARED
+#define TclGetAndDetachPids_TCL_DECLARED
 /* 11 */
-EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef TclpCloseFile_TCL_DECLARED
+#define TclpCloseFile_TCL_DECLARED
 /* 12 */
-EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
+EXTERN int		TclpCloseFile(TclFile file);
+#endif
+#ifndef TclpCreateCommandChannel_TCL_DECLARED
+#define TclpCreateCommandChannel_TCL_DECLARED
 /* 13 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
-				TclFile readFile, TclFile writeFile,
-				TclFile errorFile, int numPids,
-				Tcl_Pid *pidPtr));
+EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
+				TclFile writeFile, TclFile errorFile,
+				int numPids, Tcl_Pid *pidPtr);
+#endif
+#ifndef TclpCreatePipe_TCL_DECLARED
+#define TclpCreatePipe_TCL_DECLARED
 /* 14 */
-EXTERN int		TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
-				TclFile *writePipe));
+EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+#endif
+#ifndef TclpCreateProcess_TCL_DECLARED
+#define TclpCreateProcess_TCL_DECLARED
 /* 15 */
-EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
-				int argc, CONST char **argv,
-				TclFile inputFile, TclFile outputFile,
-				TclFile errorFile, Tcl_Pid *pidPtr));
+EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
+				CONST char **argv, TclFile inputFile,
+				TclFile outputFile, TclFile errorFile,
+				Tcl_Pid *pidPtr);
+#endif
+#ifndef TclpIsAtty_TCL_DECLARED
+#define TclpIsAtty_TCL_DECLARED
 /* 16 */
-EXTERN int		TclpIsAtty _ANSI_ARGS_((int fd));
-/* Slot 17 is reserved */
+EXTERN int		TclpIsAtty(int fd);
+#endif
+#ifndef TclUnixCopyFile_TCL_DECLARED
+#define TclUnixCopyFile_TCL_DECLARED
+/* 17 */
+EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
+				CONST Tcl_StatBuf *statBufPtr,
+				int dontCopyAtts);
+#endif
+#ifndef TclpMakeFile_TCL_DECLARED
+#define TclpMakeFile_TCL_DECLARED
 /* 18 */
-EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
-				int direction));
+EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
+#endif
+#ifndef TclpOpenFile_TCL_DECLARED
+#define TclpOpenFile_TCL_DECLARED
 /* 19 */
-EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((CONST char *fname,
-				int mode));
+EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
+#endif
+#ifndef TclWinAddProcess_TCL_DECLARED
+#define TclWinAddProcess_TCL_DECLARED
 /* 20 */
-EXTERN void		TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess,
-				DWORD id));
+EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
+#endif
+#ifndef TclpInetNtoa_TCL_DECLARED
+#define TclpInetNtoa_TCL_DECLARED
 /* 21 */
-EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
+EXTERN char *		TclpInetNtoa(struct in_addr addr);
+#endif
+#ifndef TclpCreateTempFile_TCL_DECLARED
+#define TclpCreateTempFile_TCL_DECLARED
 /* 22 */
-EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((CONST char *contents));
+EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
+#endif
+#ifndef TclpGetTZName_TCL_DECLARED
+#define TclpGetTZName_TCL_DECLARED
 /* 23 */
-EXTERN char *		TclpGetTZName _ANSI_ARGS_((int isdst));
+EXTERN char *		TclpGetTZName(int isdst);
+#endif
+#ifndef TclWinNoBackslash_TCL_DECLARED
+#define TclWinNoBackslash_TCL_DECLARED
 /* 24 */
-EXTERN char *		TclWinNoBackslash _ANSI_ARGS_((char *path));
-/* 25 */
-EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
+EXTERN char *		TclWinNoBackslash(char *path);
+#endif
+/* Slot 25 is reserved */
+#ifndef TclWinSetInterfaces_TCL_DECLARED
+#define TclWinSetInterfaces_TCL_DECLARED
 /* 26 */
-EXTERN void		TclWinSetInterfaces _ANSI_ARGS_((int wide));
+EXTERN void		TclWinSetInterfaces(int wide);
+#endif
+#ifndef TclWinFlushDirtyChannels_TCL_DECLARED
+#define TclWinFlushDirtyChannels_TCL_DECLARED
 /* 27 */
-EXTERN void		TclWinFlushDirtyChannels _ANSI_ARGS_((void));
+EXTERN void		TclWinFlushDirtyChannels(void);
+#endif
+#ifndef TclWinResetInterfaces_TCL_DECLARED
+#define TclWinResetInterfaces_TCL_DECLARED
 /* 28 */
-EXTERN void		TclWinResetInterfaces _ANSI_ARGS_((void));
+EXTERN void		TclWinResetInterfaces(void);
+#endif
+#ifndef TclWinCPUID_TCL_DECLARED
+#define TclWinCPUID_TCL_DECLARED
 /* 29 */
-EXTERN int		TclWinCPUID _ANSI_ARGS_((unsigned int index,
-				unsigned int *regs));
+EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
+#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
+#ifndef TclGetAndDetachPids_TCL_DECLARED
+#define TclGetAndDetachPids_TCL_DECLARED
 /* 0 */
-EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
-				Tcl_Channel chan));
+EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
+				Tcl_Channel chan);
+#endif
+#ifndef TclpCloseFile_TCL_DECLARED
+#define TclpCloseFile_TCL_DECLARED
 /* 1 */
-EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
+EXTERN int		TclpCloseFile(TclFile file);
+#endif
+#ifndef TclpCreateCommandChannel_TCL_DECLARED
+#define TclpCreateCommandChannel_TCL_DECLARED
 /* 2 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
-				TclFile readFile, TclFile writeFile,
-				TclFile errorFile, int numPids,
-				Tcl_Pid *pidPtr));
+EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
+				TclFile writeFile, TclFile errorFile,
+				int numPids, Tcl_Pid *pidPtr);
+#endif
+#ifndef TclpCreatePipe_TCL_DECLARED
+#define TclpCreatePipe_TCL_DECLARED
 /* 3 */
-EXTERN int		TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
-				TclFile *writePipe));
+EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+#endif
+#ifndef TclpCreateProcess_TCL_DECLARED
+#define TclpCreateProcess_TCL_DECLARED
 /* 4 */
-EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
-				int argc, CONST char **argv,
-				TclFile inputFile, TclFile outputFile,
-				TclFile errorFile, Tcl_Pid *pidPtr));
+EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
+				CONST char **argv, TclFile inputFile,
+				TclFile outputFile, TclFile errorFile,
+				Tcl_Pid *pidPtr);
+#endif
 /* Slot 5 is reserved */
+#ifndef TclpMakeFile_TCL_DECLARED
+#define TclpMakeFile_TCL_DECLARED
 /* 6 */
-EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
-				int direction));
+EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
+#endif
+#ifndef TclpOpenFile_TCL_DECLARED
+#define TclpOpenFile_TCL_DECLARED
 /* 7 */
-EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((CONST char *fname,
-				int mode));
+EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
+#endif
+#ifndef TclUnixWaitForFile_TCL_DECLARED
+#define TclUnixWaitForFile_TCL_DECLARED
 /* 8 */
-EXTERN int		TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
-				int timeout));
+EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
+#endif
+#ifndef TclpCreateTempFile_TCL_DECLARED
+#define TclpCreateTempFile_TCL_DECLARED
 /* 9 */
-EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((CONST char *contents));
+EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
+#endif
+#ifndef TclpReaddir_TCL_DECLARED
+#define TclpReaddir_TCL_DECLARED
 /* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir _ANSI_ARGS_((DIR *dir));
+EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
+#endif
+#ifndef TclpLocaltime_unix_TCL_DECLARED
+#define TclpLocaltime_unix_TCL_DECLARED
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix _ANSI_ARGS_((
-				TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
+#endif
+#ifndef TclpGmtime_unix_TCL_DECLARED
+#define TclpGmtime_unix_TCL_DECLARED
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock));
+EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
+#endif
+#ifndef TclpInetNtoa_TCL_DECLARED
+#define TclpInetNtoa_TCL_DECLARED
 /* 13 */
-EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
-/* Slot 14 is reserved */
-/* Slot 15 is reserved */
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
-/* Slot 18 is reserved */
-/* Slot 19 is reserved */
+EXTERN char *		TclpInetNtoa(struct in_addr addr);
+#endif
+#ifndef TclUnixCopyFile_TCL_DECLARED
+#define TclUnixCopyFile_TCL_DECLARED
+/* 14 */
+EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
+				CONST Tcl_StatBuf *statBufPtr,
+				int dontCopyAtts);
+#endif
+#ifndef TclMacOSXGetFileAttribute_TCL_DECLARED
+#define TclMacOSXGetFileAttribute_TCL_DECLARED
+/* 15 */
+EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
+				int objIndex, Tcl_Obj *fileName,
+				Tcl_Obj **attributePtrPtr);
+#endif
+#ifndef TclMacOSXSetFileAttribute_TCL_DECLARED
+#define TclMacOSXSetFileAttribute_TCL_DECLARED
+/* 16 */
+EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
+				int objIndex, Tcl_Obj *fileName,
+				Tcl_Obj *attributePtr);
+#endif
+#ifndef TclMacOSXCopyFileAttributes_TCL_DECLARED
+#define TclMacOSXCopyFileAttributes_TCL_DECLARED
+/* 17 */
+EXTERN int		TclMacOSXCopyFileAttributes(CONST char *src,
+				CONST char *dst,
+				CONST Tcl_StatBuf *statBufPtr);
+#endif
+#ifndef TclMacOSXMatchType_TCL_DECLARED
+#define TclMacOSXMatchType_TCL_DECLARED
+/* 18 */
+EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
+				CONST char *pathName, CONST char *fileName,
+				Tcl_StatBuf *statBufPtr,
+				Tcl_GlobTypeData *types);
+#endif
+#ifndef TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
+#define TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
+/* 19 */
+EXTERN void		TclMacOSXNotifierAddRunLoopMode(
+				CONST VOID *runLoopMode);
+#endif
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
 /* Slot 22 is reserved */
@@ -221,9 +424,11 @@ EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
+#ifndef TclWinCPUID_TCL_DECLARED
+#define TclWinCPUID_TCL_DECLARED
 /* 29 */
-EXTERN int		TclWinCPUID _ANSI_ARGS_((unsigned int index,
-				unsigned int *regs));
+EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
+#endif
 #endif /* MACOSX */
 
 typedef struct TclIntPlatStubs {
@@ -231,21 +436,21 @@ typedef struct TclIntPlatStubs {
     struct TclIntPlatStubHooks *hooks;
 
 #if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-    void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 0 */
-    int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 1 */
-    Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 2 */
-    int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 3 */
-    int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 4 */
+    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
+    int (*tclpCloseFile) (TclFile file); /* 1 */
+    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
+    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
     VOID *reserved5;
-    TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */
-    TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 7 */
-    int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */
-    TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 9 */
-    Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR *dir)); /* 10 */
-    struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */
-    struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */
-    char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
-    VOID *reserved14;
+    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
+    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
+    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
+    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
+    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
+    struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
+    struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
+    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
+    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
     VOID *reserved15;
     VOID *reserved16;
     VOID *reserved17;
@@ -260,61 +465,61 @@ typedef struct TclIntPlatStubs {
     VOID *reserved26;
     VOID *reserved27;
     VOID *reserved28;
-    int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int *regs)); /* 29 */
+    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
 #endif /* UNIX */
 #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-    void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
-    void (*tclWinConvertWSAError) _ANSI_ARGS_((DWORD errCode)); /* 1 */
-    struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char *nm, CONST char *proto)); /* 2 */
-    int (*tclWinGetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, char *optval, int *optlen)); /* 3 */
-    HINSTANCE (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */
-    int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 5 */
-    unsigned short (*tclWinNToHS) _ANSI_ARGS_((unsigned short ns)); /* 6 */
-    int (*tclWinSetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, CONST char *optval, int optlen)); /* 7 */
-    int (*tclpGetPid) _ANSI_ARGS_((Tcl_Pid pid)); /* 8 */
-    int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */
-    Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR *dir)); /* 10 */
-    void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 11 */
-    int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 12 */
-    Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 13 */
-    int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 14 */
-    int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 15 */
-    int (*tclpIsAtty) _ANSI_ARGS_((int fd)); /* 16 */
-    VOID *reserved17;
-    TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */
-    TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 19 */
-    void (*tclWinAddProcess) _ANSI_ARGS_((HANDLE hProcess, DWORD id)); /* 20 */
-    char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 21 */
-    TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 22 */
-    char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */
-    char * (*tclWinNoBackslash) _ANSI_ARGS_((char *path)); /* 24 */
-    TclPlatformType * (*tclWinGetPlatform) _ANSI_ARGS_((void)); /* 25 */
-    void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */
-    void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */
-    void (*tclWinResetInterfaces) _ANSI_ARGS_((void)); /* 28 */
-    int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int *regs)); /* 29 */
+    void (*tclWinConvertError) (DWORD errCode); /* 0 */
+    void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
+    struct servent * (*tclWinGetServByName) (CONST char *nm, CONST char *proto); /* 2 */
+    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
+    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
+    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
+    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
+    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, CONST char *optval, int optlen); /* 7 */
+    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
+    int (*tclWinGetPlatformId) (void); /* 9 */
+    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
+    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
+    int (*tclpCloseFile) (TclFile file); /* 12 */
+    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
+    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
+    int (*tclpIsAtty) (int fd); /* 16 */
+    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
+    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
+    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */
+    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
+    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
+    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */
+    char * (*tclpGetTZName) (int isdst); /* 23 */
+    char * (*tclWinNoBackslash) (char *path); /* 24 */
+    VOID *reserved25;
+    void (*tclWinSetInterfaces) (int wide); /* 26 */
+    void (*tclWinFlushDirtyChannels) (void); /* 27 */
+    void (*tclWinResetInterfaces) (void); /* 28 */
+    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-    void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 0 */
-    int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 1 */
-    Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 2 */
-    int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 3 */
-    int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 4 */
+    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
+    int (*tclpCloseFile) (TclFile file); /* 1 */
+    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
+    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
     VOID *reserved5;
-    TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */
-    TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 7 */
-    int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */
-    TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 9 */
-    Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR *dir)); /* 10 */
-    struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */
-    struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */
-    char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
-    VOID *reserved14;
-    VOID *reserved15;
-    VOID *reserved16;
-    VOID *reserved17;
-    VOID *reserved18;
-    VOID *reserved19;
+    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
+    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
+    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
+    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
+    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
+    struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
+    struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
+    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
+    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
+    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
+    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
+    int (*tclMacOSXCopyFileAttributes) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr); /* 17 */
+    int (*tclMacOSXMatchType) (Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
+    void (*tclMacOSXNotifierAddRunLoopMode) (CONST VOID *runLoopMode); /* 19 */
     VOID *reserved20;
     VOID *reserved21;
     VOID *reserved22;
@@ -324,7 +529,7 @@ typedef struct TclIntPlatStubs {
     VOID *reserved26;
     VOID *reserved27;
     VOID *reserved28;
-    int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int *regs)); /* 29 */
+    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
 #endif /* MACOSX */
 } TclIntPlatStubs;
 
@@ -396,7 +601,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
 #endif
-/* Slot 14 is reserved */
+#ifndef TclUnixCopyFile
+#define TclUnixCopyFile \
+	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+#endif
 /* Slot 15 is reserved */
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
@@ -485,7 +693,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclpIsAtty \
 	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
 #endif
-/* Slot 17 is reserved */
+#ifndef TclUnixCopyFile
+#define TclUnixCopyFile \
+	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
+#endif
 #ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
@@ -514,10 +725,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclWinNoBackslash \
 	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
 #endif
-#ifndef TclWinGetPlatform
-#define TclWinGetPlatform \
-	(tclIntPlatStubsPtr->tclWinGetPlatform) /* 25 */
-#endif
+/* Slot 25 is reserved */
 #ifndef TclWinSetInterfaces
 #define TclWinSetInterfaces \
 	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
@@ -589,12 +797,30 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
 #endif
-/* Slot 14 is reserved */
-/* Slot 15 is reserved */
-/* Slot 16 is reserved */
-/* Slot 17 is reserved */
-/* Slot 18 is reserved */
-/* Slot 19 is reserved */
+#ifndef TclUnixCopyFile
+#define TclUnixCopyFile \
+	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+#endif
+#ifndef TclMacOSXGetFileAttribute
+#define TclMacOSXGetFileAttribute \
+	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
+#endif
+#ifndef TclMacOSXSetFileAttribute
+#define TclMacOSXSetFileAttribute \
+	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
+#endif
+#ifndef TclMacOSXCopyFileAttributes
+#define TclMacOSXCopyFileAttributes \
+	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
+#endif
+#ifndef TclMacOSXMatchType
+#define TclMacOSXMatchType \
+	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
+#endif
+#ifndef TclMacOSXNotifierAddRunLoopMode
+#define TclMacOSXNotifierAddRunLoopMode \
+	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
+#endif
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
 /* Slot 22 is reserved */
@@ -614,10 +840,15 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
 #undef TclpLocaltime_unix
 #undef TclpGmtime_unix
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__)
+#if defined(__WIN32__) || defined(__CYGWIN__)
+#   undef TclWinNToHS
+#   define TclWinNToHS ntohs
+#else
 #   undef TclpGetPid
 #   define TclpGetPid(pid) ((unsigned long) (pid))
 #endif
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 53686bd..058714f 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1,63 +1,67 @@
-/* 
+/*
  * tclInterp.c --
  *
- *	This file implements the "interp" command which allows creation
- *	and manipulation of Tcl interpreters from within Tcl scripts.
+ *	This file implements the "interp" command which allows creation and
+ *	manipulation of Tcl interpreters from within Tcl scripts.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2004 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
-#include <stdio.h>
-
+
 /*
- * Counter for how many aliases were created (global)
+ * A pointer to a string that holds an initialization script that if non-NULL
+ * is evaluated in Tcl_Init() prior to the built-in initialization script
+ * above. This variable can be modified by the function below.
  */
 
-static int aliasCounter = 0;
-TCL_DECLARE_MUTEX(cntMutex)
+static char *tclPreInitScript = NULL;
+
+/* Forward declaration */
+struct Target;
 
 /*
  * struct Alias:
  *
- * Stores information about an alias. Is stored in the slave interpreter
- * and used by the source command to find the target command in the master
- * when the source command is invoked.
+ * Stores information about an alias. Is stored in the slave interpreter and
+ * used by the source command to find the target command in the master when
+ * the source command is invoked.
  */
 
 typedef struct Alias {
-    Tcl_Obj *namePtr;		/* Name of alias command in slave interp. */
+    Tcl_Obj *token;		/* Token for the alias command in the slave
+				 * interp. This used to be the command name in
+				 * the slave when the alias was first
+				 * created. */
     Tcl_Interp *targetInterp;	/* Interp in which target command will be
 				 * invoked. */
-    Tcl_Command slaveCmd;	/* Source command in slave interpreter,
-				 * bound to command that invokes the target
-				 * command in the target interpreter. */
+    Tcl_Command slaveCmd;	/* Source command in slave interpreter, bound
+				 * to command that invokes the target command
+				 * in the target interpreter. */
     Tcl_HashEntry *aliasEntryPtr;
 				/* Entry for the alias hash table in slave.
-                                 * This is used by alias deletion to remove
-                                 * the alias from the slave interpreter
-                                 * alias table. */
-    Tcl_HashEntry *targetEntryPtr;
-				/* Entry for target command in master.
-                                 * This is used in the master interpreter to
-                                 * map back from the target command to aliases
-                                 * redirecting to it. Random access to this
-                                 * hash table is never required - we are using
-                                 * a hash table only for convenience. */
-    int objc;                   /* Count of Tcl_Obj in the prefix of the
-				 * target command to be invoked in the
-				 * target interpreter. Additional arguments
-				 * specified when calling the alias in the
-				 * slave interp will be appended to the prefix
-				 * before the command is invoked. */
-    Tcl_Obj *objPtr;            /* The first actual prefix object - the target
-				 * command name; this has to be at the end of the 
-				 * structure, which will be extended to accomodate 
-				 * the remaining objects in the prefix. */
+				 * This is used by alias deletion to remove
+				 * the alias from the slave interpreter alias
+				 * table. */
+    struct Target *targetPtr;	/* Entry for target command in master. This is
+				 * used in the master interpreter to map back
+				 * from the target command to aliases
+				 * redirecting to it. */
+    int objc;			/* Count of Tcl_Obj in the prefix of the
+				 * target command to be invoked in the target
+				 * interpreter. Additional arguments specified
+				 * when calling the alias in the slave interp
+				 * will be appended to the prefix before the
+				 * command is invoked. */
+    Tcl_Obj *objPtr;		/* The first actual prefix object - the target
+				 * command name; this has to be at the end of
+				 * the structure, which will be extended to
+				 * accomodate the remaining objects in the
+				 * prefix. */
 } Alias;
 
 /*
@@ -65,23 +69,23 @@ typedef struct Alias {
  * struct Slave:
  *
  * Used by the "interp" command to record and find information about slave
- * interpreters. Maps from a command name in the master to information about
- * a slave interpreter, e.g. what aliases are defined in it.
+ * interpreters. Maps from a command name in the master to information about a
+ * slave interpreter, e.g. what aliases are defined in it.
  */
 
 typedef struct Slave {
     Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */
     Tcl_HashEntry *slaveEntryPtr;
-				/* Hash entry in masters slave table for
-                                 * this slave interpreter.  Used to find
-                                 * this record, and used when deleting the
-                                 * slave interpreter to delete it from the
-                                 * master's table. */
+				/* Hash entry in masters slave table for this
+				 * slave interpreter. Used to find this
+				 * record, and used when deleting the slave
+				 * interpreter to delete it from the master's
+				 * table. */
     Tcl_Interp	*slaveInterp;	/* The slave interpreter. */
     Tcl_Command interpCmd;	/* Interpreter object command. */
-    Tcl_HashTable aliasTable;	/* Table which maps from names of commands
-                                 * in slave interpreter to struct Alias
-                                 * defined below. */
+    Tcl_HashTable aliasTable;	/* Table which maps from names of commands in
+				 * slave interpreter to struct Alias defined
+				 * below. */
 } Slave;
 
 /*
@@ -92,43 +96,47 @@ typedef struct Slave {
  * interpreters and must be deleted when the target interpreter is deleted. In
  * case they would not be deleted the source interpreter would be left with a
  * "dangling pointer". One such record is stored in the Master record of the
- * master interpreter (in the targetTable hashtable, see below) with the
- * master for each alias which directs to a command in the master. These
- * records are used to remove the source command for an from a slave if/when
- * the master is deleted.
+ * master interpreter with the master for each alias which directs to a
+ * command in the master. These records are used to remove the source command
+ * for an from a slave if/when the master is deleted. They are organized in a
+ * doubly-linked list attached to the master interpreter.
  */
 
 typedef struct Target {
     Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */
     Tcl_Interp *slaveInterp;	/* Slave Interpreter. */
+    struct Target *nextPtr;	/* Next in list of target records, or NULL if
+				 * at the end of the list of targets. */
+    struct Target *prevPtr;	/* Previous in list of target records, or NULL
+				 * if at the start of the list of targets. */
 } Target;
 
 /*
  * struct Master:
  *
- * This record is used for two purposes: First, slaveTable (a hashtable)
- * maps from names of commands to slave interpreters. This hashtable is
- * used to store information about slave interpreters of this interpreter,
- * to map over all slaves, etc. The second purpose is to store information
- * about all aliases in slaves (or siblings) which direct to target commands
- * in this interpreter (using the targetTable hashtable).
- * 
- * NB: the flags field in the interp structure, used with SAFE_INTERP
- * mask denotes whether the interpreter is safe or not. Safe
- * interpreters have restricted functionality, can only create safe slave
- * interpreters and can only load safe extensions.
+ * This record is used for two purposes: First, slaveTable (a hashtable) maps
+ * from names of commands to slave interpreters. This hashtable is used to
+ * store information about slave interpreters of this interpreter, to map over
+ * all slaves, etc. The second purpose is to store information about all
+ * aliases in slaves (or siblings) which direct to target commands in this
+ * interpreter (using the targetsPtr doubly-linked list).
+ *
+ * NB: the flags field in the interp structure, used with SAFE_INTERP mask
+ * denotes whether the interpreter is safe or not. Safe interpreters have
+ * restricted functionality, can only create safe slave interpreters and can
+ * only load safe extensions.
  */
 
 typedef struct Master {
-    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.
-                                 * Maps from command names to Slave records. */
-    Tcl_HashTable targetTable;	/* Hash table for Target Records. Contains
-                                 * all Target records which denote aliases
-                                 * from slaves or sibling interpreters that
-                                 * direct to commands in this interpreter. This
-                                 * table is used to remove dangling pointers
-                                 * from the slave (or sibling) interpreters
-                                 * when this interpreter is deleted. */
+    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters. Maps
+				 * from command names to Slave records. */
+    Target *targetsPtr;		/* The head of a doubly-linked list of all the
+				 * target records which denote aliases from
+				 * slaves or sibling interpreters that direct
+				 * to commands in this interpreter. This list
+				 * is used to remove dangling pointers from
+				 * the slave (or sibling) interpreters when
+				 * this interpreter is deleted. */
 } Master;
 
 /*
@@ -144,67 +152,268 @@ typedef struct InterpInfo {
 } InterpInfo;
 
 /*
- * Prototypes for local static procedures:
+ * Limit callbacks handled by scripts are modelled as structures which are
+ * stored in hashes indexed by a two-word key. Note that the type of the
+ * 'type' field in the key is not int; this is to make sure that things are
+ * likely to work properly on 64-bit architectures.
+ */
+
+typedef struct ScriptLimitCallback {
+    Tcl_Interp *interp;		/* The interpreter in which to execute the
+				 * callback. */
+    Tcl_Obj *scriptObj;		/* The script to execute to perform the
+				 * user-defined part of the callback. */
+    int type;			/* What kind of callback is this. */
+    Tcl_HashEntry *entryPtr;	/* The entry in the hash table maintained by
+				 * the target interpreter that refers to this
+				 * callback record, or NULL if the entry has
+				 * already been deleted from that hash
+				 * table. */
+} ScriptLimitCallback;
+
+typedef struct ScriptLimitCallbackKey {
+    Tcl_Interp *interp;		/* The interpreter that the limit callback was
+				 * attached to. This is not the interpreter
+				 * that the callback runs in! */
+    long type;			/* The type of callback that this is. */
+} ScriptLimitCallbackKey;
+
+/*
+ * Prototypes for local static functions:
  */
 
-static int		AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
+static int		AliasCreate(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
 			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));
-static int		AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));
-static int		AliasList _ANSI_ARGS_((Tcl_Interp *interp,
-		            Tcl_Interp *slaveInterp));
-static int		AliasObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static int		AliasDelete(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
+static int		AliasDescribe(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
+static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
+static int		AliasObjCmd(ClientData dummy,
 			    Tcl_Interp *currentInterp, int objc,
-		            Tcl_Obj *CONST objv[]));
-static void		AliasObjCmdDeleteProc _ANSI_ARGS_((
-			    ClientData clientData));
-
-static Tcl_Interp *	GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr));
-static Tcl_Interp *	GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static void		InterpInfoDeleteProc _ANSI_ARGS_((
-			    ClientData clientData, Tcl_Interp *interp));
-static Tcl_Interp *	SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,
-		            Tcl_Obj *pathPtr, int safe));
-static int		SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *const objv[]);
+static void		AliasObjCmdDeleteProc(ClientData clientData);
+static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static void		InterpInfoDeleteProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		SlaveBgerror(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *const objv[]);
+static Tcl_Interp *	SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+			    int safe);
+static int		SlaveDebugCmd(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SlaveExpose(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *const objv[]);
+static int		SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SlaveHidden(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp);
+static int		SlaveInvokeHidden(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp,
+			    const char *namespaceName,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SlaveMarkTrusted(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp);
+static int		SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static void		SlaveObjCmdDeleteProc(ClientData clientData);
+static int		SlaveRecursionLimit(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp));
-static int		SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp, int global, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp));
-static int		SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static void		SlaveObjCmdDeleteProc _ANSI_ARGS_((
-			    ClientData clientData));
-static int		SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp, int objc,
-			    Tcl_Obj *CONST objv[]));
+			    Tcl_Obj *const objv[]);
+static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp, int consumedObjc,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SlaveTimeLimitCmd(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp, int consumedObjc,
+			    int objc, Tcl_Obj *const objv[]);
+static void		InheritLimitsFromMaster(Tcl_Interp *slaveInterp,
+			    Tcl_Interp *masterInterp);
+static void		SetScriptLimitCallback(Tcl_Interp *interp, int type,
+			    Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
+static void		CallScriptLimitCallback(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		DeleteScriptLimitCallback(ClientData clientData);
+static void		RunLimitHandlers(LimitHandler *handlerPtr,
+			    Tcl_Interp *interp);
+static void		TimeLimitCallback(ClientData clientData);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetPreInitScript --
+ *
+ *	This routine is used to change the value of the internal variable,
+ *	tclPreInitScript.
+ *
+ * Results:
+ *	Returns the current value of tclPreInitScript.
+ *
+ * Side effects:
+ *	Changes the way Tcl_Init() routine behaves.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclSetPreInitScript(
+    char *string)		/* Pointer to a script. */
+{
+    char *prevString = tclPreInitScript;
+    tclPreInitScript = string;
+    return(prevString);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ *	This function is typically invoked by Tcl_AppInit functions to find
+ *	and source the "init.tcl" script, which should exist somewhere on the
+ *	Tcl library path.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets the interp's result if
+ *	there is an error.
+ *
+ * Side effects:
+ *	Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(
+    Tcl_Interp *interp)		/* Interpreter to initialize. */
+{
+    if (tclPreInitScript != NULL) {
+	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+	    return (TCL_ERROR);
+	};
+    }
+
+    /*
+     * In order to find init.tcl during initialization, the following script
+     * is invoked by Tcl_Init(). It looks in several different directories:
+     *
+     *	$tcl_library		- can specify a primary location, if set, no
+     *				  other locations will be checked. This is the
+     *				  recommended way for a program that embeds
+     *				  Tcl to specifically tell Tcl where to find
+     *				  an init.tcl file.
+     *
+     *	$env(TCL_LIBRARY)	- highest priority so user can always override
+     *				  the search path unless the application has
+     *				  specified an exact directory above
+     *
+     *	$tclDefaultLibrary	- INTERNAL: This variable is set by Tcl on
+     *				  those platforms where it can determine at
+     *				  runtime the directory where it expects the
+     *				  init.tcl file to be. After [tclInit] reads
+     *				  and uses this value, it [unset]s it.
+     *				  External users of Tcl should not make use of
+     *				  the variable to customize [tclInit].
+     *
+     *	$tcl_libPath		- OBSOLETE: This variable is no longer set by
+     *				  Tcl itself, but [tclInit] examines it in
+     *				  case some program that embeds Tcl is
+     *				  customizing [tclInit] by setting this
+     *				  variable to a list of directories in which
+     *				  to search.
+     *
+     *	[tcl::pkgconfig get scriptdir,runtime]
+     *				- the directory determined by configure to be
+     *				  the place where Tcl's script library is to
+     *				  be installed.
+     *
+     * The first directory on this path that contains a valid init.tcl script
+     * will be set as the value of tcl_library.
+     *
+     * Note that this entire search mechanism can be bypassed by defining an
+     * alternate tclInit command before calling Tcl_Init().
+     */
 
+    return Tcl_Eval(interp,
+"if {[namespace which -command tclInit] eq \"\"} {\n"
+"  proc tclInit {} {\n"
+"    global tcl_libPath tcl_library env tclDefaultLibrary\n"
+"    rename tclInit {}\n"
+"    if {[info exists tcl_library]} {\n"
+"	set scripts {{set tcl_library}}\n"
+"    } else {\n"
+"	set scripts {}\n"
+"	if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
+"	    lappend scripts {set env(TCL_LIBRARY)}\n"
+"	    lappend scripts {\n"
+"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
+"if {$tail eq [info tclversion]} continue\n"
+"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
+"	}\n"
+"	if {[info exists tclDefaultLibrary]} {\n"
+"	    lappend scripts {set tclDefaultLibrary}\n"
+"	} else {\n"
+"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
+"	}\n"
+"	lappend scripts {\n"
+"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
+"set grandParentDir [file dirname $parentDir]\n"
+"file join $parentDir lib tcl[info tclversion]} \\\n"
+"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
+"	{file join $parentDir library} \\\n"
+"	{file join $grandParentDir library} \\\n"
+"	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
+"	{\n"
+"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
+"	if {[info exists tcl_libPath]\n"
+"		&& [catch {llength $tcl_libPath} len] == 0} {\n"
+"	    for {set i 0} {$i < $len} {incr i} {\n"
+"		lappend scripts [list lindex \\$tcl_libPath $i]\n"
+"	    }\n"
+"	}\n"
+"    }\n"
+"    set dirs {}\n"
+"    set errors {}\n"
+"    foreach script $scripts {\n"
+"	lappend dirs [eval $script]\n"
+"	set tcl_library [lindex $dirs end]\n"
+"	set tclfile [file join $tcl_library init.tcl]\n"
+"	if {[file exists $tclfile]} {\n"
+"	    if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
+"		append errors \"$tclfile: $msg\n\"\n"
+"		append errors \"[dict get $opts -errorinfo]\n\"\n"
+"		continue\n"
+"	    }\n"
+"	    unset -nocomplain tclDefaultLibrary\n"
+"	    return\n"
+"	}\n"
+"    }\n"
+"    unset -nocomplain tclDefaultLibrary\n"
+"    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
+"    append msg \"    $dirs\n\n\"\n"
+"    append msg \"$errors\n\n\"\n"
+"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
+"    error $msg\n"
+"  }\n"
+"}\n"
+"tclInit");
+}
 
 /*
  *---------------------------------------------------------------------------
  *
  * TclInterpInit --
  *
- *	Initializes the invoking interpreter for using the master, slave
- *	and safe interp facilities.  This is called from inside
- *	Tcl_CreateInterp().
+ *	Initializes the invoking interpreter for using the master, slave and
+ *	safe interp facilities. This is called from inside Tcl_CreateInterp().
  *
  * Results:
  *	Always returns TCL_OK for backwards compatibility.
@@ -217,19 +426,19 @@ static int		SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
  */
 
 int
-TclInterpInit(interp)
-    Tcl_Interp *interp;			/* Interpreter to initialize. */
+TclInterpInit(
+    Tcl_Interp *interp)		/* Interpreter to initialize. */
 {
     InterpInfo *interpInfoPtr;
     Master *masterPtr;
-    Slave *slavePtr;	
+    Slave *slavePtr;
 
     interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
-    ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;
+    ((Interp *) interp)->interpInfo = interpInfoPtr;
 
     masterPtr = &interpInfoPtr->master;
     Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
-    Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);
+    masterPtr->targetsPtr = NULL;
 
     slavePtr = &interpInfoPtr->slave;
     slavePtr->masterInterp	= NULL;
@@ -249,30 +458,27 @@ TclInterpInit(interp)
  *
  * InterpInfoDeleteProc --
  *
- *	Invoked when an interpreter is being deleted.  It releases all
- *	storage used by the master/slave/safe interpreter facilities.
+ *	Invoked when an interpreter is being deleted. It releases all storage
+ *	used by the master/slave/safe interpreter facilities.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Cleans up storage.  Sets the interpInfoPtr field of the interp
- *	to NULL.
+ *	Cleans up storage. Sets the interpInfoPtr field of the interp to NULL.
  *
  *---------------------------------------------------------------------------
  */
 
 static void
-InterpInfoDeleteProc(clientData, interp)
-    ClientData clientData;	/* Ignored. */
-    Tcl_Interp *interp;		/* Interp being deleted.  All commands for
+InterpInfoDeleteProc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp)		/* Interp being deleted. All commands for
 				 * slave interps should already be deleted. */
 {
     InterpInfo *interpInfoPtr;
     Slave *slavePtr;
     Master *masterPtr;
-    Tcl_HashSearch hSearch;
-    Tcl_HashEntry *hPtr;
     Target *targetPtr;
 
     interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
@@ -283,36 +489,34 @@ InterpInfoDeleteProc(clientData, interp)
 
     masterPtr = &interpInfoPtr->master;
     if (masterPtr->slaveTable.numEntries != 0) {
-	panic("InterpInfoDeleteProc: still exist commands");
+	Tcl_Panic("InterpInfoDeleteProc: still exist commands");
     }
     Tcl_DeleteHashTable(&masterPtr->slaveTable);
 
     /*
      * Tell any interps that have aliases to this interp that they should
-     * delete those aliases.  If the other interp was already dead, it
-     * would have removed the target record already. 
+     * delete those aliases. If the other interp was already dead, it would
+     * have removed the target record already.
      */
 
-    hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);
-    while (hPtr != NULL) {
-	targetPtr = (Target *) Tcl_GetHashValue(hPtr);
+    for (targetPtr = masterPtr->targetsPtr; targetPtr != NULL; ) {
+	Target *tmpPtr = targetPtr->nextPtr;
 	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
 		targetPtr->slaveCmd);
-	hPtr = Tcl_NextHashEntry(&hSearch);
+	targetPtr = tmpPtr;
     }
-    Tcl_DeleteHashTable(&masterPtr->targetTable);
 
     slavePtr = &interpInfoPtr->slave;
     if (slavePtr->interpCmd != NULL) {
 	/*
-	 * Tcl_DeleteInterp() was called on this interpreter, rather
-	 * "interp delete" or the equivalent deletion of the command in the
-	 * master.  First ensure that the cleanup callback doesn't try to
-	 * delete the interp again.
+	 * Tcl_DeleteInterp() was called on this interpreter, rather "interp
+	 * delete" or the equivalent deletion of the command in the master.
+	 * First ensure that the cleanup callback doesn't try to delete the
+	 * interp again.
 	 */
 
 	slavePtr->slaveInterp = NULL;
-        Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
+	Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
 		slavePtr->interpCmd);
     }
 
@@ -321,11 +525,11 @@ InterpInfoDeleteProc(clientData, interp)
      */
 
     if (slavePtr->aliasTable.numEntries != 0) {
-	panic("InterpInfoDeleteProc: still exist aliases");
+	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
     }
     Tcl_DeleteHashTable(&slavePtr->aliasTable);
 
-    ckfree((char *) interpInfoPtr);    
+    ckfree((char *) interpInfoPtr);
 }
 
 /*
@@ -333,8 +537,8 @@ InterpInfoDeleteProc(clientData, interp)
  *
  * Tcl_InterpObjCmd --
  *
- *	This procedure is invoked to process the "interp" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "interp" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -346,430 +550,472 @@ InterpInfoDeleteProc(clientData, interp)
  */
 	/* ARGSUSED */
 int
-Tcl_InterpObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Unused. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_InterpObjCmd(
+    ClientData clientData,		/* Unused. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *const objv[])		/* Argument objects. */
 {
     int index;
-    static CONST char *options[] = {
-        "alias",	"aliases",	"create",	"delete", 
-	"eval",		"exists",	"expose",	"hide", 
-	"hidden",	"issafe",	"invokehidden",	"marktrusted", 
-	"recursionlimit",		"slaves",	"share",
-	"target",	"transfer",
-        NULL
+    static const char *options[] = {
+	"alias",	"aliases",	"bgerror",	"create",
+	"debug",	"delete",	"eval",		"exists",	"expose",
+	"hide",		"hidden",	"issafe",	"invokehidden",
+	"limit",	"marktrusted",	"recursionlimit","slaves",
+	"share",	"target",	"transfer",
+	NULL
     };
     enum option {
-	OPT_ALIAS,	OPT_ALIASES,	OPT_CREATE,	OPT_DELETE,
-	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
-	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_MARKTRUSTED,
-	OPT_RECLIMIT,			OPT_SLAVES,	OPT_SHARE,
-	OPT_TARGET,	OPT_TRANSFER
+	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CREATE,
+	OPT_DEBUG,	OPT_DELETE,	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,
+	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
+	OPT_LIMIT,	OPT_MARKTRUSTED,OPT_RECLIMIT,	OPT_SLAVES,
+	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
     };
 
-
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
+	return TCL_ERROR;
     }
-    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
 	    &index) != TCL_OK) {
 	return TCL_ERROR;
     }
     switch ((enum option) index) {
-	case OPT_ALIAS: {
-	    Tcl_Interp *slaveInterp, *masterInterp;
+    case OPT_ALIAS: {
+	Tcl_Interp *slaveInterp, *masterInterp;
 
-	    if (objc < 4) {
-		aliasArgs:
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == (Tcl_Interp *) NULL) {
+	if (objc < 4) {
+	aliasArgs:
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	if (objc == 4) {
+	    return AliasDescribe(interp, slaveInterp, objv[3]);
+	}
+	if ((objc == 5) && (TclGetString(objv[4])[0] == '\0')) {
+	    return AliasDelete(interp, slaveInterp, objv[3]);
+	}
+	if (objc > 5) {
+	    masterInterp = GetInterp(interp, objv[4]);
+	    if (masterInterp == NULL) {
 		return TCL_ERROR;
 	    }
-	    if (objc == 4) {
-		return AliasDescribe(interp, slaveInterp, objv[3]);
-	    }
-	    if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {
-		return AliasDelete(interp, slaveInterp, objv[3]);
-	    }
-	    if (objc > 5) {
-		masterInterp = GetInterp(interp, objv[4]);
-		if (masterInterp == (Tcl_Interp *) NULL) {
-		    return TCL_ERROR;
-		}
-		if (Tcl_GetString(objv[5])[0] == '\0') {
-		    if (objc == 6) {
-			return AliasDelete(interp, slaveInterp, objv[3]);
-		    }
-		} else {
-		    return AliasCreate(interp, slaveInterp, masterInterp,
-			    objv[3], objv[5], objc - 6, objv + 6);
+	    if (TclGetString(objv[5])[0] == '\0') {
+		if (objc == 6) {
+		    return AliasDelete(interp, slaveInterp, objv[3]);
 		}
+	    } else {
+		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
+			objv[5], objc - 6, objv + 6);
 	    }
-	    goto aliasArgs;
 	}
-	case OPT_ALIASES: {
-	    Tcl_Interp *slaveInterp;
+	goto aliasArgs;
+    }
+    case OPT_ALIASES: {
+	Tcl_Interp *slaveInterp;
 
-	    slaveInterp = GetInterp2(interp, objc, objv);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    return AliasList(interp, slaveInterp);
-	}
-	case OPT_CREATE: {
-	    int i, last, safe;
-	    Tcl_Obj *slavePtr;
-	    char buf[16 + TCL_INTEGER_SPACE];
-	    static CONST char *options[] = {
-		"-safe",	"--",		NULL
-	    };
-	    enum option {
-		OPT_SAFE,	OPT_LAST
-	    };
-
-	    safe = Tcl_IsSafe(interp);
-	    
-	    /*
-	     * Weird historical rules: "-safe" is accepted at the end, too.
-	     */
+	slaveInterp = GetInterp2(interp, objc, objv);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return AliasList(interp, slaveInterp);
+    }
+    case OPT_BGERROR: {
+	Tcl_Interp *slaveInterp;
 
-	    slavePtr = NULL;
-	    last = 0;
-	    for (i = 2; i < objc; i++) {
-		if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
-		    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
-			    0, &index) != TCL_OK) {
-			return TCL_ERROR;
-		    }
-		    if (index == OPT_SAFE) {
-			safe = 1;
-			continue;
-		    }
-		    i++;
-		    last = 1;
-		}
-		if (slavePtr != NULL) {
-		    Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
+	if (objc != 3 && objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_CREATE: {
+	int i, last, safe;
+	Tcl_Obj *slavePtr;
+	char buf[16 + TCL_INTEGER_SPACE];
+	static const char *options[] = {
+	    "-safe",	"--", NULL
+	};
+	enum option {
+	    OPT_SAFE,	OPT_LAST
+	};
+
+	safe = Tcl_IsSafe(interp);
+
+	/*
+	 * Weird historical rules: "-safe" is accepted at the end, too.
+	 */
+
+	slavePtr = NULL;
+	last = 0;
+	for (i = 2; i < objc; i++) {
+	    if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+			&index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (i < objc) {
-		    slavePtr = objv[i];
-		}
-	    }
-	    buf[0] = '\0';
-	    if (slavePtr == NULL) {
-		/*
-		 * Create an anonymous interpreter -- we choose its name and
-		 * the name of the command. We check that the command name
-		 * that we use for the interpreter does not collide with an
-		 * existing command in the master interpreter.
-		 */
-		
-		for (i = 0; ; i++) {
-		    Tcl_CmdInfo cmdInfo;
-		    
-		    sprintf(buf, "interp%d", i);
-		    if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
-			break;
-		    }
+		if (index == OPT_SAFE) {
+		    safe = 1;
+		    continue;
 		}
-		slavePtr = Tcl_NewStringObj(buf, -1);
+		i++;
+		last = 1;
 	    }
-	    if (SlaveCreate(interp, slavePtr, safe) == NULL) {
-		if (buf[0] != '\0') {
-		    Tcl_DecrRefCount(slavePtr);
-		}
+	    if (slavePtr != NULL) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
 		return TCL_ERROR;
 	    }
-	    Tcl_SetObjResult(interp, slavePtr);
-	    return TCL_OK;
-	}
-	case OPT_DELETE: {
-	    int i;
-	    InterpInfo *iiPtr;
-	    Tcl_Interp *slaveInterp;
-	    
-	    for (i = 2; i < objc; i++) {
-		slaveInterp = GetInterp(interp, objv[i]);
-		if (slaveInterp == NULL) {
-		    return TCL_ERROR;
-		} else if (slaveInterp == interp) {
-		    Tcl_ResetResult(interp);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "cannot delete the current interpreter",
-			    (char *) NULL);
-		    return TCL_ERROR;
-		}
-		iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
-		Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
-			iiPtr->slave.interpCmd);
+	    if (i < objc) {
+		slavePtr = objv[i];
 	    }
-	    return TCL_OK;
 	}
-	case OPT_EVAL: {
-	    Tcl_Interp *slaveInterp;
+	buf[0] = '\0';
+	if (slavePtr == NULL) {
+	    /*
+	     * Create an anonymous interpreter -- we choose its name and the
+	     * name of the command. We check that the command name that we use
+	     * for the interpreter does not collide with an existing command
+	     * in the master interpreter.
+	     */
 
-	    if (objc < 4) {
-		Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
-		return TCL_ERROR;
+	    for (i = 0; ; i++) {
+		Tcl_CmdInfo cmdInfo;
+
+		sprintf(buf, "interp%d", i);
+		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
+		    break;
+		}
 	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
+	    slavePtr = Tcl_NewStringObj(buf, -1);
+	}
+	if (SlaveCreate(interp, slavePtr, safe) == NULL) {
+	    if (buf[0] != '\0') {
+		Tcl_DecrRefCount(slavePtr);
 	    }
-	    return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
+	    return TCL_ERROR;
 	}
-	case OPT_EXISTS: {
-	    int exists;
-	    Tcl_Interp *slaveInterp;
+	Tcl_SetObjResult(interp, slavePtr);
+	return TCL_OK;
+    }
+    case OPT_DEBUG: {
+	/* TIP #378 */
+	Tcl_Interp *slaveInterp;
 
-	    exists = 1;
-	    slaveInterp = GetInterp2(interp, objc, objv);
-	    if (slaveInterp == NULL) {
-		if (objc > 3) {
-		    return TCL_ERROR;
-		}
-		Tcl_ResetResult(interp);
-		exists = 0;
-	    }
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), exists);
-	    return TCL_OK;
+	/*
+	 * Currently only -frame supported, otherwise ?-option ?value??
+	 */
+	if (objc < 3 || objc > 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
 	}
-	case OPT_EXPOSE: {
-	    Tcl_Interp *slaveInterp;
+	return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_DELETE: {
+	int i;
+	InterpInfo *iiPtr;
+	Tcl_Interp *slaveInterp;
 
-	    if ((objc < 4) || (objc > 5)) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"path hiddenCmdName ?cmdName?");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
+	for (i = 2; i < objc; i++) {
+	    slaveInterp = GetInterp(interp, objv[i]);
 	    if (slaveInterp == NULL) {
 		return TCL_ERROR;
+	    } else if (slaveInterp == interp) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot delete the current interpreter", -1));
+		return TCL_ERROR;
 	    }
-	    return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
+	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+	    Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
+		    iiPtr->slave.interpCmd);
 	}
-	case OPT_HIDE: {
-	    Tcl_Interp *slaveInterp;		/* A slave. */
+	return TCL_OK;
+    }
+    case OPT_EVAL: {
+	Tcl_Interp *slaveInterp;
 
-	    if ((objc < 4) || (objc > 5)) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"path cmdName ?hiddenCmdName?");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == (Tcl_Interp *) NULL) {
+	if (objc < 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_EXISTS: {
+	int exists;
+	Tcl_Interp *slaveInterp;
+
+	exists = 1;
+	slaveInterp = GetInterp2(interp, objc, objv);
+	if (slaveInterp == NULL) {
+	    if (objc > 3) {
 		return TCL_ERROR;
 	    }
-	    return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
+	    Tcl_ResetResult(interp);
+	    exists = 0;
 	}
-	case OPT_HIDDEN: {
-	    Tcl_Interp *slaveInterp;		/* A slave. */
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
+	return TCL_OK;
+    }
+    case OPT_EXPOSE: {
+	Tcl_Interp *slaveInterp;
 
-	    slaveInterp = GetInterp2(interp, objc, objv);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    return SlaveHidden(interp, slaveInterp);
+	if ((objc < 4) || (objc > 5)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
 	}
-	case OPT_ISSAFE: {
-	    Tcl_Interp *slaveInterp;
+	return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_HIDE: {
+	Tcl_Interp *slaveInterp;		/* A slave. */
 
-	    slaveInterp = GetInterp2(interp, objc, objv);
-	    if (slaveInterp == NULL) {
+	if ((objc < 4) || (objc > 5)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_HIDDEN: {
+	Tcl_Interp *slaveInterp;		/* A slave. */
+
+	slaveInterp = GetInterp2(interp, objc, objv);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveHidden(interp, slaveInterp);
+    }
+    case OPT_ISSAFE: {
+	Tcl_Interp *slaveInterp;
+
+	slaveInterp = GetInterp2(interp, objc, objv);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
+	return TCL_OK;
+    }
+    case OPT_INVOKEHID: {
+	int i, index;
+	const char *namespaceName;
+	Tcl_Interp *slaveInterp;
+	static const char *hiddenOptions[] = {
+	    "-global",	"-namespace",	"--", NULL
+	};
+	enum hiddenOption {
+	    OPT_GLOBAL,	OPT_NAMESPACE,	OPT_LAST
+	};
+
+	namespaceName = NULL;
+	for (i = 3; i < objc; i++) {
+	    if (TclGetString(objv[i])[0] != '-') {
+		break;
+	    }
+	    if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
+		    0, &index) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
-	    return TCL_OK;
-	}
-	case OPT_INVOKEHID: {
-	    int i, index, global;
-	    Tcl_Interp *slaveInterp;
-	    static CONST char *hiddenOptions[] = {
-		"-global",	"--",		NULL
-	    };
-	    enum hiddenOption {
-		OPT_GLOBAL,	OPT_LAST
-	    };
-
-	    global = 0;
-	    for (i = 3; i < objc; i++) {
-		if (Tcl_GetString(objv[i])[0] != '-') {
+	    if (index == OPT_GLOBAL) {
+		namespaceName = "::";
+	    } else if (index == OPT_NAMESPACE) {
+		if (++i == objc) { /* There must be more arguments. */
 		    break;
-		}
-		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
-			"option", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (index == OPT_GLOBAL) {
-		    global = 1;
 		} else {
-		    i++;
-		    break;
+		    namespaceName = TclGetString(objv[i]);
 		}
+	    } else {
+		i++;
+		break;
 	    }
-	    if (objc - i < 1) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"path ?-global? ?--? cmd ?arg ..?");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == (Tcl_Interp *) NULL) {
-		return TCL_ERROR;
-	    }
-	    return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
-		    objv + i);
 	}
-	case OPT_MARKTRUSTED: {
-	    Tcl_Interp *slaveInterp;
+	if (objc - i < 1) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "path ?-namespace ns? ?-global? ?--? cmd ?arg ..?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i,
+		objv + i);
+    }
+    case OPT_LIMIT: {
+	Tcl_Interp *slaveInterp;
+	static const char *limitTypes[] = {
+	    "commands", "time", NULL
+	};
+	enum LimitTypes {
+	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
+	};
+	int limitType;
+
+	if (objc < 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0,
+		&limitType) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum LimitTypes) limitType) {
+	case LIMIT_TYPE_COMMANDS:
+	    return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv);
+	case LIMIT_TYPE_TIME:
+	    return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
+	}
+    }
+    case OPT_MARKTRUSTED: {
+	Tcl_Interp *slaveInterp;
 
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "path");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    return SlaveMarkTrusted(interp, slaveInterp);
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
 	}
-	case OPT_RECLIMIT: {
-	    Tcl_Interp *slaveInterp;
+	return SlaveMarkTrusted(interp, slaveInterp);
+    }
+    case OPT_RECLIMIT: {
+	Tcl_Interp *slaveInterp;
 
-	    if (objc != 3 && objc != 4) {
-		Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
-	}
-	case OPT_SLAVES: {
-	    Tcl_Interp *slaveInterp;
-	    InterpInfo *iiPtr;
-	    Tcl_Obj *resultPtr;
-	    Tcl_HashEntry *hPtr;
-	    Tcl_HashSearch hashSearch;
-	    char *string;
-	    
-	    slaveInterp = GetInterp2(interp, objc, objv);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
-	    resultPtr = Tcl_GetObjResult(interp);
-	    hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
-	    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
-		string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
-		Tcl_ListObjAppendElement(NULL, resultPtr,
-			Tcl_NewStringObj(string, -1));
-	    }
-	    return TCL_OK;
+	if (objc != 3 && objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
 	}
-	case OPT_SHARE: {
-	    Tcl_Interp *slaveInterp;		/* A slave. */
-	    Tcl_Interp *masterInterp;		/* Its master. */
-	    Tcl_Channel chan;
+	return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
+    }
+    case OPT_SLAVES: {
+	Tcl_Interp *slaveInterp;
+	InterpInfo *iiPtr;
+	Tcl_Obj *resultPtr;
+	Tcl_HashEntry *hPtr;
+	Tcl_HashSearch hashSearch;
+	char *string;
 
-	    if (objc != 5) {
-		Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
-		return TCL_ERROR;
-	    }
-	    masterInterp = GetInterp(interp, objv[2]);
-	    if (masterInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]),
-		    NULL);
-	    if (chan == NULL) {
-		TclTransferResult(masterInterp, TCL_OK, interp);
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[4]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    Tcl_RegisterChannel(slaveInterp, chan);
-	    return TCL_OK;
+	slaveInterp = GetInterp2(interp, objc, objv);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+	resultPtr = Tcl_NewObj();
+	hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
+	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
+	    string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
+	    Tcl_ListObjAppendElement(NULL, resultPtr,
+		    Tcl_NewStringObj(string, -1));
 	}
-	case OPT_TARGET: {
-	    Tcl_Interp *slaveInterp;
-	    InterpInfo *iiPtr;
-	    Tcl_HashEntry *hPtr;	
-	    Alias *aliasPtr;		
-	    char *aliasName;
+	Tcl_SetObjResult(interp, resultPtr);
+	return TCL_OK;
+    }
+    case OPT_TRANSFER:
+    case OPT_SHARE: {
+	Tcl_Interp *slaveInterp;		/* A slave. */
+	Tcl_Interp *masterInterp;		/* Its master. */
+	Tcl_Channel chan;
+
+	if (objc != 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
+	    return TCL_ERROR;
+	}
+	masterInterp = GetInterp(interp, objv[2]);
+	if (masterInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
+	if (chan == NULL) {
+	    TclTransferResult(masterInterp, TCL_OK, interp);
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[4]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_RegisterChannel(slaveInterp, chan);
+	if (index == OPT_TRANSFER) {
+	    /*
+	     * When transferring, as opposed to sharing, we must unhitch the
+	     * channel from the interpreter where it started.
+	     */
 
-	    if (objc != 4) {
-		Tcl_WrongNumArgs(interp, 2, objv, "path alias");
+	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
+		TclTransferResult(masterInterp, TCL_OK, interp);
 		return TCL_ERROR;
 	    }
+	}
+	return TCL_OK;
+    }
+    case OPT_TARGET: {
+	Tcl_Interp *slaveInterp;
+	InterpInfo *iiPtr;
+	Tcl_HashEntry *hPtr;
+	Alias *aliasPtr;
+	char *aliasName;
+
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path alias");
+	    return TCL_ERROR;
+	}
 
-	    slaveInterp = GetInterp(interp, objv[2]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
 
-	    aliasName = Tcl_GetString(objv[3]);
+	aliasName = TclGetString(objv[3]);
 
-	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
-	    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
-	    if (hPtr == NULL) {
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"alias \"", aliasName, "\" in path \"",
-			Tcl_GetString(objv[2]), "\" not found",
-			(char *) NULL);
-		return TCL_ERROR;
-	    }
-	    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-	    if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"target interpreter for alias \"", aliasName,
-			"\" in path \"", Tcl_GetString(objv[2]),
-			"\" is not my descendant", (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    return TCL_OK;
+	iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+	hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+	if (hPtr == NULL) {
+	    Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"",
+		    Tcl_GetString(objv[2]), "\" not found", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
+		    NULL);
+	    return TCL_ERROR;
 	}
-	case OPT_TRANSFER: {
-	    Tcl_Interp *slaveInterp;		/* A slave. */
-	    Tcl_Interp *masterInterp;		/* Its master. */
-	    Tcl_Channel chan;
-		    
-	    if (objc != 5) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"srcPath channelId destPath");
-		return TCL_ERROR;
-	    }
-	    masterInterp = GetInterp(interp, objv[2]);
-	    if (masterInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);
-	    if (chan == NULL) {
-		TclTransferResult(masterInterp, TCL_OK, interp);
-		return TCL_ERROR;
-	    }
-	    slaveInterp = GetInterp(interp, objv[4]);
-	    if (slaveInterp == NULL) {
-		return TCL_ERROR;
-	    }
-	    Tcl_RegisterChannel(slaveInterp, chan);
-	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
-		TclTransferResult(masterInterp, TCL_OK, interp);
-		return TCL_ERROR;
-	    }
-	    return TCL_OK;
+	aliasPtr = Tcl_GetHashValue(hPtr);
+	if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "target interpreter for alias \"",
+		    aliasName, "\" in path \"", Tcl_GetString(objv[2]),
+		    "\" is not my descendant", NULL);
+	    return TCL_ERROR;
 	}
+	return TCL_OK;
+    }
     }
     return TCL_OK;
 }
@@ -783,24 +1029,24 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
  *	potentially specified on the command line to an Tcl_Interp.
  *
  * Results:
- *	The return value is the interp specified on the command line,
- *	or the interp argument itself if no interp was specified on the
- *	command line.  If the interp could not be found or the wrong
- *	number of arguments was specified on the command line, the return
- *	value is NULL and an error message is left in the interp's result.
+ *	The return value is the interp specified on the command line, or the
+ *	interp argument itself if no interp was specified on the command line.
+ *	If the interp could not be found or the wrong number of arguments was
+ *	specified on the command line, the return value is NULL and an error
+ *	message is left in the interp's result.
  *
  * Side effects:
  *	None.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 static Tcl_Interp *
-GetInterp2(interp, objc, objv)
-    Tcl_Interp *interp;		/* Default interp if no interp was specified
+GetInterp2(
+    Tcl_Interp *interp,		/* Default interp if no interp was specified
 				 * on the command line. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     if (objc == 2) {
 	return interp;
@@ -829,25 +1075,26 @@ GetInterp2(interp, objc, objv)
  */
 
 int
-Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
-    Tcl_Interp *slaveInterp;	/* Interpreter for source command. */
-    CONST char *slaveCmd;	/* Command to install in slave. */
-    Tcl_Interp *targetInterp;	/* Interpreter for target command. */
-    CONST char *targetCmd;	/* Name of target command. */
-    int argc;			/* How many additional arguments? */
-    CONST char * CONST *argv;	/* These are the additional args. */
+Tcl_CreateAlias(
+    Tcl_Interp *slaveInterp,	/* Interpreter for source command. */
+    const char *slaveCmd,	/* Command to install in slave. */
+    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
+    const char *targetCmd,	/* Name of target command. */
+    int argc,			/* How many additional arguments? */
+    const char *const *argv)	/* These are the additional args. */
 {
     Tcl_Obj *slaveObjPtr, *targetObjPtr;
     Tcl_Obj **objv;
     int i;
     int result;
-    
-    objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
+
+    objv = (Tcl_Obj **)
+	    TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
     for (i = 0; i < argc; i++) {
-        objv[i] = Tcl_NewStringObj(argv[i], -1);
-        Tcl_IncrRefCount(objv[i]);
+	objv[i] = Tcl_NewStringObj(argv[i], -1);
+	Tcl_IncrRefCount(objv[i]);
     }
-    
+
     slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
     Tcl_IncrRefCount(slaveObjPtr);
 
@@ -860,7 +1107,7 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
     for (i = 0; i < argc; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
-    ckfree((char *) objv);
+    TclStackFree(slaveInterp, objv);
     Tcl_DecrRefCount(targetObjPtr);
     Tcl_DecrRefCount(slaveObjPtr);
 
@@ -884,13 +1131,13 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
  */
 
 int
-Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
-    Tcl_Interp *slaveInterp;	/* Interpreter for source command. */
-    CONST char *slaveCmd;	/* Command to install in slave. */
-    Tcl_Interp *targetInterp;	/* Interpreter for target command. */
-    CONST char *targetCmd;	/* Name of target command. */
-    int objc;			/* How many additional arguments? */
-    Tcl_Obj *CONST objv[];	/* Argument vector. */
+Tcl_CreateAliasObj(
+    Tcl_Interp *slaveInterp,	/* Interpreter for source command. */
+    const char *slaveCmd,	/* Command to install in slave. */
+    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
+    const char *targetCmd,	/* Name of target command. */
+    int objc,			/* How many additional arguments? */
+    Tcl_Obj *const objv[])	/* Argument vector. */
 {
     Tcl_Obj *slaveObjPtr, *targetObjPtr;
     int result;
@@ -917,7 +1164,7 @@ Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
  *	Gets information about an alias.
  *
  * Results:
- *	A standard Tcl result. 
+ *	A standard Tcl result.
  *
  * Side effects:
  *	None.
@@ -926,29 +1173,28 @@ Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
  */
 
 int
-Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
-        argvPtr)
-    Tcl_Interp *interp;			/* Interp to start search from. */
-    CONST char *aliasName;			/* Name of alias to find. */
-    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
-    CONST char **targetNamePtr;		/* (Return) name of target command. */
-    int *argcPtr;			/* (Return) count of addnl args. */
-    CONST char ***argvPtr;		/* (Return) additional arguments. */
+Tcl_GetAlias(
+    Tcl_Interp *interp,		/* Interp to start search from. */
+    const char *aliasName,	/* Name of alias to find. */
+    Tcl_Interp **targetInterpPtr,
+				/* (Return) target interpreter. */
+    const char **targetNamePtr,	/* (Return) name of target command. */
+    int *argcPtr,		/* (Return) count of addnl args. */
+    const char ***argvPtr)	/* (Return) additional arguments. */
 {
-    InterpInfo *iiPtr;
+    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
     Tcl_HashEntry *hPtr;
     Alias *aliasPtr;
     int i, objc;
     Tcl_Obj **objv;
-    
-    iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+
     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
     if (hPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "alias \"", aliasName, "\" not found", (char *) NULL);
+	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
 	return TCL_ERROR;
     }
-    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+    aliasPtr = Tcl_GetHashValue(hPtr);
     objc = aliasPtr->objc;
     objv = &aliasPtr->objPtr;
 
@@ -956,17 +1202,17 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
 	*targetInterpPtr = aliasPtr->targetInterp;
     }
     if (targetNamePtr != NULL) {
-	*targetNamePtr = Tcl_GetString(objv[0]);
+	*targetNamePtr = TclGetString(objv[0]);
     }
     if (argcPtr != NULL) {
 	*argcPtr = objc - 1;
     }
     if (argvPtr != NULL) {
-        *argvPtr = (CONST char **) 
-		ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
-        for (i = 1; i < objc; i++) {
-            (*argvPtr)[i - 1] = Tcl_GetString(objv[i]);
-        }
+	*argvPtr = (const char **)
+		ckalloc((unsigned) sizeof(const char *) * (objc - 1));
+	for (i = 1; i < objc; i++) {
+	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
+	}
     }
     return TCL_OK;
 }
@@ -988,43 +1234,42 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
  */
 
 int
-Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
-        objvPtr)
-    Tcl_Interp *interp;			/* Interp to start search from. */
-    CONST char *aliasName;		/* Name of alias to find. */
-    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
-    CONST char **targetNamePtr;		/* (Return) name of target command. */
-    int *objcPtr;			/* (Return) count of addnl args. */
-    Tcl_Obj ***objvPtr;			/* (Return) additional args. */
+Tcl_GetAliasObj(
+    Tcl_Interp *interp,		/* Interp to start search from. */
+    const char *aliasName,	/* Name of alias to find. */
+    Tcl_Interp **targetInterpPtr,
+				/* (Return) target interpreter. */
+    const char **targetNamePtr,	/* (Return) name of target command. */
+    int *objcPtr,		/* (Return) count of addnl args. */
+    Tcl_Obj ***objvPtr)		/* (Return) additional args. */
 {
-    InterpInfo *iiPtr;
+    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
     Tcl_HashEntry *hPtr;
-    Alias *aliasPtr;	
+    Alias *aliasPtr;
     int objc;
     Tcl_Obj **objv;
 
-    iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
-    if (hPtr == (Tcl_HashEntry *) NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "alias \"", aliasName, "\" not found", (char *) NULL);
-        return TCL_ERROR;
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
+	return TCL_ERROR;
     }
-    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+    aliasPtr = Tcl_GetHashValue(hPtr);
     objc = aliasPtr->objc;
     objv = &aliasPtr->objPtr;
 
-    if (targetInterpPtr != (Tcl_Interp **) NULL) {
-        *targetInterpPtr = aliasPtr->targetInterp;
+    if (targetInterpPtr != NULL) {
+	*targetInterpPtr = aliasPtr->targetInterp;
     }
-    if (targetNamePtr != (CONST char **) NULL) {
-        *targetNamePtr = Tcl_GetString(objv[0]);
+    if (targetNamePtr != NULL) {
+	*targetNamePtr = TclGetString(objv[0]);
     }
-    if (objcPtr != (int *) NULL) {
-        *objcPtr = objc - 1;
+    if (objcPtr != NULL) {
+	*objcPtr = objc - 1;
     }
-    if (objvPtr != (Tcl_Obj ***) NULL) {
-        *objvPtr = objv + 1;
+    if (objvPtr != NULL) {
+	*objvPtr = objv + 1;
     }
     return TCL_OK;
 }
@@ -1034,30 +1279,29 @@ Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
  *
  * TclPreventAliasLoop --
  *
- *	When defining an alias or renaming a command, prevent an alias
- *	loop from being formed.
+ *	When defining an alias or renaming a command, prevent an alias loop
+ *	from being formed.
  *
  * Results:
  *	A standard Tcl object result.
  *
  * Side effects:
- *	If TCL_ERROR is returned, the function also stores an error message
- *	in the interpreter's result object.
+ *	If TCL_ERROR is returned, the function also stores an error message in
+ *	the interpreter's result object.
  *
  * NOTE:
- *	This function is public internal (instead of being static to
- *	this file) because it is also used from TclRenameCommand.
+ *	This function is public internal (instead of being static to this
+ *	file) because it is also used from TclRenameCommand.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclPreventAliasLoop(interp, cmdInterp, cmd)
-    Tcl_Interp *interp;			/* Interp in which to report errors. */
-    Tcl_Interp *cmdInterp;		/* Interp in which the command is
-                                         * being defined. */
-    Tcl_Command cmd;                    /* Tcl command we are attempting
-                                         * to define. */
+TclPreventAliasLoop(
+    Tcl_Interp *interp,		/* Interp in which to report errors. */
+    Tcl_Interp *cmdInterp,	/* Interp in which the command is being
+				 * defined. */
+    Tcl_Command cmd)		/* Tcl command we are attempting to define. */
 {
     Command *cmdPtr = (Command *) cmd;
     Alias *aliasPtr, *nextAliasPtr;
@@ -1065,18 +1309,18 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
     Command *aliasCmdPtr;
 
     /*
-     * If we are not creating or renaming an alias, then it is
-     * always OK to create or rename the command.
+     * If we are not creating or renaming an alias, then it is always OK to
+     * create or rename the command.
      */
-    
+
     if (cmdPtr->objProc != AliasObjCmd) {
-        return TCL_OK;
+	return TCL_OK;
     }
 
     /*
-     * OK, we are dealing with an alias, so traverse the chain of aliases.
-     * If we encounter the alias we are defining (or renaming to) any in
-     * the chain then we have a loop.
+     * OK, we are dealing with an alias, so traverse the chain of aliases. If
+     * we encounter the alias we are defining (or renaming to) any in the
+     * chain then we have a loop.
      */
 
     aliasPtr = (Alias *) cmdPtr->objClientData;
@@ -1084,9 +1328,9 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
     while (1) {
 	Tcl_Obj *cmdNamePtr;
 
-        /*
-         * If the target of the next alias in the chain is the same as
-         * the source alias, we have a loop.
+	/*
+	 * If the target of the next alias in the chain is the same as the
+	 * source alias, we have a loop.
 	 */
 
 	if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
@@ -1095,39 +1339,37 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
 	     * [Bug #641195]
 	     */
 
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "cannot define or rename alias \"",
-		    Tcl_GetString(aliasPtr->namePtr),
-		    "\": interpreter deleted", (char *) NULL);
+	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
+		    Tcl_GetCommandName(cmdInterp, cmd),
+		    "\": interpreter deleted", NULL);
 	    return TCL_ERROR;
 	}
 	cmdNamePtr = nextAliasPtr->objPtr;
 	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
-                Tcl_GetString(cmdNamePtr),
+		TclGetString(cmdNamePtr),
 		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
 		/*flags*/ 0);
-        if (aliasCmd == (Tcl_Command) NULL) {
-            return TCL_OK;
-        }
+	if (aliasCmd == NULL) {
+	    return TCL_OK;
+	}
 	aliasCmdPtr = (Command *) aliasCmd;
-        if (aliasCmdPtr == cmdPtr) {
-            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "cannot define or rename alias \"",
-		    Tcl_GetString(aliasPtr->namePtr),
-		    "\": would create a loop", (char *) NULL);
-            return TCL_ERROR;
-        }
-
-        /*
+	if (aliasCmdPtr == cmdPtr) {
+	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
+		    Tcl_GetCommandName(cmdInterp, cmd),
+		    "\": would create a loop", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
 	 * Otherwise, follow the chain one step further. See if the target
-         * command is an alias - if so, follow the loop to its target
-         * command. Otherwise we do not have a loop.
+	 * command is an alias - if so, follow the loop to its target command.
+	 * Otherwise we do not have a loop.
 	 */
 
-        if (aliasCmdPtr->objProc != AliasObjCmd) {
-            return TCL_OK;
-        }
-        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
+	if (aliasCmdPtr->objProc != AliasObjCmd) {
+	    return TCL_OK;
+	}
+	nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
     }
 
     /* NOTREACHED */
@@ -1144,24 +1386,23 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
  *	A standard Tcl result.
  *
  * Side effects:
- *	An alias command is created and entered into the alias table
- *	for the slave interpreter.
+ *	An alias command is created and entered into the alias table for the
+ *	slave interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
-	objc, objv)
-    Tcl_Interp *interp;		/* Interp for error reporting. */
-    Tcl_Interp *slaveInterp;	/* Interp where alias cmd will live or from
+AliasCreate(
+    Tcl_Interp *interp,		/* Interp for error reporting. */
+    Tcl_Interp *slaveInterp,	/* Interp where alias cmd will live or from
 				 * which alias will be deleted. */
-    Tcl_Interp *masterInterp;	/* Interp in which target command will be
+    Tcl_Interp *masterInterp,	/* Interp in which target command will be
 				 * invoked. */
-    Tcl_Obj *namePtr;		/* Name of alias cmd. */
-    Tcl_Obj *targetNamePtr;	/* Name of target cmd. */
-    int objc;			/* Additional arguments to store */
-    Tcl_Obj *CONST objv[];	/* with alias. */
+    Tcl_Obj *namePtr,		/* Name of alias cmd. */
+    Tcl_Obj *targetNamePtr,	/* Name of target cmd. */
+    int objc,			/* Additional arguments to store */
+    Tcl_Obj *const objv[])	/* with alias. */
 {
     Alias *aliasPtr;
     Tcl_HashEntry *hPtr;
@@ -1169,13 +1410,13 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
     Slave *slavePtr;
     Master *masterPtr;
     Tcl_Obj **prefv;
-    int new, i;
+    int isNew, i;
 
-    aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) 
-            + objc * sizeof(Tcl_Obj *)));
-    aliasPtr->namePtr		= namePtr;
-    Tcl_IncrRefCount(aliasPtr->namePtr);
-    aliasPtr->targetInterp	= masterInterp;
+    aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
+	    + objc * sizeof(Tcl_Obj *)));
+    aliasPtr->token = namePtr;
+    Tcl_IncrRefCount(aliasPtr->token);
+    aliasPtr->targetInterp = masterInterp;
 
     aliasPtr->objc = objc + 1;
     prefv = &aliasPtr->objPtr;
@@ -1191,26 +1432,26 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
     Tcl_Preserve(masterInterp);
 
     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
-	    Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,
+	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
 	    AliasObjCmdDeleteProc);
 
     if (TclPreventAliasLoop(interp, slaveInterp,
 	    aliasPtr->slaveCmd) != TCL_OK) {
 	/*
-	 * Found an alias loop!	 The last call to Tcl_CreateObjCommand made
-	 * the alias point to itself.  Delete the command and its alias
-	 * record.  Be careful to wipe out its client data first, so the
-	 * command doesn't try to delete itself.
+	 * Found an alias loop! The last call to Tcl_CreateObjCommand made the
+	 * alias point to itself. Delete the command and its alias record. Be
+	 * careful to wipe out its client data first, so the command doesn't
+	 * try to delete itself.
 	 */
 
 	Command *cmdPtr;
-	
-	Tcl_DecrRefCount(aliasPtr->namePtr);
+
+	Tcl_DecrRefCount(aliasPtr->token);
 	Tcl_DecrRefCount(targetNamePtr);
 	for (i = 0; i < objc; i++) {
 	    Tcl_DecrRefCount(objv[i]);
 	}
-	
+
 	cmdPtr = (Command *) aliasPtr->slaveCmd;
 	cmdPtr->clientData = NULL;
 	cmdPtr->deleteProc = NULL;
@@ -1229,28 +1470,42 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
     }
 
     /*
-     * Make an entry in the alias table. If it already exists delete
-     * the alias command. Then retry.
+     * Make an entry in the alias table. If it already exists, retry.
      */
 
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     while (1) {
-	Alias *oldAliasPtr;
+	Tcl_Obj *newToken;
 	char *string;
-	
-	string = Tcl_GetString(namePtr);
-	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
-	if (new != 0) {
+
+	string = TclGetString(aliasPtr->token);
+	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
+	if (isNew != 0) {
 	    break;
 	}
 
-	oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-	Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd);
+	/*
+	 * The alias name cannot be used as unique token, it is already taken.
+	 * We can produce a unique token by prepending "::" repeatedly. This
+	 * algorithm is a stop-gap to try to maintain the command name as
+	 * token for most use cases, fearful of possible backwards compat
+	 * problems. A better algorithm would produce unique tokens that need
+	 * not be related to the command name.
+	 *
+	 * ATTENTION: the tests in interp.test and possibly safe.test depend
+	 * on the precise definition of these tokens.
+	 */
+
+	TclNewLiteralStringObj(newToken, "::");
+	Tcl_AppendObjToObj(newToken, aliasPtr->token);
+	Tcl_DecrRefCount(aliasPtr->token);
+	aliasPtr->token = newToken;
+	Tcl_IncrRefCount(aliasPtr->token);
     }
 
     aliasPtr->aliasEntryPtr = hPtr;
-    Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
-    
+    Tcl_SetHashValue(hPtr, aliasPtr);
+
     /*
      * Create the new command. We must do it after deleting any old command,
      * because the alias may be pointing at a renamed alias, as in:
@@ -1264,19 +1519,16 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
     targetPtr->slaveCmd = aliasPtr->slaveCmd;
     targetPtr->slaveInterp = slaveInterp;
 
-    Tcl_MutexLock(&cntMutex);
-    masterPtr = &((InterpInfo *) ((Interp *) masterInterp)->interpInfo)->master;
-    do {
-        hPtr = Tcl_CreateHashEntry(&masterPtr->targetTable,
-                (char *) aliasCounter, &new);
-	aliasCounter++;
-    } while (new == 0);
-    Tcl_MutexUnlock(&cntMutex);
-
-    Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
-    aliasPtr->targetEntryPtr = hPtr;
+    masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master;
+    targetPtr->nextPtr = masterPtr->targetsPtr;
+    targetPtr->prevPtr = NULL;
+    if (masterPtr->targetsPtr != NULL) {
+	masterPtr->targetsPtr->prevPtr = targetPtr;
+    }
+    masterPtr->targetsPtr = targetPtr;
+    aliasPtr->targetPtr = targetPtr;
 
-    Tcl_SetObjResult(interp, namePtr);
+    Tcl_SetObjResult(interp, aliasPtr->token);
 
     Tcl_Release(slaveInterp);
     Tcl_Release(masterInterp);
@@ -1300,10 +1552,10 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
  */
 
 static int
-AliasDelete(interp, slaveInterp, namePtr)
-    Tcl_Interp *interp;		/* Interpreter for result & errors. */
-    Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */
-    Tcl_Obj *namePtr;		/* Name of alias to delete. */
+AliasDelete(
+    Tcl_Interp *interp,		/* Interpreter for result & errors. */
+    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
+    Tcl_Obj *namePtr)		/* Name of alias to delete. */
 {
     Slave *slavePtr;
     Alias *aliasPtr;
@@ -1316,13 +1568,15 @@ AliasDelete(interp, slaveInterp, namePtr)
      */
 
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
-    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
+    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
     if (hPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"",
-		Tcl_GetString(namePtr), "\" not found", NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
+		"\" not found", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
+		TclGetString(namePtr), NULL);
+	return TCL_ERROR;
     }
-    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+    aliasPtr = Tcl_GetHashValue(hPtr);
     Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
     return TCL_OK;
 }
@@ -1332,10 +1586,9 @@ AliasDelete(interp, slaveInterp, namePtr)
  *
  * AliasDescribe --
  *
- *	Sets the interpreter's result object to a Tcl list describing
- *	the given alias in the given interpreter: its target command
- *	and the additional arguments to prepend to any invocation
- *	of the alias.
+ *	Sets the interpreter's result object to a Tcl list describing the
+ *	given alias in the given interpreter: its target command and the
+ *	additional arguments to prepend to any invocation of the alias.
  *
  * Results:
  *	A standard Tcl result.
@@ -1347,14 +1600,14 @@ AliasDelete(interp, slaveInterp, namePtr)
  */
 
 static int
-AliasDescribe(interp, slaveInterp, namePtr)
-    Tcl_Interp *interp;		/* Interpreter for result & errors. */
-    Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */
-    Tcl_Obj *namePtr;		/* Name of alias to describe. */
+AliasDescribe(
+    Tcl_Interp *interp,		/* Interpreter for result & errors. */
+    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
+    Tcl_Obj *namePtr)		/* Name of alias to describe. */
 {
     Slave *slavePtr;
     Tcl_HashEntry *hPtr;
-    Alias *aliasPtr;	
+    Alias *aliasPtr;
     Tcl_Obj *prefixPtr;
 
     /*
@@ -1366,9 +1619,9 @@ AliasDescribe(interp, slaveInterp, namePtr)
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
     if (hPtr == NULL) {
-        return TCL_OK;
+	return TCL_OK;
     }
-    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+    aliasPtr = Tcl_GetHashValue(hPtr);
     prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
     Tcl_SetObjResult(interp, prefixPtr);
     return TCL_OK;
@@ -1391,24 +1644,24 @@ AliasDescribe(interp, slaveInterp, namePtr)
  */
 
 static int
-AliasList(interp, slaveInterp)
-    Tcl_Interp *interp;		/* Interp for data return. */
-    Tcl_Interp *slaveInterp;	/* Interp whose aliases to compute. */
+AliasList(
+    Tcl_Interp *interp,		/* Interp for data return. */
+    Tcl_Interp *slaveInterp)	/* Interp whose aliases to compute. */
 {
     Tcl_HashEntry *entryPtr;
     Tcl_HashSearch hashSearch;
-    Tcl_Obj *resultPtr;	
+    Tcl_Obj *resultPtr = Tcl_NewObj();
     Alias *aliasPtr;
     Slave *slavePtr;
 
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
-    resultPtr = Tcl_GetObjResult(interp);
 
     entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
     for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
-        aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
-        Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);
+	aliasPtr = Tcl_GetHashValue(entryPtr);
+	Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
     }
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -1417,80 +1670,120 @@ AliasList(interp, slaveInterp)
  *
  * AliasObjCmd --
  *
- *	This is the procedure that services invocations of aliases in a
- *	slave interpreter. One such command exists for each alias. When
- *	invoked, this procedure redirects the invocation to the target
- *	command in the master interpreter as designated by the Alias
- *	record associated with this command.
+ *	This is the function that services invocations of aliases in a slave
+ *	interpreter. One such command exists for each alias. When invoked,
+ *	this function redirects the invocation to the target command in the
+ *	master interpreter as designated by the Alias record associated with
+ *	this command.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Causes forwarding of the invocation; all possible side effects
- *	may occur as a result of invoking the command to which the
- *	invocation is forwarded.
+ *	Causes forwarding of the invocation; all possible side effects may
+ *	occur as a result of invoking the command to which the invocation is
+ *	forwarded.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-AliasObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Alias record. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument vector. */	
+AliasObjCmd(
+    ClientData clientData,	/* Alias record. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument vector. */
 {
 #define ALIAS_CMDV_PREALLOC 10
-    Tcl_Interp *targetInterp;	
-    Alias *aliasPtr;		
+    Alias *aliasPtr = clientData;
+    Tcl_Interp *targetInterp = aliasPtr->targetInterp;
     int result, prefc, cmdc, i;
     Tcl_Obj **prefv, **cmdv;
     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
-    aliasPtr = (Alias *) clientData;
-    targetInterp = aliasPtr->targetInterp;
+    Interp *tPtr = (Interp *) targetInterp;
+    int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
 
     /*
-     * Append the arguments to the command prefix and invoke the command
-     * in the target interp's global namespace.
+     * Append the arguments to the command prefix and invoke the command in
+     * the target interp's global namespace.
      */
-     
+
     prefc = aliasPtr->objc;
     prefv = &aliasPtr->objPtr;
     cmdc = prefc + objc - 1;
     if (cmdc <= ALIAS_CMDV_PREALLOC) {
 	cmdv = cmdArr;
     } else {
-	cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));
+	cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
     }
 
     prefv = &aliasPtr->objPtr;
-    memcpy((VOID *) cmdv, (VOID *) prefv, 
-            (size_t) (prefc * sizeof(Tcl_Obj *)));
-    memcpy((VOID *) (cmdv+prefc), (VOID *) (objv+1), 
-	    (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
 
     Tcl_ResetResult(targetInterp);
 
     for (i=0; i<cmdc; i++) {
 	Tcl_IncrRefCount(cmdv[i]);
     }
-    if (targetInterp != interp) {
-	Tcl_Preserve((ClientData) targetInterp);
-	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
-	TclTransferResult(targetInterp, result, interp);	
-	Tcl_Release((ClientData) targetInterp);
+
+    /*
+     * Use the ensemble rewriting machinery to ensure correct error messages:
+     * only the source command should show, not the full target prefix.
+     */
+
+    if (isRootEnsemble) {
+	tPtr->ensembleRewrite.sourceObjs = objv;
+	tPtr->ensembleRewrite.numRemovedObjs = 1;
+	tPtr->ensembleRewrite.numInsertedObjs = prefc;
     } else {
-	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+	tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
+    }
+
+    /*
+     * Protect the target interpreter if it isn't the same as the source
+     * interpreter so that we can continue to work with it after the target
+     * command completes.
+     */
+
+    if (targetInterp != interp) {
+	Tcl_Preserve(targetInterp);
+    }
+
+    /*
+     * Execute the target command in the target interpreter.
+     */
+
+    result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+
+    /*
+     * Clean up the ensemble rewrite info if we set it in the first place.
+     */
+
+    if (isRootEnsemble) {
+	tPtr->ensembleRewrite.sourceObjs = NULL;
+	tPtr->ensembleRewrite.numRemovedObjs = 0;
+	tPtr->ensembleRewrite.numInsertedObjs = 0;
     }
+
+    /*
+     * If it was a cross-interpreter alias, we need to transfer the result
+     * back to the source interpreter and release the lock we previously set
+     * on the target interpreter.
+     */
+
+    if (targetInterp != interp) {
+	TclTransferResult(targetInterp, result, interp);
+	Tcl_Release(targetInterp);
+    }
+
     for (i=0; i<cmdc; i++) {
 	Tcl_DecrRefCount(cmdv[i]);
     }
-
     if (cmdv != cmdArr) {
-	ckfree((char *) cmdv);
+	TclStackFree(interp, cmdv);
     }
-    return result;        
+    return result;
 #undef ALIAS_CMDV_PREALLOC
 }
 
@@ -1499,41 +1792,53 @@ AliasObjCmd(clientData, interp, objc, objv)
  *
  * AliasObjCmdDeleteProc --
  *
- *	Is invoked when an alias command is deleted in a slave. Cleans up
- *	all storage associated with this alias.
+ *	Is invoked when an alias command is deleted in a slave. Cleans up all
+ *	storage associated with this alias.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Deletes the alias record and its entry in the alias table for
- *	the interpreter.
+ *	Deletes the alias record and its entry in the alias table for the
+ *	interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-AliasObjCmdDeleteProc(clientData)
-    ClientData clientData;	/* The alias record for this alias. */
+AliasObjCmdDeleteProc(
+    ClientData clientData)	/* The alias record for this alias. */
 {
-    Alias *aliasPtr;		
-    Target *targetPtr;		
+    Alias *aliasPtr = clientData;
+    Target *targetPtr;
     int i;
     Tcl_Obj **objv;
 
-    aliasPtr = (Alias *) clientData;
-    
-    Tcl_DecrRefCount(aliasPtr->namePtr);
+    Tcl_DecrRefCount(aliasPtr->token);
     objv = &aliasPtr->objPtr;
     for (i = 0; i < aliasPtr->objc; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
     Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
 
-    targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
-    ckfree((char *) targetPtr);
-    Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);
+    /*
+     * Splice the target record out of the target interpreter's master list.
+     */
+
+    targetPtr = aliasPtr->targetPtr;
+    if (targetPtr->prevPtr != NULL) {
+	targetPtr->prevPtr->nextPtr = targetPtr->nextPtr;
+    } else {
+	Master *masterPtr = &((InterpInfo *) ((Interp *)
+		aliasPtr->targetInterp)->interpInfo)->master;
+
+	masterPtr->targetsPtr = targetPtr->nextPtr;
+    }
+    if (targetPtr->nextPtr != NULL) {
+	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
+    }
 
+    ckfree((char *) targetPtr);
     ckfree((char *) aliasPtr);
 }
 
@@ -1542,29 +1847,29 @@ AliasObjCmdDeleteProc(clientData)
  *
  * Tcl_CreateSlave --
  *
- *	Creates a slave interpreter. The slavePath argument denotes the
- *	name of the new slave relative to the current interpreter; the
- *	slave is a direct descendant of the one-before-last component of
- *	the path, e.g. it is a descendant of the current interpreter if
- *	the slavePath argument contains only one component. Optionally makes
- *	the slave interpreter safe.
+ *	Creates a slave interpreter. The slavePath argument denotes the name
+ *	of the new slave relative to the current interpreter; the slave is a
+ *	direct descendant of the one-before-last component of the path,
+ *	e.g. it is a descendant of the current interpreter if the slavePath
+ *	argument contains only one component. Optionally makes the slave
+ *	interpreter safe.
  *
  * Results:
  *	Returns the interpreter structure created, or NULL if an error
  *	occurred.
  *
  * Side effects:
- *	Creates a new interpreter and a new interpreter object command in
- *	the interpreter indicated by the slavePath argument.
+ *	Creates a new interpreter and a new interpreter object command in the
+ *	interpreter indicated by the slavePath argument.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Interp *
-Tcl_CreateSlave(interp, slavePath, isSafe)
-    Tcl_Interp *interp;		/* Interpreter to start search at. */
-    CONST char *slavePath;	/* Name of slave to create. */
-    int isSafe;			/* Should new slave be "safe" ? */
+Tcl_CreateSlave(
+    Tcl_Interp *interp,		/* Interpreter to start search at. */
+    const char *slavePath,	/* Name of slave to create. */
+    int isSafe)			/* Should new slave be "safe" ? */
 {
     Tcl_Obj *pathPtr;
     Tcl_Interp *slaveInterp;
@@ -1584,8 +1889,7 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
  *	Finds a slave interpreter by its path name.
  *
  * Results:
- *	Returns a Tcl_Interp * for the named interpreter or NULL if not
- *	found.
+ *	Returns a Tcl_Interp * for the named interpreter or NULL if not found.
  *
  * Side effects:
  *	None.
@@ -1594,9 +1898,9 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
  */
 
 Tcl_Interp *
-Tcl_GetSlave(interp, slavePath)
-    Tcl_Interp *interp;		/* Interpreter to start search from. */
-    CONST char *slavePath;	/* Path of slave to find. */
+Tcl_GetSlave(
+    Tcl_Interp *interp,		/* Interpreter to start search from. */
+    const char *slavePath)	/* Path of slave to find. */
 {
     Tcl_Obj *pathPtr;
     Tcl_Interp *slaveInterp;
@@ -1625,13 +1929,13 @@ Tcl_GetSlave(interp, slavePath)
  */
 
 Tcl_Interp *
-Tcl_GetMaster(interp)
-    Tcl_Interp *interp;		/* Get the master of this interpreter. */
+Tcl_GetMaster(
+    Tcl_Interp *interp)		/* Get the master of this interpreter. */
 {
     Slave *slavePtr;		/* Slave record of this interpreter. */
 
-    if (interp == (Tcl_Interp *) NULL) {
-        return NULL;
+    if (interp == NULL) {
+	return NULL;
     }
     slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
     return slavePtr->masterInterp;
@@ -1643,19 +1947,17 @@ Tcl_GetMaster(interp)
  * Tcl_GetInterpPath --
  *
  *	Sets the result of the asking interpreter to a proper Tcl list
- *	containing the names of interpreters between the asking and
- *	target interpreters. The target interpreter must be either the
- *	same as the asking interpreter or one of its slaves (including
- *	recursively).
+ *	containing the names of interpreters between the asking and target
+ *	interpreters. The target interpreter must be either the same as the
+ *	asking interpreter or one of its slaves (including recursively).
  *
  * Results:
- *	TCL_OK if the target interpreter is the same as, or a descendant
- *	of, the asking interpreter; TCL_ERROR else. This way one can
- *	distinguish between the case where the asking and target interps
- *	are the same (an empty list is the result, and TCL_OK is returned)
- *	and when the target is not a descendant of the asking interpreter
- *	(in which case the Tcl result is an error message and the function
- *	returns TCL_ERROR).
+ *	TCL_OK if the target interpreter is the same as, or a descendant of,
+ *	the asking interpreter; TCL_ERROR else. This way one can distinguish
+ *	between the case where the asking and target interps are the same (an
+ *	empty list is the result, and TCL_OK is returned) and when the target
+ *	is not a descendant of the asking interpreter (in which case the Tcl
+ *	result is an error message and the function returns TCL_ERROR).
  *
  * Side effects:
  *	None.
@@ -1664,25 +1966,24 @@ Tcl_GetMaster(interp)
  */
 
 int
-Tcl_GetInterpPath(askingInterp, targetInterp)
-    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
-    Tcl_Interp *targetInterp;	/* Interpreter to find. */
+Tcl_GetInterpPath(
+    Tcl_Interp *askingInterp,	/* Interpreter to start search from. */
+    Tcl_Interp *targetInterp)	/* Interpreter to find. */
 {
     InterpInfo *iiPtr;
-    
+
     if (targetInterp == askingInterp) {
-        return TCL_OK;
+	return TCL_OK;
     }
     if (targetInterp == NULL) {
 	return TCL_ERROR;
     }
     iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
     if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    Tcl_AppendElement(askingInterp,
-	    Tcl_GetHashKey(&iiPtr->master.slaveTable,
-		    iiPtr->slave.slaveEntryPtr));
+    Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable,
+	    iiPtr->slave.slaveEntryPtr));
     return TCL_OK;
 }
 
@@ -1695,7 +1996,7 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
  *
  * Results:
  *	Returns the slave interpreter known by that name in the calling
- *	interpreter, or NULL if no interpreter known by that name exists. 
+ *	interpreter, or NULL if no interpreter known by that name exists.
  *
  * Side effects:
  *	Assigns to the pointer variable passed in, if not NULL.
@@ -1704,41 +2005,42 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
  */
 
 static Tcl_Interp *
-GetInterp(interp, pathPtr)
-    Tcl_Interp *interp;		/* Interp. to start search from. */
-    Tcl_Obj *pathPtr;		/* List object containing name of interp. to 
+GetInterp(
+    Tcl_Interp *interp,		/* Interp. to start search from. */
+    Tcl_Obj *pathPtr)		/* List object containing name of interp. to
 				 * be found. */
 {
     Tcl_HashEntry *hPtr;	/* Search element. */
     Slave *slavePtr;		/* Interim slave record. */
     Tcl_Obj **objv;
-    int objc, i;	
+    int objc, i;
     Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
     InterpInfo *masterInfoPtr;
 
-    if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+    if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
 	return NULL;
     }
 
     searchInterp = interp;
     for (i = 0; i < objc; i++) {
 	masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
-        hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
-		Tcl_GetString(objv[i]));
-        if (hPtr == NULL) {
+	hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
+		TclGetString(objv[i]));
+	if (hPtr == NULL) {
 	    searchInterp = NULL;
 	    break;
 	}
-        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
-        searchInterp = slavePtr->slaveInterp;
-        if (searchInterp == NULL) {
+	slavePtr = Tcl_GetHashValue(hPtr);
+	searchInterp = slavePtr->slaveInterp;
+	if (searchInterp == NULL) {
 	    break;
 	}
     }
     if (searchInterp == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"could not find interpreter \"",
-                Tcl_GetString(pathPtr), "\"", (char *) NULL);
+	Tcl_AppendResult(interp, "could not find interpreter \"",
+		TclGetString(pathPtr), "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
+		TclGetString(pathPtr), NULL);
     }
     return searchInterp;
 }
@@ -1746,11 +2048,51 @@ GetInterp(interp, pathPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * SlaveBgerror --
+ *
+ *	Helper function to set/query the background error handling command
+ *	prefix of an interp
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	When (objc == 1), slaveInterp will be set to a new background handler
+ *	of objv[0].
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveBgerror(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* Interp in which limit is set/queried. */
+    int objc,			/* Set or Query. */
+    Tcl_Obj *const objv[])	/* Argument strings. */
+{
+    if (objc) {
+	int length;
+
+	if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
+		|| (length < 1)) {
+	    Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
+		    NULL);
+	    return TCL_ERROR;
+	}
+	TclSetBgErrorHandler(slaveInterp, objv[0]);
+    }
+    Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * SlaveCreate --
  *
- *	Helper function to do the actual work of creating a slave interp
- *	and new object command. Also optionally makes the new slave
- *	interpreter "safe".
+ *	Helper function to do the actual work of creating a slave interp and
+ *	new object command. Also optionally makes the new slave interpreter
+ *	"safe".
  *
  * Results:
  *	Returns the new Tcl_Interp * if successful or NULL if not. If failed,
@@ -1763,17 +2105,17 @@ GetInterp(interp, pathPtr)
  */
 
 static Tcl_Interp *
-SlaveCreate(interp, pathPtr, safe)
-    Tcl_Interp *interp;		/* Interp. to start search from. */
-    Tcl_Obj *pathPtr;		/* Path (name) of slave to create. */
-    int safe;			/* Should we make it "safe"? */
+SlaveCreate(
+    Tcl_Interp *interp,		/* Interp. to start search from. */
+    Tcl_Obj *pathPtr,		/* Path (name) of slave to create. */
+    int safe)			/* Should we make it "safe"? */
 {
     Tcl_Interp *masterInterp, *slaveInterp;
     Slave *slavePtr;
     InterpInfo *masterInfoPtr;
     Tcl_HashEntry *hPtr;
     char *path;
-    int new, objc;
+    int isNew, objc;
     Tcl_Obj **objv;
 
     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
@@ -1781,29 +2123,29 @@ SlaveCreate(interp, pathPtr, safe)
     }
     if (objc < 2) {
 	masterInterp = interp;
-	path = Tcl_GetString(pathPtr);
+	path = TclGetString(pathPtr);
     } else {
 	Tcl_Obj *objPtr;
-	
+
 	objPtr = Tcl_NewListObj(objc - 1, objv);
 	masterInterp = GetInterp(interp, objPtr);
 	Tcl_DecrRefCount(objPtr);
 	if (masterInterp == NULL) {
 	    return NULL;
 	}
-	path = Tcl_GetString(objv[objc - 1]);
+	path = TclGetString(objv[objc - 1]);
     }
     if (safe == 0) {
 	safe = Tcl_IsSafe(masterInterp);
     }
 
     masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
-    hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);
-    if (new == 0) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "interpreter named \"", path,
-		"\" already exists, cannot create", (char *) NULL);
-        return NULL;
+    hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
+	    &isNew);
+    if (isNew == 0) {
+	Tcl_AppendResult(interp, "interpreter named \"", path,
+		"\" already exists, cannot create", NULL);
+	return NULL;
     }
 
     slaveInterp = Tcl_CreateInterp();
@@ -1812,35 +2154,66 @@ SlaveCreate(interp, pathPtr, safe)
     slavePtr->slaveEntryPtr = hPtr;
     slavePtr->slaveInterp = slaveInterp;
     slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
-            SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);
+	    SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
-    Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
+    Tcl_SetHashValue(hPtr, slavePtr);
     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
-    
+
     /*
      * Inherit the recursion limit.
      */
+
     ((Interp *) slaveInterp)->maxNestingDepth =
-	((Interp *) masterInterp)->maxNestingDepth ;
+	    ((Interp *) masterInterp)->maxNestingDepth;
 
     if (safe) {
-        if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
-            goto error;
-        }
+	if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
+	    goto error;
+	}
     } else {
-        if (Tcl_Init(slaveInterp) == TCL_ERROR) {
-            goto error;
-        }
+	if (Tcl_Init(slaveInterp) == TCL_ERROR) {
+	    goto error;
+	}
+
 	/*
-	 * This will create the "memory" command in slave interpreters
-	 * if we compiled with TCL_MEM_DEBUG, otherwise it does nothing.
+	 * This will create the "memory" command in slave interpreters if we
+	 * compiled with TCL_MEM_DEBUG, otherwise it does nothing.
 	 */
+
 	Tcl_InitMemory(slaveInterp);
     }
+
+    /*
+     * Inherit the TIP#143 limits.
+     */
+
+    InheritLimitsFromMaster(slaveInterp, masterInterp);
+
+    /*
+     * The [clock] command presents a safe API, but uses unsafe features in
+     * its implementation. This means it has to be implemented in safe interps
+     * as an alias to a version in the (trusted) master.
+     */
+
+    if (safe) {
+	Tcl_Obj *clockObj;
+	int status;
+
+	TclNewLiteralStringObj(clockObj, "clock");
+	Tcl_IncrRefCount(clockObj);
+	status = AliasCreate(interp, slaveInterp, masterInterp, clockObj,
+		clockObj, 0, NULL);
+	Tcl_DecrRefCount(clockObj);
+	if (status != TCL_OK) {
+	    goto error2;
+	}
+    }
+
     return slaveInterp;
 
-    error:
+  error:
     TclTransferResult(slaveInterp, TCL_ERROR, interp);
+  error2:
     Tcl_DeleteInterp(slaveInterp);
 
     return NULL;
@@ -1851,8 +2224,8 @@ SlaveCreate(interp, pathPtr, safe)
  *
  * SlaveObjCmd --
  *
- *	Command to manipulate an interpreter, e.g. to send commands to it
- *	to be evaluated. One such command exists for each slave interpreter.
+ *	Command to manipulate an interpreter, e.g. to send commands to it to
+ *	be evaluated. One such command exists for each slave interpreter.
  *
  * Results:
  *	A standard Tcl result.
@@ -1864,33 +2237,32 @@ SlaveCreate(interp, pathPtr, safe)
  */
 
 static int
-SlaveObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Slave interpreter. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+SlaveObjCmd(
+    ClientData clientData,	/* Slave interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Interp *slaveInterp;
+    Tcl_Interp *slaveInterp = clientData;
     int index;
-    static CONST char *options[] = {
-        "alias",	"aliases",	"eval",		"expose",
-        "hide",		"hidden",	"issafe",	"invokehidden",
-        "marktrusted",	"recursionlimit", NULL
+    static const char *options[] = {
+	"alias",	"aliases",	"bgerror",	"debug",	"eval",
+	"expose",	"hide",		"hidden",	"issafe",
+	"invokehidden",	"limit",	"marktrusted",	"recursionlimit", NULL
     };
     enum options {
-	OPT_ALIAS,	OPT_ALIASES,	OPT_EVAL,	OPT_EXPOSE,
-	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHIDDEN,
-	OPT_MARKTRUSTED, OPT_RECLIMIT
+	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,	OPT_EVAL,
+	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,
+	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT
     };
-    
-    slaveInterp = (Tcl_Interp *) clientData;
+
     if (slaveInterp == NULL) {
-	panic("SlaveObjCmd: interpreter has been deleted");
+	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
     }
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
+	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
 	    &index) != TCL_OK) {
@@ -1898,113 +2270,151 @@ SlaveObjCmd(clientData, interp, objc, objv)
     }
 
     switch ((enum options) index) {
-	case OPT_ALIAS: {
-	    if (objc > 2) {
-		if (objc == 3) {
-		    return AliasDescribe(interp, slaveInterp, objv[2]);
-		}
-		if (Tcl_GetString(objv[3])[0] == '\0') {
-		    if (objc == 4) {
-			return AliasDelete(interp, slaveInterp, objv[2]);
-		    }
-		} else {
-		    return AliasCreate(interp, slaveInterp, interp, objv[2],
-			    objv[3], objc - 4, objv + 4);
+    case OPT_ALIAS:
+	if (objc > 2) {
+	    if (objc == 3) {
+		return AliasDescribe(interp, slaveInterp, objv[2]);
+	    }
+	    if (TclGetString(objv[3])[0] == '\0') {
+		if (objc == 4) {
+		    return AliasDelete(interp, slaveInterp, objv[2]);
 		}
+	    } else {
+		return AliasCreate(interp, slaveInterp, interp, objv[2],
+			objv[3], objc - 4, objv + 4);
 	    }
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "aliasName ?targetName? ?args..?");
-            return TCL_ERROR;
 	}
-	case OPT_ALIASES: {
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    return AliasList(interp, slaveInterp);
+	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
+	return TCL_ERROR;
+    case OPT_ALIASES:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
 	}
-	case OPT_EVAL: {
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
-		return TCL_ERROR;
-	    }
-	    return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
+	return AliasList(interp, slaveInterp);
+    case OPT_BGERROR:
+	if (objc != 2 && objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?cmdPrefix?");
+	    return TCL_ERROR;
 	}
-        case OPT_EXPOSE: {
-	    if ((objc < 3) || (objc > 4)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
-		return TCL_ERROR;
-	    }
-            return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
+	return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_DEBUG:
+	/*
+	 * TIP #378 *
+	 * Currently only -frame supported, otherwise ?-option ?value? ...?
+	 */
+	if (objc > 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
+	    return TCL_ERROR;
 	}
-	case OPT_HIDE: {
-	    if ((objc < 3) || (objc > 4)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
-		return TCL_ERROR;
-	    }
-            return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
+	return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_EVAL:
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
+	    return TCL_ERROR;
 	}
-        case OPT_HIDDEN: {
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-            return SlaveHidden(interp, slaveInterp);
+	return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_EXPOSE:
+	if ((objc < 3) || (objc > 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
+	    return TCL_ERROR;
+	}
+	return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_HIDE:
+	if ((objc < 3) || (objc > 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
+	    return TCL_ERROR;
+	}
+	return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_HIDDEN:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
 	}
-        case OPT_ISSAFE: {
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+	return SlaveHidden(interp, slaveInterp);
+    case OPT_ISSAFE:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
+	return TCL_OK;
+    case OPT_INVOKEHIDDEN: {
+	int i, index;
+	const char *namespaceName;
+	static const char *hiddenOptions[] = {
+	    "-global",	"-namespace",	"--", NULL
+	};
+	enum hiddenOption {
+	    OPT_GLOBAL,	OPT_NAMESPACE,	OPT_LAST
+	};
+
+	namespaceName = NULL;
+	for (i = 2; i < objc; i++) {
+	    if (TclGetString(objv[i])[0] != '-') {
+		break;
+	    }
+	    if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
+		    0, &index) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
-	    return TCL_OK;
-	}
-        case OPT_INVOKEHIDDEN: {
-	    int global, i, index;
-	    static CONST char *hiddenOptions[] = {
-		"-global",	"--",		NULL
-	    };
-	    enum hiddenOption {
-		OPT_GLOBAL,	OPT_LAST
-	    };
-	    global = 0;
-	    for (i = 2; i < objc; i++) {
-		if (Tcl_GetString(objv[i])[0] != '-') {
+	    if (index == OPT_GLOBAL) {
+		namespaceName = "::";
+	    } else if (index == OPT_NAMESPACE) {
+		if (++i == objc) { /* There must be more arguments. */
 		    break;
-		}
-		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
-			"option", 0, &index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (index == OPT_GLOBAL) {
-		    global = 1;
 		} else {
-		    i++;
-		    break;
+		    namespaceName = TclGetString(objv[i]);
 		}
+	    } else {
+		i++;
+		break;
 	    }
-	    if (objc - i < 1) {
-		Tcl_WrongNumArgs(interp, 2, objv,
-			"?-global? ?--? cmd ?arg ..?");
-		return TCL_ERROR;
-	    }
-	    return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
-		    objv + i);
 	}
-	case OPT_MARKTRUSTED: {
-	    if (objc != 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-            return SlaveMarkTrusted(interp, slaveInterp);
+	if (objc - i < 1) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "?-namespace ns? ?-global? ?--? cmd ?arg ..?");
+	    return TCL_ERROR;
 	}
-	case OPT_RECLIMIT: {
-	    if (objc != 2 && objc != 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
-		return TCL_ERROR;
-	    }
-	    return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
+	return SlaveInvokeHidden(interp, slaveInterp, namespaceName,
+		objc - i, objv + i);
+    }
+    case OPT_LIMIT: {
+	static const char *limitTypes[] = {
+	    "commands", "time", NULL
+	};
+	enum LimitTypes {
+	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
+	};
+	int limitType;
+
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
+	    return TCL_ERROR;
 	}
+	if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
+		&limitType) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum LimitTypes) limitType) {
+	case LIMIT_TYPE_COMMANDS:
+	    return SlaveCommandLimitCmd(interp, slaveInterp, 3, objc,objv);
+	case LIMIT_TYPE_TIME:
+	    return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv);
+	}
+    }
+    case OPT_MARKTRUSTED:
+	if (objc != 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+	return SlaveMarkTrusted(interp, slaveInterp);
+    case OPT_RECLIMIT:
+	if (objc != 2 && objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
+	    return TCL_ERROR;
+	}
+	return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
     }
 
     return TCL_ERROR;
@@ -2023,20 +2433,20 @@ SlaveObjCmd(clientData, interp, objc, objv)
  *	None.
  *
  * Side effects:
- *	Cleans up all state associated with the slave interpreter and
- *	destroys the slave interpreter.
+ *	Cleans up all state associated with the slave interpreter and destroys
+ *	the slave interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-SlaveObjCmdDeleteProc(clientData)
-    ClientData clientData;		/* The SlaveRecord for the command. */
+SlaveObjCmdDeleteProc(
+    ClientData clientData)	/* The SlaveRecord for the command. */
 {
-    Slave *slavePtr;			/* Interim storage for Slave record. */
-    Tcl_Interp *slaveInterp;		/* And for a slave interp. */
+    Slave *slavePtr;		/* Interim storage for Slave record. */
+    Tcl_Interp *slaveInterp = clientData;
+				/* And for a slave interp. */
 
-    slaveInterp = (Tcl_Interp *) clientData;
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
 
     /*
@@ -2046,9 +2456,9 @@ SlaveObjCmdDeleteProc(clientData)
     Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);
 
     /*
-     * Set to NULL so that when the InterpInfo is cleaned up in the slave
-     * it does not try to delete the command causing all sorts of grief.
-     * See SlaveRecordDeleteProc().
+     * Set to NULL so that when the InterpInfo is cleaned up in the slave it
+     * does not try to delete the command causing all sorts of grief. See
+     * SlaveRecordDeleteProc().
      */
 
     slavePtr->interpCmd = NULL;
@@ -2061,6 +2471,75 @@ SlaveObjCmdDeleteProc(clientData)
 /*
  *----------------------------------------------------------------------
  *
+ * SlaveDebugCmd -- TIP #378
+ *
+ *	Helper function to handle 'debug' command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May modify INTERP_DEBUG flag in the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveDebugCmd(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
+				 * will be evaluated. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *debugTypes[] = {
+	"-frame", NULL
+    };
+    enum DebugTypes {
+	DEBUG_TYPE_FRAME
+    };
+    int debugType;
+    Interp *iPtr;
+    Tcl_Obj *resultPtr;
+
+    iPtr = (Interp *) slaveInterp;
+    if (objc == 0) {
+	resultPtr = Tcl_NewObj();
+	Tcl_ListObjAppendElement(NULL, resultPtr,
+		Tcl_NewStringObj("-frame", -1));
+	Tcl_ListObjAppendElement(NULL, resultPtr,
+		Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
+			"debug option", 0, &debugType) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (debugType == DEBUG_TYPE_FRAME) {
+	    if (objc == 2) { /* set */
+		if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
+			!= TCL_OK) {
+		    return TCL_ERROR;
+		}
+		/*
+		 * Quietly ignore attempts to disable interp debugging.
+		 * This is a one-way switch as frame debug info is maintained
+		 * in a stack that must be consistent once turned on.
+		 */
+		if (debugType) {
+		    iPtr->flags |= INTERP_DEBUG_FRAME;
+		}
+	    }
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * SlaveEval --
  *
  *	Helper function to evaluate a command in a slave interpreter.
@@ -2075,30 +2554,30 @@ SlaveObjCmdDeleteProc(clientData)
  */
 
 static int
-SlaveEval(interp, slaveInterp, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp *slaveInterp;	/* The slave interpreter in which command
+SlaveEval(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
 				 * will be evaluated. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result;
     Tcl_Obj *objPtr;
-    
-    Tcl_Preserve((ClientData) slaveInterp);
+
+    Tcl_Preserve(slaveInterp);
     Tcl_AllowExceptions(slaveInterp);
 
     if (objc == 1) {
-#ifndef TCL_TIP280
-	result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
-#else
-        /* TIP #280 : Make actual argument location available to eval'd script */
-        Interp* iPtr      = (Interp*) interp;
+	/*
+	 * TIP #280: Make actual argument location available to eval'd script.
+	 */
+
+        Interp *iPtr = (Interp *) interp;
 	CmdFrame* invoker = iPtr->cmdFramePtr;
 	int word          = 0;
+
 	TclArgumentGet (interp, objv[0], &invoker, &word);
 	result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
-#endif
     } else {
 	objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
@@ -2107,7 +2586,7 @@ SlaveEval(interp, slaveInterp, objc, objv)
     }
     TclTransferResult(slaveInterp, result, interp);
 
-    Tcl_Release((ClientData) slaveInterp);
+    Tcl_Release(slaveInterp);
     return result;
 }
 
@@ -2122,30 +2601,30 @@ SlaveEval(interp, slaveInterp, objc, objv)
  *	A standard Tcl result.
  *
  * Side effects:
- *	After this call scripts in the slave will be able to invoke
- *	the newly exposed command.
+ *	After this call scripts in the slave will be able to invoke the newly
+ *	exposed command.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SlaveExpose(interp, slaveInterp, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings. */
+SlaveExpose(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* Interp in which command will be exposed. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument strings. */
 {
     char *name;
-    
+
     if (Tcl_IsSafe(interp)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot expose commands",
-		(char *) NULL);
+		-1));
 	return TCL_ERROR;
     }
 
-    name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
-    if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
+    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
+    if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
 	    name) != TCL_OK) {
 	TclTransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
@@ -2164,31 +2643,29 @@ SlaveExpose(interp, slaveInterp, objc, objv)
  *	A standard Tcl result.
  *
  * Side effects:
- *      When (objc == 1), slaveInterp will be set to a new recursion
- *	limit of objv[0].
+ *	When (objc == 1), slaveInterp will be set to a new recursion limit of
+ *	objv[0].
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SlaveRecursionLimit(interp, slaveInterp, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp	*slaveInterp;	/* Interp in which limit is set/queried. */
-    int objc;			/* Set or Query. */
-    Tcl_Obj *CONST objv[];	/* Argument strings. */
+SlaveRecursionLimit(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* Interp in which limit is set/queried. */
+    int objc,			/* Set or Query. */
+    Tcl_Obj *const objv[])	/* Argument strings. */
 {
     Interp *iPtr;
     int limit;
 
     if (objc) {
 	if (Tcl_IsSafe(interp)) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "permission denied: ",
-		    "safe interpreters cannot change recursion limit",
-		    (char *) NULL);
+	    Tcl_AppendResult(interp, "permission denied: "
+		    "safe interpreters cannot change recursion limit", NULL);
 	    return TCL_ERROR;
 	}
-	if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
+	if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
 	if (limit <= 0) {
@@ -2204,11 +2681,11 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv)
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, objv[0]);
-        return TCL_OK;
+	return TCL_OK;
     } else {
 	limit = Tcl_SetRecursionLimit(slaveInterp, 0);
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
-        return TCL_OK;
+	return TCL_OK;
     }
 }
 
@@ -2223,31 +2700,30 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv)
  *	A standard Tcl result.
  *
  * Side effects:
- *	After this call scripts in the slave will no longer be able
- *	to invoke the named command.
+ *	After this call scripts in the slave will no longer be able to invoke
+ *	the named command.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SlaveHide(interp, slaveInterp, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument strings. */
+SlaveHide(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* Interp in which command will be exposed. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument strings. */
 {
     char *name;
-    
+
     if (Tcl_IsSafe(interp)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot hide commands",
-		(char *) NULL);
+		-1));
 	return TCL_ERROR;
     }
 
-    name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
-    if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),
-	    name) != TCL_OK) {
+    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
+    if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
 	TclTransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
     }
@@ -2272,26 +2748,25 @@ SlaveHide(interp, slaveInterp, objc, objv)
  */
 
 static int
-SlaveHidden(interp, slaveInterp)
-    Tcl_Interp *interp;		/* Interp for data return. */
-    Tcl_Interp *slaveInterp;	/* Interp whose hidden commands to query. */
+SlaveHidden(
+    Tcl_Interp *interp,		/* Interp for data return. */
+    Tcl_Interp *slaveInterp)	/* Interp whose hidden commands to query. */
 {
-    Tcl_Obj *listObjPtr;		/* Local object pointer. */
+    Tcl_Obj *listObjPtr = Tcl_NewObj();	/* Local object pointer. */
     Tcl_HashTable *hTblPtr;		/* For local searches. */
     Tcl_HashEntry *hPtr;		/* For local searches. */
     Tcl_HashSearch hSearch;		/* For local searches. */
-    
-    listObjPtr = Tcl_GetObjResult(interp);
+
     hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
-    if (hTblPtr != (Tcl_HashTable *) NULL) {
+    if (hTblPtr != NULL) {
 	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != (Tcl_HashEntry *) NULL;
-	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-
+		hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&hSearch)) {
 	    Tcl_ListObjAppendElement(NULL, listObjPtr,
 		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
 	}
     }
+    Tcl_SetObjResult(interp, listObjPtr);
     return TCL_OK;
 }
 
@@ -2312,37 +2787,45 @@ SlaveHidden(interp, slaveInterp)
  */
 
 static int
-SlaveInvokeHidden(interp, slaveInterp, global, objc, objv)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp *slaveInterp;	/* The slave interpreter in which command
-				 * will be invoked. */
-    int global;			/* Non-zero to invoke in global namespace. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+SlaveInvokeHidden(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command will
+				 * be invoked. */
+    const char *namespaceName,	/* The namespace to use, if any. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result;
-    
+
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"not allowed to invoke hidden commands from safe interpreter",
-		-1);
+		-1));
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve((ClientData) slaveInterp);
+    Tcl_Preserve(slaveInterp);
     Tcl_AllowExceptions(slaveInterp);
-    
-    if (global) {
-        result = TclObjInvokeGlobal(slaveInterp, objc, objv,
-                TCL_INVOKE_HIDDEN);
+
+    if (namespaceName == NULL) {
+	result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
     } else {
-        result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+	Namespace *nsPtr, *dummy1, *dummy2;
+	const char *tail;
+
+	result = TclGetNamespaceForQualName(slaveInterp, namespaceName, NULL,
+		TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG
+		| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+	if (result == TCL_OK) {
+	    result = TclObjInvokeNamespace(slaveInterp, objc, objv,
+		    (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
+	}
     }
 
     TclTransferResult(slaveInterp, result, interp);
 
-    Tcl_Release((ClientData) slaveInterp);
-    return result;        
+    Tcl_Release(slaveInterp);
+    return result;
 }
 
 /*
@@ -2356,22 +2839,22 @@ SlaveInvokeHidden(interp, slaveInterp, global, objc, objv)
  *	A standard Tcl result.
  *
  * Side effects:
- *	After this call the hard-wired security checks in the core no
- *	longer prevent the slave from performing certain operations.
+ *	After this call the hard-wired security checks in the core no longer
+ *	prevent the slave from performing certain operations.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SlaveMarkTrusted(interp, slaveInterp)
-    Tcl_Interp *interp;		/* Interp for error return. */
-    Tcl_Interp *slaveInterp;	/* The slave interpreter which will be
-				 * marked trusted. */
+SlaveMarkTrusted(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp)	/* The slave interpreter which will be marked
+				 * trusted. */
 {
     if (Tcl_IsSafe(interp)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot mark trusted",
-		(char *) NULL);
+		-1));
 	return TCL_ERROR;
     }
     ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
@@ -2395,17 +2878,15 @@ SlaveMarkTrusted(interp, slaveInterp)
  */
 
 int
-Tcl_IsSafe(interp)
-    Tcl_Interp *interp;		/* Is this interpreter "safe" ? */
+Tcl_IsSafe(
+    Tcl_Interp *interp)		/* Is this interpreter "safe" ? */
 {
-    Interp *iPtr;
+    Interp *iPtr = (Interp *) interp;
 
-    if (interp == (Tcl_Interp *) NULL) {
-        return 0;
+    if (iPtr == NULL) {
+	return 0;
     }
-    iPtr = (Interp *) interp;
-
-    return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
+    return (iPtr->flags & SAFE_INTERP) ? 1 : 0;
 }
 
 /*
@@ -2414,34 +2895,50 @@ Tcl_IsSafe(interp)
  * Tcl_MakeSafe --
  *
  *	Makes its argument interpreter contain only functionality that is
- *	defined to be part of Safe Tcl. Unsafe commands are hidden, the
- *	env array is unset, and the standard channels are removed.
+ *	defined to be part of Safe Tcl. Unsafe commands are hidden, the env
+ *	array is unset, and the standard channels are removed.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Hides commands in its argument interpreter, and removes settings
- *	and channels.
+ *	Hides commands in its argument interpreter, and removes settings and
+ *	channels.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_MakeSafe(interp)
-    Tcl_Interp *interp;		/* Interpreter to be made safe. */
+Tcl_MakeSafe(
+    Tcl_Interp *interp)		/* Interpreter to be made safe. */
 {
-    Tcl_Channel chan;				/* Channel to remove from
-                                                 * safe interpreter. */
+    Tcl_Channel chan;		/* Channel to remove from safe interpreter. */
     Interp *iPtr = (Interp *) interp;
+    Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;
 
     TclHideUnsafeCommands(interp);
-    
+
+    if (master != NULL) {
+	/*
+	 * Alias these function implementations in the slave to those in the
+	 * master; the overall implementations are safe, but they're normally
+	 * defined by init.tcl which is not sourced by safe interpreters.
+	 * Assume these functions all work. [Bug 2895741]
+	 */
+
+	(void) Tcl_Eval(interp,
+		"namespace eval ::tcl {namespace eval mathfunc {}}");
+	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
+		"::tcl::mathfunc::min", 0, NULL);
+	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
+		"::tcl::mathfunc::max", 0, NULL);
+    }
+
     iPtr->flags |= SAFE_INTERP;
 
     /*
-     *  Unsetting variables : (which should not have been set 
-     *  in the first place, but...)
+     * Unsetting variables : (which should not have been set in the first
+     * place, but...)
      */
 
     /*
@@ -2450,7 +2947,7 @@ Tcl_MakeSafe(interp)
 
     Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
 
-    /* 
+    /*
      * Remove unsafe parts of tcl_platform
      */
 
@@ -2460,37 +2957,1582 @@ Tcl_MakeSafe(interp)
     Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);
 
     /*
-     * Unset path informations variables
-     * (the only one remaining is [info nameofexecutable])
+     * Unset path informations variables (the only one remaining is [info
+     * nameofexecutable])
      */
 
     Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
     Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
     Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
-    
+
     /*
-     * Remove the standard channels from the interpreter; safe interpreters
-     * do not ordinarily have access to stdin, stdout and stderr.
+     * Remove the standard channels from the interpreter; safe interpreters do
+     * not ordinarily have access to stdin, stdout and stderr.
      *
      * NOTE: These channels are not added to the interpreter by the
      * Tcl_CreateInterp call, but may be added later, by another I/O
-     * operation. We want to ensure that the interpreter does not have
-     * these channels even if it is being made safe after being used for
-     * some time..
+     * operation. We want to ensure that the interpreter does not have these
+     * channels even if it is being made safe after being used for some time..
      */
 
     chan = Tcl_GetStdChannel(TCL_STDIN);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_UnregisterChannel(interp, chan);
+    if (chan != NULL) {
+	Tcl_UnregisterChannel(interp, chan);
     }
     chan = Tcl_GetStdChannel(TCL_STDOUT);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_UnregisterChannel(interp, chan);
+    if (chan != NULL) {
+	Tcl_UnregisterChannel(interp, chan);
     }
     chan = Tcl_GetStdChannel(TCL_STDERR);
-    if (chan != (Tcl_Channel) NULL) {
-        Tcl_UnregisterChannel(interp, chan);
+    if (chan != NULL) {
+	Tcl_UnregisterChannel(interp, chan);
     }
 
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitExceeded --
+ *
+ *	Tests whether any limit has been exceeded in the given interpreter
+ *	(i.e. whether the interpreter is currently unable to process further
+ *	scripts).
+ *
+ * Results:
+ *	A boolean value.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	If you change this function, you MUST also update TclLimitExceeded() in
+ *	tclInt.h.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitExceeded(
+    Tcl_Interp *interp)
+{
+    register Interp *iPtr = (Interp *) interp;
+
+    return iPtr->limit.exceeded != 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitReady --
+ *
+ *	Find out whether any limit has been set on the interpreter, and if so
+ *	check whether the granularity of that limit is such that the full
+ *	limit check should be carried out.
+ *
+ * Results:
+ *	A boolean value that indicates whether to call Tcl_LimitCheck.
+ *
+ * Side effects:
+ *	Increments the limit granularity counter.
+ *
+ * Notes:
+ *	If you change this function, you MUST also update TclLimitReady() in
+ *	tclInt.h.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitReady(
+    Tcl_Interp *interp)
+{
+    register Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->limit.active != 0) {
+	register int ticker = ++iPtr->limit.granularityTicker;
+
+	if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
+		((iPtr->limit.cmdGranularity == 1) ||
+		    (ticker % iPtr->limit.cmdGranularity == 0))) {
+	    return 1;
+	}
+	if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
+		((iPtr->limit.timeGranularity == 1) ||
+		    (ticker % iPtr->limit.timeGranularity == 0))) {
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitCheck --
+ *
+ *	Check all currently set limits in the interpreter (where permitted by
+ *	granularity). If a limit is exceeded, call its callbacks and, if the
+ *	limit is still exceeded after the callbacks have run, make the
+ *	interpreter generate an error that cannot be caught within the limited
+ *	interpreter.
+ *
+ * Results:
+ *	A Tcl result value (TCL_OK if no limit is exceeded, and TCL_ERROR if a
+ *	limit has been exceeded).
+ *
+ * Side effects:
+ *	May invoke system calls. May invoke other interpreters. May be
+ *	reentrant. May put the interpreter into a state where it can no longer
+ *	execute commands without outside intervention.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitCheck(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    register int ticker = iPtr->limit.granularityTicker;
+
+    if (Tcl_InterpDeleted(interp)) {
+	return TCL_OK;
+    }
+
+    if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
+	    ((iPtr->limit.cmdGranularity == 1) ||
+		    (ticker % iPtr->limit.cmdGranularity == 0)) &&
+	    (iPtr->limit.cmdCount < iPtr->cmdCount)) {
+	iPtr->limit.exceeded |= TCL_LIMIT_COMMANDS;
+	Tcl_Preserve(interp);
+	RunLimitHandlers(iPtr->limit.cmdHandlers, interp);
+	if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
+	    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
+	} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "command count limit exceeded", NULL);
+	    Tcl_Release(interp);
+	    return TCL_ERROR;
+	}
+	Tcl_Release(interp);
+    }
+
+    if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
+	    ((iPtr->limit.timeGranularity == 1) ||
+		(ticker % iPtr->limit.timeGranularity == 0))) {
+	Tcl_Time now;
+
+	Tcl_GetTime(&now);
+	if (iPtr->limit.time.sec < now.sec ||
+		(iPtr->limit.time.sec == now.sec &&
+		iPtr->limit.time.usec < now.usec)) {
+	    iPtr->limit.exceeded |= TCL_LIMIT_TIME;
+	    Tcl_Preserve(interp);
+	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
+	    if (iPtr->limit.time.sec > now.sec ||
+		    (iPtr->limit.time.sec == now.sec &&
+		    iPtr->limit.time.usec >= now.usec)) {
+		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
+	    } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "time limit exceeded", NULL);
+		Tcl_Release(interp);
+		return TCL_ERROR;
+	    }
+	    Tcl_Release(interp);
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RunLimitHandlers --
+ *
+ *	Invoke all the limit handlers in a list (for a particular limit).
+ *	Note that no particular limit handler callback will be invoked
+ *	reentrantly.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on the limit handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RunLimitHandlers(
+    LimitHandler *handlerPtr,
+    Tcl_Interp *interp)
+{
+    LimitHandler *nextPtr;
+    for (; handlerPtr!=NULL ; handlerPtr=nextPtr) {
+	if (handlerPtr->flags & (LIMIT_HANDLER_DELETED|LIMIT_HANDLER_ACTIVE)) {
+	    /*
+	     * Reentrant call or something seriously strange in the delete
+	     * code.
+	     */
+
+	    nextPtr = handlerPtr->nextPtr;
+	    continue;
+	}
+
+	/*
+	 * Set the ACTIVE flag while running the limit handler itself so we
+	 * cannot reentrantly call this handler and know to use the alternate
+	 * method of deletion if necessary.
+	 */
+
+	handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
+	(handlerPtr->handlerProc)(handlerPtr->clientData, interp);
+	handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;
+
+	/*
+	 * Rediscover this value; it might have changed during the processing
+	 * of a limit handler. We have to record it here because we might
+	 * delete the structure below, and reading a value out of a deleted
+	 * structure is unsafe (even if actually legal with some
+	 * malloc()/free() implementations.)
+	 */
+
+	nextPtr = handlerPtr->nextPtr;
+
+	/*
+	 * If we deleted the current handler while we were executing it, we
+	 * will have spliced it out of the list and set the
+	 * LIMIT_HANDLER_DELETED flag.
+	 */
+
+	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
+	    if (handlerPtr->deleteProc != NULL) {
+		(handlerPtr->deleteProc)(handlerPtr->clientData);
+	    }
+	    ckfree((char *) handlerPtr);
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitAddHandler --
+ *
+ *	Add a callback handler for a particular resource limit.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Extends the internal linked list of handlers for a limit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitAddHandler(
+    Tcl_Interp *interp,
+    int type,
+    Tcl_LimitHandlerProc *handlerProc,
+    ClientData clientData,
+    Tcl_LimitHandlerDeleteProc *deleteProc)
+{
+    Interp *iPtr = (Interp *) interp;
+    LimitHandler *handlerPtr;
+
+    /*
+     * Convert everything into a real deletion callback.
+     */
+
+    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
+	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
+    }
+    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
+	deleteProc = NULL;
+    }
+
+    /*
+     * Allocate a handler record.
+     */
+
+    handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+    handlerPtr->flags = 0;
+    handlerPtr->handlerProc = handlerProc;
+    handlerPtr->clientData = clientData;
+    handlerPtr->deleteProc = deleteProc;
+    handlerPtr->prevPtr = NULL;
+
+    /*
+     * Prepend onto the front of the correct linked list.
+     */
+
+    switch (type) {
+    case TCL_LIMIT_COMMANDS:
+	handlerPtr->nextPtr = iPtr->limit.cmdHandlers;
+	if (handlerPtr->nextPtr != NULL) {
+	    handlerPtr->nextPtr->prevPtr = handlerPtr;
+	}
+	iPtr->limit.cmdHandlers = handlerPtr;
+	return;
+
+    case TCL_LIMIT_TIME:
+	handlerPtr->nextPtr = iPtr->limit.timeHandlers;
+	if (handlerPtr->nextPtr != NULL) {
+	    handlerPtr->nextPtr->prevPtr = handlerPtr;
+	}
+	iPtr->limit.timeHandlers = handlerPtr;
+	return;
+    }
+
+    Tcl_Panic("unknown type of resource limit");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitRemoveHandler --
+ *
+ *	Remove a callback handler for a particular resource limit.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The handler is spliced out of the internal linked list for the limit,
+ *	and if not currently being invoked, deleted. Otherwise it is just
+ *	marked for deletion and removed when the limit handler has finished
+ *	executing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitRemoveHandler(
+    Tcl_Interp *interp,
+    int type,
+    Tcl_LimitHandlerProc *handlerProc,
+    ClientData clientData)
+{
+    Interp *iPtr = (Interp *) interp;
+    LimitHandler *handlerPtr;
+
+    switch (type) {
+    case TCL_LIMIT_COMMANDS:
+	handlerPtr = iPtr->limit.cmdHandlers;
+	break;
+    case TCL_LIMIT_TIME:
+	handlerPtr = iPtr->limit.timeHandlers;
+	break;
+    default:
+	Tcl_Panic("unknown type of resource limit");
+	return;
+    }
+
+    for (; handlerPtr!=NULL ; handlerPtr=handlerPtr->nextPtr) {
+	if ((handlerPtr->handlerProc != handlerProc) ||
+		(handlerPtr->clientData != clientData)) {
+	    continue;
+	}
+
+	/*
+	 * We've found the handler to delete; mark it as doomed if not already
+	 * so marked (which shouldn't actually happen).
+	 */
+
+	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
+	    return;
+	}
+	handlerPtr->flags |= LIMIT_HANDLER_DELETED;
+
+	/*
+	 * Splice the handler out of the doubly-linked list.
+	 */
+
+	if (handlerPtr->prevPtr == NULL) {
+	    switch (type) {
+	    case TCL_LIMIT_COMMANDS:
+		iPtr->limit.cmdHandlers = handlerPtr->nextPtr;
+		break;
+	    case TCL_LIMIT_TIME:
+		iPtr->limit.timeHandlers = handlerPtr->nextPtr;
+		break;
+	    }
+	} else {
+	    handlerPtr->prevPtr->nextPtr = handlerPtr->nextPtr;
+	}
+	if (handlerPtr->nextPtr != NULL) {
+	    handlerPtr->nextPtr->prevPtr = handlerPtr->prevPtr;
+	}
+
+	/*
+	 * If nothing is currently executing the handler, delete its client
+	 * data and the overall handler structure now. Otherwise it will all
+	 * go away when the handler returns.
+	 */
+
+	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
+	    if (handlerPtr->deleteProc != NULL) {
+		(handlerPtr->deleteProc)(handlerPtr->clientData);
+	    }
+	    ckfree((char *) handlerPtr);
+	}
+	return;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLimitRemoveAllHandlers --
+ *
+ *	Remove all limit callback handlers for an interpreter. This is invoked
+ *	as part of deleting the interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Limit handlers are deleted or marked for deletion (as with
+ *	Tcl_LimitRemoveHandler).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclLimitRemoveAllHandlers(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    LimitHandler *handlerPtr, *nextHandlerPtr;
+
+    /*
+     * Delete all command-limit handlers.
+     */
+
+    for (handlerPtr=iPtr->limit.cmdHandlers, iPtr->limit.cmdHandlers=NULL;
+	    handlerPtr!=NULL; handlerPtr=nextHandlerPtr) {
+	nextHandlerPtr = handlerPtr->nextPtr;
+
+	/*
+	 * Do not delete here if it has already been marked for deletion.
+	 */
+
+	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
+	    continue;
+	}
+	handlerPtr->flags |= LIMIT_HANDLER_DELETED;
+	handlerPtr->prevPtr = NULL;
+	handlerPtr->nextPtr = NULL;
+
+	/*
+	 * If nothing is currently executing the handler, delete its client
+	 * data and the overall handler structure now. Otherwise it will all
+	 * go away when the handler returns.
+	 */
+
+	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
+	    if (handlerPtr->deleteProc != NULL) {
+		(handlerPtr->deleteProc)(handlerPtr->clientData);
+	    }
+	    ckfree((char *) handlerPtr);
+	}
+    }
+
+    /*
+     * Delete all time-limit handlers.
+     */
+
+    for (handlerPtr=iPtr->limit.timeHandlers, iPtr->limit.timeHandlers=NULL;
+	    handlerPtr!=NULL; handlerPtr=nextHandlerPtr) {
+	nextHandlerPtr = handlerPtr->nextPtr;
+
+	/*
+	 * Do not delete here if it has already been marked for deletion.
+	 */
+
+	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
+	    continue;
+	}
+	handlerPtr->flags |= LIMIT_HANDLER_DELETED;
+	handlerPtr->prevPtr = NULL;
+	handlerPtr->nextPtr = NULL;
+
+	/*
+	 * If nothing is currently executing the handler, delete its client
+	 * data and the overall handler structure now. Otherwise it will all
+	 * go away when the handler returns.
+	 */
+
+	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
+	    if (handlerPtr->deleteProc != NULL) {
+		(handlerPtr->deleteProc)(handlerPtr->clientData);
+	    }
+	    ckfree((char *) handlerPtr);
+	}
+    }
+
+    /*
+     * Delete the timer callback that is used to trap limits that occur in
+     * [vwait]s...
+     */
+
+    if (iPtr->limit.timeEvent != NULL) {
+	Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+	iPtr->limit.timeEvent = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitTypeEnabled --
+ *
+ *	Check whether a particular limit has been enabled for an interpreter.
+ *
+ * Results:
+ *	A boolean value.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitTypeEnabled(
+    Tcl_Interp *interp,
+    int type)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    return (iPtr->limit.active & type) != 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitTypeExceeded --
+ *
+ *	Check whether a particular limit has been exceeded for an interpreter.
+ *
+ * Results:
+ *	A boolean value (note that Tcl_LimitExceeded will always return
+ *	non-zero when this function returns non-zero).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitTypeExceeded(
+    Tcl_Interp *interp,
+    int type)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    return (iPtr->limit.exceeded & type) != 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitTypeSet --
+ *
+ *	Enable a particular limit for an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The limit is turned on and will be checked in future at an interval
+ *	determined by the frequency of calling of Tcl_LimitReady and the
+ *	granularity of the limit in question.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitTypeSet(
+    Tcl_Interp *interp,
+    int type)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->limit.active |= type;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitTypeReset --
+ *
+ *	Disable a particular limit for an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The limit is disabled. If the limit was exceeded when this function
+ *	was called, the limit will no longer be exceeded afterwards and the
+ *	interpreter will be free to execute further scripts (assuming it isn't
+ *	also deleted, of course).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitTypeReset(
+    Tcl_Interp *interp,
+    int type)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->limit.active &= ~type;
+    iPtr->limit.exceeded &= ~type;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitSetCommands --
+ *
+ *	Set the command limit for an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Also resets whether the command limit was exceeded. This might permit
+ *	a small amount of further execution in the interpreter even if the
+ *	limit itself is theoretically exceeded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitSetCommands(
+    Tcl_Interp *interp,
+    int commandLimit)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->limit.cmdCount = commandLimit;
+    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitGetCommands --
+ *
+ *	Get the number of commands that may be executed in the interpreter
+ *	before the command-limit is reached.
+ *
+ * Results:
+ *	An upper bound on the number of commands.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitGetCommands(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    return iPtr->limit.cmdCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitSetTime --
+ *
+ *	Set the time limit for an interpreter by copying it from the value
+ *	pointed to by the timeLimitPtr argument.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Also resets whether the time limit was exceeded. This might permit a
+ *	small amount of further execution in the interpreter even if the limit
+ *	itself is theoretically exceeded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitSetTime(
+    Tcl_Interp *interp,
+    Tcl_Time *timeLimitPtr)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Time nextMoment;
+
+    memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time));
+    if (iPtr->limit.timeEvent != NULL) {
+	Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+    }
+    nextMoment.sec = timeLimitPtr->sec;
+    nextMoment.usec = timeLimitPtr->usec+10;
+    if (nextMoment.usec >= 1000000) {
+	nextMoment.sec++;
+	nextMoment.usec -= 1000000;
+    }
+    iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment,
+	    TimeLimitCallback, interp);
+    iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimeLimitCallback --
+ *
+ *	Callback that allows time limits to be enforced even when doing a
+ *	blocking wait for events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May put the interpreter into a state where it can no longer execute
+ *	commands. May make callbacks into other interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimeLimitCallback(
+    ClientData clientData)
+{
+    Tcl_Interp *interp = clientData;
+    Interp *iPtr = clientData;
+    int code;
+
+    Tcl_Preserve(interp);
+    iPtr->limit.timeEvent = NULL;
+
+    /*
+     * Must reset the granularity ticker here to force an immediate full
+     * check. This is OK because we're swallowing the cost in the overall cost
+     * of the event loop. [Bug 2891362]
+     */
+
+    iPtr->limit.granularityTicker = 0;
+
+    code = Tcl_LimitCheck(interp);
+    if (code != TCL_OK) {
+	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
+	TclBackgroundException(interp, code);
+    }
+    Tcl_Release(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitGetTime --
+ *
+ *	Get the current time limit.
+ *
+ * Results:
+ *	The time limit (by it being copied into the variable pointed to by the
+ *	timeLimitPtr).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitGetTime(
+    Tcl_Interp *interp,
+    Tcl_Time *timeLimitPtr)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    memcpy(timeLimitPtr, &iPtr->limit.time, sizeof(Tcl_Time));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitSetGranularity --
+ *
+ *	Set the granularity divisor (which must be positive) for a particular
+ *	limit.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The granularity is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LimitSetGranularity(
+    Tcl_Interp *interp,
+    int type,
+    int granularity)
+{
+    Interp *iPtr = (Interp *) interp;
+    if (granularity < 1) {
+	Tcl_Panic("limit granularity must be positive");
+    }
+
+    switch (type) {
+    case TCL_LIMIT_COMMANDS:
+	iPtr->limit.cmdGranularity = granularity;
+	return;
+    case TCL_LIMIT_TIME:
+	iPtr->limit.timeGranularity = granularity;
+	return;
+    }
+    Tcl_Panic("unknown type of resource limit");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LimitGetGranularity --
+ *
+ *	Get the granularity divisor for a particular limit.
+ *
+ * Results:
+ *	The granularity divisor for the given limit.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LimitGetGranularity(
+    Tcl_Interp *interp,
+    int type)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    switch (type) {
+    case TCL_LIMIT_COMMANDS:
+	return iPtr->limit.cmdGranularity;
+    case TCL_LIMIT_TIME:
+	return iPtr->limit.timeGranularity;
+    }
+    Tcl_Panic("unknown type of resource limit");
+    return -1; /* NOT REACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteScriptLimitCallback --
+ *
+ *	Callback for when a script limit (a limit callback implemented as a
+ *	Tcl script in a master interpreter, as set up from Tcl) is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The reference to the script callback from the controlling interpreter
+ *	is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteScriptLimitCallback(
+    ClientData clientData)
+{
+    ScriptLimitCallback *limitCBPtr = clientData;
+
+    Tcl_DecrRefCount(limitCBPtr->scriptObj);
+    if (limitCBPtr->entryPtr != NULL) {
+	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
+    }
+    ckfree((char *) limitCBPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallScriptLimitCallback --
+ *
+ *	Invoke a script limit callback. Used to implement limit callbacks set
+ *	at the Tcl level on child interpreters.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on the callback script. Errors are reported as background
+ *	errors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CallScriptLimitCallback(
+    ClientData clientData,
+    Tcl_Interp *interp)		/* Interpreter which failed the limit */
+{
+    ScriptLimitCallback *limitCBPtr = clientData;
+    int code;
+
+    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
+	return;
+    }
+    Tcl_Preserve(limitCBPtr->interp);
+    code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
+	    TCL_EVAL_GLOBAL);
+    if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
+	TclBackgroundException(limitCBPtr->interp, code);
+    }
+    Tcl_Release(limitCBPtr->interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetScriptLimitCallback --
+ *
+ *	Install (or remove, if scriptObj is NULL) a limit callback script that
+ *	is called when the target interpreter exceeds the type of limit
+ *	specified. Each interpreter may only have one callback set on another
+ *	interpreter through this mechanism (though as many interpreters may be
+ *	limited as the programmer chooses overall).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A limit callback implemented as an invokation of a Tcl script in
+ *	another interpreter is either installed or removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetScriptLimitCallback(
+    Tcl_Interp *interp,
+    int type,
+    Tcl_Interp *targetInterp,
+    Tcl_Obj *scriptObj)
+{
+    ScriptLimitCallback *limitCBPtr;
+    Tcl_HashEntry *hashPtr;
+    int isNew;
+    ScriptLimitCallbackKey key;
+    Interp *iPtr = (Interp *) interp;
+
+    if (interp == targetInterp) {
+	Tcl_Panic("installing limit callback to the limited interpreter");
+    }
+
+    key.interp = targetInterp;
+    key.type = type;
+
+    if (scriptObj == NULL) {
+	hashPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
+	if (hashPtr != NULL) {
+	    Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
+		    Tcl_GetHashValue(hashPtr));
+	}
+	return;
+    }
+
+    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
+	    &isNew);
+    if (!isNew) {
+	limitCBPtr = Tcl_GetHashValue(hashPtr);
+	limitCBPtr->entryPtr = NULL;
+	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
+		limitCBPtr);
+    }
+
+    limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
+    limitCBPtr->interp = interp;
+    limitCBPtr->scriptObj = scriptObj;
+    limitCBPtr->entryPtr = hashPtr;
+    limitCBPtr->type = type;
+    Tcl_IncrRefCount(scriptObj);
+
+    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,
+	    limitCBPtr, DeleteScriptLimitCallback);
+    Tcl_SetHashValue(hashPtr, limitCBPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRemoveScriptLimitCallbacks --
+ *
+ *	Remove all script-implemented limit callbacks that make calls back
+ *	into the given interpreter. This invoked as part of deleting an
+ *	interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The script limit callbacks are removed or marked for later removal.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclRemoveScriptLimitCallbacks(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hashPtr;
+    Tcl_HashSearch search;
+    ScriptLimitCallbackKey *keyPtr;
+
+    hashPtr = Tcl_FirstHashEntry(&iPtr->limit.callbacks, &search);
+    while (hashPtr != NULL) {
+	keyPtr = (ScriptLimitCallbackKey *)
+		Tcl_GetHashKey(&iPtr->limit.callbacks, hashPtr);
+	Tcl_LimitRemoveHandler(keyPtr->interp, keyPtr->type,
+		CallScriptLimitCallback, Tcl_GetHashValue(hashPtr));
+	hashPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&iPtr->limit.callbacks);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitLimitSupport --
+ *
+ *	Initialise all the parts of the interpreter relating to resource limit
+ *	management. This allows an interpreter to both have limits set upon
+ *	itself and set limits upon other interpreters.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The resource limit subsystem is initialised for the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitLimitSupport(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->limit.active = 0;
+    iPtr->limit.granularityTicker = 0;
+    iPtr->limit.exceeded = 0;
+    iPtr->limit.cmdCount = 0;
+    iPtr->limit.cmdHandlers = NULL;
+    iPtr->limit.cmdGranularity = 1;
+    memset(&iPtr->limit.time, 0, sizeof(Tcl_Time));
+    iPtr->limit.timeHandlers = NULL;
+    iPtr->limit.timeEvent = NULL;
+    iPtr->limit.timeGranularity = 10;
+    Tcl_InitHashTable(&iPtr->limit.callbacks,
+	    sizeof(ScriptLimitCallbackKey)/sizeof(int));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InheritLimitsFromMaster --
+ *
+ *	Derive the interpreter limit configuration for a slave interpreter
+ *	from the limit config for the master.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The slave interpreter limits are set so that if the master has a
+ *	limit, it may not exceed it by handing off work to slave interpreters.
+ *	Note that this does not transfer limit callbacks from the master to
+ *	the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InheritLimitsFromMaster(
+    Tcl_Interp *slaveInterp,
+    Tcl_Interp *masterInterp)
+{
+    Interp *slavePtr = (Interp *) slaveInterp;
+    Interp *masterPtr = (Interp *) masterInterp;
+
+    if (masterPtr->limit.active & TCL_LIMIT_COMMANDS) {
+	slavePtr->limit.active |= TCL_LIMIT_COMMANDS;
+	slavePtr->limit.cmdCount = 0;
+	slavePtr->limit.cmdGranularity = masterPtr->limit.cmdGranularity;
+    }
+    if (masterPtr->limit.active & TCL_LIMIT_TIME) {
+	slavePtr->limit.active |= TCL_LIMIT_TIME;
+	memcpy(&slavePtr->limit.time, &masterPtr->limit.time,
+		sizeof(Tcl_Time));
+	slavePtr->limit.timeGranularity = masterPtr->limit.timeGranularity;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveCommandLimitCmd --
+ *
+ *	Implementation of the [interp limit $i commands] and [$i limit
+ *	commands] subcommands. See the interp manual page for a full
+ *	description.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveCommandLimitCmd(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Interp *slaveInterp,	/* Interpreter being adjusted. */
+    int consumedObjc,		/* Number of args already parsed. */
+    int objc,			/* Total number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *options[] = {
+	"-command", "-granularity", "-value", NULL
+    };
+    enum Options {
+	OPT_CMD, OPT_GRAN, OPT_VAL
+    };
+    Interp *iPtr = (Interp *) interp;
+    int index;
+    ScriptLimitCallbackKey key;
+    ScriptLimitCallback *limitCBPtr;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * First, ensure that we are not reading or writing the calling
+     * interpreter's limits; it may only manipulate its children. Note that
+     * the low level API enforces this with Tcl_Panic, which we want to
+     * avoid. [Bug 3398794]
+     */
+
+    if (interp == slaveInterp) {
+	Tcl_AppendResult(interp,
+		"limits on current interpreter inaccessible", NULL);
+	return TCL_ERROR;
+    }
+
+    if (objc == consumedObjc) {
+	Tcl_Obj *dictPtr;
+
+	TclNewObj(dictPtr);
+	key.interp = slaveInterp;
+	key.type = TCL_LIMIT_COMMANDS;
+	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
+	if (hPtr != NULL) {
+	    limitCBPtr = Tcl_GetHashValue(hPtr);
+	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
+		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
+			limitCBPtr->scriptObj);
+	    } else {
+		goto putEmptyCommandInDict;
+	    }
+	} else {
+	    Tcl_Obj *empty;
+
+	putEmptyCommandInDict:
+	    TclNewObj(empty);
+	    Tcl_DictObjPut(NULL, dictPtr,
+		    Tcl_NewStringObj(options[0], -1), empty);
+	}
+	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
+		Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
+		TCL_LIMIT_COMMANDS)));
+
+	if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
+	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
+		    Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
+	} else {
+	    Tcl_Obj *empty;
+
+	    TclNewObj(empty);
+	    Tcl_DictObjPut(NULL, dictPtr,
+		    Tcl_NewStringObj(options[2], -1), empty);
+	}
+	Tcl_SetObjResult(interp, dictPtr);
+	return TCL_OK;
+    } else if (objc == consumedObjc+1) {
+	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
+		0, &index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum Options) index) {
+	case OPT_CMD:
+	    key.interp = slaveInterp;
+	    key.type = TCL_LIMIT_COMMANDS;
+	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
+	    if (hPtr != NULL) {
+		limitCBPtr = Tcl_GetHashValue(hPtr);
+		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
+		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
+		}
+	    }
+	    break;
+	case OPT_GRAN:
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
+		    Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_COMMANDS)));
+	    break;
+	case OPT_VAL:
+	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
+		Tcl_SetObjResult(interp,
+			Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
+	    }
+	    break;
+	}
+	return TCL_OK;
+    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
+	Tcl_WrongNumArgs(interp, consumedObjc, objv,
+		"?-option? ?value? ?-option value ...?");
+	return TCL_ERROR;
+    } else {
+	int i, scriptLen = 0, limitLen = 0;
+	Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
+	int gran = 0, limit = 0;
+
+	for (i=consumedObjc ; i<objc ; i+=2) {
+	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		    &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum Options) index) {
+	    case OPT_CMD:
+		scriptObj = objv[i+1];
+		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+		break;
+	    case OPT_GRAN:
+		granObj = objv[i+1];
+		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (gran < 1) {
+		    Tcl_AppendResult(interp, "granularity must be at "
+			    "least 1", NULL);
+		    return TCL_ERROR;
+		}
+		break;
+	    case OPT_VAL:
+		limitObj = objv[i+1];
+		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
+		if (limitLen == 0) {
+		    break;
+		}
+		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (limit < 0) {
+		    Tcl_AppendResult(interp, "command limit value must be at "
+			    "least 0", NULL);
+		    return TCL_ERROR;
+		}
+		break;
+	    }
+	}
+	if (scriptObj != NULL) {
+	    SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp,
+		    (scriptLen > 0 ? scriptObj : NULL));
+	}
+	if (granObj != NULL) {
+	    Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_COMMANDS, gran);
+	}
+	if (limitObj != NULL) {
+	    if (limitLen > 0) {
+		Tcl_LimitSetCommands(slaveInterp, limit);
+		Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_COMMANDS);
+	    } else {
+		Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_COMMANDS);
+	    }
+	}
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveTimeLimitCmd --
+ *
+ *	Implementation of the [interp limit $i time] and [$i limit time]
+ *	subcommands. See the interp manual page for a full description.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveTimeLimitCmd(
+    Tcl_Interp *interp,			/* Current interpreter. */
+    Tcl_Interp *slaveInterp,		/* Interpreter being adjusted. */
+    int consumedObjc,			/* Number of args already parsed. */
+    int objc,				/* Total number of arguments. */
+    Tcl_Obj *const objv[])		/* Argument objects. */
+{
+    static const char *options[] = {
+	"-command", "-granularity", "-milliseconds", "-seconds", NULL
+    };
+    enum Options {
+	OPT_CMD, OPT_GRAN, OPT_MILLI, OPT_SEC
+    };
+    Interp *iPtr = (Interp *) interp;
+    int index;
+    ScriptLimitCallbackKey key;
+    ScriptLimitCallback *limitCBPtr;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * First, ensure that we are not reading or writing the calling
+     * interpreter's limits; it may only manipulate its children. Note that
+     * the low level API enforces this with Tcl_Panic, which we want to
+     * avoid. [Bug 3398794]
+     */
+
+    if (interp == slaveInterp) {
+	Tcl_AppendResult(interp,
+		"limits on current interpreter inaccessible", NULL);
+	return TCL_ERROR;
+    }
+
+    if (objc == consumedObjc) {
+	Tcl_Obj *dictPtr;
+
+	TclNewObj(dictPtr);
+	key.interp = slaveInterp;
+	key.type = TCL_LIMIT_TIME;
+	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
+	if (hPtr != NULL) {
+	    limitCBPtr = Tcl_GetHashValue(hPtr);
+	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
+		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
+			limitCBPtr->scriptObj);
+	    } else {
+		goto putEmptyCommandInDict;
+	    }
+	} else {
+	    Tcl_Obj *empty;
+	putEmptyCommandInDict:
+	    TclNewObj(empty);
+	    Tcl_DictObjPut(NULL, dictPtr,
+		    Tcl_NewStringObj(options[0], -1), empty);
+	}
+	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
+		Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
+		TCL_LIMIT_TIME)));
+
+	if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+	    Tcl_Time limitMoment;
+
+	    Tcl_LimitGetTime(slaveInterp, &limitMoment);
+	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
+		    Tcl_NewLongObj(limitMoment.usec/1000));
+	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
+		    Tcl_NewLongObj(limitMoment.sec));
+	} else {
+	    Tcl_Obj *empty;
+
+	    TclNewObj(empty);
+	    Tcl_DictObjPut(NULL, dictPtr,
+		    Tcl_NewStringObj(options[2], -1), empty);
+	    Tcl_DictObjPut(NULL, dictPtr,
+		    Tcl_NewStringObj(options[3], -1), empty);
+	}
+	Tcl_SetObjResult(interp, dictPtr);
+	return TCL_OK;
+    } else if (objc == consumedObjc+1) {
+	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
+		0, &index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum Options) index) {
+	case OPT_CMD:
+	    key.interp = slaveInterp;
+	    key.type = TCL_LIMIT_TIME;
+	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
+	    if (hPtr != NULL) {
+		limitCBPtr = Tcl_GetHashValue(hPtr);
+		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
+		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
+		}
+	    }
+	    break;
+	case OPT_GRAN:
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
+		    Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_TIME)));
+	    break;
+	case OPT_MILLI:
+	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+		Tcl_Time limitMoment;
+
+		Tcl_LimitGetTime(slaveInterp, &limitMoment);
+		Tcl_SetObjResult(interp,
+			Tcl_NewLongObj(limitMoment.usec/1000));
+	    }
+	    break;
+	case OPT_SEC:
+	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
+		Tcl_Time limitMoment;
+
+		Tcl_LimitGetTime(slaveInterp, &limitMoment);
+		Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec));
+	    }
+	    break;
+	}
+	return TCL_OK;
+    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
+	Tcl_WrongNumArgs(interp, consumedObjc, objv,
+		"?-option? ?value? ?-option value ...?");
+	return TCL_ERROR;
+    } else {
+	int i, scriptLen = 0, milliLen = 0, secLen = 0;
+	Tcl_Obj *scriptObj = NULL, *granObj = NULL;
+	Tcl_Obj *milliObj = NULL, *secObj = NULL;
+	int gran = 0;
+	Tcl_Time limitMoment;
+	int tmp;
+
+	Tcl_LimitGetTime(slaveInterp, &limitMoment);
+	for (i=consumedObjc ; i<objc ; i+=2) {
+	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		    &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum Options) index) {
+	    case OPT_CMD:
+		scriptObj = objv[i+1];
+		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+		break;
+	    case OPT_GRAN:
+		granObj = objv[i+1];
+		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (gran < 1) {
+		    Tcl_AppendResult(interp, "granularity must be at "
+			    "least 1", NULL);
+		    return TCL_ERROR;
+		}
+		break;
+	    case OPT_MILLI:
+		milliObj = objv[i+1];
+		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
+		if (milliLen == 0) {
+		    break;
+		}
+		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (tmp < 0) {
+		    Tcl_AppendResult(interp, "milliseconds must be at least 0",
+			    NULL);
+		    return TCL_ERROR;
+		}
+		limitMoment.usec = ((long)tmp)*1000;
+		break;
+	    case OPT_SEC:
+		secObj = objv[i+1];
+		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
+		if (secLen == 0) {
+		    break;
+		}
+		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (tmp < 0) {
+		    Tcl_AppendResult(interp, "seconds must be at least 0",
+			    NULL);
+		    return TCL_ERROR;
+		}
+		limitMoment.sec = tmp;
+		break;
+	    }
+	}
+	if (milliObj != NULL || secObj != NULL) {
+	    if (milliObj != NULL) {
+		/*
+		 * Setting -milliseconds but clearing -seconds, or resetting
+		 * -milliseconds but not resetting -seconds? Bad voodoo!
+		 */
+
+		if (secObj != NULL && secLen == 0 && milliLen > 0) {
+		    Tcl_AppendResult(interp, "may only set -milliseconds "
+			    "if -seconds is not also being reset", NULL);
+		    return TCL_ERROR;
+		}
+		if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
+		    Tcl_AppendResult(interp, "may only reset -milliseconds "
+			    "if -seconds is also being reset", NULL);
+		    return TCL_ERROR;
+		}
+	    }
+
+	    if (milliLen > 0 || secLen > 0) {
+		/*
+		 * Force usec to be in range [0..1000000), possibly
+		 * incrementing sec in the process. This makes it much easier
+		 * for people to write scripts that do small time increments.
+		 */
+
+		limitMoment.sec += limitMoment.usec / 1000000;
+		limitMoment.usec %= 1000000;
+
+		Tcl_LimitSetTime(slaveInterp, &limitMoment);
+		Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_TIME);
+	    } else {
+		Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_TIME);
+	    }
+	}
+	if (scriptObj != NULL) {
+	    SetScriptLimitCallback(interp, TCL_LIMIT_TIME, slaveInterp,
+		    (scriptLen > 0 ? scriptObj : NULL));
+	}
+	if (granObj != NULL) {
+	    Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_TIME, gran);
+	}
+	return TCL_OK;
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 28b1786..f7911a4 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -1,102 +1,125 @@
-/* 
+/*
  * tclLink.c --
  *
- *	This file implements linked variables (a C variable that is
- *	tied to a Tcl variable).  The idea of linked variables was
- *	first suggested by Andreas Stolcke and this implementation is
- *	based heavily on a prototype implementation provided by
- *	him.
+ *	This file implements linked variables (a C variable that is tied to a
+ *	Tcl variable). The idea of linked variables was first suggested by
+ *	Andreas Stolcke and this implementation is based heavily on a
+ *	prototype implementation provided by him.
  *
  * Copyright (c) 1993 The Regents of the University of California.
  * Copyright (c) 1994-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * For each linked variable there is a data structure of the following
- * type, which describes the link and is the clientData for the trace
- * set on the Tcl variable.
+ * For each linked variable there is a data structure of the following type,
+ * which describes the link and is the clientData for the trace set on the Tcl
+ * variable.
  */
 
 typedef struct Link {
     Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
-    Tcl_Obj *varName;		/* Name of variable (must be global).  This
-				 * is needed during trace callbacks, since
-				 * the actual variable may be aliased at
-				 * that time via upvar. */
+    Tcl_Obj *varName;		/* Name of variable (must be global). This is
+				 * needed during trace callbacks, since the
+				 * actual variable may be aliased at that time
+				 * via upvar. */
     char *addr;			/* Location of C variable. */
     int type;			/* Type of link (TCL_LINK_INT, etc.). */
     union {
+	char c;
+	unsigned char uc;
 	int i;
-	double d;
+	unsigned int ui;
+	short s;
+	unsigned short us;
+	long l;
+	unsigned long ul;
 	Tcl_WideInt w;
-    } lastValue;		/* Last known value of C variable;  used to
+	Tcl_WideUInt uw;
+	float f;
+	double d;
+    } lastValue;		/* Last known value of C variable; used to
 				 * avoid string conversions. */
-    int flags;			/* Miscellaneous one-bit values;  see below
-				 * for definitions. */
+    int flags;			/* Miscellaneous one-bit values; see below for
+				 * definitions. */
 } Link;
 
 /*
  * Definitions for flag bits:
  * LINK_READ_ONLY -		1 means errors should be generated if Tcl
  *				script attempts to write variable.
- * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar
- *				is in progress for this variable, so
- *				trace callbacks on the variable should
- *				be ignored.
+ * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
+ *				in progress for this variable, so trace
+ *				callbacks on the variable should be ignored.
  */
 
 #define LINK_READ_ONLY		1
 #define LINK_BEING_UPDATED	2
 
 /*
- * Forward references to procedures defined later in this file:
+ * Forward references to functions defined later in this file:
+ */
+
+static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
+			    CONST char *name1, CONST char *name2, int flags);
+static Tcl_Obj *	ObjValue(Link *linkPtr);
+
+/*
+ * Convenience macro for accessing the value of the C variable pointed to by a
+ * link. Note that this macro produces something that may be regarded as an
+ * lvalue or rvalue; it may be assigned to as well as read. Also note that
+ * this macro assumes the name of the variable being accessed (linkPtr); this
+ * is not strictly a good thing, but it keeps the code much shorter and
+ * cleaner.
  */
 
-static char *		LinkTraceProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, CONST char *name1, 
-                            CONST char *name2, int flags));
-static Tcl_Obj *	ObjValue _ANSI_ARGS_((Link *linkPtr));
+#define LinkedVar(type) (*(type *) linkPtr->addr)
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_LinkVar --
  *
- *	Link a C variable to a Tcl variable so that changes to either
- *	one causes the other to change.
+ *	Link a C variable to a Tcl variable so that changes to either one
+ *	causes the other to change.
  *
  * Results:
- *	The return value is TCL_OK if everything went well or TCL_ERROR
- *	if an error occurred (the interp's result is also set after
- *	errors).
+ *	The return value is TCL_OK if everything went well or TCL_ERROR if an
+ *	error occurred (the interp's result is also set after errors).
  *
  * Side effects:
- *	The value at *addr is linked to the Tcl variable "varName",
- *	using "type" to convert between string values for Tcl and
- *	binary values for *addr.
+ *	The value at *addr is linked to the Tcl variable "varName", using
+ *	"type" to convert between string values for Tcl and binary values for
+ *	*addr.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_LinkVar(interp, varName, addr, type)
-    Tcl_Interp *interp;		/* Interpreter in which varName exists. */
-    CONST char *varName;	/* Name of a global variable in interp. */
-    char *addr;			/* Address of a C variable to be linked
-				 * to varName. */
-    int type;			/* Type of C variable: TCL_LINK_INT, etc. 
-				 * Also may have TCL_LINK_READ_ONLY
-				 * OR'ed in. */
+Tcl_LinkVar(
+    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
+    CONST char *varName,	/* Name of a global variable in interp. */
+    char *addr,			/* Address of a C variable to be linked to
+				 * varName. */
+    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
+				 * may have TCL_LINK_READ_ONLY OR'ed in. */
 {
-    Tcl_Obj *objPtr, *resPtr;
+    Tcl_Obj *objPtr;
     Link *linkPtr;
     int code;
 
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
+    if (linkPtr != NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"variable '%s' is already linked", varName));
+	return TCL_ERROR;
+    }
+
     linkPtr = (Link *) ckalloc(sizeof(Link));
     linkPtr->interp = interp;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
@@ -109,11 +132,8 @@ Tcl_LinkVar(interp, varName, addr, type)
 	linkPtr->flags = 0;
     }
     objPtr = ObjValue(linkPtr);
-    Tcl_IncrRefCount(objPtr);
-    resPtr = Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
-	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(objPtr);
-    if (resPtr == NULL) {
+    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DecrRefCount(linkPtr->varName);
 	ckfree((char *) linkPtr);
 	return TCL_ERROR;
@@ -139,17 +159,17 @@ Tcl_LinkVar(interp, varName, addr, type)
  *	None.
  *
  * Side effects:
- *	If "varName" was previously linked to a C variable, the link
- *	is broken to make the variable independent.  If there was no
- *	previous link for "varName" then nothing happens.
+ *	If "varName" was previously linked to a C variable, the link is broken
+ *	to make the variable independent. If there was no previous link for
+ *	"varName" then nothing happens.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_UnlinkVar(interp, varName)
-    Tcl_Interp *interp;		/* Interpreter containing variable to unlink. */
-    CONST char *varName;	/* Global variable in interp to unlink. */
+Tcl_UnlinkVar(
+    Tcl_Interp *interp,		/* Interpreter containing variable to unlink */
+    CONST char *varName)	/* Global variable in interp to unlink. */
 {
     Link *linkPtr;
 
@@ -170,28 +190,27 @@ Tcl_UnlinkVar(interp, varName)
  *
  * Tcl_UpdateLinkedVar --
  *
- *	This procedure is invoked after a linked variable has been
- *	changed by C code.  It updates the Tcl variable so that
- *	traces on the variable will trigger.
+ *	This function is invoked after a linked variable has been changed by C
+ *	code. It updates the Tcl variable so that traces on the variable will
+ *	trigger.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The Tcl variable "varName" is updated from its C value,
- *	causing traces on the variable to trigger.
+ *	The Tcl variable "varName" is updated from its C value, causing traces
+ *	on the variable to trigger.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_UpdateLinkedVar(interp, varName)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *varName;	/* Name of global variable that is linked. */
+Tcl_UpdateLinkedVar(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    CONST char *varName)	/* Name of global variable that is linked. */
 {
     Link *linkPtr;
     int savedFlag;
-    Tcl_Obj *objPtr;
 
     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
 	    LinkTraceProc, (ClientData) NULL);
@@ -200,10 +219,8 @@ Tcl_UpdateLinkedVar(interp, varName)
     }
     savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
     linkPtr->flags |= LINK_BEING_UPDATED;
-    objPtr = ObjValue(linkPtr);
-    Tcl_IncrRefCount(objPtr);
-    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY);
-    Tcl_DecrRefCount(objPtr);
+    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    TCL_GLOBAL_ONLY);
     /*
      * Callback may have unlinked the variable. [Bug 1740631]
      */
@@ -219,39 +236,42 @@ Tcl_UpdateLinkedVar(interp, varName)
  *
  * LinkTraceProc --
  *
- *	This procedure is invoked when a linked Tcl variable is read,
- *	written, or unset from Tcl.  It's responsible for keeping the
- *	C variable in sync with the Tcl variable.
+ *	This function is invoked when a linked Tcl variable is read, written,
+ *	or unset from Tcl. It's responsible for keeping the C variable in sync
+ *	with the Tcl variable.
  *
  * Results:
- *	If all goes well, NULL is returned; otherwise an error message
- *	is returned.
+ *	If all goes well, NULL is returned; otherwise an error message is
+ *	returned.
  *
  * Side effects:
- *	The C variable may be updated to make it consistent with the
- *	Tcl variable, or the Tcl variable may be overwritten to reject
- *	a modification.
+ *	The C variable may be updated to make it consistent with the Tcl
+ *	variable, or the Tcl variable may be overwritten to reject a
+ *	modification.
  *
  *----------------------------------------------------------------------
  */
 
 static char *
-LinkTraceProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Contains information about the link. */
-    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
-    CONST char *name1;		/* First part of variable name. */
-    CONST char *name2;		/* Second part of variable name. */
-    int flags;			/* Miscellaneous additional information. */
+LinkTraceProc(
+    ClientData clientData,	/* Contains information about the link. */
+    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
+    CONST char *name1,		/* First part of variable name. */
+    CONST char *name2,		/* Second part of variable name. */
+    int flags)			/* Miscellaneous additional information. */
 {
     Link *linkPtr = (Link *) clientData;
     int changed, valueLength;
     CONST char *value;
-    char **pp, *result;
-    Tcl_Obj *objPtr, *valueObj, *tmpPtr;
+    char **pp;
+    Tcl_Obj *valueObj;
+    int valueInt;
+    Tcl_WideInt valueWide;
+    double valueDouble;
 
     /*
-     * If the variable is being unset, then just re-create it (with a
-     * trace) unless the whole interpreter is going away.
+     * If the variable is being unset, then just re-create it (with a trace)
+     * unless the whole interpreter is going away.
      */
 
     if (flags & TCL_TRACE_UNSETS) {
@@ -259,11 +279,8 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 	    Tcl_DecrRefCount(linkPtr->varName);
 	    ckfree((char *) linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
 	    Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
 		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
 		    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
@@ -272,10 +289,9 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     }
 
     /*
-     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then
-     * don't do anything at all.  In particular, we don't want to get
-     * upset that the variable is being modified, even if it is
-     * supposed to be read-only.
+     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
+     * do anything at all. In particular, we don't want to get upset that the
+     * variable is being modified, even if it is supposed to be read-only.
      */
 
     if (linkPtr->flags & LINK_BEING_UPDATED) {
@@ -283,21 +299,48 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     }
 
     /*
-     * For read accesses, update the Tcl variable if the C variable
-     * has changed since the last time we updated the Tcl variable.
+     * For read accesses, update the Tcl variable if the C variable has
+     * changed since the last time we updated the Tcl variable.
      */
 
     if (flags & TCL_TRACE_READS) {
 	switch (linkPtr->type) {
 	case TCL_LINK_INT:
 	case TCL_LINK_BOOLEAN:
-	    changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+	    changed = (LinkedVar(int) != linkPtr->lastValue.i);
 	    break;
 	case TCL_LINK_DOUBLE:
-	    changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+	    changed = (LinkedVar(double) != linkPtr->lastValue.d);
 	    break;
 	case TCL_LINK_WIDE_INT:
-	    changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
+	    changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
+	    break;
+	case TCL_LINK_WIDE_UINT:
+	    changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
+	    break;
+	case TCL_LINK_CHAR:
+	    changed = (LinkedVar(char) != linkPtr->lastValue.c);
+	    break;
+	case TCL_LINK_UCHAR:
+	    changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
+	    break;
+	case TCL_LINK_SHORT:
+	    changed = (LinkedVar(short) != linkPtr->lastValue.s);
+	    break;
+	case TCL_LINK_USHORT:
+	    changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
+	    break;
+	case TCL_LINK_UINT:
+	    changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
+	    break;
+	case TCL_LINK_LONG:
+	    changed = (LinkedVar(long) != linkPtr->lastValue.l);
+	    break;
+	case TCL_LINK_ULONG:
+	    changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
+	    break;
+	case TCL_LINK_FLOAT:
+	    changed = (LinkedVar(float) != linkPtr->lastValue.f);
 	    break;
 	case TCL_LINK_STRING:
 	    changed = 1;
@@ -306,30 +349,24 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 	    return "internal error: bad linked variable type";
 	}
 	if (changed) {
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
 	}
 	return NULL;
     }
 
     /*
-     * For writes, first make sure that the variable is writable.  Then
-     * convert the Tcl value to C if possible.  If the variable isn't
-     * writable or can't be converted, then restore the varaible's old
-     * value and return an error.  Another tricky thing: we have to save
-     * and restore the interpreter's result, since the variable access
-     * could occur when the result has been partially set.
+     * For writes, first make sure that the variable is writable. Then convert
+     * the Tcl value to C if possible. If the variable isn't writable or can't
+     * be converted, then restore the varaible's old value and return an
+     * error. Another tricky thing: we have to save and restore the interp's
+     * result, since the variable access could occur when the result has been
+     * partially set.
      */
 
     if (linkPtr->flags & LINK_READ_ONLY) {
-	tmpPtr = ObjValue(linkPtr);
-	Tcl_IncrRefCount(tmpPtr);
-	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		TCL_GLOBAL_ONLY);
-	Tcl_DecrRefCount(tmpPtr);
 	return "linked variable is read-only";
     }
     valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
@@ -337,92 +374,172 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 	/*
 	 * This shouldn't ever happen.
 	 */
+
 	return "internal error: linked variable couldn't be read";
     }
 
-    objPtr = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(objPtr);
-    Tcl_ResetResult(interp);
-    result = NULL;
-
     switch (linkPtr->type) {
     case TCL_LINK_INT:
-	if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
+	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
 		!= TCL_OK) {
-	    Tcl_SetObjResult(interp, objPtr);
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
-	    result = "variable must have integer value";
-	    goto end;
+	    return "variable must have integer value";
 	}
-	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	LinkedVar(int) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_WIDE_INT:
-	if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
+	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
 		!= TCL_OK) {
-	    Tcl_SetObjResult(interp, objPtr);
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
-	    result = "variable must have integer value";
-	    goto end;
+	    return "variable must have integer value";
 	}
-	*(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
+	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	break;
 
     case TCL_LINK_DOUBLE:
-	if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
+	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
 		!= TCL_OK) {
-	    Tcl_SetObjResult(interp, objPtr);
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
-		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
-	    result = "variable must have real value";
-	    goto end;
+#ifdef ACCEPT_NAN
+	    if (valueObj->typePtr != &tclDoubleType) {
+#endif
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return "variable must have real value";
+#ifdef ACCEPT_NAN
+	    }
+	    linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+#endif
 	}
-	*(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+	LinkedVar(double) = linkPtr->lastValue.d;
 	break;
 
     case TCL_LINK_BOOLEAN:
-	if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
-	    != TCL_OK) {
-	    Tcl_SetObjResult(interp, objPtr);
-	    tmpPtr = ObjValue(linkPtr);
-	    Tcl_IncrRefCount(tmpPtr);
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
+	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
+		!= TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have boolean value";
+	}
+	LinkedVar(int) = linkPtr->lastValue.i;
+	break;
+
+    case TCL_LINK_CHAR:
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
+		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have char value";
+	}
+	linkPtr->lastValue.c = (char)valueInt;
+	LinkedVar(char) = linkPtr->lastValue.c;
+	break;
+
+    case TCL_LINK_UCHAR:
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
+		|| valueInt < 0 || valueInt > UCHAR_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(tmpPtr);
-	    result = "variable must have boolean value";
-	    goto end;
+	    return "variable must have unsigned char value";
 	}
-	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+	linkPtr->lastValue.uc = (unsigned char) valueInt;
+	LinkedVar(unsigned char) = linkPtr->lastValue.uc;
+	break;
+
+    case TCL_LINK_SHORT:
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
+		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have short value";
+	}
+	linkPtr->lastValue.s = (short)valueInt;
+	LinkedVar(short) = linkPtr->lastValue.s;
+	break;
+
+    case TCL_LINK_USHORT:
+	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
+		|| valueInt < 0 || valueInt > USHRT_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have unsigned short value";
+	}
+	linkPtr->lastValue.us = (unsigned short)valueInt;
+	LinkedVar(unsigned short) = linkPtr->lastValue.us;
+	break;
+
+    case TCL_LINK_UINT:
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
+		|| valueWide < 0 || valueWide > UINT_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have unsigned int value";
+	}
+	linkPtr->lastValue.ui = (unsigned int)valueWide;
+	LinkedVar(unsigned int) = linkPtr->lastValue.ui;
+	break;
+
+    case TCL_LINK_LONG:
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
+		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have long value";
+	}
+	linkPtr->lastValue.l = (long)valueWide;
+	LinkedVar(long) = linkPtr->lastValue.l;
+	break;
+
+    case TCL_LINK_ULONG:
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
+		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have unsigned long value";
+	}
+	linkPtr->lastValue.ul = (unsigned long)valueWide;
+	LinkedVar(unsigned long) = linkPtr->lastValue.ul;
+	break;
+
+    case TCL_LINK_WIDE_UINT:
+	/*
+	 * FIXME: represent as a bignum.
+	 */
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have unsigned wide int value";
+	}
+	linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
+	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
+	break;
+
+    case TCL_LINK_FLOAT:
+	if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
+		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have float value";
+	}
+	linkPtr->lastValue.f = (float)valueDouble;
+	LinkedVar(float) = linkPtr->lastValue.f;
 	break;
 
     case TCL_LINK_STRING:
 	value = Tcl_GetStringFromObj(valueObj, &valueLength);
 	valueLength++;
-	pp = (char **)(linkPtr->addr);
-	if (*pp != NULL) {
-	    ckfree(*pp);
-	}
-	*pp = (char *) ckalloc((unsigned) valueLength);
+	pp = (char **) linkPtr->addr;
+
+	*pp = ckrealloc(*pp, valueLength);
 	memcpy(*pp, value, (unsigned) valueLength);
 	break;
 
     default:
 	return "internal error: bad linked variable type";
     }
-    end:
-    Tcl_DecrRefCount(objPtr);
-    return result;
+    return NULL;
 }
 
 /*
@@ -430,12 +547,12 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
  *
  * ObjValue --
  *
- *	Converts the value of a C variable to a Tcl_Obj* for use in a
- *	Tcl variable to which it is linked.
+ *	Converts the value of a C variable to a Tcl_Obj* for use in a Tcl
+ *	variable to which it is linked.
  *
  * Results:
- *	The return value is a pointer to a Tcl_Obj that represents
- *	the value of the C variable given by linkPtr.
+ *	The return value is a pointer to a Tcl_Obj that represents the value
+ *	of the C variable given by linkPtr.
  *
  * Side effects:
  *	None.
@@ -444,36 +561,78 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
  */
 
 static Tcl_Obj *
-ObjValue(linkPtr)
-    Link *linkPtr;		/* Structure describing linked variable. */
+ObjValue(
+    Link *linkPtr)		/* Structure describing linked variable. */
 {
     char *p;
+    Tcl_Obj *resultObj;
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
-	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	linkPtr->lastValue.i = LinkedVar(int);
 	return Tcl_NewIntObj(linkPtr->lastValue.i);
     case TCL_LINK_WIDE_INT:
-	linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
+	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
 	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
     case TCL_LINK_DOUBLE:
-	linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+	linkPtr->lastValue.d = LinkedVar(double);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
     case TCL_LINK_BOOLEAN:
-	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+	linkPtr->lastValue.i = LinkedVar(int);
 	return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+    case TCL_LINK_CHAR:
+	linkPtr->lastValue.c = LinkedVar(char);
+	return Tcl_NewIntObj(linkPtr->lastValue.c);
+    case TCL_LINK_UCHAR:
+	linkPtr->lastValue.uc = LinkedVar(unsigned char);
+	return Tcl_NewIntObj(linkPtr->lastValue.uc);
+    case TCL_LINK_SHORT:
+	linkPtr->lastValue.s = LinkedVar(short);
+	return Tcl_NewIntObj(linkPtr->lastValue.s);
+    case TCL_LINK_USHORT:
+	linkPtr->lastValue.us = LinkedVar(unsigned short);
+	return Tcl_NewIntObj(linkPtr->lastValue.us);
+    case TCL_LINK_UINT:
+	linkPtr->lastValue.ui = LinkedVar(unsigned int);
+	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
+    case TCL_LINK_LONG:
+	linkPtr->lastValue.l = LinkedVar(long);
+	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
+    case TCL_LINK_ULONG:
+	linkPtr->lastValue.ul = LinkedVar(unsigned long);
+	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
+    case TCL_LINK_FLOAT:
+	linkPtr->lastValue.f = LinkedVar(float);
+	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
+    case TCL_LINK_WIDE_UINT:
+	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
+	/*
+	 * FIXME: represent as a bignum.
+	 */
+	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
     case TCL_LINK_STRING:
-	p = *(char **)(linkPtr->addr);
+	p = LinkedVar(char *);
 	if (p == NULL) {
-	    return Tcl_NewStringObj("NULL", 4);
+	    TclNewLiteralStringObj(resultObj, "NULL");
+	    return resultObj;
 	}
 	return Tcl_NewStringObj(p, -1);
 
     /*
-     * This code only gets executed if the link type is unknown
-     * (shouldn't ever happen).
+     * This code only gets executed if the link type is unknown (shouldn't
+     * ever happen).
      */
+
     default:
-	return Tcl_NewStringObj("??", 2);
+	TclNewLiteralStringObj(resultObj, "??");
+	return resultObj;
     }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index b4af98a..d6ffa95 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1,70 +1,193 @@
-/* 
+/*
  * tclListObj.c --
  *
- *	This file contains procedures that implement the Tcl list object
- *	type.
+ *	This file contains functions that implement the Tcl list object type.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998 by Scriptics Corporation.
  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
  */
 
-static void		DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static void		FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
-static int		SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static void		UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
+static List *		AttemptNewList(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
+static List *		NewListIntRep(int objc, Tcl_Obj *CONST objv[], int p);
+static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void		FreeListInternalRep(Tcl_Obj *listPtr);
+static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfList(Tcl_Obj *listPtr);
 
 /*
- * The structure below defines the list Tcl object type by means of
- * procedures that can be invoked by generic object code.
+ * The structure below defines the list Tcl object type by means of functions
+ * that can be invoked by generic object code.
  *
  * The internal representation of a list object is a two-pointer
- * representation.  The first pointer designates a List structure that
- * contains an array of pointers to the element objects, together with
- * integers that represent the current element count and the allocated
- * size of the array.  The second pointer is normally NULL; during
- * execution of functions in this file that operate on nested sublists,
- * it is occasionally used as working storage to avoid an auxiliary
- * stack.
+ * representation. The first pointer designates a List structure that contains
+ * an array of pointers to the element objects, together with integers that
+ * represent the current element count and the allocated size of the array.
+ * The second pointer is normally NULL; during execution of functions in this
+ * file that operate on nested sublists, it is occasionally used as working
+ * storage to avoid an auxiliary stack.
  */
 
 Tcl_ObjType tclListType = {
-    "list",				/* name */
-    FreeListInternalRep,		/* freeIntRepProc */
-    DupListInternalRep,		        /* dupIntRepProc */
-    UpdateStringOfList,			/* updateStringProc */
-    SetListFromAny			/* setFromAnyProc */
+    "list",			/* name */
+    FreeListInternalRep,	/* freeIntRepProc */
+    DupListInternalRep,		/* dupIntRepProc */
+    UpdateStringOfList,		/* updateStringProc */
+    SetListFromAny		/* setFromAnyProc */
 };
 
 /*
  *----------------------------------------------------------------------
  *
+ * NewListIntRep --
+ *
+ *	Creates a list internal rep with space for objc elements.  objc
+ *	must be > 0.  If objv!=NULL, initializes with the first objc values
+ *	in that array.  If objv==NULL, initalize list internal rep to have
+ *	0 elements, with space to add objc more.  Flag value "p" indicates
+ *	how to behave on failure.
+ *
+ * Results:
+ *	A new List struct with refCount 0 is returned. If some failure
+ *	prevents this then if p=0, NULL is returned and otherwise the
+ *	routine panics.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+NewListIntRep(
+    int objc,
+    Tcl_Obj *CONST objv[],
+    int p)
+{
+    List *listRepPtr;
+
+    if (objc <= 0) {
+	Tcl_Panic("NewListIntRep: expects postive element count");
+    }
+
+    /*
+     * First check to see if we'd overflow and try to allocate an object
+     * larger than our memory allocator allows. Note that this is actually a
+     * fairly small value when you're on a serious 64-bit machine, but that
+     * requires API changes to fix. See [Bug 219196] for a discussion.
+     */
+
+    if ((size_t)objc > LIST_MAX) {
+	if (p) {
+	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
+		    LIST_MAX);
+	}
+	return NULL;
+    }
+
+    listRepPtr = (List *)
+	    attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
+    if (listRepPtr == NULL) {
+	if (p) {
+	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
+		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
+	}
+	return NULL;
+    }
+
+    listRepPtr->canonicalFlag = 0;
+    listRepPtr->refCount = 0;
+    listRepPtr->maxElemCount = objc;
+
+    if (objv) {
+	Tcl_Obj **elemPtrs;
+	int i;
+
+	listRepPtr->elemCount = objc;
+	elemPtrs = &listRepPtr->elements;
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+    } else {
+	listRepPtr->elemCount = 0;
+    }
+    return listRepPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AttemptNewList --
+ *
+ *	Creates a list internal rep with space for objc elements.  objc
+ *	must be > 0.  If objv!=NULL, initializes with the first objc values
+ *	in that array.  If objv==NULL, initalize list internal rep to have
+ *	0 elements, with space to add objc more.  
+ *
+ * Results:
+ *	A new List struct with refCount 0 is returned. If some failure
+ *	prevents this then NULL is returned, and an error message is left
+ *	in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+AttemptNewList(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *CONST objv[])
+{
+    List *listRepPtr = NewListIntRep(objc, objv, 0);
+
+    if (interp != NULL && listRepPtr == NULL) {
+	if (objc > LIST_MAX) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "max length of a Tcl list (%d elements) exceeded",
+		    LIST_MAX));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "list creation failed: unable to alloc %u bytes",
+		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
+	}
+    }
+    return listRepPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_NewListObj --
  *
- *	This procedure is normally called when not debugging: i.e., when
+ *	This function is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates a new list object from an
  *	(objc,objv) array: that is, each of the objc elements of the array
  *	referenced by objv is inserted as an element into a new Tcl object.
  *
- *	When TCL_MEM_DEBUG is defined, this procedure just returns the
- *	result of calling the debugging version Tcl_DbNewListObj.
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewListObj.
  *
  * Results:
  *	A new list object is returned that is initialized from the object
  *	pointers in objv. If objc is less than or equal to zero, an empty
- *	object is returned. The new object's string representation
- *	is left NULL. The resulting new list object has ref count 0.
+ *	object is returned. The new object's string representation is left
+ *	NULL. The resulting new list object has ref count 0.
  *
  * Side effects:
  *	The ref counts of the elements in objv are incremented since the
@@ -77,9 +200,9 @@ Tcl_ObjType tclListType = {
 #undef Tcl_NewListObj
 
 Tcl_Obj *
-Tcl_NewListObj(objc, objv)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+    int objc,			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
 {
     return Tcl_DbNewListObj(objc, objv, "unknown", 0);
 }
@@ -87,36 +210,31 @@ Tcl_NewListObj(objc, objv)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewListObj(objc, objv)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+    int objc,			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
 {
-    register Tcl_Obj *listPtr;
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
-    
+    List *listRepPtr;
+    Tcl_Obj *listPtr;
+
     TclNewObj(listPtr);
-    
-    if (objc > 0) {
-	Tcl_InvalidateStringRep(listPtr);
-	
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
-	}
-	
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
-	
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
+
+    if (objc <= 0) {
+	return listPtr;
     }
+
+    /*
+     * Create the internal rep.
+     */
+
+    listRepPtr = NewListIntRep(objc, objv, 1);
+
+    /*
+     * Now create the object.
+     */
+
+    TclInvalidateStringRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
     return listPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -126,22 +244,22 @@ Tcl_NewListObj(objc, objv)
  *
  * Tcl_DbNewListObj --
  *
- *	This procedure is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the
- *	same as the Tcl_NewListObj procedure above except that it calls
+ *	This function is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
+ *	as the Tcl_NewListObj function above except that it calls
  *	Tcl_DbCkalloc directly with the file name and line number from its
  *	caller. This simplifies debugging since then the [memory active]
- *	command	will report the correct file name and line number when
+ *	command will report the correct file name and line number when
  *	reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
  *	result of calling Tcl_NewListObj.
  *
  * Results:
  *	A new list object is returned that is initialized from the object
  *	pointers in objv. If objc is less than or equal to zero, an empty
- *	object is returned. The new object's string representation
- *	is left NULL. The new list object has ref count 0.
+ *	object is returned. The new object's string representation is left
+ *	NULL. The new list object has ref count 0.
  *
  * Side effects:
  *	The ref counts of the elements in objv are incremented since the
@@ -153,53 +271,49 @@ Tcl_NewListObj(objc, objv)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewListObj(
+    int objc,			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[],	/* An array of pointers to Tcl objects. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
-    register Tcl_Obj *listPtr;
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
-    
+    Tcl_Obj *listPtr;
+    List *listRepPtr;
+
     TclDbNewObj(listPtr, file, line);
-    
-    if (objc > 0) {
-	Tcl_InvalidateStringRep(listPtr);
-	
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
-	}
-	
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
-	
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
+
+    if (objc <= 0) {
+	return listPtr;
     }
+
+    /*
+     * Create the internal rep.
+     */
+
+    listRepPtr = NewListIntRep(objc, objv, 1);
+
+    /*
+     * Now create the object.
+     */
+
+    TclInvalidateStringRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
+
     return listPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewListObj(
+    int objc,			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[],	/* An array of pointers to Tcl objects. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewListObj(objc, objv);
 }
@@ -210,8 +324,8 @@ Tcl_DbNewListObj(objc, objv, file, line)
  *
  * Tcl_SetListObj --
  *
- *	Modify an object to be a list containing each of the objc elements
- *	of the object array referenced by objv.
+ *	Modify an object to be a list containing each of the objc elements of
+ *	the object array referenced by objv.
  *
  * Results:
  *	None.
@@ -219,61 +333,43 @@ Tcl_DbNewListObj(objc, objv, file, line)
  * Side effects:
  *	The object is made a list object and is initialized from the object
  *	pointers in objv. If objc is less than or equal to zero, an empty
- *	object is returned. The new object's string representation
- *	is left NULL. The ref counts of the elements in objv are incremented
- *	since the list now refers to them. The object's old string and
- *	internal representations are freed and its type is set NULL.
+ *	object is returned. The new object's string representation is left
+ *	NULL. The ref counts of the elements in objv are incremented since the
+ *	list now refers to them. The object's old string and internal
+ *	representations are freed and its type is set NULL.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetListObj(objPtr, objc, objv)
-    Tcl_Obj *objPtr;		/* Object whose internal rep to init. */
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
+Tcl_SetListObj(
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    int objc,			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
 {
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    int i;
+    List *listRepPtr;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetListObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
     }
-    
+
     /*
      * Free any old string rep and any internal rep for the old type.
      */
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
+    TclFreeIntRep(objPtr);
     objPtr->typePtr = NULL;
-    Tcl_InvalidateStringRep(objPtr);
-        
+    TclInvalidateStringRep(objPtr);
+
     /*
      * Set the object's type to "list" and initialize the internal rep.
-     * However, if there are no elements to put in the list, just give
-     * the object an empty string rep and a NULL type.
+     * However, if there are no elements to put in the list, just give the
+     * object an empty string rep and a NULL type.
      */
 
     if (objc > 0) {
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
-	}
-	
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
-	
-	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	objPtr->typePtr = &tclListType;
+	listRepPtr = NewListIntRep(objc, objv, 1);
+	ListSetIntRep(objPtr, listRepPtr);
     } else {
 	objPtr->bytes = tclEmptyStringRep;
 	objPtr->length = 0;
@@ -283,25 +379,66 @@ Tcl_SetListObj(objPtr, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * TclListObjCopy --
+ *
+ *	Makes a "pure list" copy of a list value. This provides for the C
+ *	level a counterpart of the [lrange $list 0 end] command, while using
+ *	internals details to be as efficient as possible.
+ *
+ * Results:
+ *	Normally returns a pointer to a new Tcl_Obj, that contains the same
+ *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
+ *	zero. If *listPtr does not hold a list, NULL is returned, and if
+ *	interp is non-NULL, an error message is recorded there.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjCopy(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    Tcl_Obj *listPtr)		/* List object for which an element array is
+				 * to be returned. */
+{
+    Tcl_Obj *copyPtr;
+
+    if (listPtr->typePtr != &tclListType) {
+	if (SetListFromAny(interp, listPtr) != TCL_OK) {
+	    return NULL;
+	}
+    }
+
+    TclNewObj(copyPtr);
+    TclInvalidateStringRep(copyPtr);
+    DupListInternalRep(listPtr, copyPtr);
+    return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ListObjGetElements --
  *
- *	This procedure returns an (objc,objv) array of the elements in a
- *	list object.
+ *	This function returns an (objc,objv) array of the elements in a list
+ *	object.
  *
  * Results:
  *	The return value is normally TCL_OK; in this case *objcPtr is set to
  *	the count of list elements and *objvPtr is set to a pointer to an
- *	array of (*objcPtr) pointers to each list element. If listPtr does
- *	not refer to a list object and the object can not be converted to
- *	one, TCL_ERROR is returned and an error message will be left in
- *	the interpreter's result if interp is not NULL.
+ *	array of (*objcPtr) pointers to each list element. If listPtr does not
+ *	refer to a list object and the object can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in the
+ *	interpreter's result if interp is not NULL.
  *
  *	The objects referenced by the returned array should be treated as
  *	readonly and their ref counts are _not_ incremented; the caller must
- *	do that if it holds on to a reference. Furthermore, the pointer
- *	and length returned by this procedure may change as soon as any
- *	procedure is called on the list object; be careful about retaining
- *	the pointer in a local data structure.
+ *	do that if it holds on to a reference. Furthermore, the pointer and
+ *	length returned by this function may change as soon as any function is
+ *	called on the list object; be careful about retaining the pointer in a
+ *	local data structure.
  *
  * Side effects:
  *	The possible conversion of the object referenced by listPtr
@@ -311,26 +448,33 @@ Tcl_SetListObj(objPtr, objc, objv)
  */
 
 int
-Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
-    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
-    register Tcl_Obj *listPtr;	/* List object for which an element array
-				 * is to be returned. */
-    int *objcPtr;		/* Where to store the count of objects
+Tcl_ListObjGetElements(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr,	/* List object for which an element array is
+				 * to be returned. */
+    int *objcPtr,		/* Where to store the count of objects
 				 * referenced by objv. */
-    Tcl_Obj ***objvPtr;	        /* Where to store the pointer to an array
-				 * of pointers to the list's objects. */
+    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
+				 * pointers to the list's objects. */
 {
     register List *listRepPtr;
 
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result;
+
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    *objcPtr = 0;
+	    *objvPtr = NULL;
+	    return TCL_OK;
+	}
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    listRepPtr = ListRepPtr(listPtr);
     *objcPtr = listRepPtr->elemCount;
-    *objvPtr = listRepPtr->elements;
+    *objvPtr = &listRepPtr->elements;
     return TCL_OK;
 }
 
@@ -339,50 +483,46 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
  *
  * Tcl_ListObjAppendList --
  *
- *	This procedure appends the objects in the list referenced by
+ *	This function appends the objects in the list referenced by
  *	elemListPtr to the list object referenced by listPtr. If listPtr is
  *	not already a list object, an attempt will be made to convert it to
  *	one.
  *
  * Results:
- *	The return value is normally TCL_OK. If listPtr or elemListPtr do
- *	not refer to list objects and they can not be converted to one,
- *	TCL_ERROR is returned and an error message is left in
- *	the interpreter's result if interp is not NULL.
+ *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
+ *	refer to list objects and they can not be converted to one, TCL_ERROR
+ *	is returned and an error message is left in the interpreter's result
+ *	if interp is not NULL.
  *
  * Side effects:
  *	The reference counts of the elements in elemListPtr are incremented
  *	since the list now refers to them. listPtr and elemListPtr are
- *	converted, if necessary, to list objects. Also, appending the
- *	new elements may cause listObj's array of element pointers to grow.
+ *	converted, if necessary, to list objects. Also, appending the new
+ *	elements may cause listObj's array of element pointers to grow.
  *	listPtr's old string representation, if any, is invalidated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
-    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
-    register Tcl_Obj *listPtr;	/* List object to append elements to. */
-    Tcl_Obj *elemListPtr;	/* List obj with elements to append. */
+Tcl_ListObjAppendList(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr,	/* List object to append elements to. */
+    Tcl_Obj *elemListPtr)	/* List obj with elements to append. */
 {
-    register List *listRepPtr;
     int listLen, objc, result;
     Tcl_Obj **objv;
 
     if (Tcl_IsShared(listPtr)) {
-	panic("Tcl_ListObjAppendList called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
     }
-    if (listPtr->typePtr != &tclListType) {
-	result = SetListFromAny(interp, listPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+
+    result = TclListObjLength(interp, listPtr, &listLen);
+    if (result != TCL_OK) {
+	return result;
     }
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    listLen = listRepPtr->elemCount;
 
-    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
+    result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
     if (result != TCL_OK) {
 	return result;
     }
@@ -391,7 +531,7 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
      * Insert objc new elements starting after the lists's last element.
      * Delete zero existing elements.
      */
-    
+
     return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
 }
 
@@ -400,77 +540,102 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
  *
  * Tcl_ListObjAppendElement --
  *
- *	This procedure is a special purpose version of
- *	Tcl_ListObjAppendList: it appends a single object referenced by
- *	objPtr to the list object referenced by listPtr. If listPtr is not
- *	already a list object, an attempt will be made to convert it to one.
+ *	This function is a special purpose version of Tcl_ListObjAppendList:
+ *	it appends a single object referenced by objPtr to the list object
+ *	referenced by listPtr. If listPtr is not already a list object, an
+ *	attempt will be made to convert it to one.
  *
  * Results:
- *	The return value is normally TCL_OK; in this case objPtr is added
- *	to the end of listPtr's list. If listPtr does not refer to a list
- *	object and the object can not be converted to one, TCL_ERROR is
- *	returned and an error message will be left in the interpreter's
- *	result if interp is not NULL.
+ *	The return value is normally TCL_OK; in this case objPtr is added to
+ *	the end of listPtr's list. If listPtr does not refer to a list object
+ *	and the object can not be converted to one, TCL_ERROR is returned and
+ *	an error message will be left in the interpreter's result if interp is
+ *	not NULL.
  *
  * Side effects:
- *	The ref count of objPtr is incremented since the list now refers 
- *	to it. listPtr will be converted, if necessary, to a list object.
- *	Also, appending the new element may cause listObj's array of element
- *	pointers to grow. listPtr's old string representation, if any,
- *	is invalidated.
+ *	The ref count of objPtr is incremented since the list now refers to
+ *	it. listPtr will be converted, if necessary, to a list object. Also,
+ *	appending the new element may cause listObj's array of element
+ *	pointers to grow. listPtr's old string representation, if any, is
+ *	invalidated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ListObjAppendElement(interp, listPtr, objPtr)
-    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
-    Tcl_Obj *listPtr;		/* List object to append objPtr to. */
-    Tcl_Obj *objPtr;		/* Object to append to listPtr's list. */
+Tcl_ListObjAppendElement(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    Tcl_Obj *listPtr,		/* List object to append objPtr to. */
+    Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
 {
     register List *listRepPtr;
     register Tcl_Obj **elemPtrs;
-    int numElems, numRequired;
-    
+    int numElems, numRequired, newMax, newSize, i;
+
     if (Tcl_IsShared(listPtr)) {
-	panic("Tcl_ListObjAppendElement called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
     }
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result;
+
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    Tcl_SetListObj(listPtr, 1, &objPtr);
+	    return TCL_OK;
+	}
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
+    listRepPtr = ListRepPtr(listPtr);
     numElems = listRepPtr->elemCount;
     numRequired = numElems + 1 ;
-    
+
     /*
-     * If there is no room in the current array of element pointers,
-     * allocate a new, larger array and copy the pointers to it.
+     * If there is no room in the current array of element pointers, allocate
+     * a new, larger array and copy the pointers to it. If the List struct is
+     * shared, allocate a new one.
      */
 
-    if (numRequired > listRepPtr->maxElemCount) {
-	int newMax = (2 * numRequired);
-	Tcl_Obj **newElemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-	
-	memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
-	       (size_t) (numElems * sizeof(Tcl_Obj *)));
+    if (numRequired > listRepPtr->maxElemCount){
+	newMax = 2 * numRequired;
+	newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
+    } else {
+	newMax = listRepPtr->maxElemCount;
+	newSize = 0;
+    }
+
+    if (listRepPtr->refCount > 1) {
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldElems;
 
+	listRepPtr = AttemptNewList(interp, newMax, NULL);
+	if (listRepPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	oldElems = &oldListRepPtr->elements;
+	elemPtrs = &listRepPtr->elements;
+	for (i=0; i<numElems; i++) {
+	    elemPtrs[i] = oldElems[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	listRepPtr->elemCount = numElems;
+	listRepPtr->refCount++;
+	oldListRepPtr->refCount--;
+	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+    } else if (newSize) {
+	listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize);
 	listRepPtr->maxElemCount = newMax;
-	listRepPtr->elements = newElemPtrs;
-	ckfree((char *) elemPtrs);
-	elemPtrs = newElemPtrs;
+	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
     }
 
     /*
-     * Add objPtr to the end of listPtr's array of element
-     * pointers. Increment the ref count for the (now shared) objPtr.
+     * Add objPtr to the end of listPtr's array of element pointers. Increment
+     * the ref count for the (now shared) objPtr.
      */
 
+    elemPtrs = &listRepPtr->elements;
     elemPtrs[numElems] = objPtr;
     Tcl_IncrRefCount(objPtr);
     listRepPtr->elemCount++;
@@ -480,7 +645,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
      * representation has changed.
      */
 
-    Tcl_InvalidateStringRep(listPtr);
+    TclInvalidateStringRep(listPtr);
     return TCL_OK;
 }
 
@@ -489,20 +654,20 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
  *
  * Tcl_ListObjIndex --
  *
- *	This procedure returns a pointer to the index'th object from the
- *	list referenced by listPtr. The first element has index 0. If index
- *	is negative or greater than or equal to the number of elements in
- *	the list, a NULL is returned. If listPtr is not a list object, an
- *	attempt will be made to convert it to a list.
+ *	This function returns a pointer to the index'th object from the list
+ *	referenced by listPtr. The first element has index 0. If index is
+ *	negative or greater than or equal to the number of elements in the
+ *	list, a NULL is returned. If listPtr is not a list object, an attempt
+ *	will be made to convert it to a list.
  *
  * Results:
- *	The return value is normally TCL_OK; in this case objPtrPtr is set
- *	to the Tcl_Obj pointer for the index'th list element or NULL if
- *	index is out of range. This object should be treated as readonly and
- *	its ref count is _not_ incremented; the caller must do that if it
- *	holds on to the reference. If listPtr does not refer to a list and
- *	can't be converted to one, TCL_ERROR is returned and an error
- *	message is left in the interpreter's result if interp is not NULL.
+ *	The return value is normally TCL_OK; in this case objPtrPtr is set to
+ *	the Tcl_Obj pointer for the index'th list element or NULL if index is
+ *	out of range. This object should be treated as readonly and its ref
+ *	count is _not_ incremented; the caller must do that if it holds on to
+ *	the reference. If listPtr does not refer to a list and can't be
+ *	converted to one, TCL_ERROR is returned and an error message is left
+ *	in the interpreter's result if interp is not NULL.
  *
  * Side effects:
  *	listPtr will be converted, if necessary, to a list object.
@@ -511,28 +676,34 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
  */
 
 int
-Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
-    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
-    register Tcl_Obj *listPtr;	/* List object to index into. */
-    register int index;		/* Index of element to return. */
-    Tcl_Obj **objPtrPtr;	/* The resulting Tcl_Obj* is stored here. */
+Tcl_ListObjIndex(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr,	/* List object to index into. */
+    register int index,		/* Index of element to return. */
+    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
 {
     register List *listRepPtr;
-    
+
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result;
+
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    *objPtrPtr = NULL;
+	    return TCL_OK;
+	}
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    listRepPtr = ListRepPtr(listPtr);
     if ((index < 0) || (index >= listRepPtr->elemCount)) {
 	*objPtrPtr = NULL;
     } else {
-	*objPtrPtr = listRepPtr->elements[index];
+	*objPtrPtr = (&listRepPtr->elements)[index];
     }
-    
+
     return TCL_OK;
 }
 
@@ -541,16 +712,16 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
  *
  * Tcl_ListObjLength --
  *
- *	This procedure returns the number of elements in a list object. If
- *	the object is not already a list object, an attempt will be made to
+ *	This function returns the number of elements in a list object. If the
+ *	object is not already a list object, an attempt will be made to
  *	convert it to one.
  *
  * Results:
- *	The return value is normally TCL_OK; in this case *intPtr will be
- *	set to the integer count of list elements. If listPtr does not refer
- *	to a list object and the object can not be converted to one,
- *	TCL_ERROR is returned and an error message will be left in
- *	the interpreter's result if interp is not NULL.
+ *	The return value is normally TCL_OK; in this case *intPtr will be set
+ *	to the integer count of list elements. If listPtr does not refer to a
+ *	list object and the object can not be converted to one, TCL_ERROR is
+ *	returned and an error message will be left in the interpreter's result
+ *	if interp is not NULL.
  *
  * Side effects:
  *	The possible conversion of the argument object to a list object.
@@ -559,21 +730,27 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
  */
 
 int
-Tcl_ListObjLength(interp, listPtr, intPtr)
-    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
-    register Tcl_Obj *listPtr;	/* List object whose #elements to return. */
-    register int *intPtr;	/* The resulting int is stored here. */
+Tcl_ListObjLength(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    register Tcl_Obj *listPtr,	/* List object whose #elements to return. */
+    register int *intPtr)	/* The resulting int is stored here. */
 {
     register List *listRepPtr;
-    
+
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result;
+
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    *intPtr = 0;
+	    return TCL_OK;
+	}
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    listRepPtr = ListRepPtr(listPtr);
     *intPtr = listRepPtr->elemCount;
     return TCL_OK;
 }
@@ -582,456 +759,491 @@ Tcl_ListObjLength(interp, listPtr, intPtr)
  *----------------------------------------------------------------------
  *
  * Tcl_ListObjReplace --
- * 
- *	This procedure replaces zero or more elements of the list referenced
- *	by listPtr with the objects from an (objc,objv) array. 
- *	The objc elements of the array referenced by objv replace the
- *	count elements in listPtr starting at first.
+ *
+ *	This function replaces zero or more elements of the list referenced by
+ *	listPtr with the objects from an (objc,objv) array. The objc elements
+ *	of the array referenced by objv replace the count elements in listPtr
+ *	starting at first.
  *
  *	If the argument first is zero or negative, it refers to the first
  *	element. If first is greater than or equal to the number of elements
  *	in the list, then no elements are deleted; the new elements are
- *	appended to the list. Count gives the number of elements to
- *	replace. If count is zero or negative then no elements are deleted;
- *	the new elements are simply inserted before first.
+ *	appended to the list. Count gives the number of elements to replace.
+ *	If count is zero or negative then no elements are deleted; the new
+ *	elements are simply inserted before first.
  *
  *	The argument objv refers to an array of objc pointers to the new
- *	elements to be added to listPtr in place of those that were
- *	deleted. If objv is NULL, no new elements are added. If listPtr is
- *	not a list object, an attempt will be made to convert it to one.
+ *	elements to be added to listPtr in place of those that were deleted.
+ *	If objv is NULL, no new elements are added. If listPtr is not a list
+ *	object, an attempt will be made to convert it to one.
  *
  * Results:
- *	The return value is normally TCL_OK. If listPtr does
- *	not refer to a list object and can not be converted to one,
- *	TCL_ERROR is returned and an error message will be left in
- *	the interpreter's result if interp is not NULL.
+ *	The return value is normally TCL_OK. If listPtr does not refer to a
+ *	list object and can not be converted to one, TCL_ERROR is returned and
+ *	an error message will be left in the interpreter's result if interp is
+ *	not NULL.
  *
  * Side effects:
- *	The ref counts of the objc elements in objv are incremented since
- *	the resulting list now refers to them. Similarly, the ref counts for
- *	replaced objects are decremented. listPtr is converted, if
- *	necessary, to a list object. listPtr's old string representation, if
- *	any, is freed. 
+ *	The ref counts of the objc elements in objv are incremented since the
+ *	resulting list now refers to them. Similarly, the ref counts for
+ *	replaced objects are decremented. listPtr is converted, if necessary,
+ *	to a list object. listPtr's old string representation, if any, is
+ *	freed.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *listPtr;		/* List object whose elements to replace. */
-    int first;			/* Index of first element to replace. */
-    int count;			/* Number of elements to replace. */
-    int objc;			/* Number of objects to insert. */
-    Tcl_Obj *CONST objv[];	/* An array of objc pointers to Tcl objects
-				 * to insert. */
+Tcl_ListObjReplace(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *listPtr,		/* List object whose elements to replace. */
+    int first,			/* Index of first element to replace. */
+    int count,			/* Number of elements to replace. */
+    int objc,			/* Number of objects to insert. */
+    Tcl_Obj *CONST objv[])	/* An array of objc pointers to Tcl objects to
+				 * insert. */
 {
     List *listRepPtr;
-    register Tcl_Obj **elemPtrs, **newPtrs;
-    Tcl_Obj *victimPtr;
-    int numElems, numRequired, numAfterLast;
-    int start, shift, newMax, i, j, result;
-     
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired, numAfterLast, start, i, j, isShared;
+
     if (Tcl_IsShared(listPtr)) {
-	panic("Tcl_ListObjReplace called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
     }
     if (listPtr->typePtr != &tclListType) {
-	result = SetListFromAny(interp, listPtr);
-	if (result != TCL_OK) {
-	    return result;
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    if (objc) {
+		Tcl_SetListObj(listPtr, objc, NULL);
+	    } else {
+		return TCL_OK;
+	    }
+	} else {
+	    int result = SetListFromAny(interp, listPtr);
+
+	    if (result != TCL_OK) {
+		return result;
+	    }
 	}
     }
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
+
+    /*
+     * Note that when count == 0 and objc == 0, this routine is logically a
+     * no-op, removing and adding no elements to the list. However, by flowing
+     * through this routine anyway, we get the important side effect that the
+     * resulting listPtr is a list in canoncial form. This is important.
+     * Resist any temptation to optimize this case.
+     */
+
+    listRepPtr = ListRepPtr(listPtr);
+    elemPtrs = &listRepPtr->elements;
     numElems = listRepPtr->elemCount;
 
-    if (first < 0)  {
-    	first = 0;
+    if (first < 0) {
+	first = 0;
     }
     if (first >= numElems) {
-	first = numElems;	/* so we'll insert after last element */
+	first = numElems;	/* So we'll insert after last element. */
     }
     if (count < 0) {
 	count = 0;
+    } else if (numElems < first+count || first+count < 0) {
+	/*
+	 * The 'first+count < 0' condition here guards agains integer
+	 * overflow in determining 'first+count'
+	 */
+	count = numElems - first;
     }
-    
+
+    isShared = (listRepPtr->refCount > 1);
+    numRequired = numElems - count + objc;
+
     for (i = 0;  i < objc;  i++) {
 	Tcl_IncrRefCount(objv[i]);
     }
 
-    numRequired = (numElems - count + objc);
-    if (numRequired <= listRepPtr->maxElemCount) {
+    if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+	int shift;
+
 	/*
-	 * Enough room in the current array. First "delete" count
-	 * elements starting at first.
+	 * Can use the current List struct. First "delete" count elements
+	 * starting at first.
 	 */
 
-	for (i = 0, j = first;  i < count;  i++, j++) {
-	    victimPtr = elemPtrs[j];
+	for (j = first;  j < first + count;  j++) {
+	    Tcl_Obj *victimPtr = elemPtrs[j];
+
 	    TclDecrRefCount(victimPtr);
 	}
 
 	/*
-	 * Shift the elements after the last one removed to their
-	 * new locations.
+	 * Shift the elements after the last one removed to their new
+	 * locations.
 	 */
 
-	start = (first + count);
-	numAfterLast = (numElems - start);
-	shift = (objc - count);	/* numNewElems - numDeleted */
+	start = first + count;
+	numAfterLast = numElems - start;
+	shift = objc - count;	/* numNewElems - numDeleted */
 	if ((numAfterLast > 0) && (shift != 0)) {
-	    Tcl_Obj **src, **dst;
+	    Tcl_Obj **src = elemPtrs + start;
 
-	    src = elemPtrs + start; dst = src + shift;
-	    memmove((VOID*) dst, (VOID*) src, 
-	            (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
+	    memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
 	}
-
+    } else {
 	/*
-	 * Insert the new elements into elemPtrs before "first".
+	 * Cannot use the current List struct; it is shared, too small, or
+	 * both. Allocate a new struct and insert elements into it.
 	 */
 
-	for (i = 0, j = first;  i < objc;  i++, j++) {
-            elemPtrs[j] = objv[i];
-        }
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldPtrs = elemPtrs;
+	int newMax;
 
-	/*
-	 * Update the count of elements.
-	 */
+	if (numRequired > listRepPtr->maxElemCount){
+	    newMax = 2 * numRequired;
+	} else {
+	    newMax = listRepPtr->maxElemCount;
+	}
 
-	listRepPtr->elemCount = numRequired;
-    } else {
-	/*
-	 * Not enough room in the current array. Allocate a larger array and
-	 * insert elements into it. 
-	 */
+	listRepPtr = AttemptNewList(interp, newMax, NULL);
+	if (listRepPtr == NULL) {
+	    for (i = 0;  i < objc;  i++) {
+		/* See bug 3598580 */
+#if TCL_MAJOR_VERSION > 8
+		Tcl_DecrRefCount(objv[i]);
+#else
+		objv[i]->refCount--;
+#endif
+	    }
+	    return TCL_ERROR;
+	}
 
-	newMax = (2 * numRequired);
-	newPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+	listRepPtr->refCount++;
 
-	/*
-	 * Copy over the elements before "first".
-	 */
+	elemPtrs = &listRepPtr->elements;
 
-	if (first > 0) {
-	    memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
-		    (size_t) (first * sizeof(Tcl_Obj *)));
-	}
+	if (isShared) {
+	    /*
+	     * The old struct will remain in place; need new refCounts for the
+	     * new List struct references. Copy over only the surviving
+	     * elements.
+	     */
 
-	/*
-	 * "Delete" count elements starting at first.
-	 */
+	    for (i=0; i < first; i++) {
+		elemPtrs[i] = oldPtrs[i];
+		Tcl_IncrRefCount(elemPtrs[i]);
+	    }
+	    for (i = first + count, j = first + objc;
+		    j < numRequired; i++, j++) {
+		elemPtrs[j] = oldPtrs[i];
+		Tcl_IncrRefCount(elemPtrs[j]);
+	    }
 
-	for (i = 0, j = first;  i < count;  i++, j++) {
-	    victimPtr = elemPtrs[j];
-	    TclDecrRefCount(victimPtr);
-	}
+	    oldListRepPtr->refCount--;
+	} else {
+	    /*
+	     * The old struct will be removed; use its inherited refCounts.
+	     */
 
-	/*
-	 * Copy the elements after the last one removed, shifted to
-	 * their new locations.
-	 */
+	    if (first > 0) {
+		memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
+	    }
 
-	start = (first + count);
-	numAfterLast = (numElems - start);
-	if (numAfterLast > 0) {
-	    memcpy((VOID *) &(newPtrs[first + objc]),
-		    (VOID *) &(elemPtrs[start]),
-		    (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
-	}
-	
-	/*
-	 * Insert the new elements before "first" and update the
-	 * count of elements.
-	 */
+	    /*
+	     * "Delete" count elements starting at first.
+	     */
+
+	    for (j = first;  j < first + count;  j++) {
+		Tcl_Obj *victimPtr = oldPtrs[j];
+
+		TclDecrRefCount(victimPtr);
+	    }
+
+	    /*
+	     * Copy the elements after the last one removed, shifted to their
+	     * new locations.
+	     */
+
+	    start = first + count;
+	    numAfterLast = numElems - start;
+	    if (numAfterLast > 0) {
+		memcpy(elemPtrs + first + objc, oldPtrs + start,
+			(size_t) numAfterLast * sizeof(Tcl_Obj *));
+	    }
 
-	for (i = 0, j = first;  i < objc;  i++, j++) {
-	    newPtrs[j] = objv[i];
+	    ckfree((char *) oldListRepPtr);
 	}
+    }
 
-	listRepPtr->elemCount = numRequired;
-	listRepPtr->maxElemCount = newMax;
-	listRepPtr->elements = newPtrs;
-	ckfree((char *) elemPtrs);
+    /*
+     * Insert the new elements into elemPtrs before "first".
+     */
+
+    for (i=0,j=first ; i<objc ; i++,j++) {
+	elemPtrs[j] = objv[i];
     }
-    
+
+    /*
+     * Update the count of elements.
+     */
+
+    listRepPtr->elemCount = numRequired;
+
     /*
      * Invalidate and free any old string representation since it no longer
      * reflects the list's internal representation.
      */
 
-    Tcl_InvalidateStringRep(listPtr);
+    TclInvalidateStringRep(listPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclLsetList --
- *	
- *	Core of the 'lset' command when objc == 4.  Objv[2] may be
- *	either a scalar index or a list of indices.
+ * TclLindexList --
+ *
+ *	This procedure handles the 'lindex' command when objc==3.
  *
  * Results:
- *	Returns the new value of the list variable, or NULL if an
- *	error occurs.
+ *	Returns a pointer to the object extracted, or NULL if an error
+ *	occurred. The returned object already includes one reference count for
+ *	the pointer returned.
  *
  * Side effects:
- *	Surgery is performed on the list value to produce the
- *	result.
- *
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack.  The first action of this function
- * is to determine whether the object is shared, and to duplicate it if
- * it is.  The reference count of the duplicate is incremented.
- * At this point, the reference count will be 1 for either case, so that
- * the object will appear to be unshared.
- *
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this dismisses
- * any memory that was allocated by this procedure.
- *
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is
- * done to a reference count of the duplicate.  Now the reference count
- * of an unduplicated object is 2 (the returned pointer, plus the one
- * stored in the variable).  The reference count of a duplicate object
- * is 1, reflecting that the returned pointer is the only active
- * reference.  The caller is expected to store the returned value back
- * in the variable and decrement its reference count.  (INST_STORE_*
- * does exactly this.)
- *
- * Tcl_LsetFlat and related functions maintain a linked list of
- * Tcl_Obj's whose string representations must be spoilt by threading
- * via 'ptr2' of the two-pointer internal representation.  On entry
- * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
- * the 'ptr2' field of any Tcl_Obj that has been modified is set to
- * NULL.
+ *	None.
+ *
+ * Notes:
+ *	This procedure is implemented entirely as a wrapper around
+ *	TclLindexFlat. All it does is reconfigure the argument format into the
+ *	form required by TclLindexFlat, while taking care to manage shimmering
+ *	in such a way that we tend to keep the most useful intreps and/or
+ *	avoid the most expensive conversions.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj*
-TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    Tcl_Obj* listPtr;		/* Pointer to the list being modified */
-    Tcl_Obj* indexArgPtr;	/* Index or index-list arg to 'lset' */
-    Tcl_Obj* valuePtr;		/* Value arg to 'lset' */
+Tcl_Obj *
+TclLindexList(
+    Tcl_Interp *interp,		/* Tcl interpreter. */
+    Tcl_Obj *listPtr,		/* List being unpacked. */
+    Tcl_Obj *argPtr)		/* Index or index list. */
 {
-    int indexCount;		/* Number of indices in the index list */
-    Tcl_Obj** indices;		/* Vector of indices in the index list*/
-
-    int duplicated;		/* Flag == 1 if the obj has been
-				 * duplicated, 0 otherwise */
-    Tcl_Obj* retValuePtr;	/* Pointer to the list to be returned */
-    int index;			/* Current index in the list - discarded */
-    int result;			/* Status return from library calls */
-    Tcl_Obj* subListPtr;	/* Pointer to the current sublist */
-    int elemCount;		/* Count of elements in the current sublist */
-    Tcl_Obj** elemPtrs;		/* Pointers to elements of current sublist  */
-    Tcl_Obj* chainPtr;		/* Pointer to the enclosing sublist
-				 * of the current sublist */
-    int i;
 
+    int index;			/* Index into the list. */
+    Tcl_Obj **indices;		/* Array of list indices. */
+    int indexCount;		/* Size of the array of list indices. */
+    Tcl_Obj *indexListCopy;
 
     /*
-     * Determine whether the index arg designates a list or a single
-     * index.  We have to be careful about the order of the checks to
-     * avoid repeated shimmering; see TIP #22 and #23 for details.
+     * Determine whether argPtr designates a list or a single index. We have
+     * to be careful about the order of the checks to avoid repeated
+     * shimmering; see TIP#22 and TIP#33 for the details.
      */
 
-    if ( indexArgPtr->typePtr != &tclListType
-	 && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
-
-	/*
-	 * indexArgPtr designates a single index.
-	 */
-
-	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
-
-    } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
-					&indexCount, &indices ) != TCL_OK ) {
-
+    if (argPtr->typePtr != &tclListType
+	    && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
 	/*
-	 * indexArgPtr designates something that is neither an index nor a
-	 * well formed list.  Report the error via TclLsetFlat.
+	 * argPtr designates a single index.
 	 */
 
-	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
-
+	return TclLindexFlat(interp, listPtr, 1, &argPtr);
     }
 
     /*
-     * At this point, we know that argPtr designates a well formed list,
-     * and the 'else if' above has parsed it into indexCount and indices.
-     * If there are no indices, simply return 'valuePtr', counting the
-     * returned pointer as a reference.
+     * Here we make a private copy of the index list argument to avoid any
+     * shimmering issues that might invalidate the indices array below while
+     * we are still using it. This is probably unnecessary. It does not appear
+     * that any damaging shimmering is possible, and no test has been devised
+     * to show any error when this private copy is not made. But it's cheap,
+     * and it offers some future-proofing insurance in case the TclLindexFlat
+     * implementation changes in some unexpected way, or some new form of
+     * trace or callback permits things to happen that the current
+     * implementation does not.
      */
 
-    if ( indexCount == 0 ) {
-	Tcl_IncrRefCount( valuePtr );
-	return valuePtr;
-    }
-
-    /*
-     * Duplicate the list arg if necessary.
-     */
+    indexListCopy = TclListObjCopy(NULL, argPtr);
+    if (indexListCopy == NULL) {
+	/*
+	 * argPtr designates something that is neither an index nor a
+	 * well-formed list. Report the error via TclLindexFlat.
+	 */
 
-    if ( Tcl_IsShared( listPtr ) ) {
-	duplicated = 1;
-	listPtr = Tcl_DuplicateObj( listPtr );
-	Tcl_IncrRefCount( listPtr );
-    } else {
-	duplicated = 0;
+	return TclLindexFlat(interp, listPtr, 1, &argPtr);
     }
 
-    /*
-     * It would be tempting simply to go off to TclLsetFlat to finish the
-     * processing.  Alas, it is also incorrect!  The problem is that
-     * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
-     * is to be manipulated.  The fact that 'listPtr' is itself unshared
-     * does not guarantee that no sublist is.  Therefore, it's necessary
-     * to replicate all the work here, expanding the index list on each
-     * trip through the loop.
-     */
-
-    /*
-     * Anchor the linked list of Tcl_Obj's whose string reps must be
-     * invalidated if the operation succeeds.
-     */
+    TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
+    listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+    Tcl_DecrRefCount(indexListCopy);
+    return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLindexFlat --
+ *
+ *	This procedure is the core of the 'lindex' command, with all index
+ *	arguments presented as a flat list.
+ *
+ * Results:
+ *	Returns a pointer to the object extracted, or NULL if an error
+ *	occurred. The returned object already includes one reference count for
+ *	the pointer returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	The reference count of the returned object includes one reference
+ *	corresponding to the pointer returned. Thus, the calling code will
+ *	usually do something like:
+ *		Tcl_SetObjResult(interp, result);
+ *		Tcl_DecrRefCount(result);
+ *
+ *----------------------------------------------------------------------
+ */
 
-    retValuePtr = listPtr;
-    chainPtr = NULL;
+Tcl_Obj *
+TclLindexFlat(
+    Tcl_Interp *interp,		/* Tcl interpreter. */
+    Tcl_Obj *listPtr,		/* Tcl object representing the list. */
+    int indexCount,		/* Count of indices. */
+    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
+				 * represent the indices in the list. */
+{
+    int i;
 
-    /*
-     * Handle each index arg by diving into the appropriate sublist
-     */
+    Tcl_IncrRefCount(listPtr);
 
-    for ( i = 0; ; ++i ) {
+    for (i=0 ; i<indexCount && listPtr ; i++) {
+	int index, listLen;
+	Tcl_Obj **elemPtrs, *sublistCopy;
 
 	/*
-	 * Take the sublist apart.
+	 * Here we make a private copy of the current sublist, so we avoid any
+	 * shimmering issues that might invalidate the elemPtr array below
+	 * while we are still using it. See test lindex-8.4.
 	 */
 
-	result = Tcl_ListObjGetElements( interp, listPtr,
-					 &elemCount, &elemPtrs );
-	if ( result != TCL_OK ) {
-	    break;
-	}
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
-	/*
-	 * Reconstitute the index array
-	 */
+	sublistCopy = TclListObjCopy(interp, listPtr);
+	Tcl_DecrRefCount(listPtr);
+	listPtr = NULL;
 
-	result = Tcl_ListObjGetElements( interp, indexArgPtr,
-					 &indexCount, &indices );
-	if ( result != TCL_OK ) {
-	    /* 
-	     * Shouldn't be able to get here, because we already
-	     * parsed the thing successfully once.
+	if (sublistCopy == NULL) {
+	    /*
+	     * The sublist is not a list at all => error.
 	     */
-	    break;
-	}
-
-	/*
-	 * Determine the index of the requested element.
-	 */
-
-	result = TclGetIntForIndex( interp, indices[ i ],
-				    (elemCount - 1), &index );
-	if ( result != TCL_OK ) {
-	    break;
-	}
-	
-	/*
-	 * Check that the index is in range.
-	 */
 
-	if ( ( index < 0 ) || ( index >= elemCount ) ) {
-	    Tcl_SetObjResult( interp,
-			      Tcl_NewStringObj( "list index out of range",
-						-1 ) );
-	    result = TCL_ERROR;
 	    break;
 	}
+	TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+
+	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
+		&index) == TCL_OK) {
+	    if (index<0 || index>=listLen) {
+		/*
+		 * Index is out of range. Break out of loop with empty result.
+		 * First check remaining indices for validity
+		 */
 
-	/*
-	 * Break the loop after extracting the innermost sublist
-	 */
-
-	if ( i >= indexCount-1 ) {
-	    result = TCL_OK;
-	    break;
-	}
-	
-	/*
-	 * Extract the appropriate sublist, and make sure that it is unshared.
-	 */
-
-	subListPtr = elemPtrs[ index ];
-	if ( Tcl_IsShared( subListPtr ) ) {
-	    subListPtr = Tcl_DuplicateObj( subListPtr );
-	    result = TclListObjSetElement( interp, listPtr, index,
-					    subListPtr );
-	    if ( result != TCL_OK ) {
-		/* 
-		 * We actually shouldn't be able to get here, because
-		 * we've already checked everything that TclListObjSetElement
-		 * checks. If we were to get here, it would result in leaking
-		 * subListPtr.
+		while (++i < indexCount) {
+		    if (TclGetIntForIndexM(interp, indexArray[i], -1, &index)
+			!= TCL_OK) {
+			Tcl_DecrRefCount(sublistCopy);
+			return NULL;
+		    }
+		}
+		listPtr = Tcl_NewObj();
+	    } else {
+		/*
+		 * Extract the pointer to the appropriate element.
 		 */
-		break;
+
+		listPtr = elemPtrs[index];
 	    }
+	    Tcl_IncrRefCount(listPtr);
 	}
+	Tcl_DecrRefCount(sublistCopy);
+    }
 
-	/* 
-	 * Chain the current sublist onto the linked list of Tcl_Obj's
-	 * whose string reps must be spoilt.
-	 */
-
-	chainPtr = listPtr;
-	listPtr = subListPtr;
+    return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLsetList --
+ *
+ *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
+ *	scalar index or a list of indices.
+ *
+ * Results:
+ *	Returns the new value of the list variable, or NULL if there was an
+ *	error. The returned object includes one reference count for the
+ *	pointer returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	This procedure is implemented entirely as a wrapper around
+ *	TclLsetFlat. All it does is reconfigure the argument format into the
+ *	form required by TclLsetFlat, while taking care to manage shimmering
+ *	in such a way that we tend to keep the most useful intreps and/or
+ *	avoid the most expensive conversions.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    }
+Tcl_Obj *
+TclLsetList(
+    Tcl_Interp *interp,		/* Tcl interpreter. */
+    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
+    Tcl_Obj *indexArgPtr,	/* Index or index-list arg to 'lset'. */
+    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
+{
+    int indexCount;		/* Number of indices in the index list. */
+    Tcl_Obj **indices;		/* Vector of indices in the index list. */
+    Tcl_Obj *retValuePtr;	/* Pointer to the list to be returned. */
+    int index;			/* Current index in the list - discarded. */
+    Tcl_Obj *indexListCopy;
 
     /*
-     * Store the new element into the correct slot in the innermost sublist.
+     * Determine whether the index arg designates a list or a single index.
+     * We have to be careful about the order of the checks to avoid repeated
+     * shimmering; see TIP #22 and #23 for details.
      */
 
-    if ( result == TCL_OK ) {
-	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
-    }
+    if (indexArgPtr->typePtr != &tclListType
+	    && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
+	/*
+	 * indexArgPtr designates a single index.
+	 */
 
-    if ( result == TCL_OK ) {
+	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
 
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+    }
 
-	/* Spoil all the string reps */
-	
-	while ( listPtr != NULL ) {
-	    subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
-	    Tcl_InvalidateStringRep( listPtr );
-	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	    listPtr = subListPtr;
-	}
+    indexListCopy = TclListObjCopy(NULL, indexArgPtr);
+    if (indexListCopy == NULL) {
+	/*
+	 * indexArgPtr designates something that is neither an index nor a
+	 * well formed list. Report the error via TclLsetFlat.
+	 */
 
-	/* Return the new list if everything worked. */
-	
-	if ( !duplicated ) {
-	    Tcl_IncrRefCount( retValuePtr );
-	}
-	return retValuePtr;
+	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
     }
+    TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
 
-    /* Clean up the one dangling reference otherwise */
+    /*
+     * Let TclLsetFlat handle the actual lset'ting.
+     */
 
-    if ( duplicated ) {
-	Tcl_DecrRefCount( retValuePtr );
-    }
-    return NULL;
+    retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
 
+    Tcl_DecrRefCount(indexListCopy);
+    return retValuePtr;
 }
 
 /*
@@ -1039,220 +1251,216 @@ TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
  *
  * TclLsetFlat --
  *
- *	Core of the 'lset' command when objc>=5.  Objv[2], ... ,
- *	objv[objc-2] contain scalar indices.
+ *	Core engine of the 'lset' command.
  *
  * Results:
- *	Returns the new value of the list variable, or NULL if an
- *	error occurs.
+ *	Returns the new value of the list variable, or NULL if an error
+ *	occurred. The returned object includes one reference count for
+ *	the pointer returned.
  *
  * Side effects:
- *	Surgery is performed on the list value to produce the
- *	result.
- *
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack.  The first action of this function
- * is to determine whether the object is shared, and to duplicate it if
- * it is.  The reference count of the duplicate is incremented.
- * At this point, the reference count will be 1 for either case, so that
- * the object will appear to be unshared.
- *
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this dismisses
- * any memory that was allocated by this procedure.
- *
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is
- * done to a reference count of the duplicate.  Now the reference count
- * of an unduplicated object is 2 (the returned pointer, plus the one
- * stored in the variable).  The reference count of a duplicate object
- * is 1, reflecting that the returned pointer is the only active
- * reference.  The caller is expected to store the returned value back
- * in the variable and decrement its reference count.  (INST_STORE_*
- * does exactly this.)
- *
- * Tcl_LsetList and related functions maintain a linked list of
- * Tcl_Obj's whose string representations must be spoilt by threading
- * via 'ptr2' of the two-pointer internal representation.  On entry
- * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
- * the 'ptr2' field of any Tcl_Obj that has been modified is set to
- * NULL.
+ *	On entry, the reference count of the variable value does not reflect
+ *	any references held on the stack. The first action of this function is
+ *	to determine whether the object is shared, and to duplicate it if it
+ *	is. The reference count of the duplicate is incremented. At this
+ *	point, the reference count will be 1 for either case, so that the
+ *	object will appear to be unshared.
+ *
+ *	If an error occurs, and the object has been duplicated, the reference
+ *	count on the duplicate is decremented so that it is now 0: this
+ *	dismisses any memory that was allocated by this function.
+ *
+ *	If no error occurs, the reference count of the original object is
+ *	incremented if the object has not been duplicated, and nothing is done
+ *	to a reference count of the duplicate. Now the reference count of an
+ *	unduplicated object is 2 (the returned pointer, plus the one stored in
+ *	the variable). The reference count of a duplicate object is 1,
+ *	reflecting that the returned pointer is the only active reference. The
+ *	caller is expected to store the returned value back in the variable
+ *	and decrement its reference count. (INST_STORE_* does exactly this.)
+ *
+ *	Surgery is performed on the unshared list value to produce the result.
+ *	TclLsetFlat maintains a linked list of Tcl_Obj's whose string
+ *	representations must be spoilt by threading via 'ptr2' of the
+ *	two-pointer internal representation. On entry to TclLsetFlat, the
+ *	values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
+ *	Tcl_Obj that has been modified is set to NULL.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj*
-TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    Tcl_Obj* listPtr;		/* Pointer to the list being modified */
-    int indexCount;		/* Number of index args */
-    Tcl_Obj *CONST indexArray[];
-				/* Index args */
-    Tcl_Obj* valuePtr;		/* Value arg to 'lset' */
+Tcl_Obj *
+TclLsetFlat(
+    Tcl_Interp *interp,		/* Tcl interpreter. */
+    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
+    int indexCount,		/* Number of index args. */
+    Tcl_Obj *const indexArray[],
+				/* Index args. */
+    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
 {
-
-    int duplicated;		/* Flag == 1 if the obj has been
-				 * duplicated, 0 otherwise */
-    Tcl_Obj* retValuePtr;	/* Pointer to the list to be returned */
-
-    int elemCount;		/* Length of one sublist being changed */
-    Tcl_Obj** elemPtrs;		/* Pointers to the elements of a sublist */
-
-    Tcl_Obj* subListPtr;	/* Pointer to the current sublist */
-
-    int index;			/* Index of the element to replace in the
-				 * current sublist */
-    Tcl_Obj* chainPtr;		/* Pointer to the enclosing list of
-				 * the current sublist. */
-
-    int result;			/* Status return from library calls */
-
-
-
-    int i;
+    int index, result;
+    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
 
     /*
-     * If there are no indices, then simply return the new value,
-     * counting the returned pointer as a reference
+     * If there are no indices, simply return the new value.
+     * (Without indices, [lset] is a synonym for [set].
      */
 
-    if ( indexCount == 0 ) {
-	Tcl_IncrRefCount( valuePtr );
+    if (indexCount == 0) {
+	Tcl_IncrRefCount(valuePtr);
 	return valuePtr;
     }
 
     /*
-     * If the list is shared, make a private copy.
+     * If the list is shared, make a copy we can modify (copy-on-write).
+     * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few
+     * reasons: 1) we have not yet confirmed listPtr is actually a list;
+     * 2) We make a verbatim copy of any existing string rep, and when
+     * we combine that with the delayed invalidation of string reps of
+     * modified Tcl_Obj's implemented below, the outcome is that any
+     * error condition that causes this routine to return NULL, will
+     * leave the string rep of listPtr and all elements to be unchanged.
      */
 
-    if ( Tcl_IsShared( listPtr ) ) {
-	duplicated = 1;
-	listPtr = Tcl_DuplicateObj( listPtr );
-	Tcl_IncrRefCount( listPtr );
-    } else {
-	duplicated = 0;
-    }
+    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
 
     /*
      * Anchor the linked list of Tcl_Obj's whose string reps must be
      * invalidated if the operation succeeds.
      */
 
-    retValuePtr = listPtr;
+    retValuePtr = subListPtr;
     chainPtr = NULL;
 
     /*
-     * Handle each index arg by diving into the appropriate sublist
+     * Loop through all the index arguments, and for each one dive
+     * into the appropriate sublist.
      */
 
-    for ( i = 0; ; ++i ) {
-
-	/*
-	 * Take the sublist apart.
-	 */
+    do {
+	int elemCount;
+	Tcl_Obj *parentList, **elemPtrs;
 
-	result = Tcl_ListObjGetElements( interp, listPtr,
-					 &elemCount, &elemPtrs );
-	if ( result != TCL_OK ) {
+	/* Check for the possible error conditions... */
+	result = TCL_ERROR;
+	if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
+		!= TCL_OK) {
+	    /* ...the sublist we're indexing into isn't a list at all. */
 	    break;
 	}
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
 
 	/*
-	 * Determine the index of the requested element.
+	 * WARNING: the macro TclGetIntForIndexM is not safe for
+	 * post-increments, avoid '*indexArray++' here.
 	 */
-
-	result = TclGetIntForIndex( interp, indexArray[ i ],
-				    (elemCount - 1), &index );
-	if ( result != TCL_OK ) {
-	    break;
-	}
 	
-	/*
-	 * Check that the index is in range.
-	 */
-
-	if ( ( index < 0 ) || ( index >= elemCount ) ) {
-	    Tcl_SetObjResult( interp,
-			      Tcl_NewStringObj( "list index out of range",
-						-1 ) );
-	    result = TCL_ERROR;
+	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
+		!= TCL_OK)  {
+	    /* ...the index we're trying to use isn't an index at all. */
+	    indexArray++;
 	    break;
 	}
+	indexArray++;
 
-	/*
-	 * Break the loop after extracting the innermost sublist
-	 */
-
-	if ( i >= indexCount-1 ) {
-	    result = TCL_OK;
+	if (index < 0 || index >= elemCount) {
+	    /* ...the index points outside the sublist. */
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp,
+			Tcl_NewStringObj("list index out of range", -1));
+	    }
 	    break;
 	}
-	
+
 	/*
-	 * Extract the appropriate sublist, and make sure that it is unshared.
+	 * No error conditions.  As long as we're not yet on the last
+	 * index, determine the next sublist for the next pass through
+	 * the loop, and take steps to make sure it is an unshared copy,
+	 * as we intend to modify it.
 	 */
 
-	subListPtr = elemPtrs[ index ];
-	if ( Tcl_IsShared( subListPtr ) ) {
-	    subListPtr = Tcl_DuplicateObj( subListPtr );
-	    result = TclListObjSetElement( interp, listPtr, index,
-					    subListPtr );
-	    if ( result != TCL_OK ) {
-		/* 
-		 * We actually shouldn't be able to get here.
-		 * If we do, it would result in leaking subListPtr,
-		 * but everything's been validated already; the error
-		 * exit from TclListObjSetElement should never happen.
-		 */
-		break;
+	result = TCL_OK;
+	if (--indexCount) {
+	    parentList = subListPtr;
+	    subListPtr = elemPtrs[index];
+	    if (Tcl_IsShared(subListPtr)) {
+		subListPtr = Tcl_DuplicateObj(subListPtr);
 	    }
-	}
 
-	/* 
-	 * Chain the current sublist onto the linked list of Tcl_Obj's
-	 * whose string reps must be spoilt.
-	 */
+	    /*
+	     * Replace the original elemPtr[index] in parentList with a copy
+	     * we know to be unshared.  This call will also deal with the
+	     * situation where parentList shares its intrep with other
+	     * Tcl_Obj's.  Dealing with the shared intrep case can cause
+	     * subListPtr to become shared again, so detect that case and
+	     * make and store another copy.
+	     */
 
-	chainPtr = listPtr;
-	listPtr = subListPtr;
+	    TclListObjSetElement(NULL, parentList, index, subListPtr);
+	    if (Tcl_IsShared(subListPtr)) {
+		subListPtr = Tcl_DuplicateObj(subListPtr);
+		TclListObjSetElement(NULL, parentList, index, subListPtr);
+	    }
 
-    }
+	    /*
+	     * The TclListObjSetElement() calls do not spoil the string
+	     * rep of parentList, and that's fine for now, since all we've
+	     * done so far is replace a list element with an unshared copy.
+	     * The list value remains the same, so the string rep. is still
+	     * valid, and unchanged, which is good because if this whole
+	     * routine returns NULL, we'd like to leave no change to the
+	     * value of the lset variable.  Later on, when we set valuePtr
+	     * in its proper place, then all containing lists will have
+	     * their values changed, and will need their string reps spoiled.
+	     * We maintain a list of all those Tcl_Obj's (via a little intrep
+	     * surgery) so we can spoil them at that time.
+	     */
 
-    /* Store the result in the list element */
+	    parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
+	    chainPtr = parentList;
+	}
+    } while (indexCount > 0);
 
-    if ( result == TCL_OK ) {
-	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
-    }
+    /*
+     * Either we've detected and error condition, and exited the loop
+     * with result == TCL_ERROR, or we've successfully reached the last
+     * index, and we're ready to store valuePtr.  In either case, we
+     * need to clean up our string spoiling list of Tcl_Obj's.
+     */
 
-    if ( result == TCL_OK ) {
+    while (chainPtr) {
+	Tcl_Obj *objPtr = chainPtr;
 
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+	if (result == TCL_OK) {
 
-	/* Spoil all the string reps */
-	
-	while ( listPtr != NULL ) {
-	    subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
-	    Tcl_InvalidateStringRep( listPtr );
-	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	    listPtr = subListPtr;
-	}
+	    /*
+	     * We're going to store valuePtr, so spoil string reps
+	     * of all containing lists.
+	     */
 
-	/* Return the new list if everything worked. */
-	
-	if ( !duplicated ) {
-	    Tcl_IncrRefCount( retValuePtr );
+	    TclInvalidateStringRep(objPtr);
 	}
-	return retValuePtr;
-    }
 
-    /* Clean up the one dangling reference otherwise */
+	/* Clear away our intrep surgery mess */
+	chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    }
 
-    if ( duplicated ) {
-	Tcl_DecrRefCount( retValuePtr );
+    if (result != TCL_OK) {
+	/* 
+	 * Error return; message is already in interp. Clean up
+	 * any excess memory. 
+	 */
+	if (retValuePtr != listPtr) {
+	    Tcl_DecrRefCount(retValuePtr);
+	}
+	return NULL;
     }
-    return NULL;
 
+    /* Store valuePtr in proper sublist and return */
+    TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+    TclInvalidateStringRep(subListPtr);
+    Tcl_IncrRefCount(retValuePtr);
+    return retValuePtr;
 }
 
 /*
@@ -1263,86 +1471,125 @@ TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
  *	Set a single element of a list to a specified value
  *
  * Results:
- *
- *	The return value is normally TCL_OK.  If listPtr does not
- *	refer to a list object and cannot be converted to one, TCL_ERROR
- *	is returned and an error message will be left in the interpreter
- *	result if interp is not NULL.  Similarly, if index designates
- *	an element outside the range [0..listLength-1], where
- *	listLength is the count of elements in the list object designated
- *	by listPtr, TCL_ERROR is returned and an error message is left
- *	in the interpreter result.
+ *	The return value is normally TCL_OK. If listPtr does not refer to a
+ *	list object and cannot be converted to one, TCL_ERROR is returned and
+ *	an error message will be left in the interpreter result if interp is
+ *	not NULL. Similarly, if index designates an element outside the range
+ *	[0..listLength-1], where listLength is the count of elements in the
+ *	list object designated by listPtr, TCL_ERROR is returned and an error
+ *	message is left in the interpreter result.
  *
  * Side effects:
+ *	Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
+ *	to convert it to a list with a non-shared internal rep. Decrements the
+ *	ref count of the object at the specified index within the list,
+ *	replaces with the object designated by valuePtr, and increments the
+ *	ref count of the replacement object.
  *
- *	Panics if listPtr designates a shared object.  Otherwise, attempts
- *	to convert it to a list.  Decrements the ref count of the object
- *	at the specified index within the list, replaces with the
- *	object designated by valuePtr, and increments the ref count
- *	of the replacement object.  
- *
- * It is the caller's responsibility to invalidate the string
- * representation of the object.
+ *	It is the caller's responsibility to invalidate the string
+ *	representation of the object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclListObjSetElement( interp, listPtr, index, valuePtr )
-    Tcl_Interp* interp;		/* Tcl interpreter; used for error reporting
-				 * if not NULL */
-    Tcl_Obj* listPtr;		/* List object in which element should be
-				 * stored */
-    int index;			/* Index of element to store */
-    Tcl_Obj* valuePtr;		/* Tcl object to store in the designated
-				 * list element */
+TclListObjSetElement(
+    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
+				 * if not NULL. */
+    Tcl_Obj *listPtr,		/* List object in which element should be
+				 * stored. */
+    int index,			/* Index of element to store. */
+    Tcl_Obj *valuePtr)		/* Tcl object to store in the designated list
+				 * element. */
 {
-    int result;			/* Return value from this function */
-    List* listRepPtr;		/* Internal representation of the list
-				 * being modified */
-    Tcl_Obj** elemPtrs;		/* Pointers to elements of the list */
-    int elemCount;		/* Number of elements in the list */
+    List *listRepPtr;		/* Internal representation of the list being
+				 * modified. */
+    Tcl_Obj **elemPtrs;		/* Pointers to elements of the list. */
+    int elemCount;		/* Number of elements in the list. */
 
-    /* Ensure that the listPtr parameter designates an unshared list */
+    /*
+     * Ensure that the listPtr parameter designates an unshared list.
+     */
 
-    if ( Tcl_IsShared( listPtr ) ) {
-	panic( "Tcl_ListObjSetElement called with shared object" );
+    if (Tcl_IsShared(listPtr)) {
+	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
     }
-    if ( listPtr->typePtr != &tclListType ) {
-	result = SetListFromAny( interp, listPtr );
-	if ( result != TCL_OK ) {
+    if (listPtr->typePtr != &tclListType) {
+	int result;
+
+	if (listPtr->bytes == tclEmptyStringRep) {
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp,
+			Tcl_NewStringObj("list index out of range", -1));
+	    }
+	    return TCL_ERROR;
+	}
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
 	    return result;
 	}
     }
-    listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
+
+    listRepPtr = ListRepPtr(listPtr);
     elemCount = listRepPtr->elemCount;
+    elemPtrs = &listRepPtr->elements;
+
+    /*
+     * Ensure that the index is in bounds.
+     */
+
+    if (index<0 || index>=elemCount) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("list index out of range", -1));
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the internal rep is shared, replace it with an unshared copy.
+     */
 
-    /* Ensure that the index is in bounds */
+    if (listRepPtr->refCount > 1) {
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldElemPtrs = elemPtrs;
+	int i;
 
-    if ( index < 0 || index >= elemCount ) {
-	if ( interp != NULL ) {
-	    Tcl_SetObjResult( interp,
-			      Tcl_NewStringObj( "list index out of range",
-						-1 ) );
+	listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
+	if (listRepPtr == NULL) {
 	    return TCL_ERROR;
 	}
+	listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
+	elemPtrs = &listRepPtr->elements;
+	for (i=0; i < elemCount; i++) {
+	    elemPtrs[i] = oldElemPtrs[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	listRepPtr->refCount++;
+	listRepPtr->elemCount = elemCount;
+	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+	oldListRepPtr->refCount--;
     }
 
-    /* Add a reference to the new list element */
+    /*
+     * Add a reference to the new list element.
+     */
 
-    Tcl_IncrRefCount( valuePtr );
+    Tcl_IncrRefCount(valuePtr);
 
-    /* Remove a reference from the old list element */
+    /*
+     * Remove a reference from the old list element.
+     */
 
-    Tcl_DecrRefCount( elemPtrs[ index ] );
+    Tcl_DecrRefCount(elemPtrs[index]);
 
-    /* Stash the new object in the list */
+    /*
+     * Stash the new object in the list.
+     */
 
-    elemPtrs[ index ] = valuePtr;
+    elemPtrs[index] = valuePtr;
 
     return TCL_OK;
-    
 }
 
 /*
@@ -1358,31 +1605,29 @@ TclListObjSetElement( interp, listPtr, index, valuePtr )
  *
  * Side effects:
  *	Frees listPtr's List* internal representation and sets listPtr's
- *	internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts
- *	of all element objects, which may free them.
+ *	internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
+ *	element objects, which may free them.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeListInternalRep(listPtr)
-    Tcl_Obj *listPtr;		/* List object with internal rep to free. */
+FreeListInternalRep(
+    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
 {
-    register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    register Tcl_Obj **elemPtrs = listRepPtr->elements;
-    register Tcl_Obj *objPtr;
-    int numElems = listRepPtr->elemCount;
-    int i;
-    
-    for (i = 0;  i < numElems;  i++) {
-	objPtr = elemPtrs[i];
-	Tcl_DecrRefCount(objPtr);
+    List *listRepPtr = ListRepPtr(listPtr);
+
+    if (--listRepPtr->refCount <= 0) {
+	Tcl_Obj **elemPtrs = &listRepPtr->elements;
+	int i, numElems = listRepPtr->elemCount;
+
+	for (i = 0;  i < numElems;  i++) {
+	    Tcl_DecrRefCount(elemPtrs[i]);
+	}
+	ckfree((char *) listRepPtr);
     }
-    ckfree((char *) elemPtrs);
-    ckfree((char *) listRepPtr);
 
-    listPtr->internalRep.twoPtrValue.ptr1 = NULL;
-    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    listPtr->typePtr = NULL;
 }
 
 /*
@@ -1390,57 +1635,26 @@ FreeListInternalRep(listPtr)
  *
  * DupListInternalRep --
  *
- *	Initialize the internal representation of a list Tcl_Obj to a
- *	copy of the internal representation of an existing list object. 
+ *	Initialize the internal representation of a list Tcl_Obj to share the
+ *	internal representation of an existing list object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	"srcPtr"s list internal rep pointer should not be NULL and we assume
- *	it is not NULL. We set "copyPtr"s internal rep to a pointer to a
- *	newly allocated List structure that, in turn, points to "srcPtr"s
- *	element objects. Those element objects are not actually copied but
- *	are shared between "srcPtr" and "copyPtr". The ref count of each
- *	element object is incremented.
+ *	The reference count of the List internal rep is incremented.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DupListInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+DupListInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
-    int numElems = srcListRepPtr->elemCount;
-    int maxElems = srcListRepPtr->maxElemCount;
-    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
-    register Tcl_Obj **copyElemPtrs;
-    register List *copyListRepPtr;
-    int i;
+    List *listRepPtr = ListRepPtr(srcPtr);
 
-    /*
-     * Allocate a new List structure that points to "srcPtr"s element
-     * objects. Increment the ref counts for those (now shared) element
-     * objects.
-     */
-    
-    copyElemPtrs = (Tcl_Obj **)
-	ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
-    for (i = 0;  i < numElems;  i++) {
-	copyElemPtrs[i] = srcElemPtrs[i];
-	Tcl_IncrRefCount(copyElemPtrs[i]);
-    }
-    
-    copyListRepPtr = (List *) ckalloc(sizeof(List));
-    copyListRepPtr->maxElemCount = maxElems;
-    copyListRepPtr->elemCount    = numElems;
-    copyListRepPtr->elements     = copyElemPtrs;
-    
-    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
-    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    copyPtr->typePtr = &tclListType;
+    ListSetIntRep(copyPtr, listRepPtr);
 }
 
 /*
@@ -1448,8 +1662,7 @@ DupListInternalRep(srcPtr, copyPtr)
  *
  * SetListFromAny --
  *
- *	Attempt to generate a list internal form for the Tcl object
- *	"objPtr".
+ *	Attempt to generate a list internal form for the Tcl object "objPtr".
  *
  * Results:
  *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
@@ -1464,110 +1677,113 @@ DupListInternalRep(srcPtr, copyPtr)
  */
 
 static int
-SetListFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object to convert. */
+SetListFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
 {
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *string, *s;
-    CONST char *elemStart, *nextElem;
-    int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
-    char *limit;		/* Points just after string's last byte. */
-    register CONST char *p;
-    register Tcl_Obj **elemPtrs;
-    register Tcl_Obj *elemPtr;
     List *listRepPtr;
+    Tcl_Obj **elemPtrs;
 
     /*
-     * Get the string representation. Make it up-to-date if necessary.
+     * Dictionaries are a special case; they have a string representation such
+     * that *all* valid dictionaries are valid lists. Hence we can convert
+     * more directly. Only do this when there's no existing string rep; if
+     * there is, it is the string rep that's authoritative (because it could
+     * describe duplicate keys).
      */
 
-    string = Tcl_GetStringFromObj(objPtr, &length);
+    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+	Tcl_Obj *keyPtr, *valuePtr;
+	Tcl_DictSearch search;
+	int done, size;
 
-    /*
-     * Parse the string into separate string objects, and create a List
-     * structure that points to the element string objects. We use a
-     * modified version of Tcl_SplitList's implementation to avoid one
-     * malloc and a string copy for each list element. First, estimate the
-     * number of elements by counting the number of space characters in the
-     * list.
-     */
+	/*
+	 * Create the new list representation. Note that we do not need to do
+	 * anything with the string representation as the transformation (and
+	 * the reverse back to a dictionary) are both order-preserving. Also
+	 * note that since we know we've got a valid dictionary (by
+	 * representation) we also know that fetching the size of the
+	 * dictionary or iterating over it will not fail.
+	 */
 
-    limit = (string + length);
-    estCount = 1;
-    for (p = string;  p < limit;  p++) {
-	if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
-	    estCount++;
+	Tcl_DictObjSize(NULL, objPtr, &size);
+	listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
+	if (!listRepPtr) {
+	    return TCL_ERROR;
 	}
-    }
+	listRepPtr->elemCount = 2 * size;
 
-    /*
-     * Allocate a new List structure with enough room for "estCount"
-     * elements. Each element is a pointer to a Tcl_Obj with the appropriate
-     * string rep. The initial "estCount" elements are set using the
-     * corresponding "argv" strings.
-     */
+	/*
+	 * Populate the list representation.
+	 */
 
-    elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
-    for (p = string, lenRemain = length, i = 0;
-	    lenRemain > 0;
-	    p = nextElem, lenRemain = (limit - nextElem), i++) {
-	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
-				&elemSize, &hasBrace);
-	if (result != TCL_OK) {
-	    for (j = 0;  j < i;  j++) {
-		elemPtr = elemPtrs[j];
-		Tcl_DecrRefCount(elemPtr);
-	    }
-	    ckfree((char *) elemPtrs);
-	    return result;
-	}
-	if (elemStart >= limit) {
-	    break;
-	}
-	if (i > estCount) {
-	    panic("SetListFromAny: bad size estimate for list");
+	elemPtrs = &listRepPtr->elements;
+	Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
+	while (!done) {
+	    *elemPtrs++ = keyPtr;
+	    *elemPtrs++ = valuePtr;
+	    Tcl_IncrRefCount(keyPtr);
+	    Tcl_IncrRefCount(valuePtr);
+	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
 	}
+    } else {
+	int estCount, length;
+	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
 
 	/*
-	 * Allocate a Tcl object for the element and initialize it from the
-	 * "elemSize" bytes starting at "elemStart".
+	 * Allocate enough space to hold a (Tcl_Obj *) for each
+	 * (possible) list element.
 	 */
 
-	s = ckalloc((unsigned) elemSize + 1);
-	if (hasBrace) {
-	    memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
-	    s[elemSize] = 0;
-	} else {
-	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+	estCount = TclMaxListLength(nextElem, length, &limit);
+	estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
+	listRepPtr = AttemptNewList(interp, estCount, NULL);
+	if (listRepPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	elemPtrs = &listRepPtr->elements;
+
+	/* Each iteration, parse and store a list element */
+	while (nextElem < limit) {
+	    const char *elemStart;
+	    int elemSize, literal;
+
+	    if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal)) {
+		while (--elemPtrs >= &listRepPtr->elements) {
+		    Tcl_DecrRefCount(*elemPtrs);
+		}
+		ckfree((char *) listRepPtr);
+		return TCL_ERROR;
+	    }
+	    if (elemStart == limit) {
+		break;
+	    }
+
+	    /* TODO: replace panic with error on alloc failure? */
+	    if (literal) {
+		TclNewStringObj(*elemPtrs, elemStart, elemSize);
+	    } else {
+		TclNewObj(*elemPtrs);
+		(*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
+		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
+			(*elemPtrs)->bytes);
+	    }
+
+	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
 	}
-	
-	TclNewObj(elemPtr);
-        elemPtr->bytes  = s;
-        elemPtr->length = elemSize;
-        elemPtrs[i] = elemPtr;
-	Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
-    }
 
-    listRepPtr = (List *) ckalloc(sizeof(List));
-    listRepPtr->maxElemCount = estCount;
-    listRepPtr->elemCount    = i;
-    listRepPtr->elements     = elemPtrs;
+ 	listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
+    }
 
     /*
-     * Free the old internalRep before setting the new one. We do this as
-     * late as possible to allow the conversion code, in particular
+     * Free the old internalRep before setting the new one. We do this as late
+     * as possible to allow the conversion code, in particular
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-
-    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    objPtr->typePtr = &tclListType;
+    TclFreeIntRep(objPtr);
+    ListSetIntRep(objPtr, listRepPtr);
     return TCL_OK;
 }
 
@@ -1576,39 +1792,50 @@ SetListFromAny(interp, objPtr)
  *
  * UpdateStringOfList --
  *
- *	Update the string representation for a list object.
- *	Note: This procedure does not invalidate an existing old string rep
- *	so storage will be lost if this has not already been done. 
+ *	Update the string representation for a list object. Note: This
+ *	function does not invalidate an existing old string rep so storage
+ *	will be lost if this has not already been done.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's string is set to a valid string that results from
- *	the list-to-string conversion. This string will be empty if the
- *	list has no elements. The list internal representation
- *	should not be NULL and we assume it is not NULL.
+ *	The object's string is set to a valid string that results from the
+ *	list-to-string conversion. This string will be empty if the list has
+ *	no elements. The list internal representation should not be NULL and
+ *	we assume it is not NULL.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfList(listPtr)
-    Tcl_Obj *listPtr;		/* List object with string rep to update. */
+UpdateStringOfList(
+    Tcl_Obj *listPtr)		/* List object with string rep to update. */
 {
 #   define LOCAL_SIZE 20
-    int localFlags[LOCAL_SIZE], *flagPtr;
-    List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+    List *listRepPtr = ListRepPtr(listPtr);
     int numElems = listRepPtr->elemCount;
-    register int i;
+    int i, length, bytesNeeded = 0;
     char *elem, *dst;
-    int length;
+    Tcl_Obj **elemPtrs;
 
     /*
-     * Convert each element of the list to string form and then convert it
-     * to proper list element form, adding it to the result buffer.
+     * Mark the list as being canonical; although it will now have a string
+     * rep, it is one we derived through proper "canonical" quoting and so
+     * it's known to be free from nasties relating to [concat] and [eval].
      */
 
+    listRepPtr->canonicalFlag = 1;
+
+    /* Handle empty list case first, so rest of the routine is simpler */
+
+    if (numElems == 0) {
+	listPtr->bytes = tclEmptyStringRep;
+	listPtr->length = 0;
+	return;
+    }
+
     /*
      * Pass 1: estimate space, gather flags.
      */
@@ -1616,41 +1843,47 @@ UpdateStringOfList(listPtr)
     if (numElems <= LOCAL_SIZE) {
 	flagPtr = localFlags;
     } else {
-	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+	/* We know numElems <= LIST_MAX, so this is safe. */
+	flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int));
     }
-    listPtr->length = 1;
+    elemPtrs = &listRepPtr->elements;
     for (i = 0; i < numElems; i++) {
-	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
-	listPtr->length += Tcl_ScanCountedElement(elem, length,
-		&flagPtr[i]) + 1;
-	/*
-	 * Check for continued sanity. [Bug 1267380]
-	 */
-	if (listPtr->length < 1) {
-	    Tcl_Panic("string representation size exceeds sane bounds");
+	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	elem = TclGetStringFromObj(elemPtrs[i], &length);
+	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+	if (bytesNeeded < 0) {
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
 	}
     }
+    if (bytesNeeded > INT_MAX - numElems + 1) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+    bytesNeeded += numElems;
 
     /*
      * Pass 2: copy into string rep buffer.
      */
 
-    listPtr->bytes = ckalloc((unsigned) listPtr->length);
+    listPtr->length = bytesNeeded - 1;
+    listPtr->bytes = ckalloc((unsigned) bytesNeeded);
     dst = listPtr->bytes;
     for (i = 0; i < numElems; i++) {
-	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
-	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
-	*dst = ' ';
-	dst++;
+	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	elem = TclGetStringFromObj(elemPtrs[i], &length);
+	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+	*dst++ = ' ';
     }
+    listPtr->bytes[listPtr->length] = '\0';
+
     if (flagPtr != localFlags) {
 	ckfree((char *) flagPtr);
     }
-    if (dst == listPtr->bytes) {
-	*dst = 0;
-    } else {
-	dst--;
-	*dst = 0;
-    }
-    listPtr->length = dst - listPtr->bytes;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 0c88303..2c91b82 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -1,76 +1,74 @@
-/* 
+/*
  * tclLiteral.c --
  *
- *	Implementation of the global and ByteCode-local literal tables
- *	used to manage the Tcl objects created for literal values during
- *	compilation of Tcl scripts. This implementation borrows heavily
- *	from the more general hashtable implementation of Tcl hash tables
- *	that appears in tclHash.c.
+ *	Implementation of the global and ByteCode-local literal tables used to
+ *	manage the Tcl objects created for literal values during compilation
+ *	of Tcl scripts. This implementation borrows heavily from the more
+ *	general hashtable implementation of Tcl hash tables that appears in
+ *	tclHash.c.
  *
  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 #include "tclCompile.h"
-#include "tclPort.h"
+
 /*
- * When there are this many entries per bucket, on average, rebuild
- * a literal's hash table to make it larger.
+ * When there are this many entries per bucket, on average, rebuild a
+ * literal's hash table to make it larger.
  */
 
 #define REBUILD_MULTIPLIER	3
 
 /*
- * Procedure prototypes for static procedures in this file:
+ * Function prototypes for static functions in this file:
  */
 
-static int		AddLocalLiteralEntry _ANSI_ARGS_((
-			    CompileEnv *envPtr, LiteralEntry *globalPtr,
-			    int localHash));
-static void		ExpandLocalLiteralArray _ANSI_ARGS_((
-			    CompileEnv *envPtr));
-static unsigned int	HashString _ANSI_ARGS_((CONST char *bytes,
-			    int length));
-static void		RebuildLiteralTable _ANSI_ARGS_((
-			    LiteralTable *tablePtr));
+static int		AddLocalLiteralEntry(CompileEnv *envPtr,
+			    Tcl_Obj *objPtr, int localHash);
+static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
+static unsigned int	HashString(const char *bytes, int length);
+static void		RebuildLiteralTable(LiteralTable *tablePtr);
 
 /*
  *----------------------------------------------------------------------
  *
  * TclInitLiteralTable --
  *
- *	This procedure is called to initialize the fields of a literal table
+ *	This function is called to initialize the fields of a literal table
  *	structure for either an interpreter or a compilation's CompileEnv
  *	structure.
  *
  * Results:
  *	None.
  *
- * Side effects: 
+ * Side effects:
  *	The literal table is made ready for use.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclInitLiteralTable(tablePtr)
-    register LiteralTable *tablePtr; /* Pointer to table structure, which
-				      * is supplied by the caller. */
+TclInitLiteralTable(
+    register LiteralTable *tablePtr)
+				/* Pointer to table structure, which is
+				 * supplied by the caller. */
 {
-#if (TCL_SMALL_HASH_TABLE != 4) 
-    panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+#if (TCL_SMALL_HASH_TABLE != 4)
+    Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4",
 	    TCL_SMALL_HASH_TABLE);
 #endif
-    
+
     tablePtr->buckets = tablePtr->staticBuckets;
     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
     tablePtr->numEntries = 0;
-    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE * REBUILD_MULTIPLIER;
     tablePtr->mask = 3;
 }
 
@@ -79,49 +77,58 @@ TclInitLiteralTable(tablePtr)
  *
  * TclDeleteLiteralTable --
  *
- *	This procedure frees up everything associated with a literal table
- *	except for the table's structure itself.
+ *	This function frees up everything associated with a literal table
+ *	except for the table's structure itself. It is called when the
+ *	interpreter is deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Each literal in the table is released: i.e., its reference count
- *	in the global literal table is decremented and, if it becomes zero,
- *	the literal is freed. In addition, the table's bucket array is
- *	freed.
+ *	Each literal in the table is released: i.e., its reference count in
+ *	the global literal table is decremented and, if it becomes zero, the
+ *	literal is freed. In addition, the table's bucket array is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteLiteralTable(interp, tablePtr)
-    Tcl_Interp *interp;		/* Interpreter containing shared literals
+TclDeleteLiteralTable(
+    Tcl_Interp *interp,		/* Interpreter containing shared literals
 				 * referenced by the table to delete. */
-    LiteralTable *tablePtr;	/* Points to the literal table to delete. */
+    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
 {
-    LiteralEntry *entryPtr;
-    int i, start;
+    LiteralEntry *entryPtr, *nextPtr;
+    Tcl_Obj *objPtr;
+    int i;
 
     /*
-     * Release remaining literals in the table. Note that releasing a
-     * literal might release other literals, modifying the table, so we
-     * restart the search from the bucket chain we last found an entry.
+     * Release remaining literals in the table. Note that releasing a literal
+     * might release other literals, modifying the table, so we restart the
+     * search from the bucket chain we last found an entry.
      */
 
 #ifdef TCL_COMPILE_DEBUG
     TclVerifyGlobalLiteralTable((Interp *) interp);
 #endif /*TCL_COMPILE_DEBUG*/
 
-    start = 0;
-    while (tablePtr->numEntries > 0) {
-	for (i = start;  i < tablePtr->numBuckets;  i++) {
-	    entryPtr = tablePtr->buckets[i];
-	    if (entryPtr != NULL) {
-		TclReleaseLiteral(interp, entryPtr->objPtr);
-		start = i;
-		break;
-	    }
+    /*
+     * We used to call TclReleaseLiteral for each literal in the table, which
+     * is rather inefficient as it causes one lookup-by-hash for each
+     * reference to the literal. We now rely at interp-deletion on each
+     * bytecode object to release its references to the literal Tcl_Obj
+     * without requiring that it updates the global table itself, and deal
+     * here only with the table.
+     */
+
+    for (i=0 ; i<tablePtr->numBuckets ; i++) {
+	entryPtr = tablePtr->buckets[i];
+	while (entryPtr != NULL) {
+	    objPtr = entryPtr->objPtr;
+	    TclDecrRefCount(objPtr);
+	    nextPtr = entryPtr->nextPtr;
+	    ckfree((char *) entryPtr);
+	    entryPtr = nextPtr;
 	}
     }
 
@@ -137,199 +144,266 @@ TclDeleteLiteralTable(interp, tablePtr)
 /*
  *----------------------------------------------------------------------
  *
- * TclRegisterLiteral --
+ * TclCreateLiteral --
  *
- *	Find, or if necessary create, an object in a CompileEnv literal
- *	array that has a string representation matching the argument string.
+ *	Find, or if necessary create, an object in the interpreter's literal
+ *	table that has a string representation matching the argument
+ *	string. If nsPtr!=NULL then only literals stored for the namespace are
+ *	considered. 
  *
  * Results:
- *	The index in the CompileEnv's literal array that references a
- *	shared literal matching the string. The object is created if
- *	necessary.
+ *	The literal object. If it was created in this call *newPtr is set to
+ *      1, else 0. NULL is returned if newPtr==NULL and no literal is found.
  *
  * Side effects:
- *	To maximize sharing, we look up the string in the interpreter's
- *	global literal table. If not found, we create a new shared literal
- *	in the global table. We then add a reference to the shared
- *	literal in the CompileEnv's literal array. 
- *
- *	If onHeap is 1, this procedure is given ownership of the string: if
- *	an object is created then its string representation is set directly
- *	from string, otherwise the string is freed. Typically, a caller sets
- *	onHeap 1 if "string" is an already heap-allocated buffer holding the
- *	result of backslash substitutions.
+ *      Increments the ref count of the global LiteralEntry since the caller
+ *      now holds a reference. 
+ *	If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ *	of the string: if an object is created then its string representation
+ *	is set directly from string, otherwise the string is freed. Typically,
+ *	a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ *	buffer holding the result of backslash substitutions.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclRegisterLiteral(envPtr, bytes, length, onHeap)
-    CompileEnv *envPtr;		/* Points to the CompileEnv in whose object
-				 * array an object is found or created. */
-    register char *bytes;	/* Points to string for which to find or
-				 * create an object in CompileEnv's object
-				 * array. */
-    int length;			/* Number of bytes in the string. If < 0,
-				 * the string consists of all bytes up to
-				 * the first null character. */
-    int onHeap;			/* If 1 then the caller already malloc'd
-				 * bytes and ownership is passed to this
-				 * procedure. */
+Tcl_Obj *
+TclCreateLiteral(
+    Interp *iPtr,
+    char *bytes,
+    int length,
+    unsigned int hash,       /* The string's hash. If -1, it will be computed here */
+    int *newPtr,
+    Namespace *nsPtr,
+    int flags,
+    LiteralEntry **globalPtrPtr)
 {
-    Interp *iPtr = envPtr->iPtr;
     LiteralTable *globalTablePtr = &(iPtr->literalTable);
-    LiteralTable *localTablePtr = &(envPtr->localLitTable);
-    register LiteralEntry *globalPtr, *localPtr;
-    register Tcl_Obj *objPtr;
-    unsigned int hash;
-    int localHash, globalHash, objIndex;
-    long n;
-    char buf[TCL_INTEGER_SPACE];
-
-    if (length < 0) {
-	length = (bytes? strlen(bytes) : 0);
-    }
-    hash = HashString(bytes, length);
-
+    LiteralEntry *globalPtr;
+    int globalHash;
+    Tcl_Obj *objPtr;
+    
     /*
-     * Is the literal already in the CompileEnv's local literal array?
-     * If so, just return its index.
+     * Is it in the interpreter's global literal table?
      */
 
-    localHash = (hash & localTablePtr->mask);
-    for (localPtr = localTablePtr->buckets[localHash];
-	  localPtr != NULL;  localPtr = localPtr->nextPtr) {
-	objPtr = localPtr->objPtr;
-	if ((objPtr->length == length) && ((length == 0)
-		|| ((objPtr->bytes[0] == bytes[0])
-			&& (memcmp(objPtr->bytes, bytes, (unsigned) length)
-				== 0)))) {
-	    if (onHeap) {
-		ckfree(bytes);
-	    }
-	    objIndex = (localPtr - envPtr->literalArrayPtr);
-#ifdef TCL_COMPILE_DEBUG
-	    TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
-	    return objIndex;
-	}
+    if (hash == (unsigned int) -1) {
+	hash = HashString(bytes, length);
     }
-
-    /*
-     * The literal is new to this CompileEnv. Is it in the interpreter's
-     * global literal table?
-     */
-
     globalHash = (hash & globalTablePtr->mask);
-    for (globalPtr = globalTablePtr->buckets[globalHash];
-	 globalPtr != NULL;  globalPtr = globalPtr->nextPtr) {
+    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
+	    globalPtr = globalPtr->nextPtr) {
 	objPtr = globalPtr->objPtr;
-	if ((objPtr->length == length) && ((length == 0)
+	if ((globalPtr->nsPtr == nsPtr)
+		&& (objPtr->length == length) && ((length == 0)
 		|| ((objPtr->bytes[0] == bytes[0])
-			&& (memcmp(objPtr->bytes, bytes, (unsigned) length)
-				== 0)))) {
+		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
 	    /*
-	     * A global literal was found. Add an entry to the CompileEnv's
-	     * local literal array.
+	     * A literal was found: return it
 	     */
-	    
-	    if (onHeap) {
-		ckfree(bytes);
+
+	    if (newPtr) {
+		*newPtr = 0;
 	    }
-	    objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
-#ifdef TCL_COMPILE_DEBUG
-	    if (globalPtr->refCount < 1) {
-		panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
-			(length>60? 60 : length), bytes,
-			globalPtr->refCount);
+	    if (globalPtrPtr) {
+		*globalPtrPtr = globalPtr;
 	    }
-	    TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/ 
-	    return objIndex;
+	    if (flags & LITERAL_ON_HEAP) {
+		ckfree(bytes);
+	    }
+	    globalPtr->refCount++;
+	    return objPtr;
+	}
+    }
+    if (!newPtr) {
+	if (flags & LITERAL_ON_HEAP) {
+	    ckfree(bytes);
 	}
+	return NULL;
     }
 
     /*
      * The literal is new to the interpreter. Add it to the global literal
-     * table then add an entry to the CompileEnv's local literal array.
-     * Convert the object to an integer object if possible.
+     * table.
      */
 
     TclNewObj(objPtr);
     Tcl_IncrRefCount(objPtr);
-    if (onHeap) {
+    if (flags & LITERAL_ON_HEAP) {
 	objPtr->bytes = bytes;
 	objPtr->length = length;
     } else {
 	TclInitStringRep(objPtr, bytes, length);
     }
 
-    if (TclLooksLikeInt(bytes, length)) {
-	/*
-	 * From here we use the objPtr, because it is NULL terminated
-	 */
-	if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {
-	    TclFormatInt(buf, n);
-	    if (strcmp(objPtr->bytes, buf) == 0) {
-		objPtr->internalRep.longValue = n;
-		objPtr->typePtr = &tclIntType;
-	    }
-	}
-    }
-    
 #ifdef TCL_COMPILE_DEBUG
     if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
-	panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
-	        (length>60? 60 : length), bytes);
+	Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
+		(length>60? 60 : length), bytes);
     }
 #endif
 
     globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
     globalPtr->objPtr = objPtr;
-    globalPtr->refCount = 0;
+    globalPtr->refCount = 1;
+    globalPtr->nsPtr = nsPtr;
     globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
     globalTablePtr->buckets[globalHash] = globalPtr;
     globalTablePtr->numEntries++;
 
     /*
-     * If the global literal table has exceeded a decent size, rebuild it
-     * with more buckets.
+     * If the global literal table has exceeded a decent size, rebuild it with
+     * more buckets.
      */
 
     if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
 	RebuildLiteralTable(globalTablePtr);
     }
-    objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
 
 #ifdef TCL_COMPILE_DEBUG
     TclVerifyGlobalLiteralTable(iPtr);
-    TclVerifyLocalLiteralTable(envPtr);
     {
 	LiteralEntry *entryPtr;
 	int found, i;
+
 	found = 0;
-	for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
-	    for (entryPtr = globalTablePtr->buckets[i];
-		    entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
-		if ((entryPtr == globalPtr)
-		        && (entryPtr->objPtr == objPtr)) {
+	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
+		    entryPtr=entryPtr->nextPtr) {
+		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
 		    found = 1;
 		}
 	    }
 	}
 	if (!found) {
-	    panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
-	            (length>60? 60 : length), bytes);
+	    Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
+		    (length>60? 60 : length), bytes);
 	}
     }
 #endif /*TCL_COMPILE_DEBUG*/
-#ifdef TCL_COMPILE_STATS   
+
+#ifdef TCL_COMPILE_STATS
     iPtr->stats.numLiteralsCreated++;
-    iPtr->stats.totalLitStringBytes   += (double) (length + 1);
+    iPtr->stats.totalLitStringBytes += (double) (length + 1);
     iPtr->stats.currentLitStringBytes += (double) (length + 1);
     iPtr->stats.literalCount[TclLog2(length)]++;
 #endif /*TCL_COMPILE_STATS*/
+
+    if (globalPtrPtr) {
+	*globalPtrPtr = globalPtr;
+    }
+    *newPtr = 1;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ *	Find, or if necessary create, an object in a CompileEnv literal array
+ *	that has a string representation matching the argument string.
+ *
+ * Results:
+ *	The index in the CompileEnv's literal array that references a shared
+ *	literal matching the string. The object is created if necessary.
+ *
+ * Side effects:
+ *	To maximize sharing, we look up the string in the interpreter's global
+ *	literal table. If not found, we create a new shared literal in the
+ *	global table. We then add a reference to the shared literal in the
+ *	CompileEnv's literal array.
+ *
+ *	If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ *	of the string: if an object is created then its string representation
+ *	is set directly from string, otherwise the string is freed. Typically,
+ *	a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ *	buffer holding the result of backslash substitutions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(
+    CompileEnv *envPtr,		/* Points to the CompileEnv in whose object
+				 * array an object is found or created. */
+    register char *bytes,	/* Points to string for which to find or
+				 * create an object in CompileEnv's object
+				 * array. */
+    int length,			/* Number of bytes in the string. If < 0, the
+				 * string consists of all bytes up to the
+				 * first null character. */
+    int flags)			/* If LITERAL_ON_HEAP then the caller already
+				 * malloc'd bytes and ownership is passed to
+				 * this function. If LITERAL_NS_SCOPE then
+				 * the literal shouldnot be shared accross
+				 * namespaces. */
+{
+    Interp *iPtr = envPtr->iPtr;
+    LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    LiteralEntry *globalPtr, *localPtr;
+    Tcl_Obj *objPtr;
+    unsigned int hash;
+    int localHash, objIndex, new;
+    Namespace *nsPtr;
+
+    if (length < 0) {
+	length = (bytes ? strlen(bytes) : 0);
+    }
+    hash = HashString(bytes, length);
+
+    /*
+     * Is the literal already in the CompileEnv's local literal array? If so,
+     * just return its index.
+     */
+
+    localHash = (hash & localTablePtr->mask);
+    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+	    localPtr = localPtr->nextPtr) {
+	objPtr = localPtr->objPtr;
+	if ((objPtr->length == length) && ((length == 0)
+		|| ((objPtr->bytes[0] == bytes[0])
+		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
+	    if (flags & LITERAL_ON_HEAP) {
+		ckfree(bytes);
+	    }
+	    objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+	    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+	    return objIndex;
+	}
+    }
+
+    /*
+     * The literal is new to this CompileEnv. Should it be shared accross
+     * namespaces? If it is a fully qualified name, the namespace
+     * specification is not needed to avoid sharing.
+     */
+
+    if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
+	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
+	nsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+	nsPtr = NULL;
+    }
+
+    /*
+     * Is it in the interpreter's global literal table? If not, create it.
+     */
+
+    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
+	    flags, &globalPtr);
+    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+    if (globalPtr->refCount < 1) {
+	Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+		(length>60? 60 : length), bytes, globalPtr->refCount);
+    }
+    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
     return objIndex;
 }
 
@@ -339,24 +413,24 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
  * TclLookupLiteralEntry --
  *
  *	Finds the LiteralEntry that corresponds to a literal Tcl object
- *      holding a literal.
+ *	holding a literal.
  *
  * Results:
- *      Returns the matching LiteralEntry if found, otherwise NULL.
+ *	Returns the matching LiteralEntry if found, otherwise NULL.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 LiteralEntry *
-TclLookupLiteralEntry(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter for which objPtr was created
-                                 * to hold a literal. */
-    register Tcl_Obj *objPtr;	/* Points to a Tcl object holding a
-                                 * literal that was previously created by a
-                                 * call to TclRegisterLiteral. */
+TclLookupLiteralEntry(
+    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
+				 * hold a literal. */
+    register Tcl_Obj *objPtr)	/* Points to a Tcl object holding a literal
+				 * that was previously created by a call to
+				 * TclRegisterLiteral. */
 {
     Interp *iPtr = (Interp *) interp;
     LiteralTable *globalTablePtr = &(iPtr->literalTable);
@@ -364,13 +438,13 @@ TclLookupLiteralEntry(interp, objPtr)
     char *bytes;
     int length, globalHash;
 
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    bytes = TclGetStringFromObj(objPtr, &length);
     globalHash = (HashString(bytes, length) & globalTablePtr->mask);
-    for (entryPtr = globalTablePtr->buckets[globalHash];
-            entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
-        if (entryPtr->objPtr == objPtr) {
-            return entryPtr;
-        }
+    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
+	    entryPtr=entryPtr->nextPtr) {
+	if (entryPtr->objPtr == objPtr) {
+	    return entryPtr;
+	}
     }
     return NULL;
 }
@@ -380,10 +454,10 @@ TclLookupLiteralEntry(interp, objPtr)
  *
  * TclHideLiteral --
  *
- *	Remove a literal entry from the literal hash tables, leaving it in
- *	the literal array so existing references continue to function.
- *	This makes it possible to turn a shared literal into a private
- *	literal that cannot be shared.
+ *	Remove a literal entry from the literal hash tables, leaving it in the
+ *	literal array so existing references continue to function. This makes
+ *	it possible to turn a shared literal into a private literal that
+ *	cannot be shared.
  *
  * Results:
  *	None.
@@ -396,13 +470,13 @@ TclLookupLiteralEntry(interp, objPtr)
  */
 
 void
-TclHideLiteral(interp, envPtr, index)
-    Tcl_Interp *interp;		 /* Interpreter for which objPtr was created
-                                  * to hold a literal. */
-    register CompileEnv *envPtr; /* Points to CompileEnv whose literal array
-				  * contains the entry being hidden. */
-    int index;			 /* The index of the entry in the literal
-				  * array. */
+TclHideLiteral(
+    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
+				 * hold a literal. */
+    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
+				 * contains the entry being hidden. */
+    int index)			/* The index of the entry in the literal
+				 * array. */
 {
     LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
     LiteralTable *localTablePtr = &(envPtr->localLitTable);
@@ -414,9 +488,9 @@ TclHideLiteral(interp, envPtr, index)
 
     /*
      * To avoid unwanted sharing we need to copy the object and remove it from
-     * the local and global literal tables.  It still has a slot in the literal
-     * array so it can be referred to by byte codes, but it will not be matched
-     * by literal searches.
+     * the local and global literal tables. It still has a slot in the literal
+     * array so it can be referred to by byte codes, but it will not be
+     * matched by literal searches.
      */
 
     newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
@@ -424,11 +498,11 @@ TclHideLiteral(interp, envPtr, index)
     TclReleaseLiteral(interp, lPtr->objPtr);
     lPtr->objPtr = newObjPtr;
 
-    bytes = Tcl_GetStringFromObj(newObjPtr, &length);
+    bytes = TclGetStringFromObj(newObjPtr, &length);
     localHash = (HashString(bytes, length) & localTablePtr->mask);
     nextPtrPtr = &localTablePtr->buckets[localHash];
 
-    for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) {
+    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
 	if (entryPtr == lPtr) {
 	    *nextPtrPtr = lPtr->nextPtr;
 	    lPtr->nextPtr = NULL;
@@ -444,31 +518,30 @@ TclHideLiteral(interp, envPtr, index)
  *
  * TclAddLiteralObj --
  *
- *	Add a single literal object to the literal array.  This
- *	function does not add the literal to the local or global
- *	literal tables.  The caller is expected to add the entry
- *	to whatever tables are appropriate.
+ *	Add a single literal object to the literal array. This function does
+ *	not add the literal to the local or global literal tables. The caller
+ *	is expected to add the entry to whatever tables are appropriate.
  *
  * Results:
  *	The index in the CompileEnv's literal array that references the
- *	literal.  Stores the pointer to the new literal entry in the
- *	location referenced by the localPtrPtr argument.
+ *	literal. Stores the pointer to the new literal entry in the location
+ *	referenced by the localPtrPtr argument.
  *
  * Side effects:
- *	Expands the literal array if necessary.  Increments the refcount
- *	on the literal object.
+ *	Expands the literal array if necessary. Increments the refcount on the
+ *	literal object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
-    register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
-				  * array the object is to be inserted. */
-    Tcl_Obj *objPtr;		 /* The object to insert into the array. */
-    LiteralEntry **litPtrPtr;	 /* The location where the pointer to the
-				  * new literal entry should be stored.
-				  * May be NULL. */
+TclAddLiteralObj(
+    register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
+				 * the object is to be inserted. */
+    Tcl_Obj *objPtr,		/* The object to insert into the array. */
+    LiteralEntry **litPtrPtr)	/* The location where the pointer to the new
+				 * literal entry should be stored. May be
+				 * NULL. */
 {
     register LiteralEntry *lPtr;
     int objIndex;
@@ -504,27 +577,24 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
  *	literal.
  *
  * Side effects:
- *	Increments the ref count of the global LiteralEntry since the
- *	CompileEnv now refers to the literal. Expands the literal array
- *	if necessary. May rebuild the hash bucket array of the CompileEnv's
- *	literal array if it becomes too large.
+ *	Expands the literal array if necessary. May rebuild the hash bucket
+ *      array of the CompileEnv's literal array if it becomes too large.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-AddLocalLiteralEntry(envPtr, globalPtr, localHash)
-    register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
-				  * array the object is to be inserted. */
-    LiteralEntry *globalPtr;	 /* Points to the global LiteralEntry for
-				  * the literal to add to the CompileEnv. */
-    int localHash;		 /* Hash value for the literal's string. */
+AddLocalLiteralEntry(
+    register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
+				 * the object is to be inserted. */
+    Tcl_Obj *objPtr,	        /* The literal to add to the CompileEnv. */
+    int localHash)		/* Hash value for the literal's string. */
 {
     register LiteralTable *localTablePtr = &(envPtr->localLitTable);
     LiteralEntry *localPtr;
     int objIndex;
-    
-    objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+
+    objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
 
     /*
      * Add the literal to the local table.
@@ -534,8 +604,6 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
     localTablePtr->buckets[localHash] = localPtr;
     localTablePtr->numEntries++;
 
-    globalPtr->refCount++;
-
     /*
      * If the CompileEnv's local literal table has exceeded a decent size,
      * rebuild it with more buckets.
@@ -550,22 +618,25 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
     {
 	char *bytes;
 	int length, found, i;
+
 	found = 0;
-	for (i = 0;  i < localTablePtr->numBuckets;  i++) {
-	    for (localPtr = localTablePtr->buckets[i];
-		    localPtr != NULL;  localPtr = localPtr->nextPtr) {
-		if (localPtr->objPtr == globalPtr->objPtr) {
+	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
+		    localPtr=localPtr->nextPtr) {
+		if (localPtr->objPtr == objPtr) {
 		    found = 1;
 		}
 	    }
 	}
+
 	if (!found) {
-	    bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
-	    panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
-	            (length>60? 60 : length), bytes);
+	    bytes = Tcl_GetStringFromObj(objPtr, &length);
+	    Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
+		    (length>60? 60 : length), bytes);
 	}
     }
 #endif /*TCL_COMPILE_DEBUG*/
+
     return objIndex;
 }
 
@@ -574,72 +645,72 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
  *
  * ExpandLocalLiteralArray --
  *
- *	Procedure that uses malloc to allocate more storage for a
- *	CompileEnv's local literal array.
+ *	Function that uses malloc to allocate more storage for a CompileEnv's
+ *	local literal array.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The literal array in *envPtr is reallocated to a new array of
- *	double the size, and if envPtr->mallocedLiteralArray is non-zero
- *	the old array is freed. Entries are copied from the old array
- *	to the new one. The local literal table is updated to refer to
- *	the new entries.
+ *	The literal array in *envPtr is reallocated to a new array of double
+ *	the size, and if envPtr->mallocedLiteralArray is non-zero the old
+ *	array is freed. Entries are copied from the old array to the new one.
+ *	The local literal table is updated to refer to the new entries.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-ExpandLocalLiteralArray(envPtr)
-    register CompileEnv *envPtr; /* Points to the CompileEnv whose object
-				  * array must be enlarged. */
+ExpandLocalLiteralArray(
+    register CompileEnv *envPtr)/* Points to the CompileEnv whose object array
+				 * must be enlarged. */
 {
     /*
-     * The current allocated local literal entries are stored between
-     * elements 0 and (envPtr->literalArrayNext - 1) [inclusive].
+     * The current allocated local literal entries are stored between elements
+     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
      */
 
     LiteralTable *localTablePtr = &(envPtr->localLitTable);
     int currElems = envPtr->literalArrayNext;
     size_t currBytes = (currElems * sizeof(LiteralEntry));
-    register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
-    register LiteralEntry *newArrayPtr =
-	    (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
+    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+    LiteralEntry *newArrayPtr;
     int i;
-    
+
+    if (envPtr->mallocedLiteralArray) {
+	newArrayPtr = (LiteralEntry *) ckrealloc(
+		(char *)currArrayPtr, 2 * currBytes);
+    } else {
+	/*
+	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
+	 * code a ckrealloc equivalent for ourselves
+	 */
+	newArrayPtr = (LiteralEntry *) ckalloc(2 * currBytes);
+	memcpy(newArrayPtr, currArrayPtr, currBytes);
+	envPtr->mallocedLiteralArray = 1;
+    }
+
     /*
-     * Copy from the old literal array to the new, then update the local
-     * literal table's bucket array.
+     * Update the local literal table's bucket array.
      */
 
-    memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
-    for (i = 0;  i < currElems;  i++) {
-	if (currArrayPtr[i].nextPtr == NULL) {
-	    newArrayPtr[i].nextPtr = NULL;
-	} else {
-	    newArrayPtr[i].nextPtr = newArrayPtr
-		    + (currArrayPtr[i].nextPtr - currArrayPtr);
+    if (currArrayPtr != newArrayPtr) {
+	for (i=0 ; i<currElems ; i++) {
+	    if (newArrayPtr[i].nextPtr != NULL) {
+		newArrayPtr[i].nextPtr = newArrayPtr 
+			+ (newArrayPtr[i].nextPtr - currArrayPtr);
+	    }
 	}
-    }
-    for (i = 0;  i < localTablePtr->numBuckets;  i++) {
-	if (localTablePtr->buckets[i] != NULL) {
-	    localTablePtr->buckets[i] = newArrayPtr
-	            + (localTablePtr->buckets[i] - currArrayPtr);
+	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+	    if (localTablePtr->buckets[i] != NULL) {
+		localTablePtr->buckets[i] = newArrayPtr
+			+ (localTablePtr->buckets[i] - currArrayPtr);
+	    }
 	}
     }
 
-    /*
-     * Free the old literal array if needed, and mark the new literal
-     * array as malloced.
-     */
-    
-    if (envPtr->mallocedLiteralArray) {
-	ckfree((char *) currArrayPtr);
-    }
     envPtr->literalArrayPtr = newArrayPtr;
     envPtr->literalArrayEnd = (2 * currElems);
-    envPtr->mallocedLiteralArray = 1;
 }
 
 /*
@@ -647,59 +718,56 @@ ExpandLocalLiteralArray(envPtr)
  *
  * TclReleaseLiteral --
  *
- *	This procedure releases a reference to one of the shared Tcl objects
- *	that hold literals. It is called to release the literals referenced
- *	by a ByteCode that is being destroyed, and it is also called by
+ *	This function releases a reference to one of the shared Tcl objects
+ *	that hold literals. It is called to release the literals referenced by
+ *	a ByteCode that is being destroyed, and it is also called by
  *	TclDeleteLiteralTable.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The reference count for the global LiteralTable entry that 
- *	corresponds to the literal is decremented. If no other reference
- *	to a global literal object remains, it is freed.
+ *	The reference count for the global LiteralTable entry that corresponds
+ *	to the literal is decremented. If no other reference to a global
+ *	literal object remains, it is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclReleaseLiteral(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter for which objPtr was created
-				 * to hold a literal. */
-    register Tcl_Obj *objPtr;	/* Points to a literal object that was
+TclReleaseLiteral(
+    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
+				 * hold a literal. */
+    register Tcl_Obj *objPtr)	/* Points to a literal object that was
 				 * previously created by a call to
 				 * TclRegisterLiteral. */
 {
     Interp *iPtr = (Interp *) interp;
     LiteralTable *globalTablePtr = &(iPtr->literalTable);
     register LiteralEntry *entryPtr, *prevPtr;
-    ByteCode* codePtr;
     char *bytes;
     int length, index;
 
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    bytes = TclGetStringFromObj(objPtr, &length);
     index = (HashString(bytes, length) & globalTablePtr->mask);
 
     /*
-     * Check to see if the object is in the global literal table and 
-     * remove this reference.  The object may not be in the table if
-     * it is a hidden local literal.
+     * Check to see if the object is in the global literal table and remove
+     * this reference. The object may not be in the table if it is a hidden
+     * local literal.
      */
 
-    for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
-	    entryPtr != NULL;
-	    prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+    for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
+	    entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
 	if (entryPtr->objPtr == objPtr) {
 	    entryPtr->refCount--;
 
 	    /*
-	     * If the literal is no longer being used by any ByteCode,
-	     * delete the entry then remove the reference corresponding 
-	     * to the global literal table entry (decrement the ref count 
-	     * of the object).
+	     * If the literal is no longer being used by any ByteCode, delete
+	     * the entry then remove the reference corresponding to the global
+	     * literal table entry (decrement the ref count of the object).
 	     */
-		
+
 	    if (entryPtr->refCount == 0) {
 		if (prevPtr == NULL) {
 		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
@@ -711,22 +779,6 @@ TclReleaseLiteral(interp, objPtr)
 
 		TclDecrRefCount(objPtr);
 
-		/*
-		 * Check if the LiteralEntry is only being kept alive by 
-		 * a circular reference from a ByteCode stored as its 
-		 * internal rep. In that case, set the ByteCode object array 
-		 * entry NULL to signal to TclCleanupByteCode to not try to 
-		 * release this about to be freed literal again.
-		 */
-	    
-		if (objPtr->typePtr == &tclByteCodeType) {
-		    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-		    if ((codePtr->numLitObjects == 1)
-		            && (codePtr->objArrayPtr[0] == objPtr)) {			
-			codePtr->objArrayPtr[0] = NULL;
-		    }
-		}
-
 #ifdef TCL_COMPILE_STATS
 		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
 #endif /*TCL_COMPILE_STATS*/
@@ -734,10 +786,9 @@ TclReleaseLiteral(interp, objPtr)
 	    break;
 	}
     }
-    
+
     /*
-     * Remove the reference corresponding to the local literal table
-     * entry.
+     * Remove the reference corresponding to the local literal table entry.
      */
 
     Tcl_DecrRefCount(objPtr);
@@ -748,12 +799,11 @@ TclReleaseLiteral(interp, objPtr)
  *
  * HashString --
  *
- *	Compute a one-word summary of a text string, which can be
- *	used to generate a hash index.
+ *	Compute a one-word summary of a text string, which can be used to
+ *	generate a hash index.
  *
  * Results:
- *	The return value is a one-word summary of the information in
- *	string.
+ *	The return value is a one-word summary of the information in string.
  *
  * Side effects:
  *	None.
@@ -762,33 +812,32 @@ TclReleaseLiteral(interp, objPtr)
  */
 
 static unsigned int
-HashString(bytes, length)
-    register CONST char *bytes; /* String for which to compute hash
-				 * value. */
-    int length;			/* Number of bytes in the string. */
+HashString(
+    register const char *bytes,	/* String for which to compute hash value. */
+    int length)			/* Number of bytes in the string. */
 {
     register unsigned int result;
     register int i;
 
     /*
-     * I tried a zillion different hash functions and asked many other
-     * people for advice.  Many people had their own favorite functions,
-     * all different, but no-one had much idea why they were good ones.
-     * I chose the one below (multiply by 9 and add new character)
-     * because of the following reasons:
+     * I tried a zillion different hash functions and asked many other people
+     * for advice. Many people had their own favorite functions, all
+     * different, but no-one had much idea why they were good ones. I chose
+     * the one below (multiply by 9 and add new character) because of the
+     * following reasons:
      *
-     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
-     *    and multiplying by 9 is just about as good.
-     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
-     *    character's bits hang around in the low-order bits of the
-     *    hash value for ever, plus they spread fairly rapidly up to
-     *    the high-order bits to fill out the hash value.  This seems
-     *    works well both for decimal and non-decimal strings.
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
+     *	  multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old). This means that each
+     *	  character's bits hang around in the low-order bits of the hash value
+     *	  for ever, plus they spread fairly rapidly up to the high-order bits
+     *	  to fill out the hash value. This seems works well both for decimal
+     *	  and non-decimal strings.
      */
 
     result = 0;
-    for (i = 0;  i < length;  i++) {
-	result += (result<<3) + *bytes++;
+    for (i=0 ; i<length ; i++) {
+	result += (result<<3) + bytes[i];
     }
     return result;
 }
@@ -798,9 +847,9 @@ HashString(bytes, length)
  *
  * RebuildLiteralTable --
  *
- *	This procedure is invoked when the ratio of entries to hash buckets
- *	becomes too large in a local or global literal table. It allocates
- *	a larger bucket array and moves the entries into the new buckets.
+ *	This function is invoked when the ratio of entries to hash buckets
+ *	becomes too large in a local or global literal table. It allocates a
+ *	larger bucket array and moves the entries into the new buckets.
  *
  * Results:
  *	None.
@@ -812,8 +861,9 @@ HashString(bytes, length)
  */
 
 static void
-RebuildLiteralTable(tablePtr)
-    register LiteralTable *tablePtr; /* Local or global table to enlarge. */
+RebuildLiteralTable(
+    register LiteralTable *tablePtr)
+				/* Local or global table to enlarge. */
 {
     LiteralEntry **oldBuckets;
     register LiteralEntry **oldChainPtr, **newChainPtr;
@@ -826,16 +876,15 @@ RebuildLiteralTable(tablePtr)
     oldBuckets = tablePtr->buckets;
 
     /*
-     * Allocate and initialize the new bucket array, and set up
-     * hashing constants for new array size.
+     * Allocate and initialize the new bucket array, and set up hashing
+     * constants for new array size.
      */
 
     tablePtr->numBuckets *= 4;
     tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
 	    (tablePtr->numBuckets * sizeof(LiteralEntry *)));
-    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
-	    count > 0;
-	    count--, newChainPtr++) {
+    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
+	    count>0 ; count--, newChainPtr++) {
 	*newChainPtr = NULL;
     }
     tablePtr->rebuildSize *= 4;
@@ -845,14 +894,11 @@ RebuildLiteralTable(tablePtr)
      * Rehash all of the existing entries into the new bucket array.
      */
 
-    for (oldChainPtr = oldBuckets;
-	    oldSize > 0;
-	    oldSize--, oldChainPtr++) {
-	for (entryPtr = *oldChainPtr;  entryPtr != NULL;
-	        entryPtr = *oldChainPtr) {
-	    bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
+	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
+	    bytes = TclGetStringFromObj(entryPtr->objPtr, &length);
 	    index = (HashString(bytes, length) & tablePtr->mask);
-	    
+
 	    *oldChainPtr = entryPtr->nextPtr;
 	    bucketPtr = &(tablePtr->buckets[index]);
 	    entryPtr->nextPtr = *bucketPtr;
@@ -875,13 +921,12 @@ RebuildLiteralTable(tablePtr)
  *
  * TclLiteralStats --
  *
- *	Return statistics describing the layout of the hash table
- *	in its hash buckets.
+ *	Return statistics describing the layout of the hash table in its hash
+ *	buckets.
  *
  * Results:
- *	The return value is a malloc-ed string containing information
- *	about tablePtr.  It is the caller's responsibility to free
- *	this string.
+ *	The return value is a malloc-ed string containing information about
+ *	tablePtr. It is the caller's responsibility to free this string.
  *
  * Side effects:
  *	None.
@@ -890,8 +935,8 @@ RebuildLiteralTable(tablePtr)
  */
 
 char *
-TclLiteralStats(tablePtr)
-    LiteralTable *tablePtr;	/* Table for which to produce stats. */
+TclLiteralStats(
+    LiteralTable *tablePtr)	/* Table for which to produce stats. */
 {
 #define NUM_COUNTERS 10
     int count[NUM_COUNTERS], overflow, i, j;
@@ -900,19 +945,19 @@ TclLiteralStats(tablePtr)
     char *result, *p;
 
     /*
-     * Compute a histogram of bucket usage. For each bucket chain i,
-     * j is the number of entries in the chain.
+     * Compute a histogram of bucket usage. For each bucket chain i, j is the
+     * number of entries in the chain.
      */
 
-    for (i = 0;  i < NUM_COUNTERS;  i++) {
+    for (i=0 ; i<NUM_COUNTERS ; i++) {
 	count[i] = 0;
     }
     overflow = 0;
     average = 0.0;
-    for (i = 0;  i < tablePtr->numBuckets;  i++) {
+    for (i=0 ; i<tablePtr->numBuckets ; i++) {
 	j = 0;
-	for (entryPtr = tablePtr->buckets[i];  entryPtr != NULL;
-	        entryPtr = entryPtr->nextPtr) {
+	for (entryPtr=tablePtr->buckets[i] ; entryPtr!=NULL;
+		entryPtr=entryPtr->nextPtr) {
 	    j++;
 	}
 	if (j < NUM_COUNTERS) {
@@ -932,7 +977,7 @@ TclLiteralStats(tablePtr)
     sprintf(result, "%d entries in table, %d buckets\n",
 	    tablePtr->numEntries, tablePtr->numBuckets);
     p = result + strlen(result);
-    for (i = 0; i < NUM_COUNTERS; i++) {
+    for (i=0 ; i<NUM_COUNTERS ; i++) {
 	sprintf(p, "number of buckets with %d entries: %d\n",
 		i, count[i]);
 	p += strlen(p);
@@ -957,15 +1002,15 @@ TclLiteralStats(tablePtr)
  *	None.
  *
  * Side effects:
- *	Panics if problems are found.
+ *	Tcl_Panic if problems are found.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclVerifyLocalLiteralTable(envPtr)
-    CompileEnv *envPtr;		/* Points to CompileEnv whose literal
-				 * table is to be validated. */
+TclVerifyLocalLiteralTable(
+    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
+				 * to be validated. */
 {
     register LiteralTable *localTablePtr = &(envPtr->localLitTable);
     register LiteralEntry *localPtr;
@@ -974,30 +1019,29 @@ TclVerifyLocalLiteralTable(envPtr)
     int length, count;
 
     count = 0;
-    for (i = 0;  i < localTablePtr->numBuckets;  i++) {
-	for (localPtr = localTablePtr->buckets[i];
-	        localPtr != NULL;  localPtr = localPtr->nextPtr) {
+    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
+		localPtr=localPtr->nextPtr) {
 	    count++;
 	    if (localPtr->refCount != -1) {
 		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
-		panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
-		        (length>60? 60 : length), bytes,
-		        localPtr->refCount);
+		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+			(length>60? 60 : length), bytes, localPtr->refCount);
 	    }
 	    if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
 		    localPtr->objPtr) == NULL) {
 		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
-		panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
-		         (length>60? 60 : length), bytes);
+		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+			(length>60? 60 : length), bytes);
 	    }
 	    if (localPtr->objPtr->bytes == NULL) {
-		panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+		Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
 	    }
 	}
     }
     if (count != localTablePtr->numEntries) {
-	panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
-	      count, localTablePtr->numEntries);
+	Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
+		count, localTablePtr->numEntries);
     }
 }
 
@@ -1012,15 +1056,15 @@ TclVerifyLocalLiteralTable(envPtr)
  *	None.
  *
  * Side effects:
- *	Panics if problems are found.
+ *	Tcl_Panic if problems are found.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclVerifyGlobalLiteralTable(iPtr)
-    Interp *iPtr;		/* Points to interpreter whose global
-				 * literal table is to be validated. */
+TclVerifyGlobalLiteralTable(
+    Interp *iPtr)		/* Points to interpreter whose global literal
+				 * table is to be validated. */
 {
     register LiteralTable *globalTablePtr = &(iPtr->literalTable);
     register LiteralEntry *globalPtr;
@@ -1029,24 +1073,31 @@ TclVerifyGlobalLiteralTable(iPtr)
     int length, count;
 
     count = 0;
-    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
-	for (globalPtr = globalTablePtr->buckets[i];
-	        globalPtr != NULL;  globalPtr = globalPtr->nextPtr) {
+    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
+		globalPtr=globalPtr->nextPtr) {
 	    count++;
 	    if (globalPtr->refCount < 1) {
 		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
-		panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
-		        (length>60? 60 : length), bytes,
-		        globalPtr->refCount);
+		Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+			(length>60? 60 : length), bytes, globalPtr->refCount);
 	    }
 	    if (globalPtr->objPtr->bytes == NULL) {
-		panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+		Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
 	    }
 	}
     }
     if (count != globalTablePtr->numEntries) {
-	panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
-	      count, globalTablePtr->numEntries);
+	Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
+		count, globalTablePtr->numEntries);
     }
 }
 #endif /*TCL_COMPILE_DEBUG*/
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 0caa28b..ac863b9 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -1,59 +1,69 @@
-/* 
+/*
  * tclLoad.c --
  *
- *	This file provides the generic portion (those that are the same
- *	on all platforms) of Tcl's dynamic loading facilities.
+ *	This file provides the generic portion (those that are the same on all
+ *	platforms) of Tcl's dynamic loading facilities.
  *
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * The following structure describes a package that has been loaded
- * either dynamically (with the "load" command) or statically (as
- * indicated by a call to TclGetLoadedPackages).  All such packages
- * are linked together into a single list for the process.  Packages
- * are never unloaded, until the application exits, when 
- * TclFinalizeLoad is called, and these structures are freed.
+ * The following structure describes a package that has been loaded either
+ * dynamically (with the "load" command) or statically (as indicated by a call
+ * to TclGetLoadedPackages). All such packages are linked together into a
+ * single list for the process. Packages are never unloaded, until the
+ * application exits, when TclFinalizeLoad is called, and these structures are
+ * freed.
  */
 
 typedef struct LoadedPackage {
-    char *fileName;		/* Name of the file from which the
-				 * package was loaded.  An empty string
-				 * means the package is loaded statically.
-				 * Malloc-ed. */
+    char *fileName;		/* Name of the file from which the package was
+				 * loaded. An empty string means the package
+				 * is loaded statically. Malloc-ed. */
     char *packageName;		/* Name of package prefix for the package,
 				 * properly capitalized (first letter UC,
-				 * others LC), no "_", as in "Net". 
+				 * others LC), no "_", as in "Net".
 				 * Malloc-ed. */
     Tcl_LoadHandle loadHandle;	/* Token for the loaded file which should be
 				 * passed to (*unLoadProcPtr)() when the file
-				 * is no longer needed.  If fileName is NULL,
+				 * is no longer needed. If fileName is NULL,
 				 * then this field is irrelevant. */
     Tcl_PackageInitProc *initProc;
-				/* Initialization procedure to call to
+				/* Initialization function to call to
 				 * incorporate this package into a trusted
 				 * interpreter. */
     Tcl_PackageInitProc *safeInitProc;
-				/* Initialization procedure to call to
+				/* Initialization function to call to
 				 * incorporate this package into a safe
 				 * interpreter (one that will execute
-				 * untrusted scripts).   NULL means the
-				 * package can't be used in unsafe
-				 * interpreters. */
+				 * untrusted scripts). NULL means the package
+				 * can't be used in unsafe interpreters. */
+    Tcl_PackageUnloadProc *unloadProc;
+				/* Finalisation function to unload a package
+				 * from a trusted interpreter. NULL means that
+				 * the package cannot be unloaded. */
+    Tcl_PackageUnloadProc *safeUnloadProc;
+				/* Finalisation function to unload a package
+				 * from a safe interpreter. NULL means that
+				 * the package cannot be unloaded. */
+    int interpRefCount;		/* How many times the package has been loaded
+				 * in trusted interpreters. */
+    int safeInterpRefCount;	/* How many times the package has been loaded
+				 * in safe interpreters. */
     Tcl_FSUnloadFileProc *unLoadProcPtr;
-				/* Procedure to use to unload this package.
-				 * If NULL, then we do not attempt to unload
-				 * the package.  If fileName is NULL, then
-				 * this field is irrelevant. */
+				/* Function to use to unload this package. If
+				 * NULL, then we do not attempt to unload the
+				 * package. If fileName is NULL, then this
+				 * field is irrelevant. */
     struct LoadedPackage *nextPtr;
 				/* Next in list of all packages loaded into
-				 * this application process.  NULL means
-				 * end of list. */
+				 * this application process. NULL means end of
+				 * list. */
 } LoadedPackage;
 
 /*
@@ -69,35 +79,35 @@ static LoadedPackage *firstPackagePtr = NULL;
 TCL_DECLARE_MUTEX(packageMutex)
 
 /*
- * The following structure represents a particular package that has
- * been incorporated into a particular interpreter (by calling its
- * initialization procedure).  There is a list of these structures for
- * each interpreter, with an AssocData value (key "load") for the
- * interpreter that points to the first package (if any).
+ * The following structure represents a particular package that has been
+ * incorporated into a particular interpreter (by calling its initialization
+ * function). There is a list of these structures for each interpreter, with
+ * an AssocData value (key "load") for the interpreter that points to the
+ * first package (if any).
  */
 
 typedef struct InterpPackage {
     LoadedPackage *pkgPtr;	/* Points to detailed information about
 				 * package. */
     struct InterpPackage *nextPtr;
-				/* Next package in this interpreter, or
-				 * NULL for end of list. */
+				/* Next package in this interpreter, or NULL
+				 * for end of list. */
 } InterpPackage;
 
 /*
- * Prototypes for procedures that are private to this file:
+ * Prototypes for functions that are private to this file:
  */
 
-static void		LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
+static void		LoadCleanupProc(ClientData clientData,
+			    Tcl_Interp *interp);
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_LoadObjCmd --
  *
- *	This procedure is invoked to process the "load" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "load" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -109,36 +119,41 @@ static void		LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
  */
 
 int
-Tcl_LoadObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LoadObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Interp *target;
     LoadedPackage *pkgPtr, *defaultPtr;
     Tcl_DString pkgName, tmp, initName, safeInitName;
-    Tcl_PackageInitProc *initProc, *safeInitProc;
+    Tcl_DString unloadName, safeUnloadName;
+    Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
     InterpPackage *ipFirstPtr, *ipPtr;
-    int code, namesMatch, filesMatch;
+    int code, namesMatch, filesMatch, offset;
+    const char *symbols[4];
+    Tcl_PackageInitProc **procPtrs[4];
+    ClientData clientData;
     char *p, *fullFileName, *packageName;
     Tcl_LoadHandle loadHandle;
     Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
     Tcl_UniChar ch;
-    int offset;
 
     if ((objc < 2) || (objc > 4)) {
-        Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
+	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
 	return TCL_ERROR;
     }
     if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
 	return TCL_ERROR;
     }
     fullFileName = Tcl_GetString(objv[1]);
-    
+
     Tcl_DStringInit(&pkgName);
     Tcl_DStringInit(&initName);
     Tcl_DStringInit(&safeInitName);
+    Tcl_DStringInit(&unloadName);
+    Tcl_DStringInit(&safeUnloadName);
     Tcl_DStringInit(&tmp);
 
     packageName = NULL;
@@ -162,23 +177,25 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 
     target = interp;
     if (objc == 4) {
-	char *slaveIntName;
-	slaveIntName = Tcl_GetString(objv[3]);
+	char *slaveIntName = Tcl_GetString(objv[3]);
+
 	target = Tcl_GetSlave(interp, slaveIntName);
 	if (target == NULL) {
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
     }
 
     /*
      * Scan through the packages that are currently loaded to see if the
-     * package we want is already loaded.  We'll use a loaded package if
-     * it meets any of the following conditions:
+     * package we want is already loaded. We'll use a loaded package if it
+     * meets any of the following conditions:
      *  - Its name and file match the once we're looking for.
      *  - Its file matches, and we weren't given a name.
-     *  - Its name matches, the file name was specified as empty, and there
-     *    is only no statically loaded package with the same name.
+     *  - Its name matches, the file name was specified as empty, and there is
+     *	  only no statically loaded package with the same name.
      */
+
     Tcl_MutexLock(&packageMutex);
 
     defaultPtr = NULL;
@@ -210,13 +227,12 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	}
 	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
 	    /*
-	     * Can't have two different packages loaded from the same
-	     * file.
+	     * Can't have two different packages loaded from the same file.
 	     */
 
 	    Tcl_AppendResult(interp, "file \"", fullFileName,
 		    "\" is already loaded for package \"",
-		    pkgPtr->packageName, "\"", (char *) NULL);
+		    pkgPtr->packageName, "\"", NULL);
 	    code = TCL_ERROR;
 	    Tcl_MutexUnlock(&packageMutex);
 	    goto done;
@@ -229,13 +245,13 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 
     /*
      * Scan through the list of packages already loaded in the target
-     * interpreter.  If the package we want is already loaded there,
-     * then there's nothing for us to to.
+     * interpreter. If the package we want is already loaded there, then
+     * there's nothing for us to do.
      */
 
     if (pkgPtr != NULL) {
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
-		(Tcl_InterpDeleteProc **) NULL);
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
+		"tclLoad", NULL);
 	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	    if (ipPtr->pkgPtr == pkgPtr) {
 		code = TCL_OK;
@@ -246,13 +262,13 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 
     if (pkgPtr == NULL) {
 	/*
-	 * The desired file isn't currently loaded, so load it.  It's an
-	 * error if the desired package is a static one.
+	 * The desired file isn't currently loaded, so load it. It's an error
+	 * if the desired package is a static one.
 	 */
 
 	if (fullFileName[0] == 0) {
 	    Tcl_AppendResult(interp, "package \"", packageName,
-		    "\" isn't loaded statically", (char *) NULL);
+		    "\" isn't loaded statically", NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -265,9 +281,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	    Tcl_DStringAppend(&pkgName, packageName, -1);
 	} else {
 	    int retc;
+
 	    /*
 	     * Threading note - this call used to be protected by a mutex.
 	     */
+
 	    retc = TclGuessPackageName(fullFileName, &pkgName);
 	    if (!retc) {
 		Tcl_Obj *splitPtr;
@@ -276,11 +294,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 		char *pkgGuess;
 
 		/*
-		 * The platform-specific code couldn't figure out the
-		 * module name.  Make a guess by taking the last element
-		 * of the file name, stripping off any leading "lib",
-		 * and then using all of the alphabetic and underline
-		 * characters that follow that.
+		 * The platform-specific code couldn't figure out the module
+		 * name. Make a guess by taking the last element of the file
+		 * name, stripping off any leading "lib", and then using all
+		 * of the alphabetic and underline characters that follow
+		 * that.
 		 */
 
 		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
@@ -308,7 +326,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 		    Tcl_DecrRefCount(splitPtr);
 		    Tcl_AppendResult(interp,
 			    "couldn't figure out package name for ",
-			    fullFileName, (char *) NULL);
+			    fullFileName, NULL);
 		    code = TCL_ERROR;
 		    goto done;
 		}
@@ -322,36 +340,50 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	 * character is in caps (or title case) but the others are all
 	 * lower-case.
 	 */
-    
+
 	Tcl_DStringSetLength(&pkgName,
 		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
 
 	/*
-	 * Compute the names of the two initialization procedures,
-	 * based on the package name.
+	 * Compute the names of the two initialization functions, based on the
+	 * package name.
 	 */
-    
+
 	Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
 	Tcl_DStringAppend(&initName, "_Init", 5);
 	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
 	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
+	Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&unloadName, "_Unload", 7);
+	Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);
 
 	/*
-	 * Call platform-specific code to load the package and find the
-	 * two initialization procedures.
+	 * Call platform-specific code to load the package and find the two
+	 * initialization functions.
 	 */
 
+	symbols[0] = Tcl_DStringValue(&initName);
+	symbols[1] = Tcl_DStringValue(&safeInitName);
+	symbols[2] = Tcl_DStringValue(&unloadName);
+	symbols[3] = Tcl_DStringValue(&safeUnloadName);
+	procPtrs[0] = &initProc;
+	procPtrs[1] = &safeInitProc;
+	procPtrs[2] = &unloadProc;
+	procPtrs[3] = &safeUnloadProc;
+
 	Tcl_MutexLock(&packageMutex);
-	code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
-		Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
-		&loadHandle,&unLoadProcPtr);
+	code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
+		&loadHandle, &clientData, &unLoadProcPtr);
 	Tcl_MutexUnlock(&packageMutex);
+	loadHandle = (Tcl_LoadHandle) clientData;
 	if (code != TCL_OK) {
 	    goto done;
 	}
-	if (initProc == NULL) {
+
+	if (*procPtrs[0] /* initProc */ == NULL) {
 	    Tcl_AppendResult(interp, "couldn't find procedure ",
-		    Tcl_DStringValue(&initName), (char *) NULL);
+		    Tcl_DStringValue(&initName), NULL);
 	    if (unLoadProcPtr != NULL) {
 		(*unLoadProcPtr)(loadHandle);
 	    }
@@ -364,26 +396,30 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	 */
 
 	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
-	pkgPtr->fileName	= (char *) ckalloc((unsigned)
+	pkgPtr->fileName	   = (char *) ckalloc((unsigned)
 		(strlen(fullFileName) + 1));
 	strcpy(pkgPtr->fileName, fullFileName);
-	pkgPtr->packageName	= (char *) ckalloc((unsigned)
+	pkgPtr->packageName	   = (char *) ckalloc((unsigned)
 		(Tcl_DStringLength(&pkgName) + 1));
 	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
-	pkgPtr->loadHandle	= loadHandle;
-	pkgPtr->unLoadProcPtr	= unLoadProcPtr;
-	pkgPtr->initProc	= initProc;
-	pkgPtr->safeInitProc	= safeInitProc;
+	pkgPtr->loadHandle	   = loadHandle;
+	pkgPtr->unLoadProcPtr	   = unLoadProcPtr;
+	pkgPtr->initProc	   = *procPtrs[0];
+	pkgPtr->safeInitProc	   = *procPtrs[1];
+	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[2];
+	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[3];
+	pkgPtr->interpRefCount	   = 0;
+	pkgPtr->safeInterpRefCount = 0;
+
 	Tcl_MutexLock(&packageMutex);
-	pkgPtr->nextPtr		= firstPackagePtr;
-	firstPackagePtr		= pkgPtr;
+	pkgPtr->nextPtr		   = firstPackagePtr;
+	firstPackagePtr		   = pkgPtr;
 	Tcl_MutexUnlock(&packageMutex);
     }
 
     /*
-     * Invoke the package's initialization procedure (either the
-     * normal one or the safe one, depending on whether or not the
-     * interpreter is safe).
+     * Invoke the package's initialization function (either the normal one or
+     * the safe one, depending on whether or not the interpreter is safe).
      */
 
     if (Tcl_IsSafe(target)) {
@@ -391,9 +427,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	    code = (*pkgPtr->safeInitProc)(target);
 	} else {
 	    Tcl_AppendResult(interp,
-		    "can't use package in a safe interpreter: ",
-		    "no ", pkgPtr->packageName, "_SafeInit procedure",
-		    (char *) NULL);
+		    "can't use package in a safe interpreter: no ",
+		    pkgPtr->packageName, "_SafeInit procedure", NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -402,18 +437,30 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Record the fact that the package has been loaded in the
-     * target interpreter.
+     * Record the fact that the package has been loaded in the target
+     * interpreter.
      */
 
     if (code == TCL_OK) {
 	/*
+	 * Update the proper reference count.
+	 */
+
+	Tcl_MutexLock(&packageMutex);
+	if (Tcl_IsSafe(target)) {
+	    ++pkgPtr->safeInterpRefCount;
+	} else {
+	    ++pkgPtr->interpRefCount;
+	}
+	Tcl_MutexUnlock(&packageMutex);
+
+	/*
 	 * Refetch ipFirstPtr: loading the package may have introduced
 	 * additional static packages at the head of the linked list!
 	 */
 
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
-		(Tcl_InterpDeleteProc **) NULL);
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
+		"tclLoad", NULL);
 	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
 	ipPtr->pkgPtr = pkgPtr;
 	ipPtr->nextPtr = ipFirstPtr;
@@ -423,11 +470,434 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
 	TclTransferResult(target, code, interp);
     }
 
-    done:
+  done:
     Tcl_DStringFree(&pkgName);
     Tcl_DStringFree(&initName);
     Tcl_DStringFree(&safeInitName);
+    Tcl_DStringFree(&unloadName);
+    Tcl_DStringFree(&safeUnloadName);
+    Tcl_DStringFree(&tmp);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnloadObjCmd --
+ *
+ *	This function is invoked to process the "unload" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UnloadObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Interp *target;		/* Which interpreter to unload from. */
+    LoadedPackage *pkgPtr, *defaultPtr;
+    Tcl_DString pkgName, tmp;
+    Tcl_PackageUnloadProc *unloadProc;
+    InterpPackage *ipFirstPtr, *ipPtr;
+    int i, index, code, complain = 1, keepLibrary = 0;
+    int trustedRefCount = -1, safeRefCount = -1;
+    const char *fullFileName = "";
+    char *packageName;
+    static const char *options[] = {
+	"-nocomplain", "-keeplibrary", "--", NULL
+    };
+    enum options {
+	UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
+    };
+
+    for (i = 1; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		&index) != TCL_OK) {
+	    fullFileName = Tcl_GetString(objv[i]);
+	    if (fullFileName[0] == '-') {
+		/*
+		 * It looks like the command contains an option so signal an
+		 * error
+		 */
+
+		return TCL_ERROR;
+	    } else {
+		/*
+		 * This clearly isn't an option; assume it's the filename. We
+		 * must clear the error.
+		 */
+
+		Tcl_ResetResult(interp);
+		break;
+	    }
+	}
+	switch (index) {
+	case UNLOAD_NOCOMPLAIN:		/* -nocomplain */
+	    complain = 0;
+	    break;
+	case UNLOAD_KEEPLIB:		/* -keeplibrary */
+	    keepLibrary = 1;
+	    break;
+	case UNLOAD_LAST:		/* -- */
+	    i++;
+	    goto endOfForLoop;
+	}
+    }
+  endOfForLoop:
+    if ((objc-i < 1) || (objc-i > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? fileName ?packageName? ?interp?");
+	return TCL_ERROR;
+    }
+    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    fullFileName = Tcl_GetString(objv[i]);
+    Tcl_DStringInit(&pkgName);
+    Tcl_DStringInit(&tmp);
+
+    packageName = NULL;
+    if (objc - i >= 2) {
+	packageName = Tcl_GetString(objv[i+1]);
+	if (packageName[0] == '\0') {
+	    packageName = NULL;
+	}
+    }
+    if ((fullFileName[0] == 0) && (packageName == NULL)) {
+	Tcl_SetResult(interp,
+		"must specify either file name or package name",
+		TCL_STATIC);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Figure out which interpreter we're going to load the package into.
+     */
+
+    target = interp;
+    if (objc - i == 3) {
+	char *slaveIntName;
+	slaveIntName = Tcl_GetString(objv[i+2]);
+	target = Tcl_GetSlave(interp, slaveIntName);
+	if (target == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Scan through the packages that are currently loaded to see if the
+     * package we want is already loaded. We'll use a loaded package if it
+     * meets any of the following conditions:
+     *  - Its name and file match the once we're looking for.
+     *  - Its file matches, and we weren't given a name.
+     *  - Its name matches, the file name was specified as empty, and there is
+     *	  only no statically loaded package with the same name.
+     */
+
+    Tcl_MutexLock(&packageMutex);
+
+    defaultPtr = NULL;
+    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
+	int namesMatch, filesMatch;
+
+	if (packageName == NULL) {
+	    namesMatch = 0;
+	} else {
+	    Tcl_DStringSetLength(&pkgName, 0);
+	    Tcl_DStringAppend(&pkgName, packageName, -1);
+	    Tcl_DStringSetLength(&tmp, 0);
+	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
+	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
+	    if (strcmp(Tcl_DStringValue(&tmp),
+		    Tcl_DStringValue(&pkgName)) == 0) {
+		namesMatch = 1;
+	    } else {
+		namesMatch = 0;
+	    }
+	}
+	Tcl_DStringSetLength(&pkgName, 0);
+
+	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
+	if (filesMatch && (namesMatch || (packageName == NULL))) {
+	    break;
+	}
+	if (namesMatch && (fullFileName[0] == 0)) {
+	    defaultPtr = pkgPtr;
+	}
+	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
+	    break;
+	}
+    }
+    Tcl_MutexUnlock(&packageMutex);
+    if (fullFileName[0] == 0) {
+	/*
+	 * It's an error to try unload a static package.
+	 */
+
+	Tcl_AppendResult(interp, "package \"", packageName,
+		"\" is loaded statically and cannot be unloaded", NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+    if (pkgPtr == NULL) {
+	/*
+	 * The DLL pointed by the provided filename has never been loaded.
+	 */
+
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" has never been loaded", NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Scan through the list of packages already loaded in the target
+     * interpreter. If the package we want is already loaded there, then we
+     * should proceed with unloading.
+     */
+
+    code = TCL_ERROR;
+    if (pkgPtr != NULL) {
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
+		"tclLoad", NULL);
+	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+	    if (ipPtr->pkgPtr == pkgPtr) {
+		code = TCL_OK;
+		break;
+	    }
+	}
+    }
+    if (code != TCL_OK) {
+	/*
+	 * The package has not been loaded in this interpreter.
+	 */
+
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" has never been loaded in this interpreter", NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Ensure that the DLL can be unloaded. If it is a trusted interpreter,
+     * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If
+     * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL.
+     */
+
+    if (Tcl_IsSafe(target)) {
+	if (pkgPtr->safeUnloadProc == NULL) {
+	    Tcl_AppendResult(interp, "file \"", fullFileName,
+		    "\" cannot be unloaded under a safe interpreter", NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	unloadProc = pkgPtr->safeUnloadProc;
+    } else {
+	if (pkgPtr->unloadProc == NULL) {
+	    Tcl_AppendResult(interp, "file \"", fullFileName,
+		    "\" cannot be unloaded under a trusted interpreter", NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	unloadProc = pkgPtr->unloadProc;
+    }
+
+    /*
+     * We are ready to unload the package. First, evaluate the unload
+     * function. If this fails, we cannot proceed with unload. Also, we must
+     * specify the proper flag to pass to the unload callback.
+     * TCL_UNLOAD_DETACH_FROM_INTERPRETER is defined when the callback should
+     * only remove itself from the interpreter; the library will be unloaded
+     * in a future call of unload. In case the library will be unloaded just
+     * after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
+     */
+
+    code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
+    if (!keepLibrary) {
+	Tcl_MutexLock(&packageMutex);
+	trustedRefCount = pkgPtr->interpRefCount;
+	safeRefCount = pkgPtr->safeInterpRefCount;
+	Tcl_MutexUnlock(&packageMutex);
+
+	if (Tcl_IsSafe(target)) {
+	    --safeRefCount;
+	} else {
+	    --trustedRefCount;
+	}
+
+	if (safeRefCount <= 0 && trustedRefCount <= 0) {
+	    code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+	}
+    }
+    code = (*unloadProc)(target, code);
+    if (code != TCL_OK) {
+	TclTransferResult(target, code, interp);
+	goto done;
+    }
+
+    /*
+     * The unload function executed fine. Examine the reference count to see
+     * if we unload the DLL.
+     */
+
+    Tcl_MutexLock(&packageMutex);
+    if (Tcl_IsSafe(target)) {
+	--pkgPtr->safeInterpRefCount;
+
+	/*
+	 * Do not let counter get negative.
+	 */
+
+	if (pkgPtr->safeInterpRefCount < 0) {
+	    pkgPtr->safeInterpRefCount = 0;
+	}
+    } else {
+	--pkgPtr->interpRefCount;
+
+	/*
+	 * Do not let counter get negative.
+	 */
+
+	if (pkgPtr->interpRefCount < 0) {
+	    pkgPtr->interpRefCount = 0;
+	}
+    }
+    trustedRefCount = pkgPtr->interpRefCount;
+    safeRefCount = pkgPtr->safeInterpRefCount;
+    Tcl_MutexUnlock(&packageMutex);
+
+    code = TCL_OK;
+    if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
+	    && !keepLibrary) {
+	/*
+	 * Unload the shared library from the application memory...
+	 */
+
+#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+	/*
+	 * Some Unix dlls are poorly behaved - registering things like atexit
+	 * calls that can't be unregistered. If you unload such dlls, you get
+	 * a core on exit because it wants to call a function in the dll after
+	 * it's been unloaded.
+	 */
+
+	if (pkgPtr->fileName[0] != '\0') {
+	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
+
+	    if (unLoadProcPtr != NULL) {
+		Tcl_MutexLock(&packageMutex);
+		if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) {
+		    (*unLoadProcPtr)(pkgPtr->loadHandle);
+		}
+
+		/*
+		 * Remove this library from the loaded library cache.
+		 */
+
+		defaultPtr = pkgPtr;
+		if (defaultPtr == firstPackagePtr) {
+		    firstPackagePtr = pkgPtr->nextPtr;
+		} else {
+		    for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
+			    pkgPtr = pkgPtr->nextPtr) {
+			if (pkgPtr->nextPtr == defaultPtr) {
+			    pkgPtr->nextPtr = defaultPtr->nextPtr;
+			    break;
+			}
+		    }
+		}
+
+		/*
+		 * Remove this library from the interpreter's library cache.
+		 */
+
+		ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
+			"tclLoad", NULL);
+		ipPtr = ipFirstPtr;
+		if (ipPtr->pkgPtr == defaultPtr) {
+		    ipFirstPtr = ipFirstPtr->nextPtr;
+		} else {
+		    InterpPackage *ipPrevPtr;
+
+		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
+			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
+			if (ipPtr->pkgPtr == pkgPtr) {
+			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
+			    break;
+			}
+		    }
+		}
+		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
+			(ClientData) ipFirstPtr);
+		ckfree(defaultPtr->fileName);
+		ckfree(defaultPtr->packageName);
+		ckfree((char *) defaultPtr);
+		ckfree((char *) ipPtr);
+		Tcl_MutexUnlock(&packageMutex);
+	    } else {
+		Tcl_AppendResult(interp, "file \"", fullFileName,
+			"\" cannot be unloaded: filesystem does not support unloading",
+			NULL);
+		code = TCL_ERROR;
+	    }
+	}
+#else
+	Tcl_AppendResult(interp, "file \"", fullFileName,
+		"\" cannot be unloaded: unloading disabled", NULL);
+	code = TCL_ERROR;
+#endif
+    }
+
+  done:
+    Tcl_DStringFree(&pkgName);
     Tcl_DStringFree(&tmp);
+    if (!complain && code!=TCL_OK) {
+	code = TCL_OK;
+	Tcl_ResetResult(interp);
+    }
+    if (code == TCL_OK) {
+#if 0
+	/*
+	 * Result of [unload] was not documented in TIP#100, so force to be
+	 * the empty string by commenting this out. DKF.
+	 */
+
+	Tcl_Obj *resultObjPtr, *objPtr[2];
+
+	/*
+	 * Our result is the two reference counts.
+	 */
+
+	objPtr[0] = Tcl_NewIntObj(trustedRefCount);
+	objPtr[1] = Tcl_NewIntObj(safeRefCount);
+	if (objPtr[0] == NULL || objPtr[1] == NULL) {
+	    if (objPtr[0]) {
+		Tcl_DecrRefCount(objPtr[0]);
+	    }
+	    if (objPtr[1]) {
+		Tcl_DecrRefCount(objPtr[1]);
+	    }
+	} else {
+	    resultObjPtr = Tcl_NewListObj(2, objPtr);
+	    if (resultObjPtr != NULL) {
+		Tcl_SetObjResult(interp, resultObjPtr);
+	    }
+	}
+#endif
+    }
     return code;
 }
 
@@ -436,37 +906,37 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_StaticPackage --
  *
- *	This procedure is invoked to indicate that a particular
- *	package has been linked statically with an application.
+ *	This function is invoked to indicate that a particular package has
+ *	been linked statically with an application.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Once this procedure completes, the package becomes loadable
- *	via the "load" command with an empty file name.
+ *	Once this function completes, the package becomes loadable via the
+ *	"load" command with an empty file name.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
-    Tcl_Interp *interp;			/* If not NULL, it means that the
-					 * package has already been loaded
-					 * into the given interpreter by
-					 * calling the appropriate init proc. */
-    CONST char *pkgName;		/* Name of package (must be properly
-					 * capitalized: first letter upper
-					 * case, others lower case). */
-    Tcl_PackageInitProc *initProc;	/* Procedure to call to incorporate
-					 * this package into a trusted
-					 * interpreter. */
-    Tcl_PackageInitProc *safeInitProc;	/* Procedure to call to incorporate
-					 * this package into a safe interpreter
-					 * (one that will execute untrusted
-					 * scripts).   NULL means the package
-					 * can't be used in safe
-					 * interpreters. */
+Tcl_StaticPackage(
+    Tcl_Interp *interp,		/* If not NULL, it means that the package has
+				 * already been loaded into the given
+				 * interpreter by calling the appropriate init
+				 * proc. */
+    const char *pkgName,	/* Name of package (must be properly
+				 * capitalized: first letter upper case,
+				 * others lower case). */
+    Tcl_PackageInitProc *initProc,
+				/* Function to call to incorporate this
+				 * package into a trusted interpreter. */
+    Tcl_PackageInitProc *safeInitProc)
+				/* Function to call to incorporate this
+				 * package into a safe interpreter (one that
+				 * will execute untrusted scripts). NULL means
+				 * the package can't be used in safe
+				 * interpreters. */
 {
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr, *ipFirstPtr;
@@ -487,16 +957,16 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
     Tcl_MutexUnlock(&packageMutex);
 
     /*
-     * If the package is not yet recorded as being loaded statically,
-     * add it to the list now.
+     * If the package is not yet recorded as being loaded statically, add it
+     * to the list now.
      */
 
     if ( pkgPtr == NULL ) {
 	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
 	pkgPtr->fileName	= (char *) ckalloc((unsigned) 1);
 	pkgPtr->fileName[0]	= 0;
-	pkgPtr->packageName	= (char *) ckalloc((unsigned)
-						   (strlen(pkgName) + 1));
+	pkgPtr->packageName	= (char *)
+		ckalloc((unsigned) (strlen(pkgName) + 1));
 	strcpy(pkgPtr->packageName, pkgName);
 	pkgPtr->loadHandle	= NULL;
 	pkgPtr->initProc	= initProc;
@@ -510,12 +980,12 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
     if (interp != NULL) {
 
 	/*
-	 * If we're loading the package into an interpreter,
-	 * determine whether it's already loaded. 
+	 * If we're loading the package into an interpreter, determine whether
+	 * it's already loaded.
 	 */
 
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
-		(Tcl_InterpDeleteProc **) NULL);
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp,
+		"tclLoad", NULL);
 	for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
 	    if ( ipPtr->pkgPtr == pkgPtr ) {
 		return;
@@ -523,8 +993,8 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
 	}
 
 	/*
-	 * Package isn't loade in the current interp yet. Mark it as
-	 * now being loaded.
+	 * Package isn't loade in the current interp yet. Mark it as now being
+	 * loaded.
 	 */
 
 	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
@@ -540,17 +1010,15 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
  *
  * TclGetLoadedPackages --
  *
- *	This procedure returns information about all of the files
- *	that are loaded (either in a particular intepreter, or
- *	for all interpreters).
+ *	This function returns information about all of the files that are
+ *	loaded (either in a particular intepreter, or for all interpreters).
  *
  * Results:
- *	The return value is a standard Tcl completion code.  If
- *	successful, a list of lists is placed in the interp's result.
- *	Each sublist corresponds to one loaded file;  its first
- *	element is the name of the file (or an empty string for
- *	something that's statically loaded) and the second element
- *	is the name of the package in that file.
+ *	The return value is a standard Tcl completion code. If successful, a
+ *	list of lists is placed in the interp's result. Each sublist
+ *	corresponds to one loaded file; its first element is the name of the
+ *	file (or an empty string for something that's statically loaded) and
+ *	the second element is the name of the package in that file.
  *
  * Side effects:
  *	None.
@@ -559,21 +1027,21 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
  */
 
 int
-TclGetLoadedPackages(interp, targetName)
-    Tcl_Interp *interp;		/* Interpreter in which to return
-				 * information or error message. */
-    char *targetName;		/* Name of target interpreter or NULL.
-				 * If NULL, return info about all interps;
+TclGetLoadedPackages(
+    Tcl_Interp *interp,		/* Interpreter in which to return information
+				 * or error message. */
+    char *targetName)		/* Name of target interpreter or NULL. If
+				 * NULL, return info about all interps;
 				 * otherwise, just return info about this
 				 * interpreter. */
 {
     Tcl_Interp *target;
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr;
-    char *prefix;
+    const char *prefix;
 
     if (targetName == NULL) {
-	/* 
+	/*
 	 * Return information about all of the available packages.
 	 */
 
@@ -581,10 +1049,10 @@ TclGetLoadedPackages(interp, targetName)
 	Tcl_MutexLock(&packageMutex);
 	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
 		pkgPtr = pkgPtr->nextPtr) {
-	    Tcl_AppendResult(interp, prefix, (char *) NULL);
+	    Tcl_AppendResult(interp, prefix, NULL);
 	    Tcl_AppendElement(interp, pkgPtr->fileName);
 	    Tcl_AppendElement(interp, pkgPtr->packageName);
-	    Tcl_AppendResult(interp, "}", (char *) NULL);
+	    Tcl_AppendResult(interp, "}", NULL);
 	    prefix = " {";
 	}
 	Tcl_MutexUnlock(&packageMutex);
@@ -592,23 +1060,22 @@ TclGetLoadedPackages(interp, targetName)
     }
 
     /*
-     * Return information about only the packages that are loaded in
-     * a given interpreter.
+     * Return information about only the packages that are loaded in a given
+     * interpreter.
      */
 
     target = Tcl_GetSlave(interp, targetName);
     if (target == NULL) {
 	return TCL_ERROR;
     }
-    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
-	    (Tcl_InterpDeleteProc **) NULL);
+    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", NULL);
     prefix = "{";
     for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	pkgPtr = ipPtr->pkgPtr;
-	Tcl_AppendResult(interp, prefix, (char *) NULL);
+	Tcl_AppendResult(interp, prefix, NULL);
 	Tcl_AppendElement(interp, pkgPtr->fileName);
 	Tcl_AppendElement(interp, pkgPtr->packageName);
-	Tcl_AppendResult(interp, "}", (char *) NULL);
+	Tcl_AppendResult(interp, "}", NULL);
 	prefix = " {";
     }
     return TCL_OK;
@@ -619,25 +1086,24 @@ TclGetLoadedPackages(interp, targetName)
  *
  * LoadCleanupProc --
  *
- *	This procedure is called to delete all of the InterpPackage
- *	structures for an interpreter when the interpreter is deleted.
- *	It gets invoked via the Tcl AssocData mechanism.
+ *	This function is called to delete all of the InterpPackage structures
+ *	for an interpreter when the interpreter is deleted. It gets invoked
+ *	via the Tcl AssocData mechanism.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Storage for all of the InterpPackage procedures for interp
- *	get deleted.
+ *	Storage for all of the InterpPackage functions for interp get deleted.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-LoadCleanupProc(clientData, interp)
-    ClientData clientData;	/* Pointer to first InterpPackage structure
+LoadCleanupProc(
+    ClientData clientData,	/* Pointer to first InterpPackage structure
 				 * for interp. */
-    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
 {
     InterpPackage *ipPtr, *nextPtr;
 
@@ -654,8 +1120,8 @@ LoadCleanupProc(clientData, interp)
  *
  * TclFinalizeLoad --
  *
- *	This procedure is invoked just before the application exits.
- *	It frees all of the LoadedPackage structures.
+ *	This function is invoked just before the application exits. It frees
+ *	all of the LoadedPackage structures.
  *
  * Results:
  *	None.
@@ -667,38 +1133,49 @@ LoadCleanupProc(clientData, interp)
  */
 
 void
-TclFinalizeLoad()
+TclFinalizeLoad(void)
 {
     LoadedPackage *pkgPtr;
 
     /*
-     * No synchronization here because there should just be
-     * one thread alive at this point.  Logically, 
-     * packageMutex should be grabbed at this point, but
-     * the Mutexes get finalized before the call to this routine.
-     * The only subsystem left alive at this point is the
-     * memory allocator.
+     * No synchronization here because there should just be one thread alive
+     * at this point. Logically, packageMutex should be grabbed at this point,
+     * but the Mutexes get finalized before the call to this routine. The
+     * only subsystem left alive at this point is the memory allocator.
      */
 
     while (firstPackagePtr != NULL) {
 	pkgPtr = firstPackagePtr;
 	firstPackagePtr = pkgPtr->nextPtr;
+
 #if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
 	/*
-	 * Some Unix dlls are poorly behaved - registering things like
-	 * atexit calls that can't be unregistered.  If you unload
-	 * such dlls, you get a core on exit because it wants to
-	 * call a function in the dll after it's been unloaded.
+	 * Some Unix dlls are poorly behaved - registering things like atexit
+	 * calls that can't be unregistered. If you unload such dlls, you get
+	 * a core on exit because it wants to call a function in the dll after
+	 * it has been unloaded.
 	 */
+
 	if (pkgPtr->fileName[0] != '\0') {
 	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
-	    if (unLoadProcPtr != NULL) {
-	        (*unLoadProcPtr)(pkgPtr->loadHandle);
+	    if ((unLoadProcPtr != NULL)
+		    && ((pkgPtr->unloadProc != NULL)
+		    || (unLoadProcPtr == TclFSUnloadTempFile))) {
+		(*unLoadProcPtr)(pkgPtr->loadHandle);
 	    }
 	}
 #endif
+
 	ckfree(pkgPtr->fileName);
 	ckfree(pkgPtr->packageName);
 	ckfree((char *) pkgPtr);
     }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 4f795aa..af4ca81 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -1,14 +1,13 @@
-/* 
+/*
  * tclLoadNone.c --
  *
- *	This procedure provides a version of the TclLoadFile for use
- *	in systems that don't support dynamic loading; it just returns
- *	an error.
+ *	This procedure provides a version of the TclLoadFile for use in
+ *	systems that don't support dynamic loading; it just returns an error.
  *
  * Copyright (c) 1995-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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -18,13 +17,13 @@
  *
  * TclpDlopen --
  *
- *	This procedure is called to carry out dynamic loading of binary
- *	code;  it is intended for use only on systems that don't support
- *	dynamic loading (it returns an error).
+ *	This procedure is called to carry out dynamic loading of binary code;
+ *	it is intended for use only on systems that don't support dynamic
+ *	loading (it returns an error).
  *
  * Results:
- *	The result is TCL_ERROR, and an error message is left in
- *	the interp's result.
+ *	The result is TCL_ERROR, and an error message is left in the interp's
+ *	result.
  *
  * Side effects:
  *	None.
@@ -33,17 +32,17 @@
  */
 
 int
-TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
+TclpDlopen(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
 				 * code (UTF-8). */
-    Tcl_LoadHandle *loadHandle;	/* Filled with token for dynamically loaded
-				 * file which will be passed back to 
+    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
+				 * file which will be passed back to
 				 * (*unloadProcPtr)() to unload the file. */
-    Tcl_FSUnloadFileProc **unloadProcPtr;	
+    Tcl_FSUnloadFileProc **unloadProcPtr)
 				/* Filled with address of Tcl_FSUnloadFileProc
-				 * function which should be used for
-				 * this file. */
+				 * function which should be used for this
+				 * file. */
 {
     Tcl_SetResult(interp,
 	    "dynamic loading is not currently available on this system",
@@ -56,21 +55,24 @@ TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
  *
  * TclpFindSymbol --
  *
- *	Looks up a symbol, by name, through a handle associated with
- *	a previously loaded piece of code (shared library).
+ *	Looks up a symbol, by name, through a handle associated with a
+ *	previously loaded piece of code (shared library). This version of this
+ *	routine should never be called because the associated TclpDlopen()
+ *	function always returns an error.
  *
  * Results:
- *	Returns a pointer to the function associated with 'symbol' if
- *	it is found.  Otherwise returns NULL and may leave an error
- *	message in the interp's result.
+ *	Returns a pointer to the function associated with 'symbol' if it is
+ *	found. Otherwise returns NULL and may leave an error message in the
+ *	interp's result.
  *
  *----------------------------------------------------------------------
  */
-Tcl_PackageInitProc*
-TclpFindSymbol(interp, loadHandle, symbol) 
-    Tcl_Interp *interp;
-    Tcl_LoadHandle loadHandle;
-    CONST char *symbol;
+
+Tcl_PackageInitProc *
+TclpFindSymbol(
+    Tcl_Interp *interp,
+    Tcl_LoadHandle loadHandle,
+    CONST char *symbol)
 {
     return NULL;
 }
@@ -80,14 +82,14 @@ TclpFindSymbol(interp, loadHandle, symbol)
  *
  * TclGuessPackageName --
  *
- *	If the "load" command is invoked without providing a package
- *	name, this procedure is invoked to try to figure it out.
+ *	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.
+ *	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.
@@ -96,11 +98,11 @@ TclpFindSymbol(interp, loadHandle, symbol)
  */
 
 int
-TclGuessPackageName(fileName, bufPtr)
-    CONST char *fileName;	/* Name of file containing package (already
+TclGuessPackageName(
+    CONST 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. */
+    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
+				 * name to this if possible. */
 {
     return 0;
 }
@@ -110,9 +112,9 @@ TclGuessPackageName(fileName, bufPtr)
  *
  * TclpUnloadFile --
  *
- *    This procedure is called to carry out dynamic unloading of binary
- *    code;  it is intended for use only on systems that don't support
- *    dynamic loading (it does nothing).
+ *    This procedure is called to carry out dynamic unloading of binary code;
+ *    it is intended for use only on systems that don't support dynamic
+ *    loading (it does nothing).
  *
  * Results:
  *    None.
@@ -124,10 +126,50 @@ TclGuessPackageName(fileName, bufPtr)
  */
 
 void
-TclpUnloadFile(loadHandle)
-    Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call
-				 * to TclpDlopen().  The loadHandle is 
-				 * a token that represents the loaded 
-				 * file. */
+TclpUnloadFile(
+    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
+				 * TclpDlopen(). The loadHandle is a token
+				 * that represents the loaded file. */
+{
+}
+
+/*
+ * These functions are fallbacks if we somehow determine that the platform can
+ * do loading from memory but the user wishes to disable it. They just report
+ * (gracefully) that they fail.
+ */
+
+#ifdef TCL_LOAD_FROM_MEMORY
+
+MODULE_SCOPE void *
+TclpLoadMemoryGetBuffer(
+    Tcl_Interp *interp,		/* Dummy: unused by this implementation */
+    int size)			/* Dummy: unused by this implementation */
+{
+    return NULL;
+}
+
+MODULE_SCOPE int
+TclpLoadMemory(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    void *buffer,		/* Dummy: unused by this implementation */
+    int size,			/* Dummy: unused by this implementation */
+    int codeSize,		/* Dummy: unused by this implementation */
+    Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
+    Tcl_FSUnloadFileProc **unloadProcPtr)
+				/* Dummy: unused by this implementation */
 {
+    Tcl_SetResult(interp, "dynamic loading from memory is not available "
+	    "on this system", TCL_STATIC);
+    return TCL_ERROR;
 }
+
+#endif /* TCL_LOAD_FROM_MEMORY */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 28a3dab..7a19a38 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclMain.c --
  *
  *	Main program for Tcl shells and other Tcl-based applications.
@@ -7,100 +7,177 @@
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 2000 Ajuba Solutions.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#include "tcl.h"
 #include "tclInt.h"
 
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
 
 /*
- * Declarations for various library procedures and variables (don't want
- * to include tclPort.h here, because people might copy this file out of
- * the Tcl source directory to make their own modified versions).
+ * The default prompt used when the user has not overridden it.
  */
 
-extern int		isatty _ANSI_ARGS_((int fd));
+#define DEFAULT_PRIMARY_PROMPT	"% "
 
-static Tcl_Obj *tclStartupScriptPath = NULL;
+/*
+ * Declarations for various library functions and variables (don't want to
+ * include tclPort.h here, because people might copy this file out of the Tcl
+ * source directory to make their own modified versions).
+ */
+
+extern CRTIMPORT int	isatty(int fd);
 
+static Tcl_Obj *tclStartupScriptPath = NULL;
+static Tcl_Obj *tclStartupScriptEncoding = NULL;
 static Tcl_MainLoopProc *mainLoopProc = NULL;
 
-/* 
- * Structure definition for information used to keep the state of
- * an interactive command processor that reads lines from standard
- * input and writes prompts and results to standard output.
+/*
+ * Structure definition for information used to keep the state of an
+ * interactive command processor that reads lines from standard input and
+ * writes prompts and results to standard output.
  */
 
 typedef enum {
-    PROMPT_NONE,	/* Print no prompt */
-    PROMPT_START,	/* Print prompt for command start */
-    PROMPT_CONTINUE	/* Print prompt for command continuation */
+    PROMPT_NONE,		/* Print no prompt */
+    PROMPT_START,		/* Print prompt for command start */
+    PROMPT_CONTINUE		/* Print prompt for command continuation */
 } PromptType;
 
 typedef struct InteractiveState {
-    Tcl_Channel input;		/* The standard input channel from which
-				 * lines are read. */
-    int tty;                    /* Non-zero means standard input is a 
-				 * terminal-like device.  Zero means it's
-				 * a file. */
-    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into
-				 * Tcl commands. */
+    Tcl_Channel input;		/* The standard input channel from which lines
+				 * are read. */
+    int tty;			/* Non-zero means standard input is a
+				 * terminal-like device. Zero means it's a
+				 * file. */
+    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into Tcl
+				 * commands. */
     PromptType prompt;		/* Next prompt to print */
     Tcl_Interp *interp;		/* Interpreter that evaluates interactive
 				 * commands. */
 } InteractiveState;
 
 /*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
  */
 
-static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,
-			    PromptType *promptPtr));
-static void		StdinProc _ANSI_ARGS_((ClientData clientData,
-			    int mask));
-
+static void		Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+static void		StdinProc(ClientData clientData, int mask);
 
 /*
  *----------------------------------------------------------------------
  *
- * TclSetStartupScriptPath --
+ * Tcl_SetStartupScript --
  *
- *	Primes the startup script VFS path, used to override the
- *      command line processing.
+ *	Sets the path and encoding of the startup script to be evaluated by
+ *	Tcl_Main, used to override the command line processing.
  *
  * Results:
- *	None. 
+ *	None.
  *
  * Side effects:
- *	This procedure initializes the VFS path of the Tcl script to
- *      run at startup.
  *
  *----------------------------------------------------------------------
  */
-void TclSetStartupScriptPath(pathPtr)
-    Tcl_Obj *pathPtr;
+
+void
+Tcl_SetStartupScript(
+    Tcl_Obj *path,		/* Filesystem path of startup script file */
+    CONST char *encoding)	/* Encoding of the data in that file */
 {
+    Tcl_Obj *newEncoding = NULL;
+    if (encoding != NULL) {
+	newEncoding = Tcl_NewStringObj(encoding, -1);
+    }
+
     if (tclStartupScriptPath != NULL) {
 	Tcl_DecrRefCount(tclStartupScriptPath);
     }
-    tclStartupScriptPath = pathPtr;
+    tclStartupScriptPath = path;
     if (tclStartupScriptPath != NULL) {
 	Tcl_IncrRefCount(tclStartupScriptPath);
     }
+
+    if (tclStartupScriptEncoding != NULL) {
+	Tcl_DecrRefCount(tclStartupScriptEncoding);
+    }
+    tclStartupScriptEncoding = newEncoding;
+    if (tclStartupScriptEncoding != NULL) {
+	Tcl_IncrRefCount(tclStartupScriptEncoding);
+    }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStartupScript --
+ *
+ *	Gets the path and encoding of the startup script to be evaluated by
+ *	Tcl_Main.
+ *
+ * Results:
+ *	The path of the startup script; NULL if none has been set.
+ *
+ * Side effects:
+ * 	If encodingPtr is not NULL, stores a (CONST char *) in it pointing to
+ * 	the encoding name registered for the startup script. Tcl retains
+ * 	ownership of the string, and may free it. Caller should make a copy
+ * 	for long-term use.
+ *
+ *----------------------------------------------------------------------
+ */
 
+Tcl_Obj *
+Tcl_GetStartupScript(
+    CONST char **encodingPtr)	/* When not NULL, points to storage for the
+				 * (CONST char *) that points to the
+				 * registered encoding name for the startup
+				 * script */
+{
+    if (encodingPtr != NULL) {
+	if (tclStartupScriptEncoding == NULL) {
+	    *encodingPtr = NULL;
+	} else {
+	    *encodingPtr = Tcl_GetString(tclStartupScriptEncoding);
+	}
+    }
+    return tclStartupScriptPath;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetStartupScriptPath --
+ *
+ *	Primes the startup script VFS path, used to override the command line
+ *	processing.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This function initializes the VFS path of the Tcl script to run at
+ *	startup.
+ *
+ *----------------------------------------------------------------------
+ */
 
+void
+TclSetStartupScriptPath(
+    Tcl_Obj *path)
+{
+    Tcl_SetStartupScript(path, NULL);
+}
+
 /*
  *----------------------------------------------------------------------
  *
  * TclGetStartupScriptPath --
  *
- *	Gets the startup script VFS path, used to override the
- *      command line processing.
+ *	Gets the startup script VFS path, used to override the command line
+ *	processing.
  *
  * Results:
  *	The startup script VFS path, NULL if none has been set.
@@ -110,44 +187,46 @@ void TclSetStartupScriptPath(pathPtr)
  *
  *----------------------------------------------------------------------
  */
-Tcl_Obj *TclGetStartupScriptPath()
+
+Tcl_Obj *
+TclGetStartupScriptPath(void)
 {
-    return tclStartupScriptPath;
+    return Tcl_GetStartupScript(NULL);
 }
-
-
+
 /*
  *----------------------------------------------------------------------
  *
  * TclSetStartupScriptFileName --
  *
- *	Primes the startup script file name, used to override the
- *      command line processing.
+ *	Primes the startup script file name, used to override the command line
+ *	processing.
  *
  * Results:
- *	None. 
+ *	None.
  *
  * Side effects:
- *	This procedure initializes the file name of the Tcl script to
- *      run at startup.
+ *	This function initializes the file name of the Tcl script to run at
+ *	startup.
  *
  *----------------------------------------------------------------------
  */
-void TclSetStartupScriptFileName(fileName)
-    CONST char *fileName;
+
+void
+TclSetStartupScriptFileName(
+    CONST char *fileName)
 {
-    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
-    TclSetStartupScriptPath(pathPtr);
+    Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
+    Tcl_SetStartupScript(path, NULL);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclGetStartupScriptFileName --
  *
- *	Gets the startup script file name, used to override the
- *      command line processing.
+ *	Gets the startup script file name, used to override the command line
+ *	processing.
  *
  * Results:
  *	The startup script file name, NULL if none has been set.
@@ -157,54 +236,111 @@ void TclSetStartupScriptFileName(fileName)
  *
  *----------------------------------------------------------------------
  */
-CONST char *TclGetStartupScriptFileName()
+
+CONST char *
+TclGetStartupScriptFileName(void)
 {
-    Tcl_Obj *pathPtr = TclGetStartupScriptPath();
+    Tcl_Obj *path = Tcl_GetStartupScript(NULL);
 
-    if (pathPtr == NULL) {
+    if (path == NULL) {
 	return NULL;
     }
-    return Tcl_GetString(pathPtr);
+    return Tcl_GetString(path);
 }
+
+/*----------------------------------------------------------------------
+ *
+ * Tcl_SourceRCFile --
+ *
+ *	This function is typically invoked by Tcl_Main of Tk_Main function to
+ *	source an application specific rc file into the interpreter at startup
+ *	time.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what's in the rc script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SourceRCFile(
+    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
+{
+    Tcl_DString temp;
+    CONST char *fileName;
+    Tcl_Channel errChannel;
 
+    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
+    if (fileName != NULL) {
+	Tcl_Channel c;
+	CONST char *fullName;
+
+	Tcl_DStringInit(&temp);
+	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
+	if (fullName == NULL) {
+	    /*
+	     * Couldn't translate the file name (e.g. it referred to a bogus
+	     * user or there was no HOME environment variable). Just do
+	     * nothing.
+	     */
+	} else {
+	    /*
+	     * Test for the existence of the rc file before trying to read it.
+	     */
 
+	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
+	    if (c != (Tcl_Channel) NULL) {
+		Tcl_Close(NULL, c);
+		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
+		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		    if (errChannel) {
+			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+			Tcl_WriteChars(errChannel, "\n", 1);
+ 		    }
+ 		}
+ 	    }
+	}
+	Tcl_DStringFree(&temp);
+    }
+}
 
-/*
- *----------------------------------------------------------------------
+/*----------------------------------------------------------------------
  *
  * Tcl_Main --
  *
  *	Main program for tclsh and most other Tcl-based applications.
  *
  * Results:
- *	None. This procedure never returns (it exits the process when
- *	it's done).
+ *	None. This function never returns (it exits the process when it's
+ *	done).
  *
  * Side effects:
- *	This procedure initializes the Tcl world and then starts
- *	interpreting commands;  almost anything could happen, depending
- *	on the script being interpreted.
+ *	This function initializes the Tcl world and then starts interpreting
+ *	commands; almost anything could happen, depending on the script being
+ *	interpreted.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_Main(argc, argv, appInitProc)
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Array of argument strings. */
-    Tcl_AppInitProc *appInitProc;
+Tcl_Main(
+    int argc,			/* Number of arguments. */
+    char **argv,		/* Array of argument strings. */
+    Tcl_AppInitProc *appInitProc)
 				/* Application-specific initialization
-				 * procedure to call after most
-				 * initialization but before starting to
-				 * execute commands. */
+				 * function to call after most initialization
+				 * but before starting to execute commands. */
 {
-    Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL;
+    Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
+    CONST char *encodingName = NULL;
     PromptType prompt = PROMPT_START;
     int code, length, tty, exitCode = 0;
     Tcl_Channel inChannel, outChannel, errChannel;
     Tcl_Interp *interp;
     Tcl_DString appName;
-    Tcl_Obj *objPtr;
 
     Tcl_FindExecutable(argv[0]);
 
@@ -212,35 +348,48 @@ Tcl_Main(argc, argv, appInitProc)
     Tcl_InitMemory(interp);
 
     /*
-     * Make command-line arguments available in the Tcl variables "argc"
-     * and "argv".  If the first argument doesn't start with a "-" then
-     * strip it off and use it as the name of a script file to process.
+     * If the application has not already set a startup script, parse the
+     * first few command line arguments to determine the script path and
+     * encoding.
      */
 
-    if (TclGetStartupScriptPath() == NULL) {
-	if ((argc > 1) && (argv[1][0] != '-')) {
-	    TclSetStartupScriptFileName(argv[1]);
+    if (NULL == Tcl_GetStartupScript(NULL)) {
+
+	/*
+	 * Check whether first 3 args (argv[1] - argv[3]) look like
+	 * 	-encoding ENCODING FILENAME
+	 * or like
+	 * 	FILENAME
+	 */
+
+	if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
+		&& ('-' != argv[3][0])) {
+	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
+	    argc -= 3;
+	    argv += 3;
+	} else if ((argc > 1) && ('-' != argv[1][0])) {
+	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
 	    argc--;
 	    argv++;
 	}
     }
 
-    if (TclGetStartupScriptPath() == NULL) {
+    path = Tcl_GetStartupScript(&encodingName);
+    if (path == NULL) {
 	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
     } else {
-	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
-		TclGetStartupScriptFileName(), -1, &appName));
+	CONST char *pathName = Tcl_GetStringFromObj(path, &length);
+	Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
+	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
+	Tcl_SetStartupScript(path, encodingName);
     }
     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
     Tcl_DStringFree(&appName);
     argc--;
     argv++;
 
-    objPtr = Tcl_NewIntObj(argc);
-    Tcl_IncrRefCount(objPtr);
-    Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
-    Tcl_DecrRefCount(objPtr);
-    
+    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
+
     argvPtr = Tcl_NewListObj(0, NULL);
     while (argc--) {
 	Tcl_DString ds;
@@ -249,19 +398,16 @@ Tcl_Main(argc, argv, appInitProc)
 		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
 	Tcl_DStringFree(&ds);
     }
-    Tcl_IncrRefCount(argvPtr);
     Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
-    Tcl_DecrRefCount(argvPtr);
 
     /*
      * Set the "tcl_interactive" variable.
      */
 
     tty = isatty(0);
-    Tcl_SetVar(interp, "tcl_interactive",
-	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
+    Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
 	    TCL_GLOBAL_ONLY);
-    
+
     /*
      * Invoke application-specific initialization.
      */
@@ -279,27 +425,34 @@ Tcl_Main(argc, argv, appInitProc)
     if (Tcl_InterpDeleted(interp)) {
 	goto done;
     }
+    if (Tcl_LimitExceeded(interp)) {
+	goto done;
+    }
 
     /*
-     * If a script file was specified then just source that file
-     * and quit.
+     * If a script file was specified then just source that file and quit.
+     * Must fetch it again, as the appInitProc might have reset it.
      */
 
-    if (TclGetStartupScriptPath() != NULL) {
-	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
+    path = Tcl_GetStartupScript(&encodingName);
+    if (path != NULL) {
+	code = Tcl_FSEvalFileEx(interp, path, encodingName);
 	if (code != TCL_OK) {
 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	    if (errChannel) {
+		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
+		Tcl_Obj *keyPtr, *valuePtr;
 
-		/*
-		 * The following statement guarantees that the errorInfo
-		 * variable is set properly.
-		 */
+		TclNewLiteralStringObj(keyPtr, "-errorinfo");
+		Tcl_IncrRefCount(keyPtr);
+		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
+		Tcl_DecrRefCount(keyPtr);
 
-		Tcl_AddErrorInfo(interp, "");
-		Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
-			NULL, TCL_GLOBAL_ONLY));
+		if (valuePtr) {
+		    Tcl_WriteObj(errChannel, valuePtr);
+		}
 		Tcl_WriteChars(errChannel, "\n", 1);
+		Tcl_DecrRefCount(options);
 	    }
 	    exitCode = 1;
 	}
@@ -307,16 +460,19 @@ Tcl_Main(argc, argv, appInitProc)
     }
 
     /*
-     * We're running interactively.  Source a user-specific startup
-     * file if the application specified one and if the file exists.
+     * We're running interactively. Source a user-specific startup file if the
+     * application specified one and if the file exists.
      */
 
     Tcl_SourceRCFile(interp);
+    if (Tcl_LimitExceeded(interp)) {
+	goto done;
+    }
 
     /*
-     * Process commands from stdin until there's an end-of-file.  Note
-     * that we need to fetch the standard channels again after every
-     * eval, since they may have been changed.
+     * Process commands from stdin until there's an end-of-file. Note that we
+     * need to fetch the standard channels again after every eval, since they
+     * may have been changed.
      */
 
     commandPtr = Tcl_NewObj();
@@ -325,6 +481,7 @@ Tcl_Main(argc, argv, appInitProc)
     /*
      * Get a new value for tty if anyone writes to ::tcl_interactive
      */
+
     Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
     inChannel = Tcl_GetStdChannel(TCL_STDIN);
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
@@ -335,9 +492,12 @@ Tcl_Main(argc, argv, appInitProc)
 		if (Tcl_InterpDeleted(interp)) {
 		    break;
 		}
+		if (Tcl_LimitExceeded(interp)) {
+		    break;
+		}
 		inChannel = Tcl_GetStdChannel(TCL_STDIN);
 		if (inChannel == (Tcl_Channel) NULL) {
-	            break;
+		    break;
 		}
 	    }
 	    if (Tcl_IsShared(commandPtr)) {
@@ -345,32 +505,32 @@ Tcl_Main(argc, argv, appInitProc)
 		commandPtr = Tcl_DuplicateObj(commandPtr);
 		Tcl_IncrRefCount(commandPtr);
 	    }
-            length = Tcl_GetsObj(inChannel, commandPtr);
+	    length = Tcl_GetsObj(inChannel, commandPtr);
 	    if (length < 0) {
 		if (Tcl_InputBlocked(inChannel)) {
-
 		    /*
 		     * This can only happen if stdin has been set to
-		     * non-blocking.  In that case cycle back and try
-		     * again.  This sets up a tight polling loop (since
-		     * we have no event loop running).  If this causes
-		     * bad CPU hogging, we might try toggling the blocking
-		     * on stdin instead.
+		     * non-blocking.  In that case cycle back and try again.
+		     * This sets up a tight polling loop (since we have no
+		     * event loop running). If this causes bad CPU hogging,
+		     * we might try toggling the blocking on stdin instead.
 		     */
 
 		    continue;
 		}
 
-		/* 
+		/*
 		 * Either EOF, or an error on stdin; we're done
 		 */
 
 		break;
 	    }
 
-            /*
-             * Add the newline removed by Tcl_GetsObj back to the string.
-             */
+	    /*
+	     * Add the newline removed by Tcl_GetsObj back to the string.
+	     * Have to add it back before testing completeness, because
+	     * it can make a difference.  [Bug 1775878].
+	     */
 
 	    if (Tcl_IsShared(commandPtr)) {
 		Tcl_DecrRefCount(commandPtr);
@@ -384,6 +544,12 @@ Tcl_Main(argc, argv, appInitProc)
 	    }
 
 	    prompt = PROMPT_START;
+	    /*
+	     * The final newline is syntactically redundant, and causes
+	     * some error messages troubles deeper in, so lop it back off.
+	     */
+	    Tcl_GetStringFromObj(commandPtr, &length);
+	    Tcl_SetObjLength(commandPtr, --length);
 	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
 	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
 	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
@@ -396,7 +562,7 @@ Tcl_Main(argc, argv, appInitProc)
 		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
 		    Tcl_WriteChars(errChannel, "\n", 1);
 		}
-	    } else if (tty) {
+ 	    } else if (tty) {
 		resultPtr = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(resultPtr);
 		Tcl_GetStringFromObj(resultPtr, &length);
@@ -408,18 +574,18 @@ Tcl_Main(argc, argv, appInitProc)
 	    }
 	} else {	/* (mainLoopProc != NULL) */
 	    /*
-	     * If a main loop has been defined while running interactively,
-	     * we want to start a fileevent based prompt by establishing a
+	     * If a main loop has been defined while running interactively, we
+	     * want to start a fileevent based prompt by establishing a
 	     * channel handler for stdin.
 	     */
 
 	    InteractiveState *isPtr = NULL;
 
 	    if (inChannel) {
-	        if (tty) {
+		if (tty) {
 		    Prompt(interp, &prompt);
-	        }
-		isPtr = (InteractiveState *) 
+		}
+		isPtr = (InteractiveState *)
 			ckalloc((int) sizeof(InteractiveState));
 		isPtr->input = inChannel;
 		isPtr->tty = tty;
@@ -458,8 +624,8 @@ Tcl_Main(argc, argv, appInitProc)
 #ifdef TCL_MEM_DEBUG
 
 	/*
-	 * This code here only for the (unsupported and deprecated)
-	 * [checkmem] command.
+	 * This code here only for the (unsupported and deprecated) [checkmem]
+	 * command.
 	 */
 
 	if (tclMemDumpFileName != NULL) {
@@ -469,13 +635,13 @@ Tcl_Main(argc, argv, appInitProc)
 #endif
     }
 
-    done:
-    if ((exitCode == 0) && (mainLoopProc != NULL)) {
-
+  done:
+    if ((exitCode == 0) && (mainLoopProc != NULL)
+	    && !Tcl_LimitExceeded(interp)) {
 	/*
-	 * If everything has gone OK so far, call the main loop proc,
-	 * if it exists.  Packages (like Tk) can set it to start processing
-	 * events at this point.
+	 * If everything has gone OK so far, call the main loop proc, if it
+	 * exists. Packages (like Tk) can set it to start processing events at
+	 * this point.
 	 */
 
 	(*mainLoopProc)();
@@ -486,32 +652,35 @@ Tcl_Main(argc, argv, appInitProc)
     }
 
     /*
-     * Rather than calling exit, invoke the "exit" command so that
-     * users can replace "exit" with some other command to do additional
-     * cleanup on exit.  The Tcl_Eval call should never return.
+     * Rather than calling exit, invoke the "exit" command so that users can
+     * replace "exit" with some other command to do additional cleanup on
+     * exit. The Tcl_EvalObjEx call should never return.
      */
 
     if (!Tcl_InterpDeleted(interp)) {
-	char buffer[TCL_INTEGER_SPACE + 5];
-        sprintf(buffer, "exit %d", exitCode);
-        Tcl_Eval(interp, buffer);
-
-        /*
-         * If Tcl_Eval returns, trying to eval [exit], something
-         * unusual is happening.  Maybe interp has been deleted;
-         * maybe [exit] was redefined.  We still want to cleanup
-         * and exit.
-         */
-
-        if (!Tcl_InterpDeleted(interp)) {
-            Tcl_DeleteInterp(interp);
-        }
+	if (!Tcl_LimitExceeded(interp)) {
+	    Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
+	    Tcl_IncrRefCount(cmd);
+	    Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
+	    Tcl_DecrRefCount(cmd);
+	}
+
+	/*
+	 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
+	 * is happening. Maybe interp has been deleted; maybe [exit] was
+	 * redefined, maybe we've blown up because of an exceeded limit. We
+	 * still want to cleanup and exit.
+	 */
+
+	if (!Tcl_InterpDeleted(interp)) {
+	    Tcl_DeleteInterp(interp);
+	}
     }
-    TclSetStartupScriptPath(NULL);
+    Tcl_SetStartupScript(NULL, NULL);
 
     /*
-     * If we get here, the master interp has been deleted.  Allow
-     * its destruction with the last matching Tcl_Release.
+     * If we get here, the master interp has been deleted. Allow its
+     * destruction with the last matching Tcl_Release.
      */
 
     Tcl_Release((ClientData) interp);
@@ -523,21 +692,21 @@ Tcl_Main(argc, argv, appInitProc)
  *
  * Tcl_SetMainLoop --
  *
- *	Sets an alternative main loop procedure.
+ *	Sets an alternative main loop function.
  *
  * Results:
- *	Returns the previously defined main loop procedure.
+ *	Returns the previously defined main loop function.
  *
  * Side effects:
- *	This procedure will be called before Tcl exits, allowing for
- *	the creation of an event loop.
+ *	This function will be called before Tcl exits, allowing for the
+ *	creation of an event loop.
  *
  *---------------------------------------------------------------
  */
 
 void
-Tcl_SetMainLoop(proc)
-    Tcl_MainLoopProc *proc;
+Tcl_SetMainLoop(
+    Tcl_MainLoopProc *proc)
 {
     mainLoopProc = proc;
 }
@@ -547,26 +716,25 @@ Tcl_SetMainLoop(proc)
  *
  * StdinProc --
  *
- *	This procedure is invoked by the event dispatcher whenever
- *	standard input becomes readable.  It grabs the next line of
- *	input characters, adds them to a command being assembled, and
- *	executes the command if it's complete.
+ *	This function is invoked by the event dispatcher whenever standard
+ *	input becomes readable. It grabs the next line of input characters,
+ *	adds them to a command being assembled, and executes the command if
+ *	it's complete.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Could be almost arbitrary, depending on the command that's
- *	typed.
+ *	Could be almost arbitrary, depending on the command that's typed.
  *
  *----------------------------------------------------------------------
  */
 
     /* ARGSUSED */
 static void
-StdinProc(clientData, mask)
-    ClientData clientData;		/* The state of interactive cmd line */
-    int mask;				/* Not used. */
+StdinProc(
+    ClientData clientData,	/* The state of interactive cmd line */
+    int mask)			/* Not used. */
 {
     InteractiveState *isPtr = (InteractiveState *) clientData;
     Tcl_Channel chan = isPtr->input;
@@ -586,10 +754,11 @@ StdinProc(clientData, mask)
 	}
 	if (isPtr->tty) {
 	    /*
-	     * Would be better to find a way to exit the mainLoop?
-	     * Or perhaps evaluate [exit]?  Leaving as is for now due
-	     * to compatibility concerns.
+	     * Would be better to find a way to exit the mainLoop? Or perhaps
+	     * evaluate [exit]? Leaving as is for now due to compatibility
+	     * concerns.
 	     */
+
 	    Tcl_Exit(0);
 	}
 	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
@@ -603,17 +772,18 @@ StdinProc(clientData, mask)
     }
     Tcl_AppendToObj(commandPtr, "\n", 1);
     if (!TclObjCommandComplete(commandPtr)) {
-        isPtr->prompt = PROMPT_CONTINUE;
-        goto prompt;
+	isPtr->prompt = PROMPT_CONTINUE;
+	goto prompt;
     }
     isPtr->prompt = PROMPT_START;
+    Tcl_GetStringFromObj(commandPtr, &length);
+    Tcl_SetObjLength(commandPtr, --length);
 
     /*
      * Disable the stdin channel handler while evaluating the command;
-     * otherwise if the command re-enters the event loop we might
-     * process commands from stdin before the current command is
-     * finished.  Among other things, this will trash the text of the
-     * command being evaluated.
+     * otherwise if the command re-enters the event loop we might process
+     * commands from stdin before the current command is finished. Among other
+     * things, this will trash the text of the command being evaluated.
      */
 
     Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
@@ -648,7 +818,7 @@ StdinProc(clientData, mask)
      * If a tty stdin is still around, output a prompt.
      */
 
-    prompt:
+  prompt:
     if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
 	Prompt(interp, &(isPtr->prompt));
 	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
@@ -660,25 +830,24 @@ StdinProc(clientData, mask)
  *
  * Prompt --
  *
- *	Issue a prompt on standard output, or invoke a script
- *	to issue the prompt.
+ *	Issue a prompt on standard output, or invoke a script to issue the
+ *	prompt.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	A prompt gets output, and a Tcl script may be evaluated
- *	in interp.
+ *	A prompt gets output, and a Tcl script may be evaluated in interp.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-Prompt(interp, promptPtr)
-    Tcl_Interp *interp;			/* Interpreter to use for prompting. */
-    PromptType *promptPtr;		/* Points to type of prompt to print.
-					 * Filled with PROMPT_NONE after a
-					 * prompt is printed. */
+Prompt(
+    Tcl_Interp *interp,		/* Interpreter to use for prompting. */
+    PromptType *promptPtr)	/* Points to type of prompt to print. Filled
+				 * with PROMPT_NONE after a prompt is
+				 * printed. */
 {
     Tcl_Obj *promptCmdPtr;
     int code;
@@ -691,15 +860,17 @@ Prompt(interp, promptPtr)
     promptCmdPtr = Tcl_GetVar2Ex(interp,
 	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
 	    NULL, TCL_GLOBAL_ONLY);
+
     if (Tcl_InterpDeleted(interp)) {
 	return;
     }
     if (promptCmdPtr == NULL) {
-	defaultPrompt:
+    defaultPrompt:
 	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 	if ((*promptPtr == PROMPT_START)
 		&& (outChannel != (Tcl_Channel) NULL)) {
-	    Tcl_WriteChars(outChannel, "% ", 2);
+	    Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT,
+		    strlen(DEFAULT_PRIMARY_PROMPT));
 	}
     } else {
 	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
@@ -707,16 +878,25 @@ Prompt(interp, promptPtr)
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (script that generates prompt)");
 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-            if (errChannel != (Tcl_Channel) NULL) {
-                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-                Tcl_WriteChars(errChannel, "\n", 1);
-            }
+	    if (errChannel != (Tcl_Channel) NULL) {
+		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+		Tcl_WriteChars(errChannel, "\n", 1);
+	    }
 	    goto defaultPrompt;
 	}
     }
+
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
     if (outChannel != (Tcl_Channel) NULL) {
 	Tcl_Flush(outChannel);
     }
     *promptPtr = PROMPT_NONE;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclMath.h b/generic/tclMath.h
deleted file mode 100644
index 0f02855..0000000
--- a/generic/tclMath.h
+++ /dev/null
@@ -1,21 +0,0 @@
-/*
- * tclMath.h --
- *
- *	This file is necessary because of Metrowerks CodeWarrior Pro 1
- *	on the Macintosh. With 8-byte doubles turned on, the definitions of
- *	sin, cos, acos, etc., are screwed up.  They are fine as long as
- *	they are used as function calls, but if the function pointers
- *	are passed around and used, they will crash hard on the 68K.
- *
- * Copyright (c) 1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef _TCLMATH
-#define _TCLMATH
-
-#include <math.h>
-
-#endif /* _TCLMATH */
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 77352a1..44634d4 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1,164 +1,264 @@
 /*
  * tclNamesp.c --
  *
- *      Contains support for namespaces, which provide a separate context of
- *      commands and global variables. The global :: namespace is the
- *      traditional Tcl "global" scope. Other namespaces are created as
- *      children of the global namespace. These other namespaces contain
- *      special-purpose commands and variables for packages.
+ *	Contains support for namespaces, which provide a separate context of
+ *	commands and global variables. The global :: namespace is the
+ *	traditional Tcl "global" scope. Other namespaces are created as
+ *	children of the global namespace. These other namespaces contain
+ *	special-purpose commands and variables for packages. Also includes the
+ *	TIP#112 ensemble machinery.
  *
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2002-2005 Donal K. Fellows.
+ * Copyright (c) 2006 Neil Madden.
+ * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
  *
  * Originally implemented by
  *   Michael J. McLennan
  *   Bell Labs Innovations for Lucent Technologies
  *   mmclennan@lucent.com
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * Flag passed to TclGetNamespaceForQualName to indicate that it should
- * search for a namespace rather than a command or variable inside a
- * namespace. Note that this flag's value must not conflict with the values
- * of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or CREATE_NS_IF_UNKNOWN.
+ * Thread-local storage used to avoid having a global lock on data that is not
+ * limited to a single interpreter.
  */
 
-#define FIND_ONLY_NS	0x1000
+typedef struct ThreadSpecificData {
+    long numNsCreated;		/* Count of the number of namespaces created
+				 * within the thread. This value is used as a
+				 * unique id for each namespace. Cannot be
+				 * per-interp because the nsId is used to
+				 * distinguish objects which can be passed
+				 * around between interps in the same thread,
+				 * but does not need to be global because
+				 * object internal reps are always per-thread
+				 * anyway. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
 
 /*
- * Initial size of stack allocated space for tail list - used when resetting
- * shadowed command references in the functin: TclResetShadowedCmdRefs.
+ * This structure contains a cached pointer to a namespace that is the result
+ * of resolving the namespace's name in some other namespace. It is the
+ * internal representation for a nsName object. It contains the pointer along
+ * with some information that is used to check the cached pointer's validity.
  */
 
-#define NUM_TRAIL_ELEMS 5
+typedef struct ResolvedNsName {
+    Namespace *nsPtr;          /* A cached pointer to the Namespace that the
+                                * name resolved to. */
+    Namespace *refNsPtr;       /* Points to the namespace context in which the
+                                * name was resolved. NULL if the name is fully
+                                * qualified and thus the resolution does not
+                                * depend on the context. */
+    int refCount;		/* Reference count: 1 for each nsName object
+				 * that has a pointer to this ResolvedNsName
+				 * structure as its internal rep. This
+				 * structure can be freed when refCount
+				 * becomes zero. */
+} ResolvedNsName;
 
 /*
- * Count of the number of namespaces created. This value is used as a
- * unique id for each namespace.
+ * The client data for an ensemble command. This consists of the table of
+ * commands that are actually exported by the namespace, and an epoch counter
+ * that, combined with the exportLookupEpoch field of the namespace structure,
+ * defines whether the table contains valid data or will need to be recomputed
+ * next time the ensemble command is called.
  */
 
-static long numNsCreated = 0; 
-TCL_DECLARE_MUTEX(nsMutex)
+typedef struct EnsembleConfig {
+    Namespace *nsPtr;		/* The namspace backing this ensemble up. */
+    Tcl_Command token;		/* The token for the command that provides
+				 * ensemble support for the namespace, or NULL
+				 * if the command has been deleted (or never
+				 * existed; the global namespace never has an
+				 * ensemble command.) */
+    int epoch;			/* The epoch at which this ensemble's table of
+				 * exported commands is valid. */
+    char **subcommandArrayPtr;	/* Array of ensemble subcommand names. At all
+				 * consistent points, this will have the same
+				 * number of entries as there are entries in
+				 * the subcommandTable hash. */
+    Tcl_HashTable subcommandTable;
+				/* Hash table of ensemble subcommand names,
+				 * which are its keys so this also provides
+				 * the storage management for those subcommand
+				 * names. The contents of the entry values are
+				 * object version the prefix lists to use when
+				 * substituting for the command/subcommand to
+				 * build the ensemble implementation command.
+				 * Has to be stored here as well as in
+				 * subcommandDict because that field is NULL
+				 * when we are deriving the ensemble from the
+				 * namespace exports list. FUTURE WORK: use
+				 * object hash table here. */
+    struct EnsembleConfig *next;/* The next ensemble in the linked list of
+				 * ensembles associated with a namespace. If
+				 * this field points to this ensemble, the
+				 * structure has already been unlinked from
+				 * all lists, and cannot be found by scanning
+				 * the list from the namespace's ensemble
+				 * field. */
+    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD
+				 * and ENSEMBLE_COMPILE. */
+
+    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
+
+    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
+				 * subcommands to their implementing command
+				 * prefixes, or NULL if we are to build the
+				 * map automatically from the namespace
+				 * exports. */
+    Tcl_Obj *subcmdList;	/* List of commands that this ensemble
+				 * actually provides, and whose implementation
+				 * will be built using the subcommandDict (if
+				 * present and defined) and by simple mapping
+				 * to the namespace otherwise. If NULL,
+				 * indicates that we are using the (dynamic)
+				 * list of currently exported commands. */
+    Tcl_Obj *unknownHandler;	/* Script prefix used to handle the case when
+				 * no match is found (according to the rule
+				 * defined by flag bit TCL_ENSEMBLE_PREFIX) or
+				 * NULL to use the default error-generating
+				 * behaviour. The script execution gets all
+				 * the arguments to the ensemble command
+				 * (including objv[0]) and will have the
+				 * results passed directly back to the caller
+				 * (including the error code) unless the code
+				 * is TCL_CONTINUE in which case the
+				 * subcommand will be reparsed by the ensemble
+				 * core, presumably because the ensemble
+				 * itself has been updated. */
+} EnsembleConfig;
+
+#define ENS_DEAD	0x1	/* Flag value to say that the ensemble is dead
+				 * and on its way out. */
 
 /*
- * This structure contains a cached pointer to a namespace that is the
- * result of resolving the namespace's name in some other namespace. It is
- * the internal representation for a nsName object. It contains the
- * pointer along with some information that is used to check the cached
- * pointer's validity.
+ * Declarations for functions local to this file:
  */
 
-typedef struct ResolvedNsName {
-    Namespace *nsPtr;		/* A cached namespace pointer. */
-    long nsId;			/* nsPtr's unique namespace id. Used to
-				 * verify that nsPtr is still valid
-				 * (e.g., it's possible that the namespace
-				 * was deleted and a new one created at
-				 * the same address). */
-    Namespace *refNsPtr;	/* Points to the namespace containing the
-				 * reference (not the namespace that
-				 * contains the referenced namespace). */
-    int refCount;		/* Reference count: 1 for each nsName
-				 * object that has a pointer to this
-				 * ResolvedNsName structure as its internal
-				 * rep. This structure can be freed when
-				 * refCount becomes zero. */
-} ResolvedNsName;
+static void		DeleteImportedCmd(ClientData clientData);
+static int		DoImport(Tcl_Interp *interp,
+			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
+			    const char *cmdName, const char *pattern,
+			    Namespace *importNsPtr, int allowOverwrite);
+static void		DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
+static char *		ErrorCodeRead(ClientData clientData,Tcl_Interp *interp,
+			    const char *name1, const char *name2, int flags);
+static char *		ErrorInfoRead(ClientData clientData,Tcl_Interp *interp,
+			    const char *name1, const char *name2, int flags);
+static char *		EstablishErrorCodeTraces(ClientData clientData,
+			    Tcl_Interp *interp, const char *name1,
+			    const char *name2, int flags);
+static char *		EstablishErrorInfoTraces(ClientData clientData,
+			    Tcl_Interp *interp, const char *name1,
+			    const char *name2, int flags);
+static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
+static int		GetNamespaceFromObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
+static int		InvokeImportedCmd(ClientData clientData,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceChildrenCmd(ClientData dummy,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceCurrentCmd(ClientData dummy,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceEnsembleCmd(ClientData dummy,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static void		NamespaceFree(Namespace *nsPtr);
+static int		NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceInscopeCmd(ClientData dummy,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespacePathCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceQualifiersCmd(ClientData dummy,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static int		NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceUnknownCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int		NsEnsembleImplementationCmd(ClientData clientData,
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
+static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
+static int		NsEnsembleStringOrder(const void *strPtr1,
+			    const void *strPtr2);
+static void		DeleteEnsembleConfig(ClientData clientData);
+static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
+			    EnsembleConfig *ensemblePtr,
+			    const char *subcmdName, Tcl_Obj *prefixObjPtr);
+static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
+static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
+static void		UnlinkNsPath(Namespace *nsPtr);
 
 /*
- * Declarations for procedures local to this file:
- */
-
-static void		DeleteImportedCmd _ANSI_ARGS_((
-			    ClientData clientData));
-static void		DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr));
-static void		FreeNsNameInternalRep _ANSI_ARGS_((
-			    Tcl_Obj *objPtr));
-static int		GetNamespaceFromObj _ANSI_ARGS_((
-			    Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    Tcl_Namespace **nsPtrPtr));
-static int		InvokeImportedCmd _ANSI_ARGS_((
-			    ClientData clientData, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceChildrenCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceCodeCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceCurrentCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceDeleteCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceEvalCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceExistsCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceExportCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceForgetCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static void		NamespaceFree _ANSI_ARGS_((Namespace *nsPtr));
-static int		NamespaceImportCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceInscopeCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceOriginCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceParentCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceQualifiersCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceTailCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		NamespaceWhichCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		SetNsNameFromAny _ANSI_ARGS_((
-			    Tcl_Interp *interp, Tcl_Obj *objPtr));
-static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));
-
-/*
- * This structure defines a Tcl object type that contains a
- * namespace reference.  It is used in commands that take the
- * name of a namespace as an argument.  The namespace reference
- * is resolved, and the result in cached in the object.
- */
-
-Tcl_ObjType tclNsNameType = {
+ * This structure defines a Tcl object type that contains a namespace
+ * reference. It is used in commands that take the name of a namespace as an
+ * argument. The namespace reference is resolved, and the result in cached in
+ * the object.
+ */
+
+static Tcl_ObjType nsNameType = {
     "nsName",			/* the type's name */
     FreeNsNameInternalRep,	/* freeIntRepProc */
     DupNsNameInternalRep,	/* dupIntRepProc */
-    UpdateStringOfNsName,	/* updateStringProc */
+    NULL,			/* updateStringProc */
     SetNsNameFromAny		/* setFromAnyProc */
 };
+
+/*
+ * This structure defines a Tcl object type that contains a reference to an
+ * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
+ * to cache the mapping between the subcommand itself and the real command
+ * that implements it.
+ */
+
+Tcl_ObjType tclEnsembleCmdType = {
+    "ensembleCommand",		/* the type's name */
+    FreeEnsembleCmdRep,		/* freeIntRepProc */
+    DupEnsembleCmdRep,		/* dupIntRepProc */
+    StringOfEnsembleCmdRep,	/* updateStringProc */
+    NULL			/* setFromAnyProc */
+};
 
 /*
  *----------------------------------------------------------------------
  *
  * TclInitNamespaceSubsystem --
  *
- *	This procedure is called to initialize all the structures that 
- *	are used by namespaces on a per-process basis.
+ *	This function is called to initialize all the structures that are used
+ *	by namespaces on a per-process basis.
  *
  * Results:
  *	None.
@@ -170,7 +270,7 @@ Tcl_ObjType tclNsNameType = {
  */
 
 void
-TclInitNamespaceSubsystem()
+TclInitNamespaceSubsystem(void)
 {
     /*
      * Does nothing for now.
@@ -194,19 +294,11 @@ TclInitNamespaceSubsystem()
  */
 
 Tcl_Namespace *
-Tcl_GetCurrentNamespace(interp)
-    register Tcl_Interp *interp; /* Interpreter whose current namespace is
-				  * being queried. */
+Tcl_GetCurrentNamespace(
+    register Tcl_Interp *interp)/* Interpreter whose current namespace is
+				 * being queried. */
 {
-    register Interp *iPtr = (Interp *) interp;
-    register Namespace *nsPtr;
-
-    if (iPtr->varFramePtr != NULL) {
-        nsPtr = iPtr->varFramePtr->nsPtr;
-    } else {
-        nsPtr = iPtr->globalNsPtr;
-    }
-    return (Tcl_Namespace *) nsPtr;
+    return TclGetCurrentNamespace(interp);
 }
 
 /*
@@ -226,13 +318,11 @@ Tcl_GetCurrentNamespace(interp)
  */
 
 Tcl_Namespace *
-Tcl_GetGlobalNamespace(interp)
-    register Tcl_Interp *interp; /* Interpreter whose global namespace 
-				  * should be returned. */
+Tcl_GetGlobalNamespace(
+    register Tcl_Interp *interp)/* Interpreter whose global namespace should
+				 * be returned. */
 {
-    register Interp *iPtr = (Interp *) interp;
-    
-    return (Tcl_Namespace *) iPtr->globalNsPtr;
+    return TclGetGlobalNamespace(interp);
 }
 
 /*
@@ -240,9 +330,9 @@ Tcl_GetGlobalNamespace(interp)
  *
  * Tcl_PushCallFrame --
  *
- *	Pushes a new call frame onto the interpreter's Tcl call stack.
- *	Called when executing a Tcl procedure or a "namespace eval" or
- *	"namespace inscope" command. 
+ *	Pushes a new call frame onto the interpreter's Tcl call stack. Called
+ *	when executing a Tcl procedure or a "namespace eval" or "namespace
+ *	inscope" command.
  *
  * Results:
  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
@@ -255,45 +345,53 @@ Tcl_GetGlobalNamespace(interp)
  */
 
 int
-Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
-    Tcl_Interp *interp;		 /* Interpreter in which the new call frame
-				  * is to be pushed. */
-    Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to
-				  * push. Storage for this has already been
-				  * allocated by the caller; typically this
-				  * is the address of a CallFrame structure
-				  * allocated on the caller's C stack.  The
-				  * call frame will be initialized by this
-				  * procedure. The caller can pop the frame
-				  * later with Tcl_PopCallFrame, and it is
-				  * responsible for freeing the frame's
-				  * storage. */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace in which the
-				  * frame will execute. If NULL, the
-				  * interpreter's current namespace will
-				  * be used. */
-    int isProcCallFrame;	 /* If nonzero, the frame represents a
-				  * called Tcl procedure and may have local
-				  * vars. Vars will ordinarily be looked up
-				  * in the frame. If new variables are
-				  * created, they will be created in the
-				  * frame. If 0, the frame is for a
-				  * "namespace eval" or "namespace inscope"
-				  * command and var references are treated
-				  * as references to namespace variables. */
+Tcl_PushCallFrame(
+    Tcl_Interp *interp,		/* Interpreter in which the new call frame is
+				 * to be pushed. */
+    Tcl_CallFrame *callFramePtr,/* Points to a call frame structure to push.
+				 * Storage for this has already been allocated
+				 * by the caller; typically this is the
+				 * address of a CallFrame structure allocated
+				 * on the caller's C stack. The call frame
+				 * will be initialized by this function. The
+				 * caller can pop the frame later with
+				 * Tcl_PopCallFrame, and it is responsible for
+				 * freeing the frame's storage. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame
+				 * will execute. If NULL, the interpreter's
+				 * current namespace will be used. */
+    int isProcCallFrame)	/* If nonzero, the frame represents a called
+				 * Tcl procedure and may have local vars. Vars
+				 * will ordinarily be looked up in the frame.
+				 * If new variables are created, they will be
+				 * created in the frame. If 0, the frame is
+				 * for a "namespace eval" or "namespace
+				 * inscope" command and var references are
+				 * treated as references to namespace
+				 * variables. */
 {
     Interp *iPtr = (Interp *) interp;
     register CallFrame *framePtr = (CallFrame *) callFramePtr;
     register Namespace *nsPtr;
 
     if (namespacePtr == NULL) {
-	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     } else {
-        nsPtr = (Namespace *) namespacePtr;
-        if (nsPtr->flags & NS_DEAD) {
-	    panic("Trying to push call frame for dead namespace");
+	nsPtr = (Namespace *) namespacePtr;
+
+	/*
+	 * TODO: Examine whether it would be better to guard based on NS_DYING
+	 * or NS_KILLED. It appears that these are not tested because they can
+	 * be set in a global interp that has been [namespace delete]d, but
+	 * which never really completely goes away because of lingering global
+	 * things like ::errorInfo and [::unknown] and hidden commands.
+	 * Review of those designs might permit stricter checking here.
+	 */
+
+	if (nsPtr->flags & NS_DEAD) {
+	    Tcl_Panic("Trying to push call frame for dead namespace");
 	    /*NOTREACHED*/
-        }
+	}
     }
 
     nsPtr->activationCount++;
@@ -304,18 +402,20 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
     framePtr->callerPtr = iPtr->framePtr;
     framePtr->callerVarPtr = iPtr->varFramePtr;
     if (iPtr->varFramePtr != NULL) {
-        framePtr->level = (iPtr->varFramePtr->level + 1);
+	framePtr->level = (iPtr->varFramePtr->level + 1);
     } else {
-        framePtr->level = 1;
+	framePtr->level = 0;
     }
-    framePtr->procPtr = NULL; 	   /* no called procedure */
-    framePtr->varTablePtr = NULL;  /* and no local variables */
+    framePtr->procPtr = NULL;		/* no called procedure */
+    framePtr->varTablePtr = NULL;	/* and no local variables */
     framePtr->numCompiledLocals = 0;
     framePtr->compiledLocals = NULL;
+    framePtr->clientData = NULL;
+    framePtr->localCachePtr = NULL;
 
     /*
-     * Push the new call frame onto the interpreter's stack of procedure
-     * call frames making it the current frame.
+     * Push the new call frame onto the interpreter's stack of procedure call
+     * frames making it the current frame.
      */
 
     iPtr->framePtr = framePtr;
@@ -336,51 +436,57 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
  *
  * Side effects:
  *	Modifies the call stack of the interpreter. Resets various fields of
- *	the popped call frame. If a namespace has been deleted and
- *	has no more activations on the call stack, the namespace is
- *	destroyed.
+ *	the popped call frame. If a namespace has been deleted and has no more
+ *	activations on the call stack, the namespace is destroyed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_PopCallFrame(interp)
-    Tcl_Interp* interp;		/* Interpreter with call frame to pop. */
+Tcl_PopCallFrame(
+    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
 {
     register Interp *iPtr = (Interp *) interp;
     register CallFrame *framePtr = iPtr->framePtr;
     Namespace *nsPtr;
 
     /*
-     * It's important to remove the call frame from the interpreter's stack
-     * of call frames before deleting local variables, so that traces
-     * invoked by the variable deletion don't see the partially-deleted
-     * frame.
+     * It's important to remove the call frame from the interpreter's stack of
+     * call frames before deleting local variables, so that traces invoked by
+     * the variable deletion don't see the partially-deleted frame.
      */
 
-    iPtr->framePtr = framePtr->callerPtr;
-    iPtr->varFramePtr = framePtr->callerVarPtr;
+    if (framePtr->callerPtr) {
+	iPtr->framePtr = framePtr->callerPtr;
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+    } else {
+	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
+    }
 
     if (framePtr->varTablePtr != NULL) {
-        TclDeleteVars(iPtr, framePtr->varTablePtr);
-        ckfree((char *) framePtr->varTablePtr);
-        framePtr->varTablePtr = NULL;
+	TclDeleteVars(iPtr, framePtr->varTablePtr);
+	ckfree((char *) framePtr->varTablePtr);
+	framePtr->varTablePtr = NULL;
     }
     if (framePtr->numCompiledLocals > 0) {
-        TclDeleteCompiledLocalVars(iPtr, framePtr);
+	TclDeleteCompiledLocalVars(iPtr, framePtr);
+	if (--framePtr->localCachePtr->refCount == 0) {
+	    TclFreeLocalCache(interp, framePtr->localCachePtr);
+	}
+	framePtr->localCachePtr = NULL;
     }
 
     /*
-     * Decrement the namespace's count of active call frames. If the
-     * namespace is "dying" and there are no more active call frames,
-     * call Tcl_DeleteNamespace to destroy it.
+     * Decrement the namespace's count of active call frames. If the namespace
+     * is "dying" and there are no more active call frames, call
+     * Tcl_DeleteNamespace to destroy it.
      */
 
     nsPtr = framePtr->nsPtr;
     nsPtr->activationCount--;
     if ((nsPtr->flags & NS_DYING)
-	    && (nsPtr->activationCount == 0)) {
-        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
+	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
 }
@@ -388,137 +494,346 @@ Tcl_PopCallFrame(interp)
 /*
  *----------------------------------------------------------------------
  *
+ * TclPushStackFrame --
+ *
+ *	Allocates a new call frame in the interpreter's execution stack, then
+ *	pushes it onto the interpreter's Tcl call stack. Called when executing
+ *	a Tcl procedure or a "namespace eval" or "namespace inscope" command.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result object) if something goes wrong.
+ *
+ * Side effects:
+ *	Modifies the interpreter's Tcl call stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPushStackFrame(
+    Tcl_Interp *interp,		/* Interpreter in which the new call frame is
+				 * to be pushed. */
+    Tcl_CallFrame **framePtrPtr,/* Place to store a pointer to the stack
+				 * allocated call frame. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace in which the frame
+				 * will execute. If NULL, the interpreter's
+				 * current namespace will be used. */
+    int isProcCallFrame)	/* If nonzero, the frame represents a called
+				 * Tcl procedure and may have local vars. Vars
+				 * will ordinarily be looked up in the frame.
+				 * If new variables are created, they will be
+				 * created in the frame. If 0, the frame is
+				 * for a "namespace eval" or "namespace
+				 * inscope" command and var references are
+				 * treated as references to namespace
+				 * variables. */
+{
+    *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
+    return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
+	    isProcCallFrame);
+}
+
+void
+TclPopStackFrame(
+    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
+{
+    CallFrame *freePtr = ((Interp *)interp)->framePtr;
+
+    Tcl_PopCallFrame(interp);
+    TclStackFree(interp, freePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EstablishErrorCodeTraces --
+ *
+ *	Creates traces on the ::errorCode variable to keep its value
+ *	consistent with the expectations of legacy code.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read and unset traces are established on ::errorCode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+EstablishErrorCodeTraces(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    const char *name1,
+    const char *name2,
+    int flags)
+{
+    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+	    ErrorCodeRead, NULL);
+    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+	    EstablishErrorCodeTraces, NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ErrorCodeRead --
+ *
+ *	Called when the ::errorCode variable is read. Copies the current value
+ *	of the interp's errorCode field into ::errorCode.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ErrorCodeRead(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    const char *name1,
+    const char *name2,
+    int flags)
+{
+    Interp *iPtr = (Interp *)interp;
+
+    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
+	return NULL;
+    }
+    if (iPtr->errorCode) {
+	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+		iPtr->errorCode, TCL_GLOBAL_ONLY);
+	return NULL;
+    }
+    if (NULL == Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, TCL_GLOBAL_ONLY)) {
+	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+		Tcl_NewObj(), TCL_GLOBAL_ONLY);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EstablishErrorInfoTraces --
+ *
+ *	Creates traces on the ::errorInfo variable to keep its value
+ *	consistent with the expectations of legacy code.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read and unset traces are established on ::errorInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+EstablishErrorInfoTraces(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    const char *name1,
+    const char *name2,
+    int flags)
+{
+    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+	    ErrorInfoRead, NULL);
+    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+	    EstablishErrorInfoTraces, NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ErrorInfoRead --
+ *
+ *	Called when the ::errorInfo variable is read. Copies the current value
+ *	of the interp's errorInfo field into ::errorInfo.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ErrorInfoRead(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    const char *name1,
+    const char *name2,
+    int flags)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
+	return NULL;
+    }
+    if (iPtr->errorInfo) {
+	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	return NULL;
+    }
+    if (NULL == Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY)) {
+	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		Tcl_NewObj(), TCL_GLOBAL_ONLY);
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateNamespace --
  *
- *	Creates a new namespace with the given name. If there is no
- *	active namespace (i.e., the interpreter is being initialized),
- *	the global :: namespace is created and returned.
+ *	Creates a new namespace with the given name. If there is no active
+ *	namespace (i.e., the interpreter is being initialized), the global ::
+ *	namespace is created and returned.
  *
  * Results:
- *	Returns a pointer to the new namespace if successful. If the
- *	namespace already exists or if another error occurs, this routine
- *	returns NULL, along with an error message in the interpreter's
- *	result object.
+ *	Returns a pointer to the new namespace if successful. If the namespace
+ *	already exists or if another error occurs, this routine returns NULL,
+ *	along with an error message in the interpreter's result object.
  *
  * Side effects:
- *	If the name contains "::" qualifiers and a parent namespace does
- *	not already exist, it is automatically created. 
+ *	If the name contains "::" qualifiers and a parent namespace does not
+ *	already exist, it is automatically created.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Namespace *
-Tcl_CreateNamespace(interp, name, clientData, deleteProc)
-    Tcl_Interp *interp;             /* Interpreter in which a new namespace
-				     * is being created. Also used for
-				     * error reporting. */
-    CONST char *name;               /* Name for the new namespace. May be a
-				     * qualified name with names of ancestor
-				     * namespaces separated by "::"s. */
-    ClientData clientData;	    /* One-word value to store with
-				     * namespace. */
-    Tcl_NamespaceDeleteProc *deleteProc;
-    				    /* Procedure called to delete client
-				     * data when the namespace is deleted.
-				     * NULL if no procedure should be
-				     * called. */
+Tcl_CreateNamespace(
+    Tcl_Interp *interp,		/* Interpreter in which a new namespace is
+				 * being created. Also used for error
+				 * reporting. */
+    const char *name,		/* Name for the new namespace. May be a
+				 * qualified name with names of ancestor
+				 * namespaces separated by "::"s. */
+    ClientData clientData,	/* One-word value to store with namespace. */
+    Tcl_NamespaceDeleteProc *deleteProc)
+				/* Function called to delete client data when
+				 * the namespace is deleted. NULL if no
+				 * function should be called. */
 {
     Interp *iPtr = (Interp *) interp;
     register Namespace *nsPtr, *ancestorPtr;
     Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
     Namespace *globalNsPtr = iPtr->globalNsPtr;
-    CONST char *simpleName;
+    const char *simpleName;
     Tcl_HashEntry *entryPtr;
     Tcl_DString buffer1, buffer2;
-    int newEntry;
+    Tcl_DString *namePtr, *buffPtr;
+    int newEntry, nameLen;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
-     * If there is no active namespace, the interpreter is being
-     * initialized. 
+     * If there is no active namespace, the interpreter is being initialized.
      */
 
     if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
 	/*
-	 * Treat this namespace as the global namespace, and avoid
-	 * looking for a parent.
+	 * Treat this namespace as the global namespace, and avoid looking for
+	 * a parent.
 	 */
-	
-        parentPtr = NULL;
-        simpleName = "";
+
+	parentPtr = NULL;
+	simpleName = "";
     } else if (*name == '\0') {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "can't create namespace \"\": "
+		"only global namespace can have empty name", NULL);
 	return NULL;
     } else {
 	/*
 	 * Find the parent for the new namespace.
 	 */
 
-	TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
-		/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+	TclGetNamespaceForQualName(interp, name, NULL,
+		/*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
 		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
 
 	/*
 	 * If the unqualified name at the end is empty, there were trailing
-	 * "::"s after the namespace's name which we ignore. The new
-	 * namespace was already (recursively) created and is pointed to
-	 * by parentPtr.
+	 * "::"s after the namespace's name which we ignore. The new namespace
+	 * was already (recursively) created and is pointed to by parentPtr.
 	 */
 
 	if (*simpleName == '\0') {
 	    return (Tcl_Namespace *) parentPtr;
 	}
 
-        /*
-         * Check for a bad namespace name and make sure that the name
-	 * does not already exist in the parent namespace.
+	/*
+	 * Check for a bad namespace name and make sure that the name does not
+	 * already exist in the parent namespace.
 	 */
 
-        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "can't create namespace \"", name,
-    	    	    "\": already exists", (char *) NULL);
-            return NULL;
-        }
+	if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
+	    Tcl_AppendResult(interp, "can't create namespace \"", name,
+		    "\": already exists", NULL);
+	    return NULL;
+	}
     }
 
     /*
-     * Create the new namespace and root it in its parent. Increment the
-     * count of namespaces created.
+     * Create the new namespace and root it in its parent. Increment the count
+     * of namespaces created.
      */
 
-
     nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
-    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
+    nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
     strcpy(nsPtr->name, simpleName);
-    nsPtr->fullName        = NULL;   /* set below */
-    nsPtr->clientData      = clientData;
-    nsPtr->deleteProc      = deleteProc;
-    nsPtr->parentPtr       = parentPtr;
+    nsPtr->fullName = NULL;		/* Set below. */
+    nsPtr->clientData = clientData;
+    nsPtr->deleteProc = deleteProc;
+    nsPtr->parentPtr = parentPtr;
     Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
-    Tcl_MutexLock(&nsMutex);
-    numNsCreated++;
-    nsPtr->nsId            = numNsCreated;
-    Tcl_MutexUnlock(&nsMutex);
-    nsPtr->interp          = interp;
-    nsPtr->flags           = 0;
+    nsPtr->nsId = ++(tsdPtr->numNsCreated);
+    nsPtr->interp = interp;
+    nsPtr->flags = 0;
     nsPtr->activationCount = 0;
-    nsPtr->refCount        = 0;
+    nsPtr->refCount = 0;
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
-    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
-    nsPtr->exportArrayPtr  = NULL;
+    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
+    nsPtr->exportArrayPtr = NULL;
     nsPtr->numExportPatterns = 0;
     nsPtr->maxExportPatterns = 0;
-    nsPtr->cmdRefEpoch       = 0;
-    nsPtr->resolverEpoch     = 0;
-    nsPtr->cmdResProc        = NULL;
-    nsPtr->varResProc        = NULL;
+    nsPtr->cmdRefEpoch = 0;
+    nsPtr->resolverEpoch = 0;
+    nsPtr->cmdResProc = NULL;
+    nsPtr->varResProc = NULL;
     nsPtr->compiledVarResProc = NULL;
+    nsPtr->exportLookupEpoch = 0;
+    nsPtr->ensembles = NULL;
+    nsPtr->unknownHandlerPtr = NULL;
+    nsPtr->commandPathLength = 0;
+    nsPtr->commandPathArray = NULL;
+    nsPtr->commandPathSourceList = NULL;
 
     if (parentPtr != NULL) {
-        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
-	        &newEntry);
-        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+	entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+		&newEntry);
+	Tcl_SetHashValue(entryPtr, nsPtr);
+    } else {
+	/*
+	 * In the global namespace create traces to maintain the ::errorInfo
+	 * and ::errorCode variables.
+	 */
+
+	iPtr->globalNsPtr = nsPtr;
+	EstablishErrorInfoTraces(NULL, interp, NULL, NULL, 0);
+	EstablishErrorCodeTraces(NULL, interp, NULL, NULL, 0);
     }
 
     /*
@@ -527,22 +842,41 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
 
     Tcl_DStringInit(&buffer1);
     Tcl_DStringInit(&buffer2);
-    for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
+    namePtr = &buffer1;
+    buffPtr = &buffer2;
+    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
 	    ancestorPtr = ancestorPtr->parentPtr) {
-        if (ancestorPtr != globalNsPtr) {
-            Tcl_DStringAppend(&buffer1, "::", 2);
-            Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
-        }
-        Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
+	if (ancestorPtr != globalNsPtr) {
+	    register Tcl_DString *tempPtr = namePtr;
+
+	    Tcl_DStringAppend(buffPtr, "::", 2);
+	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
+	    Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
+		    Tcl_DStringLength(namePtr));
+
+	    /*
+	     * Clear the unwanted buffer or we end up appending to previous
+	     * results, making the namespace fullNames of nested namespaces
+	     * very wrong (and strange).
+	     */
 
-        Tcl_DStringSetLength(&buffer2, 0);
-        Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
-        Tcl_DStringSetLength(&buffer1, 0);
+	    Tcl_DStringSetLength(namePtr, 0);
+
+	    /*
+	     * Now swap the buffer pointers so that we build in the other
+	     * buffer. This is faster than repeated copying back and forth
+	     * between buffers.
+	     */
+
+	    namePtr = buffPtr;
+	    buffPtr = tempPtr;
+	}
     }
-    
-    name = Tcl_DStringValue(&buffer2);
-    nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
-    strcpy(nsPtr->fullName, name);
+
+    name = Tcl_DStringValue(namePtr);
+    nameLen = Tcl_DStringLength(namePtr);
+    nsPtr->fullName = ckalloc((unsigned) (nameLen+1));
+    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
 
     Tcl_DStringFree(&buffer1);
     Tcl_DStringFree(&buffer2);
@@ -566,50 +900,79 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
  *	None.
  *
  * Side effects:
- *	When a namespace is deleted, it is automatically removed as a
- *	child of its parent namespace. Also, all its commands, variables
- *	and child namespaces are deleted.
+ *	When a namespace is deleted, it is automatically removed as a child of
+ *	its parent namespace. Also, all its commands, variables and child
+ *	namespaces are deleted.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteNamespace(namespacePtr)
-    Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */
+Tcl_DeleteNamespace(
+    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
 {
     register Namespace *nsPtr = (Namespace *) namespacePtr;
     Interp *iPtr = (Interp *) nsPtr->interp;
-    Namespace *globalNsPtr =
-	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
+    Namespace *globalNsPtr = (Namespace *)
+	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
     Tcl_HashEntry *entryPtr;
 
     /*
+     * If the namespace has associated ensemble commands, delete them first.
+     * This leaves the actual contents of the namespace alone (unless they are
+     * linked ensemble commands, of course). Note that this code is actually
+     * reentrant so command delete traces won't purturb things badly.
+     */
+
+    while (nsPtr->ensembles != NULL) {
+	EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;
+
+	/*
+	 * Splice out and link to indicate that we've already been killed.
+	 */
+
+	nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
+	ensemblePtr->next = ensemblePtr;
+	Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
+    }
+
+    /*
+     * If the namespace has a registered unknown handler (TIP 181), then free
+     * it here.
+     */
+
+    if (nsPtr->unknownHandlerPtr != NULL) {
+	Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
+	nsPtr->unknownHandlerPtr = NULL;
+    }
+
+    /*
      * If the namespace is on the call frame stack, it is marked as "dying"
-     * (NS_DYING is OR'd into its flags): the namespace can't be looked up
-     * by name but its commands and variables are still usable by those
-     * active call frames. When all active call frames referring to the
-     * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will
-     * call this procedure again to delete everything in the namespace.
-     * If no nsName objects refer to the namespace (i.e., if its refCount 
-     * is zero), its commands and variables are deleted and the storage for
-     * its namespace structure is freed. Otherwise, if its refCount is
-     * nonzero, the namespace's commands and variables are deleted but the
-     * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
-     * flags to allow the namespace resolution code to recognize that the
-     * namespace is "deleted". The structure's storage is freed by
-     * FreeNsNameInternalRep when its refCount reaches 0.
-     */
-
-    if (nsPtr->activationCount > 0) {
-        nsPtr->flags |= NS_DYING;
-        if (nsPtr->parentPtr != NULL) {
-            entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+     * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
+     * name but its commands and variables are still usable by those active
+     * call frames. When all active call frames referring to the namespace
+     * have been popped from the Tcl stack, Tcl_PopCallFrame will call this
+     * function again to delete everything in the namespace. If no nsName
+     * objects refer to the namespace (i.e., if its refCount is zero), its
+     * commands and variables are deleted and the storage for its namespace
+     * structure is freed. Otherwise, if its refCount is nonzero, the
+     * namespace's commands and variables are deleted but the structure isn't
+     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
+     * namespace resolution code to recognize that the namespace is "deleted".
+     * The structure's storage is freed by FreeNsNameInternalRep when its
+     * refCount reaches 0.
+     */
+
+    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
+	nsPtr->flags |= NS_DYING;
+	if (nsPtr->parentPtr != NULL) {
+	    entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
 		    nsPtr->name);
-            if (entryPtr != NULL) {
-                Tcl_DeleteHashEntry(entryPtr);
-            }
-        }
-        nsPtr->parentPtr = NULL;
+	    if (entryPtr != NULL) {
+		Tcl_DeleteHashEntry(entryPtr);
+	    }
+	}
+	nsPtr->parentPtr = NULL;
     } else if (!(nsPtr->flags & NS_KILLED)) {
 	/*
 	 * Delete the namespace and everything in it. If this is the global
@@ -620,38 +983,46 @@ Tcl_DeleteNamespace(namespacePtr)
 	 */
 
 	nsPtr->flags |= (NS_DYING|NS_KILLED);
-	
-        TclTeardownNamespace(nsPtr);
 
-        if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
-            /*
+	TclTeardownNamespace(nsPtr);
+
+	if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
+	    /*
 	     * If this is the global namespace, then it may have residual
-             * "errorInfo" and "errorCode" variables for errors that
-             * occurred while it was being torn down.  Try to clear the
-             * variable list one last time.
+	     * "errorInfo" and "errorCode" variables for errors that occurred
+	     * while it was being torn down. Try to clear the variable list
+	     * one last time.
+	     */
+
+	    TclDeleteNamespaceVars(nsPtr);
+
+	    Tcl_DeleteHashTable(&nsPtr->childTable);
+	    Tcl_DeleteHashTable(&nsPtr->cmdTable);
+
+	    /*
+	     * If the reference count is 0, then discard the namespace.
+	     * Otherwise, mark it as "dead" so that it can't be used.
+	     */
+
+	    if (nsPtr->refCount == 0) {
+		NamespaceFree(nsPtr);
+	    } else {
+		nsPtr->flags |= NS_DEAD;
+	    }
+	} else {
+	    /*
+	     * Restore the ::errorInfo and ::errorCode traces.
 	     */
 
-            TclDeleteNamespaceVars(nsPtr);
-	    
-            Tcl_DeleteHashTable(&nsPtr->childTable);
-            Tcl_DeleteHashTable(&nsPtr->cmdTable);
-
-            /*
-             * If the reference count is 0, then discard the namespace.
-             * Otherwise, mark it as "dead" so that it can't be used.
-             */
-
-            if (nsPtr->refCount == 0) {
-                NamespaceFree(nsPtr);
-            } else {
-                nsPtr->flags |= NS_DEAD;
-            }
-        } else {
+	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+
 	    /*
-	     * We didn't really kill it, so remove the KILLED marks, so
-	     * it can get killed later, avoiding mem leaks
+	     * We didn't really kill it, so remove the KILLED marks, so it can
+	     * get killed later, avoiding mem leaks.
 	     */
-	     nsPtr->flags &= ~(NS_DYING|NS_KILLED);
+
+	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
 	}
     }
 }
@@ -666,9 +1037,7 @@ Tcl_DeleteNamespace(namespacePtr)
  *	commands, variables, and child namespaces.
  *
  *	This is kept separate from Tcl_DeleteNamespace so that the global
- *	namespace can be handled specially. Global variables like
- *	"errorInfo" and "errorCode" need to remain intact while other
- *	namespaces and commands are torn down, in case any errors occur.
+ *	namespace can be handled specially.
  *
  * Results:
  *	None.
@@ -676,15 +1045,13 @@ Tcl_DeleteNamespace(namespacePtr)
  * Side effects:
  *	Removes this namespace from its parent's child namespace hashtable.
  *	Deletes all commands, variables and namespaces in this namespace.
- *	If this is the global namespace, the "errorInfo" and "errorCode"
- *	variables are left alone and deleted later.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclTeardownNamespace(nsPtr)
-    register Namespace *nsPtr;	/* Points to the namespace to be dismantled
+TclTeardownNamespace(
+    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
 				 * and unlinked from its parent. */
 {
     Interp *iPtr = (Interp *) nsPtr->interp;
@@ -692,69 +1059,30 @@ TclTeardownNamespace(nsPtr)
     Tcl_HashSearch search;
     Tcl_Namespace *childNsPtr;
     Tcl_Command cmd;
-    Namespace *globalNsPtr =
-	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
     int i;
 
     /*
-     * Start by destroying the namespace's variable table,
-     * since variables might trigger traces.
+     * Start by destroying the namespace's variable table, since variables
+     * might trigger traces. Variable table should be cleared but not freed!
+     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
      */
 
-    if (nsPtr == globalNsPtr) {
-	/*
-	 * This is the global namespace.  Tearing it down will destroy the
-	 * ::errorInfo and ::errorCode variables.  We save and restore them
-	 * in case there are any errors in progress, so the error details
-	 * they contain will not be lost.  See test namespace-8.5
-	 */
-    
-	Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo",
-		NULL, TCL_GLOBAL_ONLY);
-	Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode",
-		NULL, TCL_GLOBAL_ONLY);
-
-	if (errorInfo) {
-	    Tcl_IncrRefCount(errorInfo);
-	}
-	if (errorCode) {
-	    Tcl_IncrRefCount(errorCode);
-	}
-
-        TclDeleteNamespaceVars(nsPtr);
-        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
-
-	if (errorInfo) {
-	    Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL,
-		    errorInfo, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(errorInfo);
-	}
-	if (errorCode) {
-	    Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL,
-		    errorCode, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(errorCode);
-	}
-    } else {
-	/*
-	 * Variable table should be cleared but not freed! TclDeleteVars
-	 * frees it, so we reinitialize it afterwards.
-	 */
-    
-        TclDeleteNamespaceVars(nsPtr);
-        Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
-    }
+    TclDeleteNamespaceVars(nsPtr);
+    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
 
     /*
      * Delete all commands in this namespace. Be careful when traversing the
      * hash table: when each command is deleted, it removes itself from the
      * command table.
+     *
+     * Don't optimize to Tcl_NextHashEntry() because of traces.
      */
 
     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-            entryPtr != NULL;
-            entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
-        cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
-        Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+	    entryPtr != NULL;
+	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
+	cmd = Tcl_GetHashValue(entryPtr);
+	Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
     }
     Tcl_DeleteHashTable(&nsPtr->cmdTable);
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -764,28 +1092,49 @@ TclTeardownNamespace(nsPtr)
      */
 
     if (nsPtr->parentPtr != NULL) {
-        entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
-	        nsPtr->name);
-        if (entryPtr != NULL) {
-            Tcl_DeleteHashEntry(entryPtr);
-        }
+	entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+		nsPtr->name);
+	if (entryPtr != NULL) {
+	    Tcl_DeleteHashEntry(entryPtr);
+	}
     }
     nsPtr->parentPtr = NULL;
 
     /*
+     * Delete the namespace path if one is installed.
+     */
+
+    if (nsPtr->commandPathLength != 0) {
+	UnlinkNsPath(nsPtr);
+	nsPtr->commandPathLength = 0;
+    }
+    if (nsPtr->commandPathSourceList != NULL) {
+	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+	do {
+	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
+		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
+	    }
+	    nsPathPtr->nsPtr = NULL;
+	    nsPathPtr = nsPathPtr->nextPtr;
+	} while (nsPathPtr != NULL);
+	nsPtr->commandPathSourceList = NULL;
+    }
+
+    /*
      * Delete all the child namespaces.
      *
-     * BE CAREFUL: When each child is deleted, it will divorce
-     *    itself from its parent. You can't traverse a hash table
-     *    properly if its elements are being deleted. We use only
-     *    the Tcl_FirstHashEntry function to be safe.
+     * BE CAREFUL: When each child is deleted, it will divorce itself from its
+     * parent. You can't traverse a hash table properly if its elements are
+     * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
+     *
+     * Don't optimize to Tcl_NextHashEntry() because of traces.
      */
 
     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-            entryPtr != NULL;
-            entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
-        childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
-        Tcl_DeleteNamespace(childNsPtr);
+	    entryPtr != NULL;
+	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
+	childNsPtr = Tcl_GetHashValue(entryPtr);
+	Tcl_DeleteNamespace(childNsPtr);
     }
 
     /*
@@ -796,7 +1145,7 @@ TclTeardownNamespace(nsPtr)
 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 	    ckfree(nsPtr->exportArrayPtr[i]);
 	}
-        ckfree((char *) nsPtr->exportArrayPtr);
+	ckfree((char *) nsPtr->exportArrayPtr);
 	nsPtr->exportArrayPtr = NULL;
 	nsPtr->numExportPatterns = 0;
 	nsPtr->maxExportPatterns = 0;
@@ -807,15 +1156,15 @@ TclTeardownNamespace(nsPtr)
      */
 
     if (nsPtr->deleteProc != NULL) {
-        (*nsPtr->deleteProc)(nsPtr->clientData);
+	(*nsPtr->deleteProc)(nsPtr->clientData);
     }
     nsPtr->deleteProc = NULL;
     nsPtr->clientData = NULL;
 
     /*
-     * Reset the namespace's id field to ensure that this namespace won't
-     * be interpreted as valid by, e.g., the cache validation code for
-     * cached command references in Tcl_GetCommandFromObj.
+     * Reset the namespace's id field to ensure that this namespace won't be
+     * interpreted as valid by, e.g., the cache validation code for cached
+     * command references in Tcl_GetCommandFromObj.
      */
 
     nsPtr->nsId = 0;
@@ -826,9 +1175,8 @@ TclTeardownNamespace(nsPtr)
  *
  * NamespaceFree --
  *
- *	Called after a namespace has been deleted, when its
- *	reference count reaches 0.  Frees the data structure
- *	representing the namespace.
+ *	Called after a namespace has been deleted, when its reference count
+ *	reaches 0. Frees the data structure representing the namespace.
  *
  * Results:
  *	None.
@@ -840,8 +1188,8 @@ TclTeardownNamespace(nsPtr)
  */
 
 static void
-NamespaceFree(nsPtr)
-    register Namespace *nsPtr;	/* Points to the namespace to free. */
+NamespaceFree(
+    register Namespace *nsPtr)	/* Points to the namespace to free. */
 {
     /*
      * Most of the namespace's contents are freed when the namespace is
@@ -854,7 +1202,6 @@ NamespaceFree(nsPtr)
 
     ckfree((char *) nsPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -862,10 +1209,10 @@ NamespaceFree(nsPtr)
  * Tcl_Export --
  *
  *	Makes all the commands matching a pattern available to later be
- *	imported from the namespace specified by namespacePtr (or the
- *	current namespace if namespacePtr is NULL). The specified pattern is
- *	appended onto the namespace's export pattern list, which is
- *	optionally cleared beforehand.
+ *	imported from the namespace specified by namespacePtr (or the current
+ *	namespace if namespacePtr is NULL). The specified pattern is appended
+ *	onto the namespace's export pattern list, which is optionally cleared
+ *	beforehand.
  *
  * Results:
  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
@@ -879,23 +1226,22 @@ NamespaceFree(nsPtr)
  */
 
 int
-Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
-    Tcl_Interp *interp;		 /* Current interpreter. */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace from which 
-				  * commands are to be exported. NULL for
-                                  * the current namespace. */
-    CONST char *pattern;         /* String pattern indicating which commands
-                                  * to export. This pattern may not include
-				  * any namespace qualifiers; only commands
-				  * in the specified namespace may be
-				  * exported. */
-    int resetListFirst;		 /* If nonzero, resets the namespace's
-				  * export list before appending. */
-{
-#define INIT_EXPORT_PATTERNS 5    
+Tcl_Export(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace from which commands
+				 * are to be exported. NULL for the current
+				 * namespace. */
+    const char *pattern,	/* String pattern indicating which commands to
+				 * export. This pattern may not include any
+				 * namespace qualifiers; only commands in the
+				 * specified namespace may be exported. */
+    int resetListFirst)		/* If nonzero, resets the namespace's export
+				 * list before appending. */
+{
+#define INIT_EXPORT_PATTERNS 5
     Namespace *nsPtr, *exportNsPtr, *dummyPtr;
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    CONST char *simplePattern;
+    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    const char *simplePattern;
     char *patternCpy;
     int neededElems, len, i;
 
@@ -904,9 +1250,9 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
      */
 
     if (namespacePtr == NULL) {
-        nsPtr = (Namespace *) currNsPtr;
+	nsPtr = (Namespace *) currNsPtr;
     } else {
-        nsPtr = (Namespace *) namespacePtr;
+	nsPtr = (Namespace *) namespacePtr;
     }
 
     /*
@@ -921,6 +1267,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
 	    }
 	    ckfree((char *) nsPtr->exportArrayPtr);
 	    nsPtr->exportArrayPtr = NULL;
+	    TclInvalidateNsCmdLookup(nsPtr);
 	    nsPtr->numExportPatterns = 0;
 	    nsPtr->maxExportPatterns = 0;
 	}
@@ -935,49 +1282,39 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
 	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	        "invalid export pattern \"", pattern,
-		"\": pattern can't specify a namespace",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
+		"\": pattern can't specify a namespace", NULL);
 	return TCL_ERROR;
     }
 
     /*
      * Make sure that we don't already have the pattern in the array
      */
+
     if (nsPtr->exportArrayPtr != NULL) {
 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 	    if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
 		/*
-		 * The pattern already exists in the list
+		 * The pattern already exists in the list.
 		 */
+
 		return TCL_OK;
 	    }
 	}
     }
 
     /*
-     * Make sure there is room in the namespace's pattern array for the
-     * new pattern.
+     * Make sure there is room in the namespace's pattern array for the new
+     * pattern.
      */
 
     neededElems = nsPtr->numExportPatterns + 1;
-    if (nsPtr->exportArrayPtr == NULL) {
+    if (neededElems > nsPtr->maxExportPatterns) {
+	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
+		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
 	nsPtr->exportArrayPtr = (char **)
-	        ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
-	nsPtr->numExportPatterns = 0;
-	nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
-    } else if (neededElems > nsPtr->maxExportPatterns) {
-	int numNewElems = 2 * nsPtr->maxExportPatterns;
-	size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
-	size_t newBytes  = numNewElems * sizeof(char *);
-	char **newPtr = (char **) ckalloc((unsigned) newBytes);
-
-	memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
-	        currBytes);
-	ckfree((char *) nsPtr->exportArrayPtr);
-	nsPtr->exportArrayPtr = (char **) newPtr;
-	nsPtr->maxExportPatterns = numNewElems;
+		ckrealloc((char *) nsPtr->exportArrayPtr,
+		sizeof(char *) * nsPtr->maxExportPatterns);
     }
 
     /*
@@ -985,11 +1322,20 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
      */
 
     len = strlen(pattern);
-    patternCpy = (char *) ckalloc((unsigned) (len + 1));
-    strcpy(patternCpy, pattern);
-    
+    patternCpy = ckalloc((unsigned) (len + 1));
+    memcpy(patternCpy, pattern, (unsigned) len + 1);
+
     nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
     nsPtr->numExportPatterns++;
+
+    /*
+     * The list of commands actually exported from the namespace might have
+     * changed (probably will have!) However, we do not need to recompute this
+     * just yet; next time we need the info will be soon enough.
+     */
+
+    TclInvalidateNsCmdLookup(nsPtr);
+
     return TCL_OK;
 #undef INIT_EXPORT_PATTERNS
 }
@@ -1005,24 +1351,24 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
  * Results:
  *	The return value is normally TCL_OK; in this case the object
  *	referenced by objPtr has each export pattern appended to it. If an
- *	error occurs, TCL_ERROR is returned and the interpreter's result
- *	holds an error message.
+ *	error occurs, TCL_ERROR is returned and the interpreter's result holds
+ *	an error message.
  *
  * Side effects:
- *	If necessary, the object referenced by objPtr is converted into
- *	a list object.
+ *	If necessary, the object referenced by objPtr is converted into a list
+ *	object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_AppendExportList(interp, namespacePtr, objPtr)
-    Tcl_Interp *interp;		 /* Interpreter used for error reporting. */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace whose export
-				  * pattern list is appended onto objPtr.
-				  * NULL for the current namespace. */
-    Tcl_Obj *objPtr;		 /* Points to the Tcl object onto which the
-				  * export pattern list is appended. */
+Tcl_AppendExportList(
+    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
+				 * pattern list is appended onto objPtr. NULL
+				 * for the current namespace. */
+    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
+				 * export pattern list is appended. */
 {
     Namespace *nsPtr;
     int i, result;
@@ -1032,9 +1378,9 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
      */
 
     if (namespacePtr == NULL) {
-        nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     } else {
-        nsPtr = (Namespace *) namespacePtr;
+	nsPtr = (Namespace *) namespacePtr;
     }
 
     /*
@@ -1057,90 +1403,79 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
  * Tcl_Import --
  *
  *	Imports all of the commands matching a pattern into the namespace
- *	specified by namespacePtr (or the current namespace if contextNsPtr
- *	is NULL). This is done by creating a new command (the "imported
- *	command") that points to the real command in its original namespace.
+ *	specified by namespacePtr (or the current namespace if contextNsPtr is
+ *	NULL). This is done by creating a new command (the "imported command")
+ *	that points to the real command in its original namespace.
  *
- *      If matching commands are on the autoload path but haven't been
- *	loaded yet, this command forces them to be loaded, then creates
- *	the links to them.
+ *	If matching commands are on the autoload path but haven't been loaded
+ *	yet, this command forces them to be loaded, then creates the links to
+ *	them.
  *
  * Results:
  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
  *	message in the interpreter's result) if something goes wrong.
  *
  * Side effects:
- *	Creates new commands in the importing namespace. These indirect
- *	calls back to the real command and are deleted if the real commands
- *	are deleted.
+ *	Creates new commands in the importing namespace. These indirect calls
+ *	back to the real command and are deleted if the real commands are
+ *	deleted.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
-    Tcl_Interp *interp;		 /* Current interpreter. */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
-				  * commands are to be imported. NULL for
-                                  * the current namespace. */
-    CONST char *pattern;         /* String pattern indicating which commands
-                                  * to import. This pattern should be
-				  * qualified by the name of the namespace
-				  * from which to import the command(s). */
-    int allowOverwrite;		 /* If nonzero, allow existing commands to
-				  * be overwritten by imported commands.
-				  * If 0, return an error if an imported
-				  * cmd conflicts with an existing one. */
+Tcl_Import(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace into which the
+				 * commands are to be imported. NULL for the
+				 * current namespace. */
+    const char *pattern,	/* String pattern indicating which commands to
+				 * import. This pattern should be qualified by
+				 * the name of the namespace from which to
+				 * import the command(s). */
+    int allowOverwrite)		/* If nonzero, allow existing commands to be
+				 * overwritten by imported commands. If 0,
+				 * return an error if an imported cmd
+				 * conflicts with an existing one. */
 {
-    Interp *iPtr = (Interp *) interp;
     Namespace *nsPtr, *importNsPtr, *dummyPtr;
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    CONST char *simplePattern;
-    char *cmdName;
+    const char *simplePattern;
     register Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    Command *cmdPtr;
-    ImportRef *refPtr;
-    Tcl_Command autoCmd, importedCmd;
-    ImportedCmdData *dataPtr;
-    int wasExported, i, result;
 
     /*
      * If the specified namespace is NULL, use the current namespace.
      */
 
     if (namespacePtr == NULL) {
-        nsPtr = (Namespace *) currNsPtr;
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     } else {
-        nsPtr = (Namespace *) namespacePtr;
+	nsPtr = (Namespace *) namespacePtr;
     }
- 
+
     /*
-     * First, invoke the "auto_import" command with the pattern
-     * being imported.  This command is part of the Tcl library.
-     * It looks for imported commands in autoloaded libraries and
-     * loads them in.  That way, they will be found when we try
-     * to create links below.
+     * First, invoke the "auto_import" command with the pattern being
+     * imported. This command is part of the Tcl library. It looks for
+     * imported commands in autoloaded libraries and loads them in. That way,
+     * they will be found when we try to create links below.
+     *
+     * Note that we don't just call Tcl_EvalObjv() directly because we do not
+     * want absence of the command to be a failure case.
      */
-    
-    autoCmd = Tcl_FindCommand(interp, "auto_import",
- 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
- 
-    if (autoCmd != NULL) {
+
+    if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) {
 	Tcl_Obj *objv[2];
- 
-	objv[0] = Tcl_NewStringObj("auto_import", -1);
-	Tcl_IncrRefCount(objv[0]);
+	int result;
+
+	TclNewLiteralStringObj(objv[0], "auto_import");
 	objv[1] = Tcl_NewStringObj(pattern, -1);
+
+	Tcl_IncrRefCount(objv[0]);
 	Tcl_IncrRefCount(objv[1]);
- 
-	cmdPtr = (Command *) autoCmd;
-	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
-		2, objv);
- 
+	result = Tcl_EvalObjv(interp, 2, objv, TCL_GLOBAL_ONLY);
 	Tcl_DecrRefCount(objv[0]);
 	Tcl_DecrRefCount(objv[1]);
- 
+
 	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -1148,38 +1483,35 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
     }
 
     /*
-     * From the pattern, find the namespace from which we are importing
-     * and get the simple pattern (no namespace qualifiers or ::'s) at
-     * the end.
+     * From the pattern, find the namespace from which we are importing and
+     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
      */
 
     if (strlen(pattern) == 0) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp),
-	        "empty import pattern", -1);
-        return TCL_ERROR;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
+	return TCL_ERROR;
     }
     TclGetNamespaceForQualName(interp, pattern, nsPtr,
 	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
 	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (importNsPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"unknown namespace in import pattern \"",
-		pattern, "\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
+		pattern, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
+	return TCL_ERROR;
     }
     if (importNsPtr == nsPtr) {
 	if (pattern == simplePattern) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    Tcl_AppendResult(interp,
 		    "no namespace specified in import pattern \"", pattern,
-		    "\"", (char *) NULL);
+		    "\"", NULL);
 	} else {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "import pattern \"", pattern,
+	    Tcl_AppendResult(interp, "import pattern \"", pattern,
 		    "\" tries to import from namespace \"",
-		    importNsPtr->name, "\" into itself", (char *) NULL);
+		    importNsPtr->name, "\" into itself", NULL);
 	}
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
@@ -1189,118 +1521,154 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
      * commands redirect their invocations to the "real" command.
      */
 
+    if ((simplePattern != NULL) && TclMatchIsTrivial(simplePattern)) {
+	hPtr = Tcl_FindHashEntry(&importNsPtr->cmdTable, simplePattern);
+	if (hPtr == NULL) {
+	    return TCL_OK;
+	}
+	return DoImport(interp, nsPtr, hPtr, simplePattern, pattern,
+		importNsPtr, allowOverwrite);
+    }
     for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
-	    (hPtr != NULL);
-	    hPtr = Tcl_NextHashEntry(&search)) {
-        cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
-        if (Tcl_StringMatch(cmdName, simplePattern)) {
-	    /*
-	     * The command cmdName in the source namespace matches the
-	     * pattern. Check whether it was exported. If it wasn't,
-	     * we ignore it.
-	     */
-	    Tcl_HashEntry *found;
+	    (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
+	char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
+	if (Tcl_StringMatch(cmdName, simplePattern) &&
+		DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr,
+		allowOverwrite) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoImport --
+ *
+ *	Import a particular command from one namespace into another. Helper
+ *	for Tcl_Import().
+ *
+ * Results:
+ *	Standard Tcl result code. If TCL_ERROR, appends an error message to
+ *	the interpreter result.
+ *
+ * Side effects:
+ *	A new command is created in the target namespace unless this is a
+ *	reimport of exactly the same command as before.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    wasExported = 0;
-	    for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {
-		if (Tcl_StringMatch(cmdName,
-			importNsPtr->exportArrayPtr[i])) {
-		    wasExported = 1;
-		    break;
-		}
-	    }
-	    if (!wasExported) {
-		continue;
-            }
+static int
+DoImport(
+    Tcl_Interp *interp,
+    Namespace *nsPtr,
+    Tcl_HashEntry *hPtr,
+    const char *cmdName,
+    const char *pattern,
+    Namespace *importNsPtr,
+    int allowOverwrite)
+{
+    int i = 0, exported = 0;
+    Tcl_HashEntry *found;
 
-	    /*
-	     * Unless there is a name clash, create an imported command
-	     * in the current namespace that refers to cmdPtr.
-	     */
+    /*
+     * The command cmdName in the source namespace matches the pattern. Check
+     * whether it was exported. If it wasn't, we ignore it.
+     */
 
-	    found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
-	    if ((found == NULL) || allowOverwrite) {
-		/*
-		 * Create the imported command and its client data.
-		 * To create the new command in the current namespace, 
-		 * generate a fully qualified name for it.
-		 */
+    while (!exported && (i < importNsPtr->numExportPatterns)) {
+	exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);
+    }
+    if (!exported) {
+	return TCL_OK;
+    }
 
-		Tcl_DString ds;
+    /*
+     * Unless there is a name clash, create an imported command in the current
+     * namespace that refers to cmdPtr.
+     */
 
-		Tcl_DStringInit(&ds);
-		Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-		if (nsPtr != iPtr->globalNsPtr) {
-		    Tcl_DStringAppend(&ds, "::", 2);
-		}
-		Tcl_DStringAppend(&ds, cmdName, -1);
+    found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
+    if ((found == NULL) || allowOverwrite) {
+	/*
+	 * Create the imported command and its client data. To create the new
+	 * command in the current namespace, generate a fully qualified name
+	 * for it.
+	 */
 
-		/*
-		 * Check whether creating the new imported command in the
-		 * current namespace would create a cycle of imported
-		 * command references.
-		 */
+	Tcl_DString ds;
+	Tcl_Command importedCmd;
+	ImportedCmdData *dataPtr;
+	Command *cmdPtr;
+	ImportRef *refPtr;
 
-		cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-		if ((found != NULL)
-			&& cmdPtr->deleteProc == DeleteImportedCmd) {
-
-		    Command *overwrite = (Command *) Tcl_GetHashValue(found);
-		    Command *link = cmdPtr;
-		    while (link->deleteProc == DeleteImportedCmd) {
-			ImportedCmdData *dataPtr;
-		       
-			dataPtr = (ImportedCmdData *) link->objClientData;
-			link = dataPtr->realCmdPtr;
-			if (overwrite == link) {
-			    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-				    "import pattern \"", pattern,
-				    "\" would create a loop containing ",
-				    "command \"", Tcl_DStringValue(&ds),
-				    "\"", (char *) NULL);
-			    Tcl_DStringFree(&ds);
-			    return TCL_ERROR;
-			}
-		    }
+	Tcl_DStringInit(&ds);
+	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
+	    Tcl_DStringAppend(&ds, "::", 2);
+	}
+	Tcl_DStringAppend(&ds, cmdName, -1);
+
+	/*
+	 * Check whether creating the new imported command in the current
+	 * namespace would create a cycle of imported command references.
+	 */
+
+	cmdPtr = Tcl_GetHashValue(hPtr);
+	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
+	    Command *overwrite = Tcl_GetHashValue(found);
+	    Command *link = cmdPtr;
+
+	    while (link->deleteProc == DeleteImportedCmd) {
+		ImportedCmdData *dataPtr = link->objClientData;
+
+		link = dataPtr->realCmdPtr;
+		if (overwrite == link) {
+		    Tcl_AppendResult(interp, "import pattern \"", pattern,
+			    "\" would create a loop containing command \"",
+			    Tcl_DStringValue(&ds), "\"", NULL);
+		    Tcl_DStringFree(&ds);
+		    return TCL_ERROR;
 		}
+	    }
+	}
+
+	dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
+	importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
+		InvokeImportedCmd, dataPtr, DeleteImportedCmd);
+	dataPtr->realCmdPtr = cmdPtr;
+	dataPtr->selfPtr = (Command *) importedCmd;
+	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
+	Tcl_DStringFree(&ds);
+
+	/*
+	 * Create an ImportRef structure describing this new import command
+	 * and add it to the import ref list in the "real" command.
+	 */
+
+	refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+	refPtr->importedCmdPtr = (Command *) importedCmd;
+	refPtr->nextPtr = cmdPtr->importRefPtr;
+	cmdPtr->importRefPtr = refPtr;
+    } else {
+	Command *overwrite = Tcl_GetHashValue(found);
 
-		dataPtr = (ImportedCmdData *)
-		        ckalloc(sizeof(ImportedCmdData));
-                importedCmd = Tcl_CreateObjCommand(interp, 
-                        Tcl_DStringValue(&ds), InvokeImportedCmd,
-                        (ClientData) dataPtr, DeleteImportedCmd);
-		dataPtr->realCmdPtr = cmdPtr;
-		dataPtr->selfPtr = (Command *) importedCmd;
-		dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
-		Tcl_DStringFree(&ds);
+	if (overwrite->deleteProc == DeleteImportedCmd) {
+	    ImportedCmdData *dataPtr = overwrite->objClientData;
 
+	    if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
 		/*
-		 * Create an ImportRef structure describing this new import
-		 * command and add it to the import ref list in the "real"
-		 * command.
+		 * Repeated import of same command is acceptable.
 		 */
 
-                refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
-                refPtr->importedCmdPtr = (Command *) importedCmd;
-                refPtr->nextPtr = cmdPtr->importRefPtr;
-                cmdPtr->importRefPtr = refPtr;
-            } else {
-		Command *overwrite = (Command *) Tcl_GetHashValue(found);
-		if (overwrite->deleteProc == DeleteImportedCmd) {
-		    ImportedCmdData *dataPtr =
-			    (ImportedCmdData *) overwrite->objClientData;
-		    if (dataPtr->realCmdPtr
-			    == (Command *) Tcl_GetHashValue(hPtr)) {
-			/* Repeated import of same command -- acceptable */
-			return TCL_OK;
-		    }
-		}
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		        "can't import command \"", cmdName,
-			"\": already exists", (char *) NULL);
-                return TCL_ERROR;
-            }
-        }
+		return TCL_OK;
+	    }
+	}
+	Tcl_AppendResult(interp, "can't import command \"", cmdName,
+		"\": already exists", NULL);
+	return TCL_ERROR;
     }
     return TCL_OK;
 }
@@ -1310,40 +1678,39 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
  *
  * Tcl_ForgetImport --
  *
- *	Deletes commands previously imported into the namespace indicated.  The
- *	by namespacePtr, or the current namespace of interp, when
- *	namespacePtr is NULL.  The pattern controls which imported commands
- *	are deleted.  A simple pattern, one without namespace separators,
- *	matches the current command names of imported commands in the
- *	namespace.  Matching imported commands are deleted.  A qualified
- *	pattern is interpreted as deletion selection on the basis of where
- *	the command is imported from.  The original command and "first link"
- *	command for each imported command are determined, and they are matched
- *	against the pattern.  A match leads to deletion of the imported
- *	command.
+ *	Deletes commands previously imported into the namespace indicated.
+ *	The by namespacePtr, or the current namespace of interp, when
+ *	namespacePtr is NULL. The pattern controls which imported commands are
+ *	deleted. A simple pattern, one without namespace separators, matches
+ *	the current command names of imported commands in the namespace.
+ *	Matching imported commands are deleted. A qualified pattern is
+ *	interpreted as deletion selection on the basis of where the command is
+ *	imported from. The original command and "first link" command for each
+ *	imported command are determined, and they are matched against the
+ *	pattern. A match leads to deletion of the imported command.
  *
  * Results:
- * 	Returns TCL_ERROR and records an error message in the interp
- * 	result if a namespace qualified pattern refers to a namespace
- * 	that does not exist.  Otherwise, returns TCL_OK.
+ *	Returns TCL_ERROR and records an error message in the interp result if
+ *	a namespace qualified pattern refers to a namespace that does not
+ *	exist. Otherwise, returns TCL_OK.
  *
  * Side effects:
- *	May delete commands. 
+ *	May delete commands.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ForgetImport(interp, namespacePtr, pattern)
-    Tcl_Interp *interp;		 /* Current interpreter. */
-    Tcl_Namespace *namespacePtr; /* Points to the namespace from which
-				  * previously imported commands should be
-				  * removed. NULL for current namespace. */
-    CONST char *pattern;	 /* String pattern indicating which imported
-				  * commands to remove. */
+Tcl_ForgetImport(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Namespace *namespacePtr,/* Points to the namespace from which
+				 * previously imported commands should be
+				 * removed. NULL for current namespace. */
+    const char *pattern)	/* String pattern indicating which imported
+				 * commands to remove. */
 {
     Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
-    CONST char *simplePattern;
+    const char *simplePattern;
     char *cmdName;
     register Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
@@ -1353,14 +1720,14 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
      */
 
     if (namespacePtr == NULL) {
-        nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     } else {
-        nsPtr = (Namespace *) namespacePtr;
+	nsPtr = (Namespace *) namespacePtr;
     }
 
     /*
-     * Parse the pattern into its namespace-qualification (if any)
-     * and the simple pattern.
+     * Parse the pattern into its namespace-qualification (if any) and the
+     * simple pattern.
      */
 
     TclGetNamespaceForQualName(interp, pattern, nsPtr,
@@ -1368,22 +1735,33 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
 	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (sourceNsPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	Tcl_AppendResult(interp,
 		"unknown namespace in namespace forget pattern \"",
-		pattern, "\"", (char *) NULL);
-        return TCL_ERROR;
+		pattern, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
+	return TCL_ERROR;
     }
 
     if (strcmp(pattern, simplePattern) == 0) {
 	/*
-	 * The pattern is simple.
-	 * Delete any imported commands that match it.
+	 * The pattern is simple. Delete any imported commands that match it.
 	 */
 
+	if (TclMatchIsTrivial(simplePattern)) {
+	    Command *cmdPtr;
+
+	    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
+	    if ((hPtr != NULL)
+		    && (cmdPtr = Tcl_GetHashValue(hPtr))
+		    && (cmdPtr->deleteProc == DeleteImportedCmd)) {
+		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	    }
+	    return TCL_OK;
+	}
 	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-		(hPtr != NULL);
-		hPtr = Tcl_NextHashEntry(&search)) {
-	    Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+		(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
+	    Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
 	    if (cmdPtr->deleteProc != DeleteImportedCmd) {
 		continue;
 	    }
@@ -1395,26 +1773,29 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
 	return TCL_OK;
     }
 
-    /* The pattern was namespace-qualified */
+    /*
+     * The pattern was namespace-qualified.
+     */
 
     for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);
 	    hPtr = Tcl_NextHashEntry(&search)) {
 	Tcl_CmdInfo info;
-	Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr);
+	Tcl_Command token = Tcl_GetHashValue(hPtr);
 	Tcl_Command origin = TclGetOriginalCommand(token);
 
 	if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {
-	    continue;	/* Not an imported command */
+	    continue;			/* Not an imported command. */
 	}
 	if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
 	    /*
-	     * Original not in namespace we're matching.
-	     * Check the first link in the import chain.
+	     * Original not in namespace we're matching. Check the first link
+	     * in the import chain.
 	     */
+
 	    Command *cmdPtr = (Command *) token;
-	    ImportedCmdData *dataPtr =
-		    (ImportedCmdData *) cmdPtr->objClientData;
+	    ImportedCmdData *dataPtr = cmdPtr->objClientData;
 	    Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
+
 	    if (firstToken == origin) {
 		continue;
 	    }
@@ -1438,15 +1819,15 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
  *
  *	An imported command is created in an namespace when a "real" command
  *	is imported from another namespace. If the specified command is an
- *	imported command, this procedure returns the original command it
- *	refers to. 
+ *	imported command, this function returns the original command it refers
+ *	to.
  *
  * Results:
  *	If the command was imported into a sequence of namespaces a, b,...,n
  *	where each successive namespace just imports the command from the
- *	previous namespace, this procedure returns the Tcl_Command token in
- *	the first namespace, a. Otherwise, if the specified command is not
- *	an imported command, the procedure returns NULL.
+ *	previous namespace, this function returns the Tcl_Command token in the
+ *	first namespace, a. Otherwise, if the specified command is not an
+ *	imported command, the function returns NULL.
  *
  * Side effects:
  *	None.
@@ -1455,19 +1836,19 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
  */
 
 Tcl_Command
-TclGetOriginalCommand(command)
-    Tcl_Command command;	/* The imported command for which the
-				 * original command should be returned. */
+TclGetOriginalCommand(
+    Tcl_Command command)	/* The imported command for which the original
+				 * command should be returned. */
 {
     register Command *cmdPtr = (Command *) command;
     ImportedCmdData *dataPtr;
 
     if (cmdPtr->deleteProc != DeleteImportedCmd) {
-	return (Tcl_Command) NULL;
+	return NULL;
     }
-    
+
     while (cmdPtr->deleteProc == DeleteImportedCmd) {
-	dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
+	dataPtr = cmdPtr->objClientData;
 	cmdPtr = dataPtr->realCmdPtr;
     }
     return (Tcl_Command) cmdPtr;
@@ -1478,33 +1859,33 @@ TclGetOriginalCommand(command)
  *
  * InvokeImportedCmd --
  *
- *	Invoked by Tcl whenever the user calls an imported command that
- *	was created by Tcl_Import. Finds the "real" command (in another
+ *	Invoked by Tcl whenever the user calls an imported command that was
+ *	created by Tcl_Import. Finds the "real" command (in another
  *	namespace), and passes control to it.
  *
  * Results:
- *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result object is set to an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result object is set to an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-InvokeImportedCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Points to the imported command's
+InvokeImportedCmd(
+    ClientData clientData,	/* Points to the imported command's
 				 * ImportedCmdData structure. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    register ImportedCmdData *dataPtr = clientData;
     register Command *realCmdPtr = dataPtr->realCmdPtr;
 
     return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
-            objc, objv);
+	    objc, objv);
 }
 
 /*
@@ -1513,11 +1894,11 @@ InvokeImportedCmd(clientData, interp, objc, objv)
  * DeleteImportedCmd --
  *
  *	Invoked by Tcl whenever an imported command is deleted. The "real"
- *	command keeps a list of all the imported commands that refer to it,
- *	so those imported commands can be deleted when the real command is
- *	deleted. This procedure removes the imported command reference from
- *	the real command's list, and frees up the memory associated with
- *	the imported command.
+ *	command keeps a list of all the imported commands that refer to it, so
+ *	those imported commands can be deleted when the real command is
+ *	deleted. This function removes the imported command reference from the
+ *	real command's list, and frees up the memory associated with the
+ *	imported command.
  *
  * Results:
  *	None.
@@ -1529,25 +1910,25 @@ InvokeImportedCmd(clientData, interp, objc, objv)
  */
 
 static void
-DeleteImportedCmd(clientData)
-    ClientData clientData;	/* Points to the imported command's
+DeleteImportedCmd(
+    ClientData clientData)	/* Points to the imported command's
 				 * ImportedCmdData structure. */
 {
-    ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    ImportedCmdData *dataPtr = clientData;
     Command *realCmdPtr = dataPtr->realCmdPtr;
     Command *selfPtr = dataPtr->selfPtr;
     register ImportRef *refPtr, *prevPtr;
 
     prevPtr = NULL;
-    for (refPtr = realCmdPtr->importRefPtr;  refPtr != NULL;
-            refPtr = refPtr->nextPtr) {
+    for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
+	    refPtr = refPtr->nextPtr) {
 	if (refPtr->importedCmdPtr == selfPtr) {
 	    /*
 	     * Remove *refPtr from real command's list of imported commands
 	     * that refer to it.
 	     */
-	    
-	    if (prevPtr == NULL) { /* refPtr is first in list */
+
+	    if (prevPtr == NULL) { /* refPtr is first in list. */
 		realCmdPtr->importRefPtr = refPtr->nextPtr;
 	    } else {
 		prevPtr->nextPtr = refPtr->nextPtr;
@@ -1558,8 +1939,8 @@ DeleteImportedCmd(clientData)
 	}
 	prevPtr = refPtr;
     }
-	
-    panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
+
+    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
 }
 
 /*
@@ -1568,162 +1949,157 @@ DeleteImportedCmd(clientData)
  * TclGetNamespaceForQualName --
  *
  *	Given a qualified name specifying a command, variable, or namespace,
- *	and a namespace in which to resolve the name, this procedure returns
- *	a pointer to the namespace that contains the item. A qualified name
- *	consists of the "simple" name of an item qualified by the names of
- *	an arbitrary number of containing namespace separated by "::"s. If
- *	the qualified name starts with "::", it is interpreted absolutely
- *	from the global namespace. Otherwise, it is interpreted relative to
- *	the namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr
- *	is NULL, the name is interpreted relative to the current namespace.
- *
- *	A relative name like "foo::bar::x" can be found starting in either
- *	the current namespace or in the global namespace. So each search
- *	usually follows two tracks, and two possible namespaces are
- *	returned. If the procedure sets either *nsPtrPtr or *altNsPtrPtr to
- *	NULL, then that path failed.
+ *	and a namespace in which to resolve the name, this function returns a
+ *	pointer to the namespace that contains the item. A qualified name
+ *	consists of the "simple" name of an item qualified by the names of an
+ *	arbitrary number of containing namespace separated by "::"s. If the
+ *	qualified name starts with "::", it is interpreted absolutely from the
+ *	global namespace. Otherwise, it is interpreted relative to the
+ *	namespace specified by cxtNsPtr if it is non-NULL. If cxtNsPtr is
+ *	NULL, the name is interpreted relative to the current namespace.
+ *
+ *	A relative name like "foo::bar::x" can be found starting in either the
+ *	current namespace or in the global namespace. So each search usually
+ *	follows two tracks, and two possible namespaces are returned. If the
+ *	function sets either *nsPtrPtr or *altNsPtrPtr to NULL, then that path
+ *	failed.
  *
  *	If "flags" contains TCL_GLOBAL_ONLY, the relative qualified name is
- *	sought only in the global :: namespace. The alternate search
- *	(also) starting from the global namespace is ignored and
- *	*altNsPtrPtr is set NULL. 
- *
- *	If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified
- *	name is sought only in the namespace specified by cxtNsPtr. The
- *	alternate search starting from the global namespace is ignored and
- *	*altNsPtrPtr is set NULL. If both TCL_GLOBAL_ONLY and
- *	TCL_NAMESPACE_ONLY are specified, TCL_GLOBAL_ONLY is ignored and
- *	the search starts from the namespace specified by cxtNsPtr.
- *
- *	If "flags" contains CREATE_NS_IF_UNKNOWN, all namespace
- *	components of the qualified name that cannot be found are
- *	automatically created within their specified parent. This makes sure
- *	that functions like Tcl_CreateCommand always succeed. There is no
- *	alternate search path, so *altNsPtrPtr is set NULL.
- *
- *	If "flags" contains FIND_ONLY_NS, the qualified name is treated as a
- *	reference to a namespace, and the entire qualified name is
- *	followed. If the name is relative, the namespace is looked up only
- *	in the current namespace. A pointer to the namespace is stored in
- *	*nsPtrPtr and NULL is stored in *simpleNamePtr. Otherwise, if
- *	FIND_ONLY_NS is not specified, only the leading components are
- *	treated as namespace names, and a pointer to the simple name of the
- *	final component is stored in *simpleNamePtr.
+ *	sought only in the global :: namespace. The alternate search (also)
+ *	starting from the global namespace is ignored and *altNsPtrPtr is set
+ *	NULL.
+ *
+ *	If "flags" contains TCL_NAMESPACE_ONLY, the relative qualified name is
+ *	sought only in the namespace specified by cxtNsPtr. The alternate
+ *	search starting from the global namespace is ignored and *altNsPtrPtr
+ *	is set NULL. If both TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY are
+ *	specified, TCL_GLOBAL_ONLY is ignored and the search starts from the
+ *	namespace specified by cxtNsPtr.
+ *
+ *	If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, all namespace components
+ *	of the qualified name that cannot be found are automatically created
+ *	within their specified parent. This makes sure that functions like
+ *	Tcl_CreateCommand always succeed. There is no alternate search path,
+ *	so *altNsPtrPtr is set NULL.
+ *
+ *	If "flags" contains TCL_FIND_ONLY_NS, the qualified name is treated as
+ *	a reference to a namespace, and the entire qualified name is followed.
+ *	If the name is relative, the namespace is looked up only in the
+ *	current namespace. A pointer to the namespace is stored in *nsPtrPtr
+ *	and NULL is stored in *simpleNamePtr. Otherwise, if TCL_FIND_ONLY_NS
+ *	is not specified, only the leading components are treated as namespace
+ *	names, and a pointer to the simple name of the final component is
+ *	stored in *simpleNamePtr.
  *
  * Results:
  *	It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible
  *	namespaces which represent the last (containing) namespace in the
- *	qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr
- *	to NULL, then the search along that path failed.  The procedure also
+ *	qualified name. If the function sets either *nsPtrPtr or *altNsPtrPtr
+ *	to NULL, then the search along that path failed. The function also
  *	stores a pointer to the simple name of the final component in
  *	*simpleNamePtr. If the qualified name is "::" or was treated as a
- *	namespace reference (FIND_ONLY_NS), the procedure stores a pointer
+ *	namespace reference (TCL_FIND_ONLY_NS), the function stores a pointer
  *	to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
  *	*simpleNamePtr to point to an empty string.
  *
- *	If there is an error, this procedure returns TCL_ERROR. If "flags"
+ *	If there is an error, this function returns TCL_ERROR. If "flags"
  *	contains TCL_LEAVE_ERR_MSG, an error message is returned in the
  *	interpreter's result object. Otherwise, the interpreter's result
  *	object is left unchanged.
  *
- *	*actualCxtPtrPtr is set to the actual context namespace. It is
- *	set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
- *	is NULL, it is set to the current namespace context.
+ *	*actualCxtPtrPtr is set to the actual context namespace. It is set to
+ *	the input context namespace pointer in cxtNsPtr. If cxtNsPtr is NULL,
+ *	it is set to the current namespace context.
  *
- *	For backwards compatibility with the TclPro byte code loader,
- *	this function always returns TCL_OK.
+ *	For backwards compatibility with the TclPro byte code loader, this
+ *	function always returns TCL_OK.
  *
  * Side effects:
- *	If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
+ *	If "flags" contains TCL_CREATE_NS_IF_UNKNOWN, new namespaces may be
  *	created.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
-	nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
-    Tcl_Interp *interp;		 /* Interpreter in which to find the
-				  * namespace containing qualName. */
-    CONST char *qualName;	 /* A namespace-qualified name of an
-				  * command, variable, or namespace. */
-    Namespace *cxtNsPtr;	 /* The namespace in which to start the
-				  * search for qualName's namespace. If NULL
-				  * start from the current namespace.
-				  * Ignored if TCL_GLOBAL_ONLY is set. */
-    int flags;			 /* Flags controlling the search: an OR'd
-				  * combination of TCL_GLOBAL_ONLY,
-				  * TCL_NAMESPACE_ONLY,
-				  * CREATE_NS_IF_UNKNOWN, and
-				  * FIND_ONLY_NS. */
-    Namespace **nsPtrPtr;	 /* Address where procedure stores a pointer
-				  * to containing namespace if qualName is
-				  * found starting from *cxtNsPtr or, if
-				  * TCL_GLOBAL_ONLY is set, if qualName is
-				  * found in the global :: namespace. NULL
-				  * is stored otherwise. */
-    Namespace **altNsPtrPtr;	 /* Address where procedure stores a pointer
-				  * to containing namespace if qualName is
-				  * found starting from the global ::
-				  * namespace. NULL is stored if qualName
-				  * isn't found starting from :: or if the
-				  * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
-				  * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag
-				  * is set. */
-    Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer
-				  * to the actual namespace from which the
-				  * search started. This is either cxtNsPtr,
-				  * the :: namespace if TCL_GLOBAL_ONLY was
-				  * specified, or the current namespace if
-				  * cxtNsPtr was NULL. */
-    CONST char **simpleNamePtr;	 /* Address where procedure stores the
-				  * simple name at end of the qualName, or
-				  * NULL if qualName is "::" or the flag
-				  * FIND_ONLY_NS was specified. */
+TclGetNamespaceForQualName(
+    Tcl_Interp *interp,		/* Interpreter in which to find the namespace
+				 * containing qualName. */
+    const char *qualName,	/* A namespace-qualified name of an command,
+				 * variable, or namespace. */
+    Namespace *cxtNsPtr,	/* The namespace in which to start the search
+				 * for qualName's namespace. If NULL start
+				 * from the current namespace. Ignored if
+				 * TCL_GLOBAL_ONLY is set. */
+    int flags,			/* Flags controlling the search: an OR'd
+				 * combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS, and
+				 * TCL_CREATE_NS_IF_UNKNOWN. */
+    Namespace **nsPtrPtr,	/* Address where function stores a pointer to
+				 * containing namespace if qualName is found
+				 * starting from *cxtNsPtr or, if
+				 * TCL_GLOBAL_ONLY is set, if qualName is
+				 * found in the global :: namespace. NULL is
+				 * stored otherwise. */
+    Namespace **altNsPtrPtr,	/* Address where function stores a pointer to
+				 * containing namespace if qualName is found
+				 * starting from the global :: namespace.
+				 * NULL is stored if qualName isn't found
+				 * starting from :: or if the TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, TCL_FIND_ONLY_NS,
+				 * TCL_CREATE_NS_IF_UNKNOWN flag is set. */
+    Namespace **actualCxtPtrPtr,/* Address where function stores a pointer to
+				 * the actual namespace from which the search
+				 * started. This is either cxtNsPtr, the ::
+				 * namespace if TCL_GLOBAL_ONLY was specified,
+				 * or the current namespace if cxtNsPtr was
+				 * NULL. */
+    const char **simpleNamePtr) /* Address where function stores the simple
+				 * name at end of the qualName, or NULL if
+				 * qualName is "::" or the flag
+				 * TCL_FIND_ONLY_NS was specified. */
 {
     Interp *iPtr = (Interp *) interp;
     Namespace *nsPtr = cxtNsPtr;
     Namespace *altNsPtr;
     Namespace *globalNsPtr = iPtr->globalNsPtr;
-    CONST char *start, *end;
-    CONST char *nsName;
+    const char *start, *end;
+    const char *nsName;
     Tcl_HashEntry *entryPtr;
     Tcl_DString buffer;
     int len;
 
     /*
      * Determine the context namespace nsPtr in which to start the primary
-     * search.  If the qualName name starts with a "::" or TCL_GLOBAL_ONLY
-     * was specified, search from the global namespace. Otherwise, use the
+     * search. If the qualName name starts with a "::" or TCL_GLOBAL_ONLY was
+     * specified, search from the global namespace. Otherwise, use the
      * namespace given in cxtNsPtr, or if that is NULL, use the current
-     * namespace context. Note that we always treat two or more
-     * adjacent ":"s as a namespace separator.
+     * namespace context. Note that we always treat two or more adjacent ":"s
+     * as a namespace separator.
      */
 
     if (flags & TCL_GLOBAL_ONLY) {
 	nsPtr = globalNsPtr;
     } else if (nsPtr == NULL) {
-	if (iPtr->varFramePtr != NULL) {
-	    nsPtr = iPtr->varFramePtr->nsPtr;
-	} else {
-	    nsPtr = iPtr->globalNsPtr;
-	}
+	nsPtr = iPtr->varFramePtr->nsPtr;
     }
 
-    start = qualName;		/* pts to start of qualifying namespace */
+    start = qualName;			/* Points to start of qualifying
+					 * namespace. */
     if ((*qualName == ':') && (*(qualName+1) == ':')) {
-	start = qualName+2;	/* skip over the initial :: */
+	start = qualName+2;		/* Skip over the initial :: */
 	while (*start == ':') {
-            start++;		/* skip over a subsequent : */
+	    start++;			/* Skip over a subsequent : */
 	}
-        nsPtr = globalNsPtr;
-        if (*start == '\0') {	/* qualName is just two or more ":"s */
-            *nsPtrPtr        = globalNsPtr;
-            *altNsPtrPtr     = NULL;
+	nsPtr = globalNsPtr;
+	if (*start == '\0') {		/* qualName is just two or more
+					 * ":"s. */
+	    *nsPtrPtr = globalNsPtr;
+	    *altNsPtrPtr = NULL;
 	    *actualCxtPtrPtr = globalNsPtr;
-            *simpleNamePtr   = start; /* points to empty string */
-            return TCL_OK;
-        }
+	    *simpleNamePtr = start;	/* Points to empty string. */
+	    return TCL_OK;
+	}
     }
     *actualCxtPtrPtr = nsPtr;
 
@@ -1736,8 +2112,8 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
 
     altNsPtr = globalNsPtr;
     if ((nsPtr == globalNsPtr)
-	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
-        altNsPtr = NULL;
+	    || (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS))) {
+	altNsPtr = NULL;
     }
 
     /*
@@ -1747,38 +2123,37 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
     Tcl_DStringInit(&buffer);
     end = start;
     while (*start != '\0') {
-        /*
-         * Find the next namespace qualifier (i.e., a name ending in "::")
-	 * or the end of the qualified name  (i.e., a name ending in "\0").
-	 * Set len to the number of characters, starting from start,
-	 * in the name; set end to point after the "::"s or at the "\0".
-         */
+	/*
+	 * Find the next namespace qualifier (i.e., a name ending in "::") or
+	 * the end of the qualified name (i.e., a name ending in "\0"). Set
+	 * len to the number of characters, starting from start, in the name;
+	 * set end to point after the "::"s or at the "\0".
+	 */
 
 	len = 0;
-        for (end = start;  *end != '\0';  end++) {
+	for (end = start;  *end != '\0';  end++) {
 	    if ((*end == ':') && (*(end+1) == ':')) {
-		end += 2;	/* skip over the initial :: */
+		end += 2;		/* Skip over the initial :: */
 		while (*end == ':') {
-		    end++;	/* skip over the subsequent : */
+		    end++;		/* Skip over the subsequent : */
 		}
-		break;		/* exit for loop; end is after ::'s */
+		break;			/* Exit for loop; end is after ::'s */
 	    }
-            len++;
+	    len++;
 	}
 
-	if ((*end == '\0')
-	        && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {
+	if (*end=='\0' && !(end-start>=2 && *(end-1)==':' && *(end-2)==':')) {
 	    /*
-	     * qualName ended with a simple name at start. If FIND_ONLY_NS
-	     * was specified, look this up as a namespace. Otherwise,
-	     * start is the name of a cmd or var and we are done.
+	     * qualName ended with a simple name at start. If TCL_FIND_ONLY_NS
+	     * was specified, look this up as a namespace. Otherwise, start is
+	     * the name of a cmd or var and we are done.
 	     */
-	    
-	    if (flags & FIND_ONLY_NS) {
+
+	    if (flags & TCL_FIND_ONLY_NS) {
 		nsName = start;
 	    } else {
-		*nsPtrPtr      = nsPtr;
-		*altNsPtrPtr   = altNsPtr;
+		*nsPtrPtr = nsPtr;
+		*altNsPtrPtr = altNsPtr;
 		*simpleNamePtr = start;
 		Tcl_DStringFree(&buffer);
 		return TCL_OK;
@@ -1787,69 +2162,70 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
 	    /*
 	     * start points to the beginning of a namespace qualifier ending
 	     * in "::". end points to the start of a name in that namespace
-	     * that might be empty. Copy the namespace qualifier to a
-	     * buffer so it can be null terminated. We can't modify the
-	     * incoming qualName since it may be a string constant.
+	     * that might be empty. Copy the namespace qualifier to a buffer
+	     * so it can be null terminated. We can't modify the incoming
+	     * qualName since it may be a string constant.
 	     */
 
 	    Tcl_DStringSetLength(&buffer, 0);
-            Tcl_DStringAppend(&buffer, start, len);
-            nsName = Tcl_DStringValue(&buffer);
-        }
+	    Tcl_DStringAppend(&buffer, start, len);
+	    nsName = Tcl_DStringValue(&buffer);
+	}
 
-        /*
+	/*
 	 * Look up the namespace qualifier nsName in the current namespace
-         * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,
-         * create that qualifying namespace. This is needed for procedures
-         * like Tcl_CreateCommand that cannot fail.
+	 * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set,
+	 * create that qualifying namespace. This is needed for functions like
+	 * Tcl_CreateCommand that cannot fail.
+	 */
+
+	if (nsPtr != NULL) {
+	    entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+	    if (entryPtr != NULL) {
+		nsPtr = Tcl_GetHashValue(entryPtr);
+	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
+		Tcl_CallFrame *framePtr;
+
+		(void) TclPushStackFrame(interp, &framePtr,
+			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
+
+		nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
+			NULL, NULL);
+		TclPopStackFrame(interp);
+
+		if (nsPtr == NULL) {
+		    Tcl_Panic("Could not create namespace '%s'", nsName);
+		}
+	    } else {			/* Namespace not found and was not
+					 * created. */
+		nsPtr = NULL;
+	    }
+	}
+
+	/*
+	 * Look up the namespace qualifier in the alternate search path too.
 	 */
 
-        if (nsPtr != NULL) {
-            entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
-            if (entryPtr != NULL) {
-                nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
-            } else if (flags & CREATE_NS_IF_UNKNOWN) {
-		Tcl_CallFrame frame;
-		
-		(void) Tcl_PushCallFrame(interp, &frame,
-		        (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
-
-                nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
-		        (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
-                Tcl_PopCallFrame(interp);
-
-                if (nsPtr == NULL) {
-                    panic("Could not create namespace '%s'", nsName);
-                }
-            } else {		/* namespace not found and wasn't created */
-                nsPtr = NULL;
-            }
-        }
-
-        /*
-         * Look up the namespace qualifier in the alternate search path too.
-         */
-
-        if (altNsPtr != NULL) {
-            entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
-            if (entryPtr != NULL) {
-                altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
-            } else {
-                altNsPtr = NULL;
-            }
-        }
-
-        /*
-         * If both search paths have failed, return NULL results.
-         */
-
-        if ((nsPtr == NULL) && (altNsPtr == NULL)) {
-            *nsPtrPtr      = NULL;
-            *altNsPtrPtr   = NULL;
-            *simpleNamePtr = NULL;
-            Tcl_DStringFree(&buffer);
-            return TCL_OK;
-        }
+	if (altNsPtr != NULL) {
+	    entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
+	    if (entryPtr != NULL) {
+		altNsPtr = Tcl_GetHashValue(entryPtr);
+	    } else {
+		altNsPtr = NULL;
+	    }
+	}
+
+	/*
+	 * If both search paths have failed, return NULL results.
+	 */
+
+	if ((nsPtr == NULL) && (altNsPtr == NULL)) {
+	    *nsPtrPtr = NULL;
+	    *altNsPtrPtr = NULL;
+	    *simpleNamePtr = NULL;
+	    Tcl_DStringFree(&buffer);
+	    return TCL_OK;
+	}
 
 	start = end;
     }
@@ -1859,26 +2235,26 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
      * variable name, trailing "::"s refer to the cmd or var named {}.
      */
 
-    if ((flags & FIND_ONLY_NS)
-	    || ((end > start ) && (*(end-1) != ':'))) {
-	*simpleNamePtr = NULL; /* found namespace name */
+    if ((flags & TCL_FIND_ONLY_NS) || (end>start && *(end-1)!=':')) {
+	*simpleNamePtr = NULL;		/* Found namespace name. */
     } else {
-	*simpleNamePtr = end;  /* found cmd/var: points to empty string */
+	*simpleNamePtr = end;		/* Found cmd/var: points to empty
+					 * string. */
     }
 
     /*
-     * As a special case, if we are looking for a namespace and qualName
-     * is "" and the current active namespace (nsPtr) is not the global
-     * namespace, return NULL (no namespace was found). This is because
-     * namespaces can not have empty names except for the global namespace.
+     * As a special case, if we are looking for a namespace and qualName is ""
+     * and the current active namespace (nsPtr) is not the global namespace,
+     * return NULL (no namespace was found). This is because namespaces can
+     * not have empty names except for the global namespace.
      */
 
-    if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
+    if ((flags & TCL_FIND_ONLY_NS) && (*qualName == '\0')
 	    && (nsPtr != globalNsPtr)) {
 	nsPtr = NULL;
     }
 
-    *nsPtrPtr    = nsPtr;
+    *nsPtrPtr = nsPtr;
     *altNsPtrPtr = altNsPtr;
     Tcl_DStringFree(&buffer);
     return TCL_OK;
@@ -1892,9 +2268,9 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
  *	Searches for a namespace.
  *
  * Results:
- *	Returns a pointer to the namespace if it is found. Otherwise,
- *	returns NULL and leaves an error message in the interpreter's
- *	result object if "flags" contains TCL_LEAVE_ERR_MSG.
+ *	Returns a pointer to the namespace if it is found. Otherwise, returns
+ *	NULL and leaves an error message in the interpreter's result object if
+ *	"flags" contains TCL_LEAVE_ERR_MSG.
  *
  * Side effects:
  *	None.
@@ -1903,41 +2279,41 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
  */
 
 Tcl_Namespace *
-Tcl_FindNamespace(interp, name, contextNsPtr, flags)
-    Tcl_Interp *interp;		 /* The interpreter in which to find the
-				  * namespace. */
-    CONST char *name;		 /* Namespace name. If it starts with "::",
-				  * will be looked up in global namespace.
-				  * Else, looked up first in contextNsPtr
-				  * (current namespace if contextNsPtr is
-				  * NULL), then in global namespace. */
-    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag is set
-				  * or if the name starts with "::".
-				  * Otherwise, points to namespace in which
-				  * to resolve name; if NULL, look up name
-				  * in the current namespace. */
-    register int flags;		 /* Flags controlling namespace lookup: an
-				  * OR'd combination of TCL_GLOBAL_ONLY and
-				  * TCL_LEAVE_ERR_MSG flags. */
+Tcl_FindNamespace(
+    Tcl_Interp *interp,		/* The interpreter in which to find the
+				 * namespace. */
+    const char *name,		/* Namespace name. If it starts with "::",
+				 * will be looked up in global namespace.
+				 * Else, looked up first in contextNsPtr
+				 * (current namespace if contextNsPtr is
+				 * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or
+				 * if the name starts with "::". Otherwise,
+				 * points to namespace in which to resolve
+				 * name; if NULL, look up name in the current
+				 * namespace. */
+    register int flags)		/* Flags controlling namespace lookup: an OR'd
+				 * combination of TCL_GLOBAL_ONLY and
+				 * TCL_LEAVE_ERR_MSG flags. */
 {
     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
-    CONST char *dummy;
+    const char *dummy;
 
     /*
-     * Find the namespace(s) that contain the specified namespace name.
-     * Add the FIND_ONLY_NS flag to resolve the name all the way down
-     * to its last component, a namespace.
+     * Find the namespace(s) that contain the specified namespace name. Add
+     * the TCL_FIND_ONLY_NS flag to resolve the name all the way down to its
+     * last component, a namespace.
      */
 
     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-	    (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
-    
+	    flags|TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
     if (nsPtr != NULL) {
-       return (Tcl_Namespace *) nsPtr;
+	return (Tcl_Namespace *) nsPtr;
     } else if (flags & TCL_LEAVE_ERR_MSG) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "unknown namespace \"", name, "\"", (char *) NULL);
+	Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
     }
     return NULL;
 }
@@ -1950,10 +2326,10 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
  *	Searches for a command.
  *
  * Results:
- *	Returns a token for the command if it is found. Otherwise, if it
- *	can't be found or there is an error, returns NULL and leaves an
- *	error message in the interpreter's result object if "flags"
- *	contains TCL_LEAVE_ERR_MSG.
+ *	Returns a token for the command if it is found. Otherwise, if it can't
+ *	be found or there is an error, returns NULL and leaves an error
+ *	message in the interpreter's result object if "flags" contains
+ *	TCL_LEAVE_ERR_MSG.
  *
  * Side effects:
  *	None.
@@ -1962,244 +2338,171 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
  */
 
 Tcl_Command
-Tcl_FindCommand(interp, name, contextNsPtr, flags)
-    Tcl_Interp *interp;         /* The interpreter in which to find the
-				  * command and to report errors. */
-    CONST char *name;	         /* Command's name. If it starts with "::",
-				  * will be looked up in global namespace.
-				  * Else, looked up first in contextNsPtr
-				  * (current namespace if contextNsPtr is
-				  * NULL), then in global namespace. */
-    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
-				  * Otherwise, points to namespace in which
-				  * to resolve name. If NULL, look up name
-				  * in the current namespace. */
-    int flags;                   /* An OR'd combination of flags:
-				  * TCL_GLOBAL_ONLY (look up name only in
-				  * global namespace), TCL_NAMESPACE_ONLY
-				  * (look up only in contextNsPtr, or the
-				  * current namespace if contextNsPtr is
-				  * NULL), and TCL_LEAVE_ERR_MSG. If both
-				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
-				  * are given, TCL_GLOBAL_ONLY is
-				  * ignored. */
-{
-    Interp *iPtr = (Interp*)interp;
-
-    ResolverScheme *resPtr;
-    Namespace *nsPtr[2], *cxtNsPtr;
-    CONST char *simpleName;
+Tcl_FindCommand(
+    Tcl_Interp *interp,		/* The interpreter in which to find the
+				 * command and to report errors. */
+    const char *name,		/* Command's name. If it starts with "::",
+				 * will be looked up in global namespace.
+				 * Else, looked up first in contextNsPtr
+				 * (current namespace if contextNsPtr is
+				 * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+				 * Otherwise, points to namespace in which to
+				 * resolve name. If NULL, look up name in the
+				 * current namespace. */
+    int flags)			/* An OR'd combination of flags:
+				 * TCL_GLOBAL_ONLY (look up name only in
+				 * global namespace), TCL_NAMESPACE_ONLY (look
+				 * up only in contextNsPtr, or the current
+				 * namespace if contextNsPtr is NULL), and
+				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY are given,
+				 * TCL_GLOBAL_ONLY is ignored. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Namespace *cxtNsPtr;
     register Tcl_HashEntry *entryPtr;
     register Command *cmdPtr;
-    register int search;
+    const char *simpleName;
     int result;
-    Tcl_Command cmd;
 
     /*
-     * If this namespace has a command resolver, then give it first
-     * crack at the command resolution.  If the interpreter has any
-     * command resolvers, consult them next.  The command resolver
-     * procedures may return a Tcl_Command value, they may signal
-     * to continue onward, or they may signal an error.
+     * If this namespace has a command resolver, then give it first crack at
+     * the command resolution. If the interpreter has any command resolvers,
+     * consult them next. The command resolver functions may return a
+     * Tcl_Command value, they may signal to continue onward, or they may
+     * signal an error.
      */
-    if ((flags & TCL_GLOBAL_ONLY) != 0) {
-        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    }
-    else if (contextNsPtr != NULL) {
-        cxtNsPtr = (Namespace *) contextNsPtr;
-    }
-    else {
-        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+
+    if ((flags & TCL_GLOBAL_ONLY) || !strncmp(name, "::", 2)) {
+	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
+    } else if (contextNsPtr != NULL) {
+	cxtNsPtr = (Namespace *) contextNsPtr;
+    } else {
+	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     }
 
     if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
-        resPtr = iPtr->resolverPtr;
+	ResolverScheme *resPtr = iPtr->resolverPtr;
+	Tcl_Command cmd;
 
-        if (cxtNsPtr->cmdResProc) {
-            result = (*cxtNsPtr->cmdResProc)(interp, name,
-                (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
-        } else {
-            result = TCL_CONTINUE;
-        }
+	if (cxtNsPtr->cmdResProc) {
+	    result = (*cxtNsPtr->cmdResProc)(interp, name,
+		    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+	} else {
+	    result = TCL_CONTINUE;
+	}
 
-        while (result == TCL_CONTINUE && resPtr) {
-            if (resPtr->cmdResProc) {
-                result = (*resPtr->cmdResProc)(interp, name,
-                    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
-            }
-            resPtr = resPtr->nextPtr;
-        }
+	while (result == TCL_CONTINUE && resPtr) {
+	    if (resPtr->cmdResProc) {
+		result = (*resPtr->cmdResProc)(interp, name,
+			(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
+	    }
+	    resPtr = resPtr->nextPtr;
+	}
 
-        if (result == TCL_OK) {
-            return cmd;
-        }
-        else if (result != TCL_CONTINUE) {
-            return (Tcl_Command) NULL;
-        }
+	if (result == TCL_OK) {
+	    return cmd;
+	} else if (result != TCL_CONTINUE) {
+	    return NULL;
+	}
     }
 
     /*
      * Find the namespace(s) that contain the command.
      */
 
-    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
-
-    /*
-     * Look for the command in the command table of its namespace.
-     * Be sure to check both possible search paths: from the specified
-     * namespace context and from the global namespace.
-     */
-
     cmdPtr = NULL;
-    for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
-        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
-	    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
-		    simpleName);
-	    if (entryPtr != NULL) {
-		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
+	    && !(flags & TCL_NAMESPACE_ONLY)) {
+	int i;
+	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;
+
+	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
+		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
+		&simpleName);
+	if ((realNsPtr != NULL) && (simpleName != NULL)) {
+	    if ((cxtNsPtr == realNsPtr)
+		    || !(realNsPtr->flags & NS_DYING)) {
+		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
+		if (entryPtr != NULL) {
+		    cmdPtr = Tcl_GetHashValue(entryPtr);
+		}
 	    }
 	}
-    }
-
-    if (cmdPtr != NULL) {
-        return (Tcl_Command) cmdPtr;
-    } else if (flags & TCL_LEAVE_ERR_MSG) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "unknown command \"", name, "\"", (char *) NULL);
-    }
 
-    return (Tcl_Command) NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindNamespaceVar --
- *
- *	Searches for a namespace variable, a variable not local to a
- *	procedure. The variable can be either a scalar or an array, but
- *	may not be an element of an array.
- *
- * Results:
- *	Returns a token for the variable if it is found. Otherwise, if it
- *	can't be found or there is an error, returns NULL and leaves an
- *	error message in the interpreter's result object if "flags"
- *	contains TCL_LEAVE_ERR_MSG.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	/*
+	 * Next, check along the path.
+	 */
 
-Tcl_Var
-Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
-    Tcl_Interp *interp;		 /* The interpreter in which to find the
-				  * variable. */
-    CONST char *name;		 /* Variable's name. If it starts with "::",
-				  * will be looked up in global namespace.
-				  * Else, looked up first in contextNsPtr
-				  * (current namespace if contextNsPtr is
-				  * NULL), then in global namespace. */
-    Tcl_Namespace *contextNsPtr; /* Ignored if TCL_GLOBAL_ONLY flag set.
-				  * Otherwise, points to namespace in which
-				  * to resolve name. If NULL, look up name
-				  * in the current namespace. */
-    int flags;			 /* An OR'd combination of flags:
-				  * TCL_GLOBAL_ONLY (look up name only in
-				  * global namespace), TCL_NAMESPACE_ONLY
-				  * (look up only in contextNsPtr, or the
-				  * current namespace if contextNsPtr is
-				  * NULL), and TCL_LEAVE_ERR_MSG. If both
-				  * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
-				  * are given, TCL_GLOBAL_ONLY is
-				  * ignored. */
-{
-    Interp *iPtr = (Interp*)interp;
-    ResolverScheme *resPtr;
-    Namespace *nsPtr[2], *cxtNsPtr;
-    CONST char *simpleName;
-    Tcl_HashEntry *entryPtr;
-    Var *varPtr;
-    register int search;
-    int result;
-    Tcl_Var var;
+	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
+	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
+	    if (pathNsPtr == NULL) {
+		continue;
+	    }
+	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
+		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
+		    &simpleName);
+	    if ((realNsPtr != NULL) && (simpleName != NULL)
+		    && !(realNsPtr->flags & NS_DYING)) {
+		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
+		if (entryPtr != NULL) {
+		    cmdPtr = Tcl_GetHashValue(entryPtr);
+		}
+	    }
+	}
 
-    /*
-     * If this namespace has a variable resolver, then give it first
-     * crack at the variable resolution.  It may return a Tcl_Var
-     * value, it may signal to continue onward, or it may signal
-     * an error.
-     */
-    if ((flags & TCL_GLOBAL_ONLY) != 0) {
-        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    }
-    else if (contextNsPtr != NULL) {
-        cxtNsPtr = (Namespace *) contextNsPtr;
-    }
-    else {
-        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    }
+	/*
+	 * If we've still not found the command, look in the global namespace
+	 * as a last resort.
+	 */
 
-    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
-        resPtr = iPtr->resolverPtr;
+	if (cmdPtr == NULL) {
+	    (void) TclGetNamespaceForQualName(interp, name, NULL,
+		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
+		    &simpleName);
+	    if ((realNsPtr != NULL) && (simpleName != NULL)
+		    && !(realNsPtr->flags & NS_DYING)) {
+		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
+		if (entryPtr != NULL) {
+		    cmdPtr = Tcl_GetHashValue(entryPtr);
+		}
+	    }
+	}
+    } else {
+	Namespace *nsPtr[2];
+	register int search;
 
-        if (cxtNsPtr->varResProc) {
-            result = (*cxtNsPtr->varResProc)(interp, name,
-                (Tcl_Namespace *) cxtNsPtr, flags, &var);
-        } else {
-            result = TCL_CONTINUE;
-        }
+	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
 
-        while (result == TCL_CONTINUE && resPtr) {
-            if (resPtr->varResProc) {
-                result = (*resPtr->varResProc)(interp, name,
-                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
-            }
-            resPtr = resPtr->nextPtr;
-        }
+	/*
+	 * Look for the command in the command table of its namespace. Be sure
+	 * to check both possible search paths: from the specified namespace
+	 * context and from the global namespace.
+	 */
 
-        if (result == TCL_OK) {
-            return var;
-        }
-        else if (result != TCL_CONTINUE) {
-            return (Tcl_Var) NULL;
-        }
+	for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
+	    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+		entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
+			simpleName);
+		if (entryPtr != NULL) {
+		    cmdPtr = Tcl_GetHashValue(entryPtr);
+		}
+	    }
+	}
     }
 
-    /*
-     * Find the namespace(s) that contain the variable.
-     */
-
-    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
-
-    /*
-     * Look for the variable in the variable table of its namespace.
-     * Be sure to check both possible search paths: from the specified
-     * namespace context and from the global namespace.
-     */
-
-    varPtr = NULL;
-    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
-        if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
-            entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable,
-		    simpleName);
-            if (entryPtr != NULL) {
-                varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-            }
-        }
+    if (cmdPtr != NULL) {
+	return (Tcl_Command) cmdPtr;
     }
-    if (varPtr != NULL) {
-	return (Tcl_Var) varPtr;
-    } else if (flags & TCL_LEAVE_ERR_MSG) {
+
+    if (flags & TCL_LEAVE_ERR_MSG) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                "unknown variable \"", name, "\"", (char *) NULL);
+	Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
     }
-    return (Tcl_Var) NULL;
+    return NULL;
 }
 
 /*
@@ -2211,56 +2514,49 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
  *	command references that the new command may invalidate. Consider the
  *	following cases that could happen when you add a command "foo" to a
  *	namespace "b":
- *	   1. It could shadow a command named "foo" at the global scope.
- *	      If it does, all command references in the namespace "b" are
+ *	   1. It could shadow a command named "foo" at the global scope. If
+ *	      it does, all command references in the namespace "b" are
  *	      suspect.
- *	   2. Suppose the namespace "b" resides in a namespace "a".
- *	      Then to "a" the new command "b::foo" could shadow another
- *	      command "b::foo" in the global namespace. If so, then all
- *	      command references in "a" are suspect.
- *	The same checks are applied to all parent namespaces, until we
- *	reach the global :: namespace.
+ *	   2. Suppose the namespace "b" resides in a namespace "a". Then to
+ *	      "a" the new command "b::foo" could shadow another command
+ *	      "b::foo" in the global namespace. If so, then all command
+ *	      references in "a" * are suspect.
+ *	The same checks are applied to all parent namespaces, until we reach
+ *	the global :: namespace.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	If the new command shadows an existing command, the cmdRefEpoch
- *	counter is incremented in each namespace that sees the shadow.
- *	This invalidates all command references that were previously cached
- *	in that namespace. The next time the commands are used, they are
- *	resolved from scratch.
+ *	counter is incremented in each namespace that sees the shadow. This
+ *	invalidates all command references that were previously cached in that
+ *	namespace. The next time the commands are used, they are resolved from
+ *	scratch.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclResetShadowedCmdRefs(interp, newCmdPtr)
-    Tcl_Interp *interp;	       /* Interpreter containing the new command. */
-    Command *newCmdPtr;	       /* Points to the new command. */
+TclResetShadowedCmdRefs(
+    Tcl_Interp *interp,		/* Interpreter containing the new command. */
+    Command *newCmdPtr)		/* Points to the new command. */
 {
     char *cmdName;
     Tcl_HashEntry *hPtr;
     register Namespace *nsPtr;
     Namespace *trailNsPtr, *shadowNsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
     int found, i;
-
-    /*
-     * This procedure generates an array used to hold the trail list. This
-     * starts out with stack-allocated space but uses dynamically-allocated
-     * storage if needed.
-     */
-
-    Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
-    Namespace **trailPtr = trailStorage;
     int trailFront = -1;
-    int trailSize = NUM_TRAIL_ELEMS;
+    int trailSize = 5;		/* Formerly NUM_TRAIL_ELEMS. */
+    Namespace **trailPtr = (Namespace **)
+	    TclStackAlloc(interp, trailSize * sizeof(Namespace *));
 
     /*
-     * Start at the namespace containing the new command, and work up
-     * through the list of parents. Stop just before the global namespace,
-     * since the global namespace can't "shadow" its own entries.
+     * Start at the namespace containing the new command, and work up through
+     * the list of parents. Stop just before the global namespace, since the
+     * global namespace can't "shadow" its own entries.
      *
      * The namespace "trail" list we build consists of the names of each
      * namespace that encloses the new command, in order from outermost to
@@ -2268,200 +2564,164 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
      * eventually extends the trail upwards by one namespace, nsPtr. We use
      * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
      * now-invalid cached command references. This will happen if nsPtr
-     * (e.g. "a") contains a sequence of child namespaces (e.g. "b")
-     * such that there is a identically-named sequence of child namespaces
-     * starting from :: (e.g. "::b") whose tail namespace contains a command
-     * also named cmdName.
+     * (e.g. "a") contains a sequence of child namespaces (e.g. "b") such that
+     * there is a identically-named sequence of child namespaces starting from
+     * :: (e.g. "::b") whose tail namespace contains a command also named
+     * cmdName.
      */
 
     cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
-    for (nsPtr = newCmdPtr->nsPtr;
-	    (nsPtr != NULL) && (nsPtr != globalNsPtr);
-            nsPtr = nsPtr->parentPtr) {
-        /*
+    for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ;
+	    nsPtr=nsPtr->parentPtr) {
+	/*
 	 * Find the maximal sequence of child namespaces contained in nsPtr
-	 * such that there is a identically-named sequence of child
-	 * namespaces starting from ::. shadowNsPtr will be the tail of this
-	 * sequence, or the deepest namespace under :: that might contain a
-	 * command now shadowed by cmdName. We check below if shadowNsPtr
-	 * actually contains a command cmdName.
+	 * such that there is a identically-named sequence of child namespaces
+	 * starting from ::. shadowNsPtr will be the tail of this sequence, or
+	 * the deepest namespace under :: that might contain a command now
+	 * shadowed by cmdName. We check below if shadowNsPtr actually
+	 * contains a command cmdName.
 	 */
 
-        found = 1;
-        shadowNsPtr = globalNsPtr;
+	found = 1;
+	shadowNsPtr = globalNsPtr;
 
-        for (i = trailFront;  i >= 0;  i--) {
-            trailNsPtr = trailPtr[i];
-            hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
+	for (i = trailFront;  i >= 0;  i--) {
+	    trailNsPtr = trailPtr[i];
+	    hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
 		    trailNsPtr->name);
-            if (hPtr != NULL) {
-                shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);
-            } else {
-                found = 0;
-                break;
-            }
-        }
-
-        /*
-	 * If shadowNsPtr contains a command named cmdName, we invalidate
-         * all of the command refs cached in nsPtr. As a boundary case,
+	    if (hPtr != NULL) {
+		shadowNsPtr = Tcl_GetHashValue(hPtr);
+	    } else {
+		found = 0;
+		break;
+	    }
+	}
+
+	/*
+	 * If shadowNsPtr contains a command named cmdName, we invalidate all
+	 * of the command refs cached in nsPtr. As a boundary case,
 	 * shadowNsPtr is initially :: and we check for case 1. above.
 	 */
 
-        if (found) {
-            hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
-            if (hPtr != NULL) {
-                nsPtr->cmdRefEpoch++;
+	if (found) {
+	    hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
+	    if (hPtr != NULL) {
+		nsPtr->cmdRefEpoch++;
+		TclInvalidateNsPath(nsPtr);
 
-		/* 
+		/*
 		 * If the shadowed command was compiled to bytecodes, we
 		 * invalidate all the bytecodes in nsPtr, to force a new
 		 * compilation. We use the resolverEpoch to signal the need
 		 * for a fresh compilation of every bytecode.
 		 */
 
-		if ((((Command *) Tcl_GetHashValue(hPtr))->compileProc) != NULL) {
+		if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL) {
 		    nsPtr->resolverEpoch++;
 		}
-            }
-        }
+	    }
+	}
 
-        /*
-	 * Insert nsPtr at the front of the trail list: i.e., at the end
-	 * of the trailPtr array.
+	/*
+	 * Insert nsPtr at the front of the trail list: i.e., at the end of
+	 * the trailPtr array.
 	 */
 
 	trailFront++;
 	if (trailFront == trailSize) {
-	    size_t currBytes = trailSize * sizeof(Namespace *);
-	    int newSize = 2*trailSize;
-	    size_t newBytes = newSize * sizeof(Namespace *);
-	    Namespace **newPtr =
-		    (Namespace **) ckalloc((unsigned) newBytes);
-	    
-	    memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);
-	    if (trailPtr != trailStorage) {
-		ckfree((char *) trailPtr);
-	    }
-	    trailPtr = newPtr;
+	    int newSize = 2 * trailSize;
+	    trailPtr = (Namespace **) TclStackRealloc(interp,
+		    trailPtr, newSize * sizeof(Namespace *));
 	    trailSize = newSize;
 	}
 	trailPtr[trailFront] = nsPtr;
     }
-
-    /*
-     * Free any allocated storage.
-     */
-    
-    if (trailPtr != trailStorage) {
-	ckfree((char *) trailPtr);
-    }
+    TclStackFree(interp, trailPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * GetNamespaceFromObj --
+ * TclGetNamespaceFromObj, GetNamespaceFromObj --
  *
  *	Gets the namespace specified by the name in a Tcl_Obj.
  *
  * Results:
- *	Returns TCL_OK if the namespace was resolved successfully, and
- *	stores a pointer to the namespace in the location specified by
- *	nsPtrPtr. If the namespace can't be found, the procedure stores
- *	NULL in *nsPtrPtr and returns TCL_OK. If anything else goes wrong,
- *	this procedure returns TCL_ERROR.
+ *	Returns TCL_OK if the namespace was resolved successfully, and stores
+ *	a pointer to the namespace in the location specified by nsPtrPtr. If
+ *	the namespace can't be found, or anything else goes wrong, this
+ *	function returns TCL_ERROR and writes an error message to interp,
+ *	if non-NULL.
  *
  * Side effects:
  *	May update the internal representation for the object, caching the
- *	namespace reference. The next time this procedure is called, the
+ *	namespace reference. The next time this function is called, the
  *	namespace value can be found quickly.
  *
- *	If anything goes wrong, an error message is left in the
- *	interpreter's result object.
- *
  *----------------------------------------------------------------------
  */
 
-static int
-GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
-    Tcl_Interp *interp;		/* The current interpreter. */
-    Tcl_Obj *objPtr;		/* The object to be resolved as the name
-				 * of a namespace. */
-    Tcl_Namespace **nsPtrPtr;	/* Result namespace pointer goes here. */
+int
+TclGetNamespaceFromObj(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
+				 * namespace. */
+    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
 {
-    Interp *iPtr = (Interp *) interp;
-    register ResolvedNsName *resNamePtr;
-    register Namespace *nsPtr;
-    Namespace *currNsPtr;
-    CallFrame *savedFramePtr;
-    int result = TCL_OK;
-    char *name;
+    if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) {
+	const char *name = TclGetString(objPtr);
 
-    /*
-     * If the namespace name is fully qualified, do as if the lookup were
-     * done from the global namespace; this helps avoid repeated lookups 
-     * of fully qualified names. 
-     */
+	if ((name[0] == ':') && (name[1] == ':')) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "namespace \"%s\" not found", name));
+	} else {
+	    /*
+	     * Get the current namespace name.
+	     */
 
-    savedFramePtr = iPtr->varFramePtr;
-    name = Tcl_GetString(objPtr);
-    if ((*name++ == ':') && (*name == ':')) {
-	iPtr->varFramePtr = NULL;
+	    NamespaceCurrentCmd(NULL, interp, 2, NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "namespace \"%s\" not found in \"%s\"", name,
+		    Tcl_GetStringResult(interp)));
+	}
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
+	return TCL_ERROR;
     }
+    return TCL_OK;
+}
 
-    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    
-    /*
-     * Get the internal representation, converting to a namespace type if
-     * needed. The internal representation is a ResolvedNsName that points
-     * to the actual namespace.
-     */
-
-    if (objPtr->typePtr != &tclNsNameType) {
-        result = tclNsNameType.setFromAnyProc(interp, objPtr);
-        if (result != TCL_OK) {
-	    goto done;
-        }
-    }
-    resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+static int
+GetNamespaceFromObj(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
+				 * namespace. */
+    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
+{
+    ResolvedNsName *resNamePtr;
+    Namespace *nsPtr, *refNsPtr;
 
-    /*
-     * Check the context namespace of the resolved symbol to make sure that
-     * it is fresh. If not, then force another conversion to the namespace
-     * type, to discard the old rep and create a new one. Note that we
-     * verify that the namespace id of the cached namespace is the same as
-     * the id when we cached it; this insures that the namespace wasn't
-     * deleted and a new one created at the same address.
-     */
+    if (objPtr->typePtr == &nsNameType) {
+	/*
+	 * Check that the ResolvedNsName is still valid; avoid letting the ref 
+	 * cross interps.
+	 */
 
-    nsPtr = NULL;
-    if ((resNamePtr != NULL)
-	    && (resNamePtr->refNsPtr == currNsPtr)
-	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
-        nsPtr = resNamePtr->nsPtr;
-	if (nsPtr->flags & NS_DEAD) {
-	    nsPtr = NULL;
-	}
-    }
-    if (nsPtr == NULL) {	/* try again */
-        result = tclNsNameType.setFromAnyProc(interp, objPtr);
-        if (result != TCL_OK) {
-	    goto done;
-        }
-        resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
-        if (resNamePtr != NULL) {
-            nsPtr = resNamePtr->nsPtr;
-            if (nsPtr->flags & NS_DEAD) {
-                nsPtr = NULL;
-            }
-        }
-    }
-    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
-
-    done:
-    iPtr->varFramePtr = savedFramePtr;
-    return result;
+	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+	nsPtr = resNamePtr->nsPtr;
+	refNsPtr = resNamePtr->refNsPtr;
+	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
+		(!refNsPtr || ((interp == refNsPtr->interp) &&
+		 (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
+	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+	    return TCL_OK;
+	}
+    }
+    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
+	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
 }
 
 /*
@@ -2469,13 +2729,14 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
  *
  * Tcl_NamespaceObjCmd --
  *
- *	Invoked to implement the "namespace" command that creates, deletes,
- *	or manipulates Tcl namespaces. Handles the following syntax:
+ *	Invoked to implement the "namespace" command that creates, deletes, or
+ *	manipulates Tcl namespaces. Handles the following syntax:
  *
  *	    namespace children ?name? ?pattern?
  *	    namespace code arg
  *	    namespace current
  *	    namespace delete ?name name...?
+ *	    namespace ensemble subcommand ?arg...?
  *	    namespace eval name arg ?arg...?
  *	    namespace exists name
  *	    namespace export ?-clear? ?pattern pattern...?
@@ -2493,41 +2754,40 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
  *	anything goes wrong.
  *
  * Side effects:
- *	Based on the subcommand name (e.g., "import"), this procedure
- *	dispatches to a corresponding procedure NamespaceXXXCmd defined
- *	statically in this file. This procedure's side effects depend on
- *	whatever that subcommand procedure does. If there is an error, this
- *	procedure returns an error message in the interpreter's result
- *	object. Otherwise it may return a result in the interpreter's result
- *	object.
+ *	Based on the subcommand name (e.g., "import"), this function
+ *	dispatches to a corresponding function NamespaceXXXCmd defined
+ *	statically in this file. This function's side effects depend on
+ *	whatever that subcommand function does. If there is an error, this
+ *	function returns an error message in the interpreter's result object.
+ *	Otherwise it may return a result in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Arbitrary value passed to cmd. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    register int objc;			/* Number of arguments. */
-    register Tcl_Obj *CONST objv[];	/* Argument objects. */
-{
-    static CONST char *subCmds[] = {
-	"children", "code", "current", "delete",
+Tcl_NamespaceObjCmd(
+    ClientData clientData,	/* Arbitrary value passed to cmd. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *subCmds[] = {
+	"children", "code", "current", "delete", "ensemble",
 	"eval", "exists", "export", "forget", "import",
-	"inscope", "origin", "parent", "qualifiers",
-	"tail", "which", (char *) NULL
+	"inscope", "origin", "parent", "path", "qualifiers",
+	"tail", "unknown", "upvar", "which", NULL
     };
     enum NSSubCmdIdx {
-	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
 	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
-	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
-	NSTailIdx, NSWhichIdx
+	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
+	NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
     };
     int index, result;
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+	return TCL_ERROR;
     }
 
     /*
@@ -2539,53 +2799,65 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
     if (result != TCL_OK) {
 	return result;
     }
-    
+
     switch (index) {
-        case NSChildrenIdx:
-	    result = NamespaceChildrenCmd(clientData, interp, objc, objv);
-            break;
-        case NSCodeIdx:
-	    result = NamespaceCodeCmd(clientData, interp, objc, objv);
-            break;
-        case NSCurrentIdx:
-	    result = NamespaceCurrentCmd(clientData, interp, objc, objv);
-            break;
-        case NSDeleteIdx:
-	    result = NamespaceDeleteCmd(clientData, interp, objc, objv);
-            break;
-        case NSEvalIdx:
-	    result = NamespaceEvalCmd(clientData, interp, objc, objv);
-            break;
-        case NSExistsIdx:
-	    result = NamespaceExistsCmd(clientData, interp, objc, objv);
-            break;
-        case NSExportIdx:
-	    result = NamespaceExportCmd(clientData, interp, objc, objv);
-            break;
-        case NSForgetIdx:
-	    result = NamespaceForgetCmd(clientData, interp, objc, objv);
-            break;
-        case NSImportIdx:
-	    result = NamespaceImportCmd(clientData, interp, objc, objv);
-            break;
-        case NSInscopeIdx:
-	    result = NamespaceInscopeCmd(clientData, interp, objc, objv);
-            break;
-        case NSOriginIdx:
-	    result = NamespaceOriginCmd(clientData, interp, objc, objv);
-            break;
-        case NSParentIdx:
-	    result = NamespaceParentCmd(clientData, interp, objc, objv);
-            break;
-        case NSQualifiersIdx:
-	    result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
-            break;
-        case NSTailIdx:
-	    result = NamespaceTailCmd(clientData, interp, objc, objv);
-            break;
-        case NSWhichIdx:
-	    result = NamespaceWhichCmd(clientData, interp, objc, objv);
-            break;
+    case NSChildrenIdx:
+	result = NamespaceChildrenCmd(clientData, interp, objc, objv);
+	break;
+    case NSCodeIdx:
+	result = NamespaceCodeCmd(clientData, interp, objc, objv);
+	break;
+    case NSCurrentIdx:
+	result = NamespaceCurrentCmd(clientData, interp, objc, objv);
+	break;
+    case NSDeleteIdx:
+	result = NamespaceDeleteCmd(clientData, interp, objc, objv);
+	break;
+    case NSEnsembleIdx:
+	result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
+	break;
+    case NSEvalIdx:
+	result = NamespaceEvalCmd(clientData, interp, objc, objv);
+	break;
+    case NSExistsIdx:
+	result = NamespaceExistsCmd(clientData, interp, objc, objv);
+	break;
+    case NSExportIdx:
+	result = NamespaceExportCmd(clientData, interp, objc, objv);
+	break;
+    case NSForgetIdx:
+	result = NamespaceForgetCmd(clientData, interp, objc, objv);
+	break;
+    case NSImportIdx:
+	result = NamespaceImportCmd(clientData, interp, objc, objv);
+	break;
+    case NSInscopeIdx:
+	result = NamespaceInscopeCmd(clientData, interp, objc, objv);
+	break;
+    case NSOriginIdx:
+	result = NamespaceOriginCmd(clientData, interp, objc, objv);
+	break;
+    case NSParentIdx:
+	result = NamespaceParentCmd(clientData, interp, objc, objv);
+	break;
+    case NSPathIdx:
+	result = NamespacePathCmd(clientData, interp, objc, objv);
+	break;
+    case NSQualifiersIdx:
+	result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
+	break;
+    case NSTailIdx:
+	result = NamespaceTailCmd(clientData, interp, objc, objv);
+	break;
+    case NSUpvarIdx:
+	result = NamespaceUpvarCmd(clientData, interp, objc, objv);
+	break;
+    case NSUnknownIdx:
+	result = NamespaceUnknownCmd(clientData, interp, objc, objv);
+	break;
+    case NSWhichIdx:
+	result = NamespaceWhichCmd(clientData, interp, objc, objv);
+	break;
     }
     return result;
 }
@@ -2596,8 +2868,8 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
  * NamespaceChildrenCmd --
  *
  *	Invoked to implement the "namespace children" command that returns a
- *	list containing the fully-qualified names of the child namespaces of
- *	a given namespace. Handles the following syntax:
+ *	list containing the fully-qualified names of the child namespaces of a
+ *	given namespace. Handles the following syntax:
  *
  *	    namespace children ?name? ?pattern?
  *
@@ -2605,22 +2877,22 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceChildrenCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceChildrenCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
     Namespace *nsPtr, *childNsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
     char *pattern = NULL;
     Tcl_DString buffer;
     register Tcl_HashEntry *entryPtr;
@@ -2632,21 +2904,15 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
      */
 
     if (objc == 2) {
-	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     } else if ((objc == 3) || (objc == 4)) {
-        if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
-            return TCL_ERROR;
-        }
-        if (namespacePtr == NULL) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "unknown namespace \"", Tcl_GetString(objv[2]),
-		    "\" in namespace children command", (char *) NULL);
-            return TCL_ERROR;
-        }
-        nsPtr = (Namespace *) namespacePtr;
+	if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	nsPtr = (Namespace *) namespacePtr;
     } else {
 	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
@@ -2655,37 +2921,50 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
 
     Tcl_DStringInit(&buffer);
     if (objc == 4) {
-        char *name = Tcl_GetString(objv[3]);
-	
-        if ((*name == ':') && (*(name+1) == ':')) {
-            pattern = name;
-        } else {
-            Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
-            if (nsPtr != globalNsPtr) {
-                Tcl_DStringAppend(&buffer, "::", 2);
-            }
-            Tcl_DStringAppend(&buffer, name, -1);
-            pattern = Tcl_DStringValue(&buffer);
-        }
+	char *name = TclGetString(objv[3]);
+
+	if ((*name == ':') && (*(name+1) == ':')) {
+	    pattern = name;
+	} else {
+	    Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
+	    if (nsPtr != globalNsPtr) {
+		Tcl_DStringAppend(&buffer, "::", 2);
+	    }
+	    Tcl_DStringAppend(&buffer, name, -1);
+	    pattern = Tcl_DStringValue(&buffer);
+	}
     }
 
     /*
-     * Create a list containing the full names of all child namespaces
-     * whose names match the specified pattern, if any.
+     * Create a list containing the full names of all child namespaces whose
+     * names match the specified pattern, if any.
      */
 
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    listPtr = Tcl_NewListObj(0, NULL);
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	unsigned int length = strlen(nsPtr->fullName);
+
+	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
+	    goto searchDone;
+	}
+	if (Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL) {
+	    Tcl_ListObjAppendElement(interp, listPtr,
+		    Tcl_NewStringObj(pattern, -1));
+	}
+	goto searchDone;
+    }
     entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
     while (entryPtr != NULL) {
-        childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
-        if ((pattern == NULL)
-	        || Tcl_StringMatch(childNsPtr->fullName, pattern)) {
-            elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
-            Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
-        }
-        entryPtr = Tcl_NextHashEntry(&search);
+	childNsPtr = Tcl_GetHashValue(entryPtr);
+	if ((pattern == NULL)
+		|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
+	    elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
+	    Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
+	}
+	entryPtr = Tcl_NextHashEntry(&search);
     }
 
+  searchDone:
     Tcl_SetObjResult(interp, listPtr);
     Tcl_DStringFree(&buffer);
     return TCL_OK;
@@ -2706,79 +2985,73 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
  *
  *	    list ::namespace inscope [namespace current] $arg
  *
- *	However, if "arg" is itself a scoped value starting with
- *	"::namespace inscope", then the result is just "arg".
+ *	However, if "arg" is itself a scoped value starting with "::namespace
+ *	inscope", then the result is just "arg".
  *
  * Results:
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	If anything goes wrong, this procedure returns an error
- *	message as the result in the interpreter's result object.
+ *	If anything goes wrong, this function returns an error message as the
+ *	result in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceCodeCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceCodeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Namespace *currNsPtr;
     Tcl_Obj *listPtr, *objPtr;
-    register char *arg, *p;
+    register char *arg;
     int length;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 2, objv, "arg");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * If "arg" is already a scoped value, then return it directly.
+     * Take care to only check for scoping in precisely the style that
+     * [::namespace code] generates it.  Anything more forgiving can have
+     * the effect of failing in namespaces that contain their own custom
+     " "namespace" command.  [Bug 3202171].
      */
 
-    arg = Tcl_GetStringFromObj(objv[2], &length);
-    while (*arg == ':') { 
-	arg++; 
-	length--; 
-    } 
-    if ((*arg == 'n') && (length > 17)
-	    && (strncmp(arg, "namespace", 9) == 0)) {
-	for (p = (arg + 9);  (*p == ' ');  p++) {
-	    /* empty body: skip over spaces */
-	}
-	if ((*p == 'i') && ((p + 7) <= (arg + length))
-	        && (strncmp(p, "inscope", 7) == 0)) {
-	    Tcl_SetObjResult(interp, objv[2]);
-	    return TCL_OK;
-	}
+    arg = TclGetStringFromObj(objv[2], &length);
+    if (*arg==':' && length > 20 
+	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
+	Tcl_SetObjResult(interp, objv[2]);
+	return TCL_OK;
     }
 
     /*
      * Otherwise, construct a scoped command by building a list with
-     * "namespace inscope", the full name of the current namespace, and 
-     * the argument "arg". By constructing a list, we ensure that scoped
-     * commands are interpreted properly when they are executed later,
-     * by the "namespace inscope" command.
+     * "namespace inscope", the full name of the current namespace, and the
+     * argument "arg". By constructing a list, we ensure that scoped commands
+     * are interpreted properly when they are executed later, by the
+     * "namespace inscope" command.
      */
 
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    Tcl_ListObjAppendElement(interp, listPtr,
-            Tcl_NewStringObj("::namespace", -1));
-    Tcl_ListObjAppendElement(interp, listPtr,
-	    Tcl_NewStringObj("inscope", -1));
+    TclNewObj(listPtr);
+    TclNewLiteralStringObj(objPtr, "::namespace");
+    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+    TclNewLiteralStringObj(objPtr, "inscope");
+    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
 
-    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
-	objPtr = Tcl_NewStringObj("::", -1);
+    currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+	TclNewLiteralStringObj(objPtr, "::");
     } else {
 	objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
     }
     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-    
+
     Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
 
     Tcl_SetObjResult(interp, listPtr);
@@ -2790,9 +3063,9 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
  *
  * NamespaceCurrentCmd --
  *
- *	Invoked to implement the "namespace current" command which returns
- *	the fully-qualified name of the current namespace. Handles the
- *	following syntax:
+ *	Invoked to implement the "namespace current" command which returns the
+ *	fully-qualified name of the current namespace. Handles the following
+ *	syntax:
  *
  *	    namespace current
  *
@@ -2800,40 +3073,40 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceCurrentCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceCurrentCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Namespace *currNsPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 2, objv, NULL);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
-     * The "real" name of the global namespace ("::") is the null string,
-     * but we return "::" for it as a convenience to programmers. Note that
-     * "" and "::" are treated as synonyms by the namespace code so that it
-     * is still easy to do things like:
+     * The "real" name of the global namespace ("::") is the null string, but
+     * we return "::" for it as a convenience to programmers. Note that "" and
+     * "::" are treated as synonyms by the namespace code so that it is still
+     * easy to do things like:
      *
      *    namespace [namespace current]::bar { ... }
      */
 
-    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
-        Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
+    currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
     } else {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1));
     }
     return TCL_OK;
 }
@@ -2851,57 +3124,58 @@ NamespaceCurrentCmd(dummy, interp, objc, objv)
  *	Each name identifies a namespace. It may include a sequence of
  *	namespace qualifiers separated by "::"s. If a namespace is found, it
  *	is deleted: all variables and procedures contained in that namespace
- *	are deleted. If that namespace is being used on the call stack, it
- *	is kept alive (but logically deleted) until it is removed from the
- *	call stack: that is, it can no longer be referenced by name but any
+ *	are deleted. If that namespace is being used on the call stack, it is
+ *	kept alive (but logically deleted) until it is removed from the call
+ *	stack: that is, it can no longer be referenced by name but any
  *	currently executing procedure that refers to it is allowed to do so
  *	until the procedure returns. If the namespace can't be found, this
- *	procedure returns an error. If no namespaces are specified, this
+ *	function returns an error. If no namespaces are specified, this
  *	command does nothing.
  *
  * Results:
- *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
  *	Deletes the specified namespaces. If anything goes wrong, this
- *	procedure returns an error message in the interpreter's
- *	result object.
+ *	function returns an error message in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceDeleteCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceDeleteCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
     char *name;
     register int i;
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+	return TCL_ERROR;
     }
 
     /*
-     * Destroying one namespace may cause another to be destroyed. Break
-     * this into two passes: first check to make sure that all namespaces on
-     * the command line are valid, and report any errors.
+     * Destroying one namespace may cause another to be destroyed. Break this
+     * into two passes: first check to make sure that all namespaces on the
+     * command line are valid, and report any errors.
      */
 
     for (i = 2;  i < objc;  i++) {
-        name = Tcl_GetString(objv[i]);
-	namespacePtr = Tcl_FindNamespace(interp, name,
-		(Tcl_Namespace *) NULL, /*flags*/ 0);
-	if (namespacePtr == NULL) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "unknown namespace \"", Tcl_GetString(objv[i]),
-		    "\" in namespace delete command", (char *) NULL);
-            return TCL_ERROR;
-        }
+	name = TclGetString(objv[i]);
+	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
+	if ((namespacePtr == NULL)
+		|| (((Namespace *)namespacePtr)->flags & NS_KILLED)) {
+	    Tcl_AppendResult(interp, "unknown namespace \"",
+		    TclGetString(objv[i]),
+		    "\" in namespace delete command", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
+		    TclGetString(objv[i]), NULL);
+	    return TCL_ERROR;
+	}
     }
 
     /*
@@ -2909,12 +3183,11 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
      */
 
     for (i = 2;  i < objc;  i++) {
-        name = Tcl_GetString(objv[i]);
-	namespacePtr = Tcl_FindNamespace(interp, name,
-	    (Tcl_Namespace *) NULL, /* flags */ 0);
+	name = TclGetString(objv[i]);
+	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
 	if (namespacePtr) {
-            Tcl_DeleteNamespace(namespacePtr);
-        }
+	    Tcl_DeleteNamespace(namespacePtr);
+	}
     }
     return TCL_OK;
 }
@@ -2924,44 +3197,43 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
  *
  * NamespaceEvalCmd --
  *
- *	Invoked to implement the "namespace eval" command. Executes
- *	commands in a namespace. If the namespace does not already exist,
- *	it is created. Handles the following syntax:
+ *	Invoked to implement the "namespace eval" command. Executes commands
+ *	in a namespace. If the namespace does not already exist, it is
+ *	created. Handles the following syntax:
  *
  *	    namespace eval name arg ?arg...?
  *
  *	If more than one arg argument is specified, the command that is
- *	executed is the result of concatenating the arguments together with
- *	a space between each argument.
+ *	executed is the result of concatenating the arguments together with a
+ *	space between each argument.
  *
  * Results:
- *	Returns TCL_OK if the namespace is found and the commands are
- *	executed successfully. Returns TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if the namespace is found and the commands are executed
+ *	successfully. Returns TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns the result of the command in the interpreter's result
- *	object. If anything goes wrong, this procedure returns an error
- *	message as the result.
+ *	Returns the result of the command in the interpreter's result object.
+ *	If anything goes wrong, this function returns an error message as the
+ *	result.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceEvalCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceEvalCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
-    CallFrame frame;
+    CallFrame *framePtr, **framePtrPtr;
     Tcl_Obj *objPtr;
-    char *name;
-    int length, result;
+    int result;
 
     if (objc < 4) {
-        Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+	return TCL_ERROR;
     }
 
     /*
@@ -2970,74 +3242,79 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
      */
 
     result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
-    if (result != TCL_OK) {
-        return result;
-    }
 
     /*
      * If the namespace wasn't found, try to create it.
      */
-    
-    if (namespacePtr == NULL) {
-	name = Tcl_GetStringFromObj(objv[2], &length);
-	namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, 
-                (Tcl_NamespaceDeleteProc *) NULL);
+
+    if (result == TCL_ERROR) {
+	char *name = TclGetString(objv[2]);
+
+	namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
 	if (namespacePtr == NULL) {
 	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Make the specified namespace the current namespace and evaluate
-     * the command(s).
+     * Make the specified namespace the current namespace and evaluate the
+     * command(s).
      */
 
-    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame, 
-            namespacePtr, /*isProcCallFrame*/ 0);
+    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    namespacePtr, /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    frame.objc = objc;
-    frame.objv = objv;  /* ref counts do not need to be incremented here */
+
+    framePtr->objc = objc;
+    framePtr->objv = objv;
 
     if (objc == 4) {
-#ifndef TCL_TIP280
-        result = Tcl_EvalObjEx(interp, objv[3], 0);
-#else
-        /* TIP #280 : Make actual argument location available to eval'd script */
-        Interp* iPtr      = (Interp*) interp;
+	/*
+	 * TIP #280: Make actual argument location available to eval'd script.
+	 */
+
+	Interp *iPtr      = (Interp *) interp;
 	CmdFrame* invoker = iPtr->cmdFramePtr;
 	int word          = 3;
+
 	TclArgumentGet (interp, objv[3], &invoker, &word);
-        result = TclEvalObjEx(interp, objv[3], 0, invoker, word);
-#endif
+	result = TclEvalObjEx(interp, objv[3], 0, invoker, word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
-	 * between, then evaluate the result.  Tcl_EvalObjEx will delete
-	 * the object when it decrements its refcount after eval'ing it.
+	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
+	 * object when it decrements its refcount after eval'ing it.
 	 */
-        objPtr = Tcl_ConcatObj(objc-3, objv+3);
-#ifndef TCL_TIP280
-        result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
-#else
-	/* TIP #280. Make invoking context available to eval'd script */
+
+	objPtr = Tcl_ConcatObj(objc-3, objv+3);
+
+	/*
+	 * TIP #280: Make invoking context available to eval'd script.
+	 */
+
 	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
-#endif
     }
+
     if (result == TCL_ERROR) {
-        char msg[256 + TCL_INTEGER_SPACE];
-	
-        sprintf(msg, "\n    (in namespace eval \"%.200s\" script line %d)",
-            namespacePtr->fullName, interp->errorLine);
-        Tcl_AddObjErrorInfo(interp, msg, -1);
+	int length = strlen(namespacePtr->fullName);
+	int limit = 200;
+	int overflow = (length > limit);
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (in namespace eval \"%.*s%s\" script line %d)",
+		(overflow ? limit : length), namespacePtr->fullName,
+		(overflow ? "..." : ""), interp->errorLine));
     }
 
     /*
      * Restore the previous "current" namespace.
      */
-    
-    Tcl_PopCallFrame(interp);
+
+    TclPopStackFrame(interp);
     return result;
 }
 
@@ -3046,9 +3323,9 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
  *
  * NamespaceExistsCmd --
  *
- *	Invoked to implement the "namespace exists" command that returns 
- *	true if the given namespace currently exists, and false otherwise.
- *	Handles the following syntax:
+ *	Invoked to implement the "namespace exists" command that returns true
+ *	if the given namespace currently exists, and false otherwise. Handles
+ *	the following syntax:
  *
  *	    namespace exists name
  *
@@ -3056,35 +3333,28 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceExistsCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceExistsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
 
     if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "name");
-        return TCL_ERROR;
-    }
-
-    /*
-     * Check whether the given namespace exists
-     */
-
-    if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "name");
+	return TCL_ERROR;
     }
 
-    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+	    GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK));
     return TCL_OK;
 }
 
@@ -3095,18 +3365,18 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
  *
  *	Invoked to implement the "namespace export" command that specifies
  *	which commands are exported from a namespace. The exported commands
- *	are those that can be imported into another namespace using
- *	"namespace import". Both commands defined in a namespace and
- *	commands the namespace has imported can be exported by a
- *	namespace. This command has the following syntax:
+ *	are those that can be imported into another namespace using "namespace
+ *	import". Both commands defined in a namespace and commands the
+ *	namespace has imported can be exported by a namespace. This command
+ *	has the following syntax:
  *
  *	    namespace export ?-clear? ?pattern pattern...?
  *
- *	Each pattern may contain "string match"-style pattern matching
- *	special characters, but the pattern may not include any namespace
- *	qualifiers: that is, the pattern must specify commands in the
- *	current (exporting) namespace. The specified patterns are appended
- *	onto the namespace's list of export patterns.
+ *	Each pattern may contain "string match"-style pattern matching special
+ *	characters, but the pattern may not include any namespace qualifiers:
+ *	that is, the pattern must specify commands in the current (exporting)
+ *	namespace. The specified patterns are appended onto the namespace's
+ *	list of export patterns.
  *
  *	To reset the namespace's export pattern list, specify the "-clear"
  *	flag.
@@ -3118,28 +3388,27 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceExportCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceExportCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     char *pattern, *string;
     int resetListFirst = 0;
     int firstArg, patternCt, i, result;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 2, objv,
-	        "?-clear? ?pattern pattern...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
+	return TCL_ERROR;
     }
 
     /*
@@ -3148,7 +3417,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
 
     firstArg = 2;
     if (firstArg < objc) {
-	string = Tcl_GetString(objv[firstArg]);
+	string = TclGetString(objv[firstArg]);
 	if (strcmp(string, "-clear") == 0) {
 	    resetListFirst = 1;
 	    firstArg++;
@@ -3156,18 +3425,22 @@ NamespaceExportCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * If no pattern arguments are given, and "-clear" isn't specified,
-     * return the namespace's current export pattern list.
+     * If no pattern arguments are given, and "-clear" isn't specified, return
+     * the namespace's current export pattern list.
      */
 
     patternCt = (objc - firstArg);
     if (patternCt == 0) {
 	if (firstArg > 2) {
 	    return TCL_OK;
-	} else {		/* create list with export patterns */
-	    Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-	    result = Tcl_AppendExportList(interp,
-		    (Tcl_Namespace *) currNsPtr, listPtr);
+	} else {
+	    /*
+	     * Create list with export patterns.
+	     */
+
+	    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
+	    result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr,
+		    listPtr);
 	    if (result != TCL_OK) {
 		return result;
 	    }
@@ -3179,14 +3452,14 @@ NamespaceExportCmd(dummy, interp, objc, objv)
     /*
      * Add each pattern to the namespace's export pattern list.
      */
-    
+
     for (i = firstArg;  i < objc;  i++) {
-	pattern = Tcl_GetString(objv[i]);
+	pattern = TclGetString(objv[i]);
 	result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
 		((i == firstArg)? resetListFirst : 0));
-        if (result != TCL_OK) {
-            return result;
-        }
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
     return TCL_OK;
 }
@@ -3196,52 +3469,52 @@ NamespaceExportCmd(dummy, interp, objc, objv)
  *
  * NamespaceForgetCmd --
  *
- *	Invoked to implement the "namespace forget" command to remove
- *	imported commands from a namespace. Handles the following syntax:
+ *	Invoked to implement the "namespace forget" command to remove imported
+ *	commands from a namespace. Handles the following syntax:
  *
  *	    namespace forget ?pattern pattern...?
  *
  *	Each pattern is a name like "foo::*" or "a::b::x*". That is, the
- *	pattern may include the special pattern matching characters
- *	recognized by the "string match" command, but only in the command
- *	name at the end of the qualified name; the special pattern
- *	characters may not appear in a namespace name. All of the commands
- *	that match that pattern are checked to see if they have an imported
- *	command in the current namespace that refers to the matched
- *	command. If there is an alias, it is removed.
- *	
+ *	pattern may include the special pattern matching characters recognized
+ *	by the "string match" command, but only in the command name at the end
+ *	of the qualified name; the special pattern characters may not appear
+ *	in a namespace name. All of the commands that match that pattern are
+ *	checked to see if they have an imported command in the current
+ *	namespace that refers to the matched command. If there is an alias, it
+ *	is removed.
+ *
  * Results:
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Imported commands are removed from the current namespace. If
- *	anything goes wrong, this procedure returns an error message in the
+ *	Imported commands are removed from the current namespace. If anything
+ *	goes wrong, this function returns an error message in the
  *	interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceForgetCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceForgetCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *pattern;
     register int i, result;
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+	return TCL_ERROR;
     }
 
     for (i = 2;  i < objc;  i++) {
-        pattern = Tcl_GetString(objv[i]);
-	result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
-        if (result != TCL_OK) {
-            return result;
-        }
+	pattern = TclGetString(objv[i]);
+	result = Tcl_ForgetImport(interp, NULL, pattern);
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
     return TCL_OK;
 }
@@ -3256,39 +3529,42 @@ NamespaceForgetCmd(dummy, interp, objc, objv)
  *
  *	    namespace import ?-force? ?pattern pattern...?
  *
- *	Each pattern is a namespace-qualified name like "foo::*",
- *	"a::b::x*", or "bar::p". That is, the pattern may include the
- *	special pattern matching characters recognized by the "string match"
- *	command, but only in the command name at the end of the qualified
- *	name; the special pattern characters may not appear in a namespace
- *	name. All of the commands that match the pattern and which are
- *	exported from their namespace are made accessible from the current
- *	namespace context. This is done by creating a new "imported command"
- *	in the current namespace that points to the real command in its
- *	original namespace; when the imported command is called, it invokes
- *	the real command.
+ *	Each pattern is a namespace-qualified name like "foo::*", "a::b::x*",
+ *	or "bar::p". That is, the pattern may include the special pattern
+ *	matching characters recognized by the "string match" command, but only
+ *	in the command name at the end of the qualified name; the special
+ *	pattern characters may not appear in a namespace name. All of the
+ *	commands that match the pattern and which are exported from their
+ *	namespace are made accessible from the current namespace context. This
+ *	is done by creating a new "imported command" in the current namespace
+ *	that points to the real command in its original namespace; when the
+ *	imported command is called, it invokes the real command.
  *
  *	If an imported command conflicts with an existing command, it is
  *	treated as an error. But if the "-force" option is included, then
  *	existing commands are overwritten by the imported commands.
- *	
+ *
+ *	If there are no pattern arguments and the "-force" flag isn't given,
+ *	this command returns the list of commands currently imported in
+ *	the current namespace.
+ *
  * Results:
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
  *	Adds imported commands to the current namespace. If anything goes
- *	wrong, this procedure returns an error message in the interpreter's
+ *	wrong, this function returns an error message in the interpreter's
  *	result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceImportCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceImportCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int allowOverwrite = 0;
     char *string, *pattern;
@@ -3296,9 +3572,8 @@ NamespaceImportCmd(dummy, interp, objc, objv)
     int firstArg;
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 2, objv,
-	        "?-force? ?pattern pattern...?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
+	return TCL_ERROR;
     }
 
     /*
@@ -3307,11 +3582,34 @@ NamespaceImportCmd(dummy, interp, objc, objv)
 
     firstArg = 2;
     if (firstArg < objc) {
-	string = Tcl_GetString(objv[firstArg]);
+	string = TclGetString(objv[firstArg]);
 	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
 	    allowOverwrite = 1;
 	    firstArg++;
 	}
+    } else {
+	/*
+	 * When objc == 2, command is just [namespace import]. Introspection
+	 * form to return list of imported commands.
+	 */
+
+	Tcl_HashEntry *hPtr;
+	Tcl_HashSearch search;
+	Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+	Tcl_Obj *listPtr;
+
+	TclNewObj(listPtr);
+	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	    Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
+	    if (cmdPtr->deleteProc == DeleteImportedCmd) {
+		Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(
+			Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
+	    }
+	}
+	Tcl_SetObjResult(interp, listPtr);
+	return TCL_OK;
     }
 
     /*
@@ -3319,12 +3617,11 @@ NamespaceImportCmd(dummy, interp, objc, objv)
      */
 
     for (i = firstArg;  i < objc;  i++) {
-        pattern = Tcl_GetString(objv[i]);
-	result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
-	        allowOverwrite);
-        if (result != TCL_OK) {
-            return result;
-        }
+	pattern = TclGetString(objv[i]);
+	result = Tcl_Import(interp, NULL, pattern, allowOverwrite);
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
     return TCL_OK;
 }
@@ -3336,30 +3633,29 @@ NamespaceImportCmd(dummy, interp, objc, objv)
  *
  *	Invoked to implement the "namespace inscope" command that executes a
  *	script in the context of a particular namespace. This command is not
- *	expected to be used directly by programmers; calls to it are
- *	generated implicitly when programs use "namespace code" commands
- *	to register callback scripts. Handles the following syntax:
+ *	expected to be used directly by programmers; calls to it are generated
+ *	implicitly when programs use "namespace code" commands to register
+ *	callback scripts. Handles the following syntax:
  *
  *	    namespace inscope name arg ?arg...?
  *
  *	The "namespace inscope" command is much like the "namespace eval"
  *	command except that it has lappend semantics and the namespace must
- *	already exist. It treats the first argument as a list, and appends
- *	any arguments after the first onto the end as proper list elements.
- *	For example,
+ *	already exist. It treats the first argument as a list, and appends any
+ *	arguments after the first onto the end as proper list elements. For
+ *	example,
  *
- *	    namespace inscope ::foo a b c d
+ *	    namespace inscope ::foo {a b} c d e
  *
  *	is equivalent to
  *
- *	    namespace eval ::foo [concat a [list b c d]]
+ *	    namespace eval ::foo [concat {a b} [list c d e]]
  *
- *	This lappend semantics is important because many callback scripts
- *	are actually prefixes.
+ *	This lappend semantics is important because many callback scripts are
+ *	actually prefixes.
  *
  * Results:
- *	Returns TCL_OK to indicate success, or TCL_ERROR to indicate
- *	failure.
+ *	Returns TCL_OK to indicate success, or TCL_ERROR to indicate failure.
  *
  * Side effects:
  *	Returns a result in the Tcl interpreter's result object.
@@ -3368,88 +3664,88 @@ NamespaceImportCmd(dummy, interp, objc, objv)
  */
 
 static int
-NamespaceInscopeCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceInscopeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
-    Tcl_CallFrame frame;
+    CallFrame *framePtr, **framePtrPtr;
     int i, result;
 
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Resolve the namespace reference.
      */
 
-    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
-    if (result != TCL_OK) {
-        return result;
-    }
-    if (namespacePtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	        "unknown namespace \"", Tcl_GetString(objv[2]),
-		"\" in inscope namespace command", (char *) NULL);
-        return TCL_ERROR;
+    if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     /*
      * Make the specified namespace the current namespace.
      */
 
-    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
-	    /*isProcCallFrame*/ 0);
+    framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
+					 * strict aliasing rules. */
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    namespacePtr, /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
-        return result;
+	return result;
     }
 
+    framePtr->objc = objc;
+    framePtr->objv = objv;
+
     /*
-     * Execute the command. If there is just one argument, just treat it as
-     * a script and evaluate it. Otherwise, create a list from the arguments
+     * Execute the command. If there is just one argument, just treat it as a
+     * script and evaluate it. Otherwise, create a list from the arguments
      * after the first one, then concatenate the first argument and the list
      * of extra arguments to form the command to evaluate.
      */
 
     if (objc == 4) {
-        result = Tcl_EvalObjEx(interp, objv[3], 0);
+	result = Tcl_EvalObjEx(interp, objv[3], 0);
     } else {
 	Tcl_Obj *concatObjv[2];
 	register Tcl_Obj *listPtr, *cmdObjPtr;
-	
-        listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-        for (i = 4;  i < objc;  i++) {
-	    result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
-            if (result != TCL_OK) {
-                Tcl_DecrRefCount(listPtr); /* free unneeded obj */
-                return result;
-            }
-        }
+
+	listPtr = Tcl_NewListObj(0, NULL);
+	for (i = 4;  i < objc;  i++) {
+	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK) {
+		Tcl_DecrRefCount(listPtr);	/* Free unneeded obj. */
+		return TCL_ERROR;
+	    }
+	}
 
 	concatObjv[0] = objv[3];
 	concatObjv[1] = listPtr;
 	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
-        result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
-	Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
+	result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
+	Tcl_DecrRefCount(listPtr);    /* We're done with the list object. */
     }
+
     if (result == TCL_ERROR) {
-        char msg[256 + TCL_INTEGER_SPACE];
-	
-        sprintf(msg,
-	    "\n    (in namespace inscope \"%.200s\" script line %d)",
-            namespacePtr->fullName, interp->errorLine);
-        Tcl_AddObjErrorInfo(interp, msg, -1);
+	int length = strlen(namespacePtr->fullName);
+	int limit = 200;
+	int overflow = (length > limit);
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (in namespace inscope \"%.*s%s\" script line %d)",
+		(overflow ? limit : length), namespacePtr->fullName,
+		(overflow ? "..." : ""), interp->errorLine));
     }
 
     /*
      * Restore the previous "current" namespace.
      */
 
-    Tcl_PopCallFrame(interp);
+    TclPopStackFrame(interp);
     return result;
 }
 
@@ -3472,49 +3768,53 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
  *	command returns the fully-qualified name of the original command in
  *	the first namespace, a. If "name" does not refer to an alias, its
  *	fully-qualified name is returned. The returned name is stored in the
- *	interpreter's result object. This procedure returns TCL_OK if
+ *	interpreter's result object. This function returns TCL_OK if
  *	successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	If anything goes wrong, this procedure returns an error message in
- *	the interpreter's result object.
+ *	If anything goes wrong, this function returns an error message in the
+ *	interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceOriginCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceOriginCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Command command, origCommand;
+    Tcl_Obj *resultPtr;
 
     if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 2, objv, "name");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "name");
+	return TCL_ERROR;
     }
 
     command = Tcl_GetCommandFromObj(interp, objv[2]);
-    if (command == (Tcl_Command) NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"invalid command name \"", Tcl_GetString(objv[2]),
-		"\"", (char *) NULL);
+    if (command == NULL) {
+	Tcl_AppendResult(interp, "invalid command name \"",
+		TclGetString(objv[2]), "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+		TclGetString(objv[2]), NULL);
 	return TCL_ERROR;
     }
     origCommand = TclGetOriginalCommand(command);
-    if (origCommand == (Tcl_Command) NULL) {
+    TclNewObj(resultPtr);
+    if (origCommand == NULL) {
 	/*
 	 * The specified command isn't an imported command. Return the
-	 * command's name qualified by the full name of the namespace it
-	 * was defined in.
+	 * command's name qualified by the full name of the namespace it was
+	 * defined in.
 	 */
-	
-	Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
+
+	Tcl_GetCommandFullName(interp, command, resultPtr);
     } else {
-	Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
+	Tcl_GetCommandFullName(interp, origCommand, resultPtr);
     }
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -3533,38 +3833,30 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceParentCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceParentCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *nsPtr;
-    int result;
 
     if (objc == 2) {
-        nsPtr = Tcl_GetCurrentNamespace(interp);
+	nsPtr = TclGetCurrentNamespace(interp);
     } else if (objc == 3) {
-	result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
-        if (result != TCL_OK) {
-            return result;
-        }
-        if (nsPtr == NULL) {
-            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "unknown namespace \"", Tcl_GetString(objv[2]),
-		    "\" in namespace parent command", (char *) NULL);
-            return TCL_ERROR;
-        }
+	if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
     } else {
-        Tcl_WrongNumArgs(interp, 2, objv, "?name?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+	return TCL_ERROR;
     }
 
     /*
@@ -3572,8 +3864,8 @@ NamespaceParentCmd(dummy, interp, objc, objv)
      */
 
     if (nsPtr->parentPtr != NULL) {
-        Tcl_SetStringObj(Tcl_GetObjResult(interp),
-	        nsPtr->parentPtr->fullName, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		nsPtr->parentPtr->fullName, -1));
     }
     return TCL_OK;
 }
@@ -3581,66 +3873,479 @@ NamespaceParentCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * NamespacePathCmd --
+ *
+ *	Invoked to implement the "namespace path" command that reads and
+ *	writes the current namespace's command resolution path. Has one
+ *	optional argument: if present, it is a list of named namespaces to set
+ *	the path to, and if absent, the current path should be returned.
+ *	Handles the following syntax:
+ *
+ *	    namespace path ?nsList?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong
+ *	(most notably if the namespace list contains the name of something
+ *	other than a namespace). In the successful-exit case, may set the
+ *	interpreter result to the list of names of the namespaces on the
+ *	current namespace's path.
+ *
+ * Side effects:
+ *	May update the namespace path (triggering a recomputing of all command
+ *	names that depend on the namespace for resolution).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespacePathCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    int i, nsObjc, result = TCL_ERROR;
+    Tcl_Obj **nsObjv;
+    Tcl_Namespace **namespaceList = NULL;
+
+    if (objc > 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If no path is given, return the current path.
+     */
+
+    if (objc == 2) {
+	/*
+	 * Not a very fast way to compute this, but easy to get right.
+	 */
+
+	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+	    if (nsPtr->commandPathArray[i].nsPtr != NULL) {
+		Tcl_AppendElement(interp,
+			nsPtr->commandPathArray[i].nsPtr->fullName);
+	    }
+	}
+	return TCL_OK;
+    }
+
+    /*
+     * There is a path given, so parse it into an array of namespace pointers.
+     */
+
+    if (TclListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
+	goto badNamespace;
+    }
+    if (nsObjc != 0) {
+	namespaceList = (Tcl_Namespace **)
+		TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc);
+
+	for (i=0 ; i<nsObjc ; i++) {
+	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
+		    &namespaceList[i]) != TCL_OK) {
+		goto badNamespace;
+	    }
+	}
+    }
+
+    /*
+     * Now we have the list of valid namespaces, install it as the path.
+     */
+
+    TclSetNsPath(nsPtr, nsObjc, namespaceList);
+
+    result = TCL_OK;
+  badNamespace:
+    if (namespaceList != NULL) {
+	TclStackFree(interp, namespaceList);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetNsPath --
+ *
+ *	Sets the namespace command name resolution path to the given list of
+ *	namespaces. If the list is empty (of zero length) the path is set to
+ *	empty and the default old-style behaviour of command name resolution
+ *	is used.
+ *
+ * Results:
+ *	nothing
+ *
+ * Side effects:
+ *	Invalidates the command name resolution caches for any command
+ *	resolved in the given namespace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetNsPath(
+    Namespace *nsPtr,		/* Namespace whose path is to be set. */
+    int pathLength,		/* Length of pathAry. */
+    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
+{
+    if (pathLength != 0) {
+	NamespacePathEntry *tmpPathArray = (NamespacePathEntry *)
+		ckalloc(sizeof(NamespacePathEntry) * pathLength);
+	int i;
+
+	for (i=0 ; i<pathLength ; i++) {
+	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
+	    tmpPathArray[i].creatorNsPtr = nsPtr;
+	    tmpPathArray[i].prevPtr = NULL;
+	    tmpPathArray[i].nextPtr =
+		    tmpPathArray[i].nsPtr->commandPathSourceList;
+	    if (tmpPathArray[i].nextPtr != NULL) {
+		tmpPathArray[i].nextPtr->prevPtr = &tmpPathArray[i];
+	    }
+	    tmpPathArray[i].nsPtr->commandPathSourceList = &tmpPathArray[i];
+	}
+	if (nsPtr->commandPathLength != 0) {
+	    UnlinkNsPath(nsPtr);
+	}
+	nsPtr->commandPathArray = tmpPathArray;
+    } else {
+	if (nsPtr->commandPathLength != 0) {
+	    UnlinkNsPath(nsPtr);
+	}
+    }
+
+    nsPtr->commandPathLength = pathLength;
+    nsPtr->cmdRefEpoch++;
+    nsPtr->resolverEpoch++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkNsPath --
+ *
+ *	Delete the given namespace's command name resolution path. Only call
+ *	if the path is non-empty. Caller must reset the counter containing the
+ *	path size.
+ *
+ * Results:
+ *	nothing
+ *
+ * Side effects:
+ *	Deletes the array of path entries and unlinks those path entries from
+ *	the target namespace's list of interested namespaces.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkNsPath(
+    Namespace *nsPtr)
+{
+    int i;
+    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
+	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];
+	if (nsPathPtr->prevPtr != NULL) {
+	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
+	}
+	if (nsPathPtr->nextPtr != NULL) {
+	    nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr;
+	}
+	if (nsPathPtr->nsPtr != NULL) {
+	    if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) {
+		nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr;
+	    }
+	}
+    }
+    ckfree((char *) nsPtr->commandPathArray);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvalidateNsPath --
+ *
+ *	Invalidate the name resolution caches for all names looked up in
+ *	namespaces whose name path includes the given namespace.
+ *
+ * Results:
+ *	nothing
+ *
+ * Side effects:
+ *	Increments the command reference epoch in each namespace whose path
+ *	includes the given namespace. This causes any cached resolved names
+ *	whose root cacheing context starts at that namespace to be recomputed
+ *	the next time they are used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInvalidateNsPath(
+    Namespace *nsPtr)
+{
+    NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+    while (nsPathPtr != NULL) {
+	if (nsPathPtr->nsPtr != NULL) {
+	    nsPathPtr->creatorNsPtr->cmdRefEpoch++;
+	}
+	nsPathPtr = nsPathPtr->nextPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceQualifiersCmd --
  *
  *	Invoked to implement the "namespace qualifiers" command that returns
  *	any leading namespace qualifiers in a string. These qualifiers are
  *	namespace names separated by "::"s. For example, for "::foo::p" this
- *	command returns "::foo", and for "::" it returns "". This command
- *	is the complement of the "namespace tail" command. Note that this
- *	command does not check whether the "namespace" names are, in fact,
- *	the names of currently defined namespaces. Handles the following
- *	syntax:
+ *	command returns "::foo", and for "::" it returns "". This command is
+ *	the complement of the "namespace tail" command. Note that this command
+ *	does not check whether the "namespace" names are, in fact, the names
+ *	of currently defined namespaces. Handles the following syntax:
  *
  *	    namespace qualifiers string
  *
  * Results:
- *	Returns TCL_OK if successful, and  TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceQualifiersCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceQualifiersCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register char *name, *p;
     int length;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 2, objv, "string");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
-     * Find the end of the string, then work backward and find
-     * the start of the last "::" qualifier.
+     * Find the end of the string, then work backward and find the start of
+     * the last "::" qualifier.
      */
 
-    name = Tcl_GetString(objv[2]);
+    name = TclGetString(objv[2]);
     for (p = name;  *p != '\0';  p++) {
 	/* empty body */
     }
     while (--p >= name) {
-        if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
-	    p -= 2;		/* back up over the :: */
+	if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
+	    p -= 2;			/* Back up over the :: */
 	    while ((p >= name) && (*p == ':')) {
-		p--;		/* back up over the preceeding : */
+		p--;			/* Back up over the preceeding : */
 	    }
 	    break;
-        }
+	}
     }
 
     if (p >= name) {
-        length = p-name+1;
-        Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
+	length = p-name+1;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, length));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceUnknownCmd --
+ *
+ *	Invoked to implement the "namespace unknown" command (TIP 181) that
+ *	sets or queries a per-namespace unknown command handler. This handler
+ *	is called when command lookup fails (current and global ns). The
+ *	default handler for the global namespace is ::unknown. The default
+ *	handler for other namespaces is to call the global namespace unknown
+ *	handler. Passing an empty list results in resetting the handler to its
+ *	default.
+ *
+ *	    namespace unknown ?handler?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	If no handler is specified, returns a result in the interpreter's
+ *	result object, otherwise it sets the unknown handler pointer in the
+ *	current namespace to the script fragment provided. If anything goes
+ *	wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceUnknownCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Namespace *currNsPtr;
+    Tcl_Obj *resultPtr;
+    int rc;
+
+    if (objc > 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+	return TCL_ERROR;
+    }
+
+    currNsPtr = TclGetCurrentNamespace(interp);
+
+    if (objc == 2) {
+	/*
+	 * Introspection - return the current namespace handler.
+	 */
+
+	resultPtr = Tcl_GetNamespaceUnknownHandler(interp, currNsPtr);
+	if (resultPtr == NULL) {
+	    TclNewObj(resultPtr);
+	}
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
+	if (rc == TCL_OK) {
+	    Tcl_SetObjResult(interp, objv[2]);
+	}
+	return rc;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNamespaceUnknownHandler --
+ *
+ *	Returns the unknown command handler registered for the given
+ *	namespace.
+ *
+ * Results:
+ *	Returns the current unknown command handler, or NULL if none exists
+ *	for the namespace.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetNamespaceUnknownHandler(
+    Tcl_Interp *interp,		/* The interpreter in which the namespace
+				 * exists. */
+    Tcl_Namespace *nsPtr)	/* The namespace. */
+{
+    Namespace *currNsPtr = (Namespace *)nsPtr;
+
+    if (currNsPtr->unknownHandlerPtr == NULL &&
+	    currNsPtr == ((Interp *)interp)->globalNsPtr) {
+	/*
+	 * Default handler for global namespace is "::unknown". For all other
+	 * namespaces, it is NULL (which falls back on the global unknown
+	 * handler).
+	 */
+
+	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+    }
+    return currNsPtr->unknownHandlerPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNamespaceUnknownHandler --
+ *
+ *	Sets the unknown command handler for the given namespace to the
+ *	command prefix passed.
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Sets the namespace unknown command handler. If the passed in handler
+ *	is NULL or an empty list, then the handler is reset to its default. If
+ *	an error occurs, then an error message is left in the interpreter
+ *	result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetNamespaceUnknownHandler(
+    Tcl_Interp *interp,		/* Interpreter in which the namespace
+				 * exists. */
+    Tcl_Namespace *nsPtr,	/* Namespace which is being updated. */
+    Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
+{
+    int lstlen = 0;
+    Namespace *currNsPtr = (Namespace *)nsPtr;
+
+    /*
+     * Ensure that we check for errors *first* before we change anything.
+     */
+
+    if (handlerPtr != NULL) {
+	if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
+	    /*
+	     * Not a list.
+	     */
+
+	    return TCL_ERROR;
+	}
+	if (lstlen > 0) {
+	    /*
+	     * We are going to be saving this handler. Increment the reference
+	     * count before decrementing the refcount on the previous handler,
+	     * so that nothing strange can happen if we are told to set the
+	     * handler to the previous value.
+	     */
+
+	    Tcl_IncrRefCount(handlerPtr);
+	}
+    }
+
+    /*
+     * Remove old handler next.
+     */
+
+    if (currNsPtr->unknownHandlerPtr != NULL) {
+	Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr);
+    }
+
+    /*
+     * Install the new handler.
+     */
+
+    if (lstlen > 0) {
+	/*
+	 * Just store the handler. It already has the correct reference count.
+	 */
+
+	currNsPtr->unknownHandlerPtr = handlerPtr;
+    } else {
+	/*
+	 * If NULL or an empty list is passed, this resets to the default
+	 * handler.
+	 */
+
+	currNsPtr->unknownHandlerPtr = NULL;
     }
     return TCL_OK;
 }
@@ -3651,13 +4356,13 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
  * NamespaceTailCmd --
  *
  *	Invoked to implement the "namespace tail" command that returns the
- *	trailing name at the end of a string with "::" namespace
- *	qualifiers. These qualifiers are namespace names separated by
- *	"::"s. For example, for "::foo::p" this command returns "p", and for
- *	"::" it returns "". This command is the complement of the "namespace
- *	qualifiers" command. Note that this command does not check whether
- *	the "namespace" names are, in fact, the names of currently defined
- *	namespaces. Handles the following syntax:
+ *	trailing name at the end of a string with "::" namespace qualifiers.
+ *	These qualifiers are namespace names separated by "::"s. For example,
+ *	for "::foo::p" this command returns "p", and for "::" it returns "".
+ *	This command is the complement of the "namespace qualifiers" command.
+ *	Note that this command does not check whether the "namespace" names
+ *	are, in fact, the names of currently defined namespaces. Handles the
+ *	following syntax:
  *
  *	    namespace tail string
  *
@@ -3665,44 +4370,44 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceTailCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+NamespaceTailCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register char *name, *p;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 2, objv, "string");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
-     * Find the end of the string, then work backward and find the
-     * last "::" qualifier.
+     * Find the end of the string, then work backward and find the last "::"
+     * qualifier.
      */
 
-    name = Tcl_GetString(objv[2]);
+    name = TclGetString(objv[2]);
     for (p = name;  *p != '\0';  p++) {
 	/* empty body */
     }
     while (--p > name) {
-        if ((*p == ':') && (*(p-1) == ':')) {
-            p++;		/* just after the last "::" */
-            break;
-        }
+	if ((*p == ':') && (*(p-1) == ':')) {
+	    p++;			/* Just after the last "::" */
+	    break;
+	}
     }
-    
+
     if (p >= name) {
-        Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
     }
     return TCL_OK;
 }
@@ -3710,6 +4415,81 @@ NamespaceTailCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * NamespaceUpvarCmd --
+ *
+ *	Invoked to implement the "namespace upvar" command, that creates
+ *	variables in the current scope linked to variables in another
+ *	namespace. Handles the following syntax:
+ *
+ *	    namespace upvar ns otherVar myVar ?otherVar myVar ...?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Creates new variables in the current scope, linked to the
+ *	corresponding variables in the stipulated nmamespace. If anything goes
+ *	wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceUpvarCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Namespace *nsPtr, *savedNsPtr;
+    Var *otherPtr, *arrayPtr;
+    char *myName;
+
+    if (objc < 5 || !(objc & 1)) {
+	Tcl_WrongNumArgs(interp, 2, objv,
+		"ns otherVar myVar ?otherVar myVar ...?");
+	return TCL_ERROR;
+    }
+
+    if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    objc -= 3;
+    objv += 3;
+
+    for (; objc>0 ; objc-=2, objv+=2) {
+	/*
+	 * Locate the other variable
+	 */
+
+	savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+	otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
+	if (otherPtr == NULL) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Create the new variable and link it to otherPtr.
+	 */
+
+	myName = TclGetString(objv[1]);
+	if (TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceWhichCmd --
  *
  *	Invoked to implement the "namespace which" command that returns the
@@ -3723,70 +4503,66 @@ NamespaceTailCmd(dummy, interp, objc, objv)
  *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If anything
- *	goes wrong, the result is an error message.
+ *	Returns a result in the interpreter's result object. If anything goes
+ *	wrong, the result is an error message.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceWhichCmd(dummy, interp, objc, objv)
-    ClientData dummy;                   /* Not used. */
-    Tcl_Interp *interp;                 /* Current interpreter. */
-    int objc;                           /* Number of arguments. */
-    Tcl_Obj *CONST objv[];              /* Argument objects. */
+NamespaceWhichCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register char *arg;
-    Tcl_Command cmd;
-    Tcl_Var variable;
-    int argIndex, lookup;
+    static const char *opts[] = {
+	"-command", "-variable", NULL
+    };
+    int lookupType = 0;
+    Tcl_Obj *resultPtr;
 
-    if (objc < 3) {
-        badArgs:
-        Tcl_WrongNumArgs(interp, 2, objv,
-	        "?-command? ?-variable? name");
-        return TCL_ERROR;
-    }
+    if (objc < 3 || objc > 4) {
+    badArgs:
+	Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
+	return TCL_ERROR;
+    } else if (objc == 4) {
+	/*
+	 * Look for a flag controlling the lookup.
+	 */
 
-    /*
-     * Look for a flag controlling the lookup.
-     */
+	if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
+		&lookupType) != TCL_OK) {
+	    /*
+	     * Preserve old style of error message!
+	     */
 
-    argIndex = 2;
-    lookup = 0;			/* assume command lookup by default */
-    arg = Tcl_GetString(objv[2]);
-    if (*arg == '-') {
-	if (strncmp(arg, "-command", 8) == 0) {
-	    lookup = 0;
-	} else if (strncmp(arg, "-variable", 9) == 0) {
-	    lookup = 1;
-	} else {
+	    Tcl_ResetResult(interp);
 	    goto badArgs;
 	}
-	argIndex = 3;
-    }
-    if (objc != (argIndex + 1)) {
-	goto badArgs;
     }
 
-    switch (lookup) {
-    case 0:			/* -command */
-	cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
-        if (cmd == (Tcl_Command) NULL) {	
-            return TCL_OK;	/* cmd not found, just return (no error) */
-        }
-	Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
-        break;
+    TclNewObj(resultPtr);
+    switch (lookupType) {
+    case 0: {				/* -command */
+	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
 
-    case 1:			/* -variable */
-        arg = Tcl_GetString(objv[argIndex]);
-	variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
-		/*flags*/ 0);
-        if (variable != (Tcl_Var) NULL) {
-            Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
-        }
-        break;
+	if (cmd != NULL) {
+	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
+	}
+	break;
+    }
+    case 1: {				/* -variable */
+	Tcl_Var var = Tcl_FindNamespaceVar(interp,
+		TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
+
+	if (var != NULL) {
+	    Tcl_GetVariableFullName(interp, var, resultPtr);
+	}
+	break;
+    }
     }
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -3802,45 +4578,44 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
  *	None.
  *
  * Side effects:
- *	Decrements the ref count of any Namespace structure pointed
- *	to by the nsName's internal representation. If there are no more
- *	references to the namespace, it's structure will be freed.
+ *	Decrements the ref count of any Namespace structure pointed to by the
+ *	nsName's internal representation. If there are no more references to
+ *	the namespace, it's structure will be freed.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeNsNameInternalRep(objPtr)
-    register Tcl_Obj *objPtr;   /* nsName object with internal
-                                 * representation to free */
+FreeNsNameInternalRep(
+    register Tcl_Obj *objPtr)	/* nsName object with internal representation
+				 * to free. */
 {
-    register ResolvedNsName *resNamePtr =
-        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
+	    objPtr->internalRep.twoPtrValue.ptr1;
     Namespace *nsPtr;
 
     /*
-     * Decrement the reference count of the namespace. If there are no
-     * more references, free it up.
+     * Decrement the reference count of the namespace. If there are no more
+     * references, free it up.
      */
 
-    if (resNamePtr != NULL) {
-        resNamePtr->refCount--;
-        if (resNamePtr->refCount == 0) {
+    resNamePtr->refCount--;
+    if (resNamePtr->refCount == 0) {
 
-            /*
-	     * Decrement the reference count for the cached namespace.  If
-	     * the namespace is dead, and there are no more references to
-	     * it, free it.
-	     */
+	/*
+	 * Decrement the reference count for the cached namespace. If the
+	 * namespace is dead, and there are no more references to it, free
+	 * it.
+	 */
 
-            nsPtr = resNamePtr->nsPtr;
-            nsPtr->refCount--;
-            if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
-                NamespaceFree(nsPtr);
-            }
-            ckfree((char *) resNamePtr);
-        }
+	nsPtr = resNamePtr->nsPtr;
+	nsPtr->refCount--;
+	if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+	    NamespaceFree(nsPtr);
+	}
+	ckfree((char *) resNamePtr);
     }
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -3856,25 +4631,23 @@ FreeNsNameInternalRep(objPtr)
  *
  * Side effects:
  *	copyPtr's internal rep is set to refer to the same namespace
- *	referenced by srcPtr's internal rep. Increments the ref count of
- *	the ResolvedNsName structure used to hold the namespace reference.
+ *	referenced by srcPtr's internal rep. Increments the ref count of the
+ *	ResolvedNsName structure used to hold the namespace reference.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DupNsNameInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;                /* Object with internal rep to copy. */
-    register Tcl_Obj *copyPtr;      /* Object with internal rep to set. */
+DupNsNameInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    register ResolvedNsName *resNamePtr =
-        (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
+    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
+	    srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
-    if (resNamePtr != NULL) {
-        resNamePtr->refCount++;
-    }
-    copyPtr->typePtr = &tclNsNameType;
+    copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
+    resNamePtr->refCount++;
+    copyPtr->typePtr = &nsNameType;
 }
 
 /*
@@ -3882,146 +4655,2349 @@ DupNsNameInternalRep(srcPtr, copyPtr)
  *
  * SetNsNameFromAny --
  *
- *	Attempt to generate a nsName internal representation for a
- *	Tcl object.
+ *	Attempt to generate a nsName internal representation for a Tcl object.
  *
  * Results:
- *	Returns TCL_OK if the value could be converted to a proper
- *	namespace reference. Otherwise, it returns TCL_ERROR, along
- *	with an error message in the interpreter's result object.
+ *	Returns TCL_OK if the value could be converted to a proper namespace
+ *	reference. Otherwise, it returns TCL_ERROR, along with an error
+ *	message in the interpreter's result object.
  *
  * Side effects:
- *	If successful, the object is made a nsName object. Its internal rep
- *	is set to point to a ResolvedNsName, which contains a cached pointer
- *	to the Namespace. Reference counts are kept on both the
- *	ResolvedNsName and the Namespace, so we can keep track of their
- *	usage and free them when appropriate.
+ *	If successful, the object is made a nsName object. Its internal rep is
+ *	set to point to a ResolvedNsName, which contains a cached pointer to
+ *	the Namespace. Reference counts are kept on both the ResolvedNsName
+ *	and the Namespace, so we can keep track of their usage and free them
+ *	when appropriate.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetNsNameFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Points to the namespace in which to
-				 * resolve name. Also used for error
-				 * reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
+SetNsNameFromAny(
+    Tcl_Interp *interp,		/* Points to the namespace in which to resolve
+				 * name. Also used for error reporting if not
+				 * NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *name;
-    CONST char *dummy;
+    const char *dummy;
     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
     register ResolvedNsName *resNamePtr;
+    const char *name;
 
     if (interp == NULL) {
 	return TCL_ERROR;
     }
 
+    name = TclGetString(objPtr);
+    TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
+	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
     /*
-     * Get the string representation. Make it up-to-date if necessary.
+     * If we found a namespace, then create a new ResolvedNsName structure
+     * that holds a reference to it.
      */
 
-    name = objPtr->bytes;
-    if (name == NULL) {
-	name = Tcl_GetString(objPtr);
+    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+	/*
+	 * Our failed lookup proves any previously cached nsName intrep is no
+	 * longer valid. Get rid of it so we no longer waste memory storing
+	 * it, nor time determining its invalidity again and again.
+	 */
+
+	if (objPtr->typePtr == &nsNameType) {
+	    TclFreeIntRep(objPtr);
+	    objPtr->typePtr = NULL;
+	}
+	return TCL_ERROR;
+    }
+
+    nsPtr->refCount++;
+    resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
+    resNamePtr->nsPtr = nsPtr;
+    if ((name[0] == ':') && (name[1] == ':')) {
+	resNamePtr->refNsPtr = NULL;
+    } else {
+	resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    }
+    resNamePtr->refCount = 1;
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
+    objPtr->typePtr = &nsNameType;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NamespaceEnsembleCmd --
+ *
+ *	Invoked to implement the "namespace ensemble" command that creates and
+ *	manipulates ensembles built on top of namespaces. Handles the
+ *	following syntax:
+ *
+ *	    namespace ensemble name ?dictionary?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Creates the ensemble for the namespace if one did not previously
+ *	exist. Alternatively, alters the way that the ensemble's subcommand =>
+ *	implementation prefix is configured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceEnsembleCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Namespace *nsPtr;
+    Tcl_Command token;
+    static const char *subcommands[] = {
+	"configure", "create", "exists", NULL
+    };
+    enum EnsSubcmds {
+	ENS_CONFIG, ENS_CREATE, ENS_EXISTS
+    };
+    static const char *createOptions[] = {
+	"-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
+    };
+    enum EnsCreateOpts {
+	CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
+    };
+    static const char *configOptions[] = {
+	"-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
+    };
+    enum EnsConfigOpts {
+	CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
+    };
+    int index;
+
+    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
+	if (!Tcl_InterpDeleted(interp)) {
+	    Tcl_AppendResult(interp,
+		    "tried to manipulate ensemble of deleted namespace", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum EnsSubcmds) index) {
+    case ENS_CREATE: {
+	char *name;
+	Tcl_DictSearch search;
+	Tcl_Obj *listObj;
+	int done, len, allocatedMapFlag = 0;
+	/*
+	 * Defaults
+	 */
+	Tcl_Obj *subcmdObj = NULL;
+	Tcl_Obj *mapObj = NULL;
+	int permitPrefix = 1;
+	Tcl_Obj *unknownObj = NULL;
+
+	objv += 3;
+	objc -= 3;
+
+	/*
+	 * Work out what name to use for the command to create. If supplied,
+	 * it is either fully specified or relative to the current namespace.
+	 * If not supplied, it is exactly the name of the current namespace.
+	 */
+
+	name = nsPtr->fullName;
+
+	/*
+	 * Parse the option list, applying type checks as we go. Note that we
+	 * are not incrementing any reference counts in the objects at this
+	 * stage, so the presence of an option multiple times won't cause any
+	 * memory leaks.
+	 */
+
+	for (; objc>1 ; objc-=2,objv+=2 ) {
+	    if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option",
+		    0, &index) != TCL_OK) {
+		if (allocatedMapFlag) {
+		    Tcl_DecrRefCount(mapObj);
+		}
+		return TCL_ERROR;
+	    }
+	    switch ((enum EnsCreateOpts) index) {
+	    case CRT_CMD:
+		name = TclGetString(objv[1]);
+		continue;
+	    case CRT_SUBCMDS:
+		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    return TCL_ERROR;
+		}
+		subcmdObj = (len > 0 ? objv[1] : NULL);
+		continue;
+	    case CRT_MAP: {
+		Tcl_Obj *patchedDict = NULL, *subcmdObj;
+
+		/*
+		 * Verify that the map is sensible.
+		 */
+
+		if (Tcl_DictObjFirst(interp, objv[1], &search,
+			&subcmdObj, &listObj, &done) != TCL_OK) {
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    return TCL_ERROR;
+		}
+		if (done) {
+		    mapObj = NULL;
+		    continue;
+		}
+		do {
+		    Tcl_Obj **listv;
+		    char *cmd;
+
+		    if (TclListObjGetElements(interp, listObj, &len,
+			    &listv) != TCL_OK) {
+			Tcl_DictObjDone(&search);
+			if (patchedDict) {
+			    Tcl_DecrRefCount(patchedDict);
+			}
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    if (len < 1) {
+			Tcl_SetResult(interp,
+				"ensemble subcommand implementations "
+				"must be non-empty lists", TCL_STATIC);
+			Tcl_DictObjDone(&search);
+			if (patchedDict) {
+			    Tcl_DecrRefCount(patchedDict);
+			}
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    cmd = TclGetString(listv[0]);
+		    if (!(cmd[0] == ':' && cmd[1] == ':')) {
+			Tcl_Obj *newList = Tcl_NewListObj(len, listv);
+			Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);
+
+			if (nsPtr->parentPtr) {
+			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
+			}
+			Tcl_AppendObjToObj(newCmd, listv[0]);
+			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
+			if (patchedDict == NULL) {
+			    patchedDict = Tcl_DuplicateObj(objv[1]);
+			}
+			Tcl_DictObjPut(NULL, patchedDict, subcmdObj, newList);
+		    }
+		    Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
+		} while (!done);
+
+		if (allocatedMapFlag) {
+		    Tcl_DecrRefCount(mapObj);
+		}
+		mapObj = (patchedDict ? patchedDict : objv[1]);
+		if (patchedDict) {
+		    allocatedMapFlag = 1;
+		}
+		continue;
+	    }
+	    case CRT_PREFIX:
+		if (Tcl_GetBooleanFromObj(interp, objv[1],
+			&permitPrefix) != TCL_OK) {
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    return TCL_ERROR;
+		}
+		continue;
+	    case CRT_UNKNOWN:
+		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    return TCL_ERROR;
+		}
+		unknownObj = (len > 0 ? objv[1] : NULL);
+		continue;
+	    }
+	}
+
+	/*
+	 * Create the ensemble. Note that this might delete another ensemble
+	 * linked to the same namespace, so we must be careful. However, we
+	 * should be OK because we only link the namespace into the list once
+	 * we've created it (and after any deletions have occurred.)
+	 */
+
+	token = Tcl_CreateEnsemble(interp, name, NULL,
+		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
+	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
+	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
+
+	/*
+	 * Tricky! Must ensure that the result is not shared (command delete
+	 * traces could have corrupted the pristine object that we started
+	 * with). [Snit test rename-1.5]
+	 */
+
+	Tcl_ResetResult(interp);
+	Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
+	return TCL_OK;
+    }
+
+    case ENS_EXISTS:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+		Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
+	return TCL_OK;
+
+    case ENS_CONFIG:
+	if (objc < 4 || (objc != 5 && objc & 1)) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
+	    return TCL_ERROR;
+	}
+	token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
+	if (token == NULL) {
+	    return TCL_ERROR;
+	}
+
+	if (objc == 5) {
+	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */
+
+	    if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
+		    0, &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum EnsConfigOpts) index) {
+	    case CONF_SUBCMDS:
+		Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
+		if (resultObj != NULL) {
+		    Tcl_SetObjResult(interp, resultObj);
+		}
+		break;
+	    case CONF_MAP:
+		Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
+		if (resultObj != NULL) {
+		    Tcl_SetObjResult(interp, resultObj);
+		}
+		break;
+	    case CONF_NAMESPACE: {
+		Tcl_Namespace *namespacePtr = NULL; /* silence gcc 4 warning */
+
+		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
+		Tcl_SetResult(interp, ((Namespace *)namespacePtr)->fullName,
+			TCL_VOLATILE);
+		break;
+	    }
+	    case CONF_PREFIX: {
+		int flags = 0;			/* silence gcc 4 warning */
+
+		Tcl_GetEnsembleFlags(NULL, token, &flags);
+		Tcl_SetObjResult(interp,
+			Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
+		break;
+	    }
+	    case CONF_UNKNOWN:
+		Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
+		if (resultObj != NULL) {
+		    Tcl_SetObjResult(interp, resultObj);
+		}
+		break;
+	    }
+	    return TCL_OK;
+
+	} else if (objc == 4) {
+	    /*
+	     * Produce list of all information.
+	     */
+
+	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
+	    Tcl_Namespace *namespacePtr = NULL;	/* silence gcc 4 warning */
+	    int flags = 0;			/* silence gcc 4 warning */
+
+	    TclNewObj(resultObj);
+
+	    /* -map option */
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(configOptions[CONF_MAP], -1));
+	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+	    /* -namespace option */
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
+	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
+		    -1));
+
+	    /* -prefix option */
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
+	    Tcl_GetEnsembleFlags(NULL, token, &flags);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
+
+	    /* -subcommands option */
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
+	    Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+	    /* -unknown option */
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
+	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
+	    Tcl_SetObjResult(interp, resultObj);
+	    return TCL_OK;
+	} else {
+	    Tcl_DictSearch search;
+	    Tcl_Obj *listObj;
+	    int done, len, allocatedMapFlag = 0;
+	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL,
+		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
+	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */
+
+	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
+	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
+	    Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
+	    Tcl_GetEnsembleFlags(NULL, token, &flags);
+	    permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
+
+	    objv += 4;
+	    objc -= 4;
+
+	    /*
+	     * Parse the option list, applying type checks as we go. Note that
+	     * we are not incrementing any reference counts in the objects at
+	     * this stage, so the presence of an option multiple times won't
+	     * cause any memory leaks.
+	     */
+
+	    for (; objc>0 ; objc-=2,objv+=2 ) {
+		if (Tcl_GetIndexFromObj(interp, objv[0], configOptions,
+			"option", 0, &index) != TCL_OK) {
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    return TCL_ERROR;
+		}
+		switch ((enum EnsConfigOpts) index) {
+		case CONF_SUBCMDS:
+		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    subcmdObj = (len > 0 ? objv[1] : NULL);
+		    continue;
+		case CONF_MAP: {
+		    Tcl_Obj *patchedDict = NULL, *subcmdObj;
+
+		    /*
+		     * Verify that the map is sensible.
+		     */
+
+		    if (Tcl_DictObjFirst(interp, objv[1], &search,
+			    &subcmdObj, &listObj, &done) != TCL_OK) {
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    if (done) {
+			mapObj = NULL;
+			continue;
+		    }
+		    do {
+			Tcl_Obj **listv;
+			char *cmd;
+
+			if (TclListObjGetElements(interp, listObj, &len,
+				&listv) != TCL_OK) {
+			    Tcl_DictObjDone(&search);
+			    if (patchedDict) {
+				Tcl_DecrRefCount(patchedDict);
+			    }
+			    if (allocatedMapFlag) {
+				Tcl_DecrRefCount(mapObj);
+			    }
+			    return TCL_ERROR;
+			}
+			if (len < 1) {
+			    Tcl_SetResult(interp,
+				    "ensemble subcommand implementations "
+				    "must be non-empty lists", TCL_STATIC);
+			    Tcl_DictObjDone(&search);
+			    if (patchedDict) {
+				Tcl_DecrRefCount(patchedDict);
+			    }
+			    if (allocatedMapFlag) {
+				Tcl_DecrRefCount(mapObj);
+			    }
+			    return TCL_ERROR;
+			}
+			cmd = TclGetString(listv[0]);
+			if (!(cmd[0] == ':' && cmd[1] == ':')) {
+			    Tcl_Obj *newList = Tcl_NewListObj(len, listv);
+			    Tcl_Obj *newCmd =
+				    Tcl_NewStringObj(nsPtr->fullName, -1);
+			    if (nsPtr->parentPtr) {
+				Tcl_AppendStringsToObj(newCmd, "::", NULL);
+			    }
+			    Tcl_AppendObjToObj(newCmd, listv[0]);
+			    Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
+			    if (patchedDict == NULL) {
+				patchedDict = Tcl_DuplicateObj(objv[1]);
+			    }
+			    Tcl_DictObjPut(NULL, patchedDict, subcmdObj,
+				    newList);
+			}
+			Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
+		    } while (!done);
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    mapObj = (patchedDict ? patchedDict : objv[1]);
+		    if (patchedDict) {
+			allocatedMapFlag = 1;
+		    }
+		    continue;
+		}
+		case CONF_NAMESPACE:
+		    if (allocatedMapFlag) {
+			Tcl_DecrRefCount(mapObj);
+		    }
+		    Tcl_AppendResult(interp, "option -namespace is read-only",
+			    NULL);
+		    return TCL_ERROR;
+		case CONF_PREFIX:
+		    if (Tcl_GetBooleanFromObj(interp, objv[1],
+			    &permitPrefix) != TCL_OK) {
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    continue;
+		case CONF_UNKNOWN:
+		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+			if (allocatedMapFlag) {
+			    Tcl_DecrRefCount(mapObj);
+			}
+			return TCL_ERROR;
+		    }
+		    unknownObj = (len > 0 ? objv[1] : NULL);
+		    continue;
+		}
+	    }
+
+	    /*
+	     * Update the namespace now that we've finished the parsing stage.
+	     */
+
+	    flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
+		    : flags&~TCL_ENSEMBLE_PREFIX);
+	    Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
+	    Tcl_SetEnsembleMappingDict(interp, token, mapObj);
+	    Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
+	    Tcl_SetEnsembleFlags(interp, token, flags);
+	    return TCL_OK;
+	}
+
+    default:
+	Tcl_Panic("unexpected ensemble command");
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEnsemble --
+ *
+ *	Create a simple ensemble attached to the given namespace.
+ *
+ * Results:
+ *	The token for the command created.
+ *
+ * Side effects:
+ *	The ensemble is created and marked for compilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateEnsemble(
+    Tcl_Interp *interp,
+    const char *name,
+    Tcl_Namespace *namespacePtr,
+    int flags)
+{
+    Namespace *nsPtr = (Namespace *) namespacePtr;
+    EnsembleConfig *ensemblePtr = (EnsembleConfig *)
+	    ckalloc(sizeof(EnsembleConfig));
+    Tcl_Obj *nameObj = NULL;
+
+    if (nsPtr == NULL) {
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     }
 
     /*
-     * Look for the namespace "name" in the current namespace. If there is
-     * an error parsing the (possibly qualified) name, return an error.
-     * If the namespace isn't found, we convert the object to an nsName
-     * object with a NULL ResolvedNsName* internal rep.
+     * Make the name of the ensemble into a fully qualified name. This might
+     * allocate a temporary object.
      */
 
-    TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
-            FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+    if (!(name[0] == ':' && name[1] == ':')) {
+	nameObj = Tcl_NewStringObj(nsPtr->fullName, -1);
+	if (nsPtr->parentPtr == NULL) {
+	    Tcl_AppendStringsToObj(nameObj, name, NULL);
+	} else {
+	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
+	}
+	Tcl_IncrRefCount(nameObj);
+	name = TclGetString(nameObj);
+    }
+
+    ensemblePtr->nsPtr = nsPtr;
+    ensemblePtr->epoch = 0;
+    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
+    ensemblePtr->subcommandArrayPtr = NULL;
+    ensemblePtr->subcmdList = NULL;
+    ensemblePtr->subcommandDict = NULL;
+    ensemblePtr->flags = flags;
+    ensemblePtr->unknownHandler = NULL;
+    ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
+	    NsEnsembleImplementationCmd, ensemblePtr, DeleteEnsembleConfig);
+    ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
+    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
 
     /*
-     * If we found a namespace, then create a new ResolvedNsName structure
-     * that holds a reference to it.
+     * Trigger an eventual recomputation of the ensemble command set. Note
+     * that this is slightly tricky, as it means that we are not actually
+     * counting the number of namespace export actions, but it is the simplest
+     * way to go!
      */
 
-    if (nsPtr != NULL) {
-	Namespace *currNsPtr =
-	        (Namespace *) Tcl_GetCurrentNamespace(interp);
-	
-        nsPtr->refCount++;
-        resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
-        resNamePtr->nsPtr = nsPtr;
-        resNamePtr->nsId = nsPtr->nsId;
-        resNamePtr->refNsPtr = currNsPtr;
-        resNamePtr->refCount = 1;
-    } else {
-        resNamePtr = NULL;
+    nsPtr->exportLookupEpoch++;
+
+    if (flags & ENSEMBLE_COMPILE) {
+	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+    }
+
+    if (nameObj != NULL) {
+	TclDecrRefCount(nameObj);
+    }
+    return ensemblePtr->token;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleSubcommandList --
+ *
+ *	Set the subcommand list for a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an ensemble
+ *	or the subcommand list - if non-NULL - is not a list).
+ *
+ * Side effects:
+ *	The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleSubcommandList(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj *subcmdList)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+    Tcl_Obj *oldList;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	return TCL_ERROR;
+    }
+    if (subcmdList != NULL) {
+	int length;
+
+	if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (length < 1) {
+	    subcmdList = NULL;
+	}
     }
 
+    ensemblePtr = cmdPtr->objClientData;
+    oldList = ensemblePtr->subcmdList;
+    ensemblePtr->subcmdList = subcmdList;
+    if (subcmdList != NULL) {
+	Tcl_IncrRefCount(subcmdList);
+    }
+    if (oldList != NULL) {
+	TclDecrRefCount(oldList);
+    }
+
+    /*
+     * Trigger an eventual recomputation of the ensemble command set. Note
+     * that this is slightly tricky, as it means that we are not actually
+     * counting the number of namespace export actions, but it is the simplest
+     * way to go!
+     */
+
+    ensemblePtr->nsPtr->exportLookupEpoch++;
+
     /*
-     * Free the old internalRep before setting the new one.
-     * We do this as late as possible to allow the conversion code
-     * (in particular, Tcl_GetStringFromObj) to use that old internalRep.
+     * Special hack to make compiling of [info exists] work when the
+     * dictionary is modified.
      */
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-        oldTypePtr->freeIntRepProc(objPtr);
+    if (cmdPtr->compileProc != NULL) {
+	((Interp *)interp)->compileEpoch++;
     }
 
-    objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
-    objPtr->typePtr = &tclNsNameType;
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * UpdateStringOfNsName --
+ * Tcl_SetEnsembleMappingDict --
  *
- *	Updates the string representation for a nsName object.
- *	Note: This procedure does not free an existing old string rep
- *	so storage will be lost if this has not already been done.
+ *	Set the mapping dictionary for a particular ensemble.
  *
  * Results:
- *	None.
+ *	Tcl result code (error if command token does not indicate an ensemble
+ *	or the mapping - if non-NULL - is not a dict).
  *
  * Side effects:
- *	The object's string is set to a copy of the fully qualified
- *	namespace name.
+ *	The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleMappingDict(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj *mapDict)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+    Tcl_Obj *oldDict;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	return TCL_ERROR;
+    }
+    if (mapDict != NULL) {
+	int size, done;
+	Tcl_DictSearch search;
+	Tcl_Obj *valuePtr;
+
+	if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	for (Tcl_DictObjFirst(NULL, mapDict, &search, NULL, &valuePtr, &done);
+		!done; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
+	    Tcl_Obj *cmdPtr;
+	    const char *bytes;
+
+	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdPtr) != TCL_OK) {
+		Tcl_DictObjDone(&search);
+		return TCL_ERROR;
+	    }
+	    bytes = TclGetString(cmdPtr);
+	    if (bytes[0] != ':' || bytes[1] != ':') {
+		Tcl_AppendResult(interp,
+			"ensemble target is not a fully-qualified command",
+			NULL);
+		Tcl_DictObjDone(&search);
+		return TCL_ERROR;
+	    }
+	}
+
+	if (size < 1) {
+	    mapDict = NULL;
+	}
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    oldDict = ensemblePtr->subcommandDict;
+    ensemblePtr->subcommandDict = mapDict;
+    if (mapDict != NULL) {
+	Tcl_IncrRefCount(mapDict);
+    }
+    if (oldDict != NULL) {
+	TclDecrRefCount(oldDict);
+    }
+
+    /*
+     * Trigger an eventual recomputation of the ensemble command set. Note
+     * that this is slightly tricky, as it means that we are not actually
+     * counting the number of namespace export actions, but it is the simplest
+     * way to go!
+     */
+
+    ensemblePtr->nsPtr->exportLookupEpoch++;
+
+    /*
+     * Special hack to make compiling of [info exists] work when the
+     * dictionary is modified.
+     */
+
+    if (cmdPtr->compileProc != NULL) {
+	((Interp *)interp)->compileEpoch++;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleUnknownHandler --
+ *
+ *	Set the unknown handler for a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an ensemble
+ *	or the unknown handler - if non-NULL - is not a list).
+ *
+ * Side effects:
+ *	The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleUnknownHandler(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj *unknownList)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+    Tcl_Obj *oldList;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	return TCL_ERROR;
+    }
+    if (unknownList != NULL) {
+	int length;
+
+	if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (length < 1) {
+	    unknownList = NULL;
+	}
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    oldList = ensemblePtr->unknownHandler;
+    ensemblePtr->unknownHandler = unknownList;
+    if (unknownList != NULL) {
+	Tcl_IncrRefCount(unknownList);
+    }
+    if (oldList != NULL) {
+	TclDecrRefCount(oldList);
+    }
+
+    /*
+     * Trigger an eventual recomputation of the ensemble command set. Note
+     * that this is slightly tricky, as it means that we are not actually
+     * counting the number of namespace export actions, but it is the simplest
+     * way to go!
+     */
+
+    ensemblePtr->nsPtr->exportLookupEpoch++;
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetEnsembleFlags --
+ *
+ *	Set the flags for a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble).
+ *
+ * Side effects:
+ *	The ensemble is updated and marked for recompilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleFlags(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    int flags)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+    int wasCompiled;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;
+
+    /*
+     * This API refuses to set the ENS_DEAD flag...
+     */
+
+    ensemblePtr->flags &= ENS_DEAD;
+    ensemblePtr->flags |= flags & ~ENS_DEAD;
+
+    /*
+     * Trigger an eventual recomputation of the ensemble command set. Note
+     * that this is slightly tricky, as it means that we are not actually
+     * counting the number of namespace export actions, but it is the simplest
+     * way to go!
+     */
+
+    ensemblePtr->nsPtr->exportLookupEpoch++;
+
+    /*
+     * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
+     * compiler function and bump the interpreter's compilation epoch so that
+     * bytecode gets regenerated.
+     */
+
+    if (flags & ENSEMBLE_COMPILE) {
+	if (!wasCompiled) {
+	    ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+	    ((Interp *) interp)->compileEpoch++;
+	}
+    } else {
+	if (wasCompiled) {
+	    ((Command*) ensemblePtr->token)->compileProc = NULL;
+	    ((Interp *) interp)->compileEpoch++;
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleSubcommandList --
+ *
+ *	Get the list of subcommands associated with a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble). The list of subcommands is returned by updating the
+ *	variable pointed to by the last parameter (NULL if this is to be
+ *	derived from the mapping dictionary or the associated namespace's
+ *	exported commands).
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleSubcommandList(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj **subcmdListPtr)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    *subcmdListPtr = ensemblePtr->subcmdList;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleMappingDict --
+ *
+ *	Get the command mapping dictionary associated with a particular
+ *	ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble). The mapping dict is returned by updating the variable
+ *	pointed to by the last parameter (NULL if none is installed).
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleMappingDict(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj **mapDictPtr)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    *mapDictPtr = ensemblePtr->subcommandDict;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleUnknownHandler --
+ *
+ *	Get the unknown handler associated with a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble). The unknown handler is returned by updating the variable
+ *	pointed to by the last parameter (NULL if no handler is installed).
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleUnknownHandler(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Obj **unknownListPtr)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    *unknownListPtr = ensemblePtr->unknownHandler;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleFlags --
+ *
+ *	Get the flags for a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble). The flags are returned by updating the variable pointed to
+ *	by the last parameter.
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleFlags(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    int *flagsPtr)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    *flagsPtr = ensemblePtr->flags;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetEnsembleNamespace --
+ *
+ *	Get the namespace associated with a particular ensemble.
+ *
+ * Results:
+ *	Tcl result code (error if command token does not indicate an
+ *	ensemble). Namespace is returned by updating the variable pointed to
+ *	by the last parameter.
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleNamespace(
+    Tcl_Interp *interp,
+    Tcl_Command token,
+    Tcl_Namespace **namespacePtrPtr)
+{
+    Command *cmdPtr = (Command *) token;
+    EnsembleConfig *ensemblePtr;
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    ensemblePtr = cmdPtr->objClientData;
+    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindEnsemble --
+ *
+ *	Given a command name, get the ensemble token for it, allowing for
+ *	[namespace import]s. [Bug 1017022]
+ *
+ * Results:
+ *	The token for the ensemble command with the given name, or NULL if the
+ *	command either does not exist or is not an ensemble (when an error
+ *	message will be written into the interp if thats non-NULL).
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_FindEnsemble(
+    Tcl_Interp *interp,		/* Where to do the lookup, and where to write
+				 * the errors if TCL_LEAVE_ERR_MSG is set in
+				 * the flags. */
+    Tcl_Obj *cmdNameObj,	/* Name of command to look up. */
+    int flags)			/* Either 0 or TCL_LEAVE_ERR_MSG; other flags
+				 * are probably not useful. */
+{
+    Command *cmdPtr;
+
+    cmdPtr = (Command *)
+	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
+    if (cmdPtr == NULL) {
+	return NULL;
+    }
+
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	/*
+	 * Reuse existing infrastructure for following import link chains
+	 * rather than duplicating it.
+	 */
+
+	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+
+	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
+			"\" is not an ensemble command", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
+			TclGetString(cmdNameObj), NULL);
+	    }
+	    return NULL;
+	}
+    }
+
+    return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsEnsemble --
+ *
+ *	Simple test for ensemble-hood that takes into account imported
+ *	ensemble commands as well.
+ *
+ * Results:
+ *	Boolean value
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsEnsemble(
+    Tcl_Command token)
+{
+    Command *cmdPtr = (Command *) token;
+    if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
+	return 1;
+    }
+    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+    if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	return 0;
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMakeEnsemble --
+ *
+ *	Create an ensemble from a table of implementation commands. The
+ *	ensemble will be subject to (limited) compilation if any of the
+ *	implementation commands are compilable.
+ *
+ * Results:
+ *	Handle for the ensemble, or NULL if creation of it fails.
+ *
+ * Side effects:
+ *	May advance bytecode compilation epoch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclMakeEnsemble(
+    Tcl_Interp *interp,
+    const char *name,
+    const EnsembleImplMap map[])
+{
+    Tcl_Command ensemble;	/* The overall ensemble. */
+    Tcl_Namespace *tclNsPtr;	/* Reference to the "::tcl" namespace. */
+    Tcl_DString buf;
+
+    tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN);
+    if (tclNsPtr == NULL) {
+	Tcl_Panic("unable to find or create ::tcl namespace!");
+    }
+    Tcl_DStringInit(&buf);
+    Tcl_DStringAppend(&buf, "::tcl::", -1);
+    Tcl_DStringAppend(&buf, name, -1);
+    tclNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN);
+    if (tclNsPtr == NULL) {
+	Tcl_Panic("unable to find or create %s namespace!",
+		Tcl_DStringValue(&buf));
+    }
+    ensemble = Tcl_CreateEnsemble(interp, Tcl_DStringValue(&buf)+5, tclNsPtr,
+	    TCL_ENSEMBLE_PREFIX);
+    Tcl_DStringAppend(&buf, "::", -1);
+    if (ensemble != NULL) {
+	Tcl_Obj *mapDict;
+	int i, compile = 0;
+
+	TclNewObj(mapDict);
+	for (i=0 ; map[i].name != NULL ; i++) {
+	    Tcl_Obj *fromObj, *toObj;
+	    Command *cmdPtr;
+
+	    fromObj = Tcl_NewStringObj(map[i].name, -1);
+	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
+		    Tcl_DStringLength(&buf));
+	    Tcl_AppendToObj(toObj, map[i].name, -1);
+	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+	    cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
+		    TclGetString(toObj), map[i].proc, NULL, NULL);
+	    cmdPtr->compileProc = map[i].compileProc;
+	    compile |= (map[i].compileProc != NULL);
+	}
+	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
+	if (compile) {
+	    Tcl_SetEnsembleFlags(interp, ensemble,
+		    TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
+	}
+    }
+    Tcl_DStringFree(&buf);
+
+    return ensemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleImplementationCmd --
+ *
+ *	Implements an ensemble of commands (being those exported by a
+ *	namespace other than the global namespace) as a command with the same
+ *	(short) name as the namespace in the parent namespace.
+ *
+ * Results:
+ *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
+ *	unambiguous prefix of any command exported by the ensemble's
+ *	namespace.
+ *
+ * Side effects:
+ *	Depends on the command within the namespace that gets executed. If the
+ *	ensemble itself returns TCL_ERROR, a descriptive error message will be
+ *	placed in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleImplementationCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    EnsembleConfig *ensemblePtr = clientData;
+				/* The ensemble itself. */
+    Tcl_Obj **tempObjv;		/* Space used to construct the list of
+				 * arguments to pass to the command that
+				 * implements the ensemble subcommand. */
+    int result;			/* The result of the subcommand execution. */
+    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
+				 * the command that implements the
+				 * subcommand. */
+    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
+				 * specified but not yet cached command
+				 * names. */
+    Tcl_Obj **prefixObjv;	/* The list of objects to substitute in as the
+				 * target command prefix. */
+    int prefixObjc;		/* Size of prefixObjv of course! */
+    int reparseCount = 0;	/* Number of reparses. */
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
+	return TCL_ERROR;
+    }
+
+  restartEnsembleParse:
+    if (ensemblePtr->nsPtr->flags & NS_DYING) {
+	/*
+	 * Don't know how we got here, but make things give up quickly.
+	 */
+
+	if (!Tcl_InterpDeleted(interp)) {
+	    Tcl_AppendResult(interp,
+		    "ensemble activated for deleted namespace", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Determine if the table of subcommands is right. If so, we can just look
+     * up in there and go straight to dispatch.
+     */
+
+    if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
+	/*
+	 * Table of subcommands is still valid; therefore there might be a
+	 * valid cache of discovered information which we can reuse. Do the
+	 * check here, and if we're still valid, we can jump straight to the
+	 * part where we do the invocation of the subcommand.
+	 */
+
+	if (objv[1]->typePtr == &tclEnsembleCmdType) {
+	    EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.twoPtrValue.ptr1;
+
+	    if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
+		    ensembleCmd->epoch == ensemblePtr->epoch &&
+		    ensembleCmd->token == ensemblePtr->token) {
+		prefixObj = ensembleCmd->realPrefixObj;
+		Tcl_IncrRefCount(prefixObj);
+		goto runResultingSubcommand;
+	    }
+	}
+    } else {
+	BuildEnsembleConfig(ensemblePtr);
+	ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
+    }
+
+    /*
+     * Look in the hashtable for the subcommand name; this is the fastest way
+     * of all.
+     */
+
+    hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
+	    TclGetString(objv[1]));
+    if (hPtr != NULL) {
+	char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
+
+	prefixObj = Tcl_GetHashValue(hPtr);
+
+	/*
+	 * Cache for later in the subcommand object.
+	 */
+
+	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
+    } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
+	/*
+	 * Could not map, no prefixing, go to unknown/error handling.
+	 */
+
+	goto unknownOrAmbiguousSubcommand;
+    } else {
+	/*
+	 * If we've not already confirmed the command with the hash as part of
+	 * building our export table, we need to scan the sorted array for
+	 * matches.
+	 */
+
+	char *subcmdName;	/* Name of the subcommand, or unique prefix of
+				 * it (will be an error for a non-unique
+				 * prefix). */
+	char *fullName = NULL;	/* Full name of the subcommand. */
+	int stringLength, i;
+	int tableLength = ensemblePtr->subcommandTable.numEntries;
+
+	subcmdName = TclGetString(objv[1]);
+	stringLength = objv[1]->length;
+	for (i=0 ; i<tableLength ; i++) {
+	    register int cmp = strncmp(subcmdName,
+		    ensemblePtr->subcommandArrayPtr[i],
+		    (unsigned) stringLength);
+
+	    if (cmp == 0) {
+		if (fullName != NULL) {
+		    /*
+		     * Since there's never the exact-match case to worry about
+		     * (hash search filters this), getting here indicates that
+		     * our subcommand is an ambiguous prefix of (at least) two
+		     * exported subcommands, which is an error case.
+		     */
+
+		    goto unknownOrAmbiguousSubcommand;
+		}
+		fullName = ensemblePtr->subcommandArrayPtr[i];
+	    } else if (cmp < 0) {
+		/*
+		 * Because we are searching a sorted table, we can now stop
+		 * searching because we have gone past anything that could
+		 * possibly match.
+		 */
+
+		break;
+	    }
+	}
+	if (fullName == NULL) {
+	    /*
+	     * The subcommand is not a prefix of anything, so bail out!
+	     */
+
+	    goto unknownOrAmbiguousSubcommand;
+	}
+	hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
+	if (hPtr == NULL) {
+	    Tcl_Panic("full name %s not found in supposedly synchronized hash",
+		    fullName);
+	}
+	prefixObj = Tcl_GetHashValue(hPtr);
+
+	/*
+	 * Cache for later in the subcommand object.
+	 */
+
+	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
+    }
+
+    Tcl_IncrRefCount(prefixObj);
+  runResultingSubcommand:
+
+    /*
+     * Do the real work of execution of the subcommand by building an array of
+     * objects (note that this is potentially not the same length as the
+     * number of arguments to this ensemble command), populating it and then
+     * feeding it back through the main command-lookup engine. In theory, we
+     * could look up the command in the namespace ourselves, as we already
+     * have the namespace in which it is guaranteed to exist, but we don't do
+     * that (the cacheing of the command object used should help with that.)
+     */
+
+    {
+	Interp *iPtr = (Interp *) interp;
+	int isRootEnsemble;
+	Tcl_Obj *copyObj;
+
+	/*
+	 * Get the prefix that we're rewriting to. To do this we need to
+	 * ensure that the internal representation of the list does not change
+	 * so that we can safely keep the internal representations of the
+	 * elements in the list.
+	 */
+
+	copyObj = TclListObjCopy(NULL, prefixObj);
+	TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+
+	/*
+	 * Record what arguments the script sent in so that things like
+	 * Tcl_WrongNumArgs can give the correct error message.
+	 */
+
+	isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+	if (isRootEnsemble) {
+	    iPtr->ensembleRewrite.sourceObjs = objv;
+	    iPtr->ensembleRewrite.numRemovedObjs = 2;
+	    iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
+	} else {
+	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
+
+	    if (ni < 2) {
+		iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
+		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
+	    } else {
+		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
+	    }
+	}
+
+	/*
+	 * Allocate a workspace and build the list of arguments to pass to the
+	 * target command in it.
+	 */
+
+	tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
+		(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
+	memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
+	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+
+	/*
+	 * Hand off to the target command.
+	 */
+
+	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
+		TCL_EVAL_INVOKE);
+
+	/*
+	 * Clean up.
+	 */
+
+	TclStackFree(interp, tempObjv);
+	Tcl_DecrRefCount(copyObj);
+	if (isRootEnsemble) {
+	    iPtr->ensembleRewrite.sourceObjs = NULL;
+	    iPtr->ensembleRewrite.numRemovedObjs = 0;
+	    iPtr->ensembleRewrite.numInsertedObjs = 0;
+	}
+    }
+    Tcl_DecrRefCount(prefixObj);
+    return result;
+
+  unknownOrAmbiguousSubcommand:
+    /*
+     * Have not been able to match the subcommand asked for with a real
+     * subcommand that we export. See whether a handler has been registered
+     * for dealing with this situation. Will only call (at most) once for any
+     * particular ensemble invocation.
+     */
+
+    if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
+	int paramc, i;
+	Tcl_Obj **paramv, *unknownCmd, *ensObj;
+
+	unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
+	TclNewObj(ensObj);
+	Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
+	Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
+	for (i=1 ; i<objc ; i++) {
+	    Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
+	}
+	TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
+	Tcl_Preserve(ensemblePtr);
+	Tcl_IncrRefCount(unknownCmd);
+	result = Tcl_EvalObjv(interp, paramc, paramv, 0);
+	if (result == TCL_OK) {
+	    prefixObj = Tcl_GetObjResult(interp);
+	    Tcl_IncrRefCount(prefixObj);
+	    Tcl_DecrRefCount(unknownCmd);
+	    Tcl_Release(ensemblePtr);
+	    Tcl_ResetResult(interp);
+	    if (ensemblePtr->flags & ENS_DEAD) {
+		Tcl_DecrRefCount(prefixObj);
+		Tcl_SetResult(interp,
+			"unknown subcommand handler deleted its ensemble",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Namespace is still there. Check if the result is a valid list.
+	     * If it is, and it is non-empty, that list is what we are using
+	     * as our replacement.
+	     */
+
+	    if (TclListObjLength(interp, prefixObj, &prefixObjc) != TCL_OK) {
+		Tcl_DecrRefCount(prefixObj);
+		Tcl_AddErrorInfo(interp, "\n    while parsing result of "
+			"ensemble unknown subcommand handler");
+		return TCL_ERROR;
+	    }
+	    if (prefixObjc > 0) {
+		goto runResultingSubcommand;
+	    }
+
+	    /*
+	     * Namespace alive & empty result => reparse.
+	     */
+
+	    Tcl_DecrRefCount(prefixObj);
+	    goto restartEnsembleParse;
+	}
+	if (!Tcl_InterpDeleted(interp)) {
+	    if (result != TCL_ERROR) {
+		char buf[TCL_INTEGER_SPACE];
+
+		Tcl_ResetResult(interp);
+		Tcl_SetResult(interp,
+			"unknown subcommand handler returned bad code: ",
+			TCL_STATIC);
+		switch (result) {
+		case TCL_RETURN:
+		    Tcl_AppendResult(interp, "return", NULL);
+		    break;
+		case TCL_BREAK:
+		    Tcl_AppendResult(interp, "break", NULL);
+		    break;
+		case TCL_CONTINUE:
+		    Tcl_AppendResult(interp, "continue", NULL);
+		    break;
+		default:
+		    sprintf(buf, "%d", result);
+		    Tcl_AppendResult(interp, buf, NULL);
+		}
+		Tcl_AddErrorInfo(interp, "\n    result of "
+			"ensemble unknown subcommand handler: ");
+		Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+	    } else {
+		Tcl_AddErrorInfo(interp,
+			"\n    (ensemble unknown subcommand handler)");
+	    }
+	}
+	Tcl_DecrRefCount(unknownCmd);
+	Tcl_Release(ensemblePtr);
+	return TCL_ERROR;
+    }
+
+    /*
+     * We cannot determine what subcommand to hand off to, so generate a
+     * (standard) failure message. Note the one odd case compared with
+     * standard ensemble-like command, which is where a namespace has no
+     * exported commands at all...
+     */
+
+    Tcl_ResetResult(interp);
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
+	    TclGetString(objv[1]), NULL);
+    if (ensemblePtr->subcommandTable.numEntries == 0) {
+	Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
+		"\": namespace ", ensemblePtr->nsPtr->fullName,
+		" does not export any commands", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
+		TclGetString(objv[1]), NULL);
+	return TCL_ERROR;
+    }
+    Tcl_AppendResult(interp, "unknown ",
+	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
+	    "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
+    if (ensemblePtr->subcommandTable.numEntries == 1) {
+	Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
+    } else {
+	int i;
+
+	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
+	    Tcl_AppendResult(interp,
+		    ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
+	}
+	Tcl_AppendResult(interp, "or ",
+		ensemblePtr->subcommandArrayPtr[i], NULL);
+    }
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
+	    TclGetString(objv[1]), NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeCachedEnsembleCommand --
+ *
+ *	Cache what we've computed so far; it's not nice to repeatedly copy
+ *	strings about. Note that to do this, we start by deleting any old
+ *	representation that there was (though if it was an out of date
+ *	ensemble rep, we can skip some of the deallocation process.)
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Alters the internal representation of the first object parameter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfNsName(objPtr)
-    register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
+MakeCachedEnsembleCommand(
+    Tcl_Obj *objPtr,
+    EnsembleConfig *ensemblePtr,
+    const char *subcommandName,
+    Tcl_Obj *prefixObjPtr)
 {
-    ResolvedNsName *resNamePtr =
-        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
-    register Namespace *nsPtr;
-    char *name = "";
+    register EnsembleCmdRep *ensembleCmd;
     int length;
 
-    if ((resNamePtr != NULL)
-	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
-        nsPtr = resNamePtr->nsPtr;
-        if (nsPtr->flags & NS_DEAD) {
-            nsPtr = NULL;
-        }
-        if (nsPtr != NULL) {
-            name = nsPtr->fullName;
-        }
+    if (objPtr->typePtr == &tclEnsembleCmdType) {
+	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+	Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
+	ensembleCmd->nsPtr->refCount--;
+	if ((ensembleCmd->nsPtr->refCount == 0)
+		&& (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+	    NamespaceFree(ensembleCmd->nsPtr);
+	}
+	ckfree(ensembleCmd->fullSubcmdName);
+    } else {
+	/*
+	 * Kill the old internal rep, and replace it with a brand new one of
+	 * our own.
+	 */
+
+	TclFreeIntRep(objPtr);
+	ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
+	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
+	objPtr->typePtr = &tclEnsembleCmdType;
+    }
+
+    /*
+     * Populate the internal rep.
+     */
+
+    ensembleCmd->nsPtr = ensemblePtr->nsPtr;
+    ensembleCmd->epoch = ensemblePtr->epoch;
+    ensembleCmd->token = ensemblePtr->token;
+    ensemblePtr->nsPtr->refCount++;
+    ensembleCmd->realPrefixObj = prefixObjPtr;
+    length = strlen(subcommandName)+1;
+    ensembleCmd->fullSubcmdName = ckalloc((unsigned) length);
+    memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
+    Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsembleConfig --
+ *
+ *	Destroys the data structure used to represent an ensemble. This is
+ *	called when the ensemble's command is deleted (which happens
+ *	automatically if the ensemble's namespace is deleted.) Maintainers
+ *	should note that ensembles should be deleted by deleting their
+ *	commands.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is (eventually) deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteEnsembleConfig(
+    ClientData clientData)
+{
+    EnsembleConfig *ensemblePtr = clientData;
+    Namespace *nsPtr = ensemblePtr->nsPtr;
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hEnt;
+
+    /*
+     * Unlink from the ensemble chain if it has not been marked as having been
+     * done already.
+     */
+
+    if (ensemblePtr->next != ensemblePtr) {
+	EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;
+	if (ensPtr == ensemblePtr) {
+	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
+	} else {
+	    while (ensPtr != NULL) {
+		if (ensPtr->next == ensemblePtr) {
+		    ensPtr->next = ensemblePtr->next;
+		    break;
+		}
+		ensPtr = ensPtr->next;
+	    }
+	}
     }
 
     /*
-     * The following sets the string rep to an empty string on the heap
-     * if the internal rep is NULL.
+     * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
+     * whether disaster happened anyway.
      */
 
-    length = strlen(name);
-    if (length == 0) {
-	objPtr->bytes = tclEmptyStringRep;
+    ensemblePtr->flags |= ENS_DEAD;
+
+    /*
+     * Kill the pointer-containing fields.
+     */
+
+    if (ensemblePtr->subcommandTable.numEntries != 0) {
+	ckfree((char *) ensemblePtr->subcommandArrayPtr);
+    }
+    hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
+    while (hEnt != NULL) {
+	Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
+
+	Tcl_DecrRefCount(prefixObj);
+	hEnt = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
+    if (ensemblePtr->subcmdList != NULL) {
+	Tcl_DecrRefCount(ensemblePtr->subcmdList);
+    }
+    if (ensemblePtr->subcommandDict != NULL) {
+	Tcl_DecrRefCount(ensemblePtr->subcommandDict);
+    }
+    if (ensemblePtr->unknownHandler != NULL) {
+	Tcl_DecrRefCount(ensemblePtr->unknownHandler);
+    }
+
+    /*
+     * Arrange for the structure to be reclaimed. Note that this is complex
+     * because we have to make sure that we can react sensibly when an
+     * ensemble is deleted during the process of initialising the ensemble
+     * (especially the unknown callback.)
+     */
+
+    Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildEnsembleConfig --
+ *
+ *	Create the internal data structures that describe how an ensemble
+ *	looks, being a hash mapping from the full command name to the Tcl list
+ *	that describes the implementation prefix words, and a sorted array of
+ *	all the full command names to allow for reasonably efficient
+ *	unambiguous prefix handling.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Reallocates and rebuilds the hash table and array stored at the
+ *	ensemblePtr argument. For large ensembles or large namespaces, this is
+ *	a potentially expensive operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BuildEnsembleConfig(
+    EnsembleConfig *ensemblePtr)
+{
+    Tcl_HashSearch search;	/* Used for scanning the set of commands in
+				 * the namespace that backs up this
+				 * ensemble. */
+    int i, j, isNew;
+    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
+    Tcl_HashEntry *hPtr;
+
+    if (hash->numEntries != 0) {
+	/*
+	 * Remove pre-existing table.
+	 */
+
+	Tcl_HashSearch search;
+
+	ckfree((char *) ensemblePtr->subcommandArrayPtr);
+	hPtr = Tcl_FirstHashEntry(hash, &search);
+	while (hPtr != NULL) {
+	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
+	    Tcl_DecrRefCount(prefixObj);
+	    hPtr = Tcl_NextHashEntry(&search);
+	}
+	Tcl_DeleteHashTable(hash);
+	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
+    }
+
+    /*
+     * See if we've got an export list. If so, we will only export exactly
+     * those commands, which may be either implemented by the prefix in the
+     * subcommandDict or mapped directly onto the namespace's commands.
+     */
+
+    if (ensemblePtr->subcmdList != NULL) {
+	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
+	int subcmdc;
+
+	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
+		&subcmdv);
+	for (i=0 ; i<subcmdc ; i++) {
+	    char *name = TclGetString(subcmdv[i]);
+
+	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+
+	    /*
+	     * Skip non-unique cases.
+	     */
+
+	    if (!isNew) {
+		continue;
+	    }
+
+	    /*
+	     * Look in our dictionary (if present) for the command.
+	     */
+
+	    if (ensemblePtr->subcommandDict != NULL) {
+		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
+			&target);
+		if (target != NULL) {
+		    Tcl_SetHashValue(hPtr, target);
+		    Tcl_IncrRefCount(target);
+		    continue;
+		}
+	    }
+
+	    /*
+	     * Not there, so map onto the namespace. Note in this case that we
+	     * do not guarantee that the command is actually there; that is
+	     * the programmer's responsibility (or [::unknown] of course).
+	     */
+
+	    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
+		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+	    } else {
+		Tcl_AppendStringsToObj(cmdObj, name, NULL);
+	    }
+	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
+	    Tcl_IncrRefCount(cmdPrefixObj);
+	}
+    } else if (ensemblePtr->subcommandDict != NULL) {
+	/*
+	 * No subcmd list, but we do have a mapping dictionary so we should
+	 * use the keys of that. Convert the dictionary's contents into the
+	 * form required for the ensemble's internal hashtable.
+	 */
+
+	Tcl_DictSearch dictSearch;
+	Tcl_Obj *keyObj, *valueObj;
+	int done;
+
+	Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
+		&keyObj, &valueObj, &done);
+	while (!done) {
+	    char *name = TclGetString(keyObj);
+
+	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+	    Tcl_SetHashValue(hPtr, valueObj);
+	    Tcl_IncrRefCount(valueObj);
+	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
+	}
     } else {
-	objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
-	memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
-	objPtr->bytes[length] = '\0';
+	/*
+	 * Discover what commands are actually exported by the namespace.
+	 * What we have is an array of patterns and a hash table whose keys
+	 * are the command names exported by the namespace (the contents do
+	 * not matter here.) We must find out what commands are actually
+	 * exported by filtering each command in the namespace against each of
+	 * the patterns in the export list. Note that we use an intermediate
+	 * hash table to make memory management easier, and because that makes
+	 * exact matching far easier too.
+	 *
+	 * Suggestion for future enhancement: compute the unique prefixes and
+	 * place them in the hash too, which should make for even faster
+	 * matching.
+	 */
+
+	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
+	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
+	    char *nsCmdName =		/* Name of command in namespace. */
+		    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
+
+	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
+		if (Tcl_StringMatch(nsCmdName,
+			ensemblePtr->nsPtr->exportArrayPtr[i])) {
+		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
+
+		    /*
+		     * Remember, hash entries have a full reference to the
+		     * substituted part of the command (as a list) as their
+		     * content!
+		     */
+
+		    if (isNew) {
+			Tcl_Obj *cmdObj, *cmdPrefixObj;
+
+			TclNewObj(cmdObj);
+			Tcl_AppendStringsToObj(cmdObj,
+				ensemblePtr->nsPtr->fullName,
+				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
+				nsCmdName, NULL);
+			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+			Tcl_SetHashValue(hPtr, cmdPrefixObj);
+			Tcl_IncrRefCount(cmdPrefixObj);
+		    }
+		    break;
+		}
+	    }
+	}
+    }
+
+    if (hash->numEntries == 0) {
+	ensemblePtr->subcommandArrayPtr = NULL;
+	return;
+    }
+
+    /*
+     * Create a sorted array of all subcommands in the ensemble; hash tables
+     * are all very well for a quick look for an exact match, but they can't
+     * determine things like whether a string is a prefix of another (not
+     * without lots of preparation anyway) and they're no good for when we're
+     * generating the error message either.
+     *
+     * We do this by filling an array with the names (we use the hash keys
+     * directly to save a copy, since any time we change the array we change
+     * the hash too, and vice versa) and running quicksort over the array.
+     */
+
+    ensemblePtr->subcommandArrayPtr = (char **)
+	    ckalloc(sizeof(char *) * hash->numEntries);
+
+    /*
+     * Fill array from both ends as this makes us less likely to end up with
+     * performance problems in qsort(), which is good. Note that doing this
+     * makes this code much more opaque, but the naive alternatve:
+     *
+     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
+     *	       hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
+     *     ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
+     * }
+     *
+     * can produce long runs of precisely ordered table entries when the
+     * commands in the namespace are declared in a sorted fashion (an ordering
+     * some people like) and the hashing functions (or the command names
+     * themselves) are fairly unfortunate. By filling from both ends, it
+     * requires active malice (and probably a debugger) to get qsort() to have
+     * awful runtime behaviour.
+     */
+
+    i = 0;
+    j = hash->numEntries;
+    hPtr = Tcl_FirstHashEntry(hash, &search);
+    while (hPtr != NULL) {
+	ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
+	hPtr = Tcl_NextHashEntry(&search);
+	if (hPtr == NULL) {
+	    break;
+	}
+	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
+	hPtr = Tcl_NextHashEntry(&search);
+    }
+    if (hash->numEntries > 1) {
+	qsort(ensemblePtr->subcommandArrayPtr, (unsigned)hash->numEntries,
+		sizeof(char *), NsEnsembleStringOrder);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleStringOrder --
+ *
+ *	Helper function to compare two pointers to two strings for use with
+ *	qsort().
+ *
+ * Results:
+ *	-1 if the first string is smaller, 1 if the second string is smaller,
+ *	and 0 if they are equal.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleStringOrder(
+    const void *strPtr1,
+    const void *strPtr2)
+{
+    return strcmp(*(const char **)strPtr1, *(const char **)strPtr2);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEnsembleCmdRep --
+ *
+ *	Destroys the internal representation of a Tcl_Obj that has been
+ *	holding information about a command in an ensemble.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is deallocated. If this held the last reference to a
+ *	namespace's main structure, that main structure will also be
+ *	destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeEnsembleCmdRep(
+    Tcl_Obj *objPtr)
+{
+    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+
+    Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
+    ckfree(ensembleCmd->fullSubcmdName);
+    ensembleCmd->nsPtr->refCount--;
+    if ((ensembleCmd->nsPtr->refCount == 0)
+	    && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+	NamespaceFree(ensembleCmd->nsPtr);
     }
+    ckfree((char *) ensembleCmd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEnsembleCmdRep --
+ *
+ *	Makes one Tcl_Obj into a copy of another that is a subcommand of an
+ *	ensemble.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is allocated, and the namespace that the ensemble is built on
+ *	top of gains another reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupEnsembleCmdRep(
+    Tcl_Obj *objPtr,
+    Tcl_Obj *copyPtr)
+{
+    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)
+	    ckalloc(sizeof(EnsembleCmdRep));
+    int length = strlen(ensembleCmd->fullSubcmdName);
+
+    copyPtr->typePtr = &tclEnsembleCmdType;
+    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+    ensembleCopy->nsPtr = ensembleCmd->nsPtr;
+    ensembleCopy->epoch = ensembleCmd->epoch;
+    ensembleCopy->token = ensembleCmd->token;
+    ensembleCopy->nsPtr->refCount++;
+    ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
+    Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
+    ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1);
+    memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
+	    (unsigned) length+1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringOfEnsembleCmdRep --
+ *
+ *	Creates a string representation of a Tcl_Obj that holds a subcommand
+ *	of an ensemble.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object gains a string (UTF-8) representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StringOfEnsembleCmdRep(
+    Tcl_Obj *objPtr)
+{
+    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    int length = strlen(ensembleCmd->fullSubcmdName);
+
     objPtr->length = length;
+    objPtr->bytes = ckalloc((unsigned) length+1);
+    memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LogCommandInfo --
+ *
+ *	This function is invoked after an error occurs in an interpreter. It
+ *	adds information to iPtr->errorInfo field to describe the command that
+ *	was being executed when the error occurred.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Information about the command is added to errorInfo and the line
+ *	number stored internally in the interpreter is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LogCommandInfo(
+    Tcl_Interp *interp,		/* Interpreter in which to log information. */
+    const char *script,		/* First character in script containing
+				 * command (must be <= command). */
+    const char *command,	/* First character in command that generated
+				 * the error. */
+    int length)			/* Number of bytes in command (-1 means use
+				 * all bytes up to first null byte). */
+{
+    register const char *p;
+    Interp *iPtr = (Interp *) interp;
+    int overflow, limit = 150;
+    Var *varPtr, *arrayPtr;
+
+    if (iPtr->flags & ERR_ALREADY_LOGGED) {
+	/*
+	 * Someone else has already logged error information for this command;
+	 * we shouldn't add anything more.
+	 */
+
+	return;
+    }
+
+    /*
+     * Compute the line number where the error occurred.
+     */
+
+    iPtr->errorLine = 1;
+    for (p = script; p != command; p++) {
+	if (*p == '\n') {
+	    iPtr->errorLine++;
+	}
+    }
+
+    if (length < 0) {
+	length = strlen(command);
+    }
+    overflow = (length > limit);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
+	    ? "while executing" : "invoked from within"),
+	    (overflow ? limit : length), command, (overflow ? "..." : "")));
+
+    varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
+	    NULL, 0, 0, &arrayPtr);
+    if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
+	/*
+	 * Should not happen.
+	 */
+
+	return;
+    } else {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		(char *) varPtr);
+	VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
+
+	if (tracePtr->traceProc != EstablishErrorInfoTraces) {
+	    /*
+	     * The most recent trace set on ::errorInfo is not the one the
+	     * core itself puts on last. This means some other code is tracing
+	     * the variable, and the additional trace(s) might be write traces
+	     * that expect the timing of writes to ::errorInfo that existed
+	     * Tcl releases before 8.5. To satisfy that compatibility need, we
+	     * write the current -errorinfo value to the ::errorInfo variable.
+	     */
+
+	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
+		    TCL_GLOBAL_ONLY);
+	}
+    }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 1f5a607..f85fb7a 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -1,28 +1,27 @@
-/* 
+/*
  * tclNotify.c --
  *
- *	This file implements the generic portion of the Tcl notifier.
- *	The notifier is lowest-level part of the event system.  It
- *	manages an event queue that holds Tcl_Event structures.  The
- *	platform specific portion of the notifier is defined in the
- *	tcl*Notify.c files in each platform directory.
+ *	This file implements the generic portion of the Tcl notifier. The
+ *	notifier is lowest-level part of the event system. It manages an event
+ *	queue that holds Tcl_Event structures. The platform specific portion
+ *	of the notifier is defined in the tcl*Notify.c files in each platform
+ *	directory.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998 by Scriptics Corporation.
  * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 extern TclStubs tclStubs;
 
 /*
- * For each event source (created with Tcl_CreateEventSource) there
- * is a structure of the following type:
+ * For each event source (created with Tcl_CreateEventSource) there is a
+ * structure of the following type:
  */
 
 typedef struct EventSource {
@@ -35,34 +34,34 @@ typedef struct EventSource {
 /*
  * The following structure keeps track of the state of the notifier on a
  * per-thread basis. The first three elements keep track of the event queue.
- * In addition to the first (next to be serviced) and last events in the queue,
- * we keep track of a "marker" event.  This provides a simple priority
+ * In addition to the first (next to be serviced) and last events in the
+ * queue, we keep track of a "marker" event. This provides a simple priority
  * mechanism whereby events can be inserted at the front of the queue but
- * behind all other high-priority events already in the queue (this is used for
- * things like a sequence of Enter and Leave events generated during a grab in
- * Tk).  These elements are protected by the queueMutex so that any thread
- * can queue an event on any notifier.  Note that all of the values in this
- * structure will be initialized to 0.
+ * behind all other high-priority events already in the queue (this is used
+ * for things like a sequence of Enter and Leave events generated during a
+ * grab in Tk). These elements are protected by the queueMutex so that any
+ * thread can queue an event on any notifier. Note that all of the values in
+ * this structure will be initialized to 0.
  */
 
 typedef struct ThreadSpecificData {
     Tcl_Event *firstEventPtr;	/* First pending event, or NULL if none. */
     Tcl_Event *lastEventPtr;	/* Last pending event, or NULL if none. */
-    Tcl_Event *markerEventPtr;	/* Last high-priority event in queue, or
-				 * NULL if none. */
+    Tcl_Event *markerEventPtr;	/* Last high-priority event in queue, or NULL
+				 * if none. */
     Tcl_Mutex queueMutex;	/* Mutex to protect access to the previous
 				 * three fields. */
     int serviceMode;		/* One of TCL_SERVICE_NONE or
 				 * TCL_SERVICE_ALL. */
-    int blockTimeSet;		/* 0 means there is no maximum block
-				 * time:  block forever. */
-    Tcl_Time blockTime;		/* If blockTimeSet is 1, gives the
-				 * maximum elapsed time for the next block. */
-    int inTraversal;		/* 1 if Tcl_SetMaxBlockTime is being
-				 * called during an event source traversal. */
+    int blockTimeSet;		/* 0 means there is no maximum block time:
+				 * block forever. */
+    Tcl_Time blockTime;		/* If blockTimeSet is 1, gives the maximum
+				 * elapsed time for the next block. */
+    int inTraversal;		/* 1 if Tcl_SetMaxBlockTime is being called
+				 * during an event source traversal. */
     EventSource *firstEventSourcePtr;
-				/* Pointer to first event source in
-				 * list of event sources for this thread. */
+				/* Pointer to first event source in list of
+				 * event sources for this thread. */
     Tcl_ThreadId threadId;	/* Thread that owns this notifier instance. */
     ClientData clientData;	/* Opaque handle for platform specific
 				 * notifier. */
@@ -76,20 +75,20 @@ typedef struct ThreadSpecificData {
 static Tcl_ThreadDataKey dataKey;
 
 /*
- * Global list of notifiers.  Access to this list is controlled by the
- * listLock mutex.  If this becomes a performance bottleneck, this could
- * be replaced with a hashtable.
+ * Global list of notifiers. Access to this list is controlled by the listLock
+ * mutex. If this becomes a performance bottleneck, this could be replaced
+ * with a hashtable.
  */
 
-static ThreadSpecificData *firstNotifierPtr;
+static ThreadSpecificData *firstNotifierPtr = NULL;
 TCL_DECLARE_MUTEX(listLock)
 
 /*
  * Declarations for routines used only in this file.
  */
 
-static void		QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
-			    Tcl_Event* evPtr, Tcl_QueuePosition position));
+static void		QueueEvent(ThreadSpecificData *tsdPtr,
+			    Tcl_Event* evPtr, Tcl_QueuePosition position);
 
 /*
  *----------------------------------------------------------------------
@@ -109,18 +108,29 @@ static void		QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
  */
 
 void
-TclInitNotifier()
+TclInitNotifier(void)
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    ThreadSpecificData *tsdPtr;
+    Tcl_ThreadId threadId = Tcl_GetCurrentThread();
 
     Tcl_MutexLock(&listLock);
+    for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
+	    tsdPtr = tsdPtr->nextPtr) {
+	/* Empty loop body. */
+    }
 
-    tsdPtr->threadId = Tcl_GetCurrentThread();
-    tsdPtr->clientData = tclStubs.tcl_InitNotifier();
-    tsdPtr->initialized = 1;
-    tsdPtr->nextPtr = firstNotifierPtr;
-    firstNotifierPtr = tsdPtr;
+    if (NULL == tsdPtr) {
+	/*
+	 * Notifier not yet initialized in this thread.
+	 */
 
+	tsdPtr = TCL_TSD_INIT(&dataKey);
+	tsdPtr->threadId = threadId;
+	tsdPtr->clientData = tclStubs.tcl_InitNotifier();
+	tsdPtr->initialized = 1;
+	tsdPtr->nextPtr = firstNotifierPtr;
+	firstNotifierPtr = tsdPtr;
+    }
     Tcl_MutexUnlock(&listLock);
 }
 
@@ -129,40 +139,39 @@ TclInitNotifier()
  *
  * TclFinalizeNotifier --
  *
- *	Finalize the thread local data structures for the notifier
- *	subsystem.
+ *	Finalize the thread local data structures for the notifier subsystem.
  *
  * Results:
- *	None.	
+ *	None.
  *
  * Side effects:
- *	Removes the notifier associated with the current thread from
- *	the global notifier list. This is done only if the notifier
- *	was initialized for this thread by call to TclInitNotifier().
- *	This is always true for threads which have been seeded with
- *	an Tcl interpreter, since the call to Tcl_CreateInterp will,
- *	among other things, call TclInitializeSubsystems() and this
- *	one will, in turn, call the TclInitNotifier() for the thread.
- *	For threads created without the Tcl interpreter, though,
- *	nobody is explicitly nor implicitly calling the TclInitNotifier
- *	hence, TclFinalizeNotifier should not be performed at all.
+ *	Removes the notifier associated with the current thread from the
+ *	global notifier list. This is done only if the notifier was
+ *	initialized for this thread by call to TclInitNotifier(). This is
+ *	always true for threads which have been seeded with an Tcl
+ *	interpreter, since the call to Tcl_CreateInterp will, among other
+ *	things, call TclInitializeSubsystems() and this one will, in turn,
+ *	call the TclInitNotifier() for the thread. For threads created without
+ *	the Tcl interpreter, though, nobody is explicitly nor implicitly
+ *	calling the TclInitNotifier hence, TclFinalizeNotifier should not be
+ *	performed at all.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclFinalizeNotifier()
+TclFinalizeNotifier(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ThreadSpecificData **prevPtrPtr;
     Tcl_Event *evPtr, *hold;
 
     if (!tsdPtr->initialized) {
-        return; /* Notifier not initialized for the current thread */
+	return;		/* Notifier not initialized for the current thread */
     }
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
-    for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
+    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
 	hold = evPtr;
 	evPtr = evPtr->nextPtr;
 	ckfree((char *) hold);
@@ -178,7 +187,7 @@ TclFinalizeNotifier()
     }
     Tcl_MutexFinalize(&(tsdPtr->queueMutex));
     for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
-	 prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
+	    prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
 	if (*prevPtrPtr == tsdPtr) {
 	    *prevPtrPtr = tsdPtr->nextPtr;
 	    break;
@@ -194,24 +203,24 @@ TclFinalizeNotifier()
  *
  * Tcl_SetNotifier --
  *
- *	Install a set of alternate functions for use with the notifier.
- #	In particular, this can be used to install the Xt-based
- *	notifier for use with the Browser plugin.
+ *	Install a set of alternate functions for use with the notifier. In
+ *	particular, this can be used to install the Xt-based notifier for use
+ *	with the Browser plugin.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Overstomps part of the stub vector.  This relies on hooks
- *	added to the default procedures in case those are called
- *	directly (i.e., not through the stub table.)
+ *	Overstomps part of the stub vector. This relies on hooks added to the
+ *	default functions in case those are called directly (i.e., not through
+ *	the stub table.)
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetNotifier(notifierProcPtr)
-    Tcl_NotifierProcs *notifierProcPtr;
+Tcl_SetNotifier(
+    Tcl_NotifierProcs *notifierProcPtr)
 {
 #if !defined(__WIN32__) /* UNIX */
     tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
@@ -230,10 +239,9 @@ Tcl_SetNotifier(notifierProcPtr)
  *
  * Tcl_CreateEventSource --
  *
- *	This procedure is invoked to create a new source of events.
- *	The source is identified by a procedure that gets invoked
- *	during Tcl_DoOneEvent to check for events on that source
- *	and queue them.
+ *	This function is invoked to create a new source of events. The source
+ *	is identified by a function that gets invoked during Tcl_DoOneEvent to
+ *	check for events on that source and queue them.
  *
  *
  * Results:
@@ -241,34 +249,36 @@ Tcl_SetNotifier(notifierProcPtr)
  *
  * Side effects:
  *	SetupProc and checkProc will be invoked each time that Tcl_DoOneEvent
- *	runs out of things to do.  SetupProc will be invoked before
- *	Tcl_DoOneEvent calls select or whatever else it uses to wait
- *	for events.  SetupProc typically calls functions like
- *	Tcl_SetMaxBlockTime to indicate what to wait for.
+ *	runs out of things to do. SetupProc will be invoked before
+ *	Tcl_DoOneEvent calls select or whatever else it uses to wait for
+ *	events. SetupProc typically calls functions like Tcl_SetMaxBlockTime
+ *	to indicate what to wait for.
  *
  *	CheckProc is called after select or whatever operation was actually
- *	used to wait.  It figures out whether anything interesting actually
+ *	used to wait. It figures out whether anything interesting actually
  *	happened (e.g. by calling Tcl_AsyncReady), and then calls
  *	Tcl_QueueEvent to queue any events that are ready.
  *
- *	Each of these procedures is passed two arguments, e.g.
+ *	Each of these functions is passed two arguments, e.g.
  *		(*checkProc)(ClientData clientData, int flags));
- *	ClientData is the same as the clientData argument here, and flags
- *	is a combination of things like TCL_FILE_EVENTS that indicates
- *	what events are of interest:  setupProc and checkProc use flags
- *	to figure out whether their events are relevant or not.
+ *	ClientData is the same as the clientData argument here, and flags is a
+ *	combination of things like TCL_FILE_EVENTS that indicates what events
+ *	are of interest: setupProc and checkProc use flags to figure out
+ *	whether their events are relevant or not.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CreateEventSource(setupProc, checkProc, clientData)
-    Tcl_EventSetupProc *setupProc;	/* Procedure to invoke to figure out
-					 * what to wait for. */
-    Tcl_EventCheckProc *checkProc;	/* Procedure to call after waiting
-					 * to see what happened. */
-    ClientData clientData;		/* One-word argument to pass to
-					 * setupProc and checkProc. */
+Tcl_CreateEventSource(
+    Tcl_EventSetupProc *setupProc,
+				/* Function to invoke to figure out what to
+				 * wait for. */
+    Tcl_EventCheckProc *checkProc,
+				/* Function to call after waiting to see what
+				 * happened. */
+    ClientData clientData)	/* One-word argument to pass to setupProc and
+				 * checkProc. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
@@ -285,28 +295,29 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
  *
  * Tcl_DeleteEventSource --
  *
- *	This procedure is invoked to delete the source of events
- *	given by proc and clientData.
+ *	This function is invoked to delete the source of events given by proc
+ *	and clientData.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The given event source is cancelled, so its procedure will
- *	never again be called.  If no such source exists, nothing
- *	happens.
+ *	The given event source is cancelled, so its function will never again
+ *	be called. If no such source exists, nothing happens.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DeleteEventSource(setupProc, checkProc, clientData)
-    Tcl_EventSetupProc *setupProc;	/* Procedure to invoke to figure out
-					 * what to wait for. */
-    Tcl_EventCheckProc *checkProc;	/* Procedure to call after waiting
-					 * to see what happened. */
-    ClientData clientData;		/* One-word argument to pass to
-					 * setupProc and checkProc. */
+Tcl_DeleteEventSource(
+    Tcl_EventSetupProc *setupProc,
+				/* Function to invoke to figure out what to
+				 * wait for. */
+    Tcl_EventCheckProc *checkProc,
+				/* Function to call after waiting to see what
+				 * happened. */
+    ClientData clientData)	/* One-word argument to pass to setupProc and
+				 * checkProc. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     EventSource *sourcePtr, *prevPtr;
@@ -334,8 +345,7 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
  *
  * Tcl_QueueEvent --
  *
- *	Queue an event on the event queue associated with the
- *	current thread.
+ *	Queue an event on the event queue associated with the current thread.
  *
  * Results:
  *	None.
@@ -347,14 +357,13 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
  */
 
 void
-Tcl_QueueEvent(evPtr, position)
-    Tcl_Event* evPtr;		/* Event to add to queue.  The storage
-				 * space must have been allocated the caller
-				 * with malloc (ckalloc), and it becomes
-				 * the property of the event queue.  It
-				 * will be freed after the event has been
-				 * handled. */
-    Tcl_QueuePosition position;	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+Tcl_QueueEvent(
+    Tcl_Event* evPtr,		/* Event to add to queue. The storage space
+				 * must have been allocated the caller with
+				 * malloc (ckalloc), and it becomes the
+				 * property of the event queue. It will be
+				 * freed after the event has been handled. */
+    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 				 * TCL_QUEUE_MARK. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -378,15 +387,14 @@ Tcl_QueueEvent(evPtr, position)
  */
 
 void
-Tcl_ThreadQueueEvent(threadId, evPtr, position)
-    Tcl_ThreadId threadId;	/* Identifier for thread to use. */
-    Tcl_Event* evPtr;		/* Event to add to queue.  The storage
-				 * space must have been allocated the caller
-				 * with malloc (ckalloc), and it becomes
-				 * the property of the event queue.  It
-				 * will be freed after the event has been
-				 * handled. */
-    Tcl_QueuePosition position;	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+Tcl_ThreadQueueEvent(
+    Tcl_ThreadId threadId,	/* Identifier for thread to use. */
+    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
+				 * must have been allocated the caller with
+				 * malloc (ckalloc), and it becomes the
+				 * property of the event queue. It will be
+				 * freed after the event has been handled. */
+    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 				 * TCL_QUEUE_MARK. */
 {
     ThreadSpecificData *tsdPtr;
@@ -397,7 +405,7 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
 
     Tcl_MutexLock(&listLock);
     for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
-	     tsdPtr = tsdPtr->nextPtr) {
+	    tsdPtr = tsdPtr->nextPtr) {
 	/* Empty loop body. */
     }
 
@@ -418,12 +426,12 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
  *
  * QueueEvent --
  *
- *	Insert an event into the specified thread's event queue at one
- *	of three positions: the head, the tail, or before a floating
- *	marker. Events inserted before the marker will be processed in
- *	first-in-first-out order, but before any events inserted at
- *	the tail of the queue.  Events inserted at the head of the
- *	queue will be processed in last-in-first-out order.
+ *	Insert an event into the specified thread's event queue at one of
+ *	three positions: the head, the tail, or before a floating marker.
+ *	Events inserted before the marker will be processed in first-in-
+ *	first-out order, but before any events inserted at the tail of the
+ *	queue. Events inserted at the head of the queue will be processed in
+ *	last-in-first-out order.
  *
  * Results:
  *	None.
@@ -435,16 +443,15 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
  */
 
 static void
-QueueEvent(tsdPtr, evPtr, position)
-    ThreadSpecificData *tsdPtr;	/* Handle to thread local data that indicates
+QueueEvent(
+    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
 				 * which event queue to use. */
-    Tcl_Event* evPtr;		/* Event to add to queue.  The storage
-				 * space must have been allocated the caller
-				 * with malloc (ckalloc), and it becomes
-				 * the property of the event queue.  It
-				 * will be freed after the event has been
-				 * handled. */
-    Tcl_QueuePosition position;	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+    Tcl_Event *evPtr,		/* Event to add to queue.  The storage space
+				 * must have been allocated the caller with
+				 * malloc (ckalloc), and it becomes the
+				 * property of the event queue. It will be
+				 * freed after the event has been handled. */
+    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
 				 * TCL_QUEUE_MARK. */
 {
     Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -468,12 +475,12 @@ QueueEvent(tsdPtr, evPtr, position)
 	evPtr->nextPtr = tsdPtr->firstEventPtr;
 	if (tsdPtr->firstEventPtr == NULL) {
 	    tsdPtr->lastEventPtr = evPtr;
-	}	    
+	}
 	tsdPtr->firstEventPtr = evPtr;
     } else if (position == TCL_QUEUE_MARK) {
 	/*
-	 * Insert the event after the current marker event and advance
-	 * the marker to the new event.
+	 * Insert the event after the current marker event and advance the
+	 * marker to the new event.
 	 */
 
 	if (tsdPtr->markerEventPtr == NULL) {
@@ -496,10 +503,10 @@ QueueEvent(tsdPtr, evPtr, position)
  *
  * Tcl_DeleteEvents --
  *
- *	Calls a procedure for each event in the queue and deletes those
- *	for which the procedure returns 1. Events for which the
- *	procedure returns 0 are left in the queue.  Operates on the
- *	queue associated with the current thread.
+ *	Calls a function for each event in the queue and deletes those for
+ *	which the function returns 1. Events for which the function returns 0
+ *	are left in the queue. Operates on the queue associated with the
+ *	current thread.
  *
  * Results:
  *	None.
@@ -511,36 +518,65 @@ QueueEvent(tsdPtr, evPtr, position)
  */
 
 void
-Tcl_DeleteEvents(proc, clientData)
-    Tcl_EventDeleteProc *proc;		/* The procedure to call. */
-    ClientData clientData;    		/* type-specific data. */
+Tcl_DeleteEvents(
+    Tcl_EventDeleteProc *proc,	/* The function to call. */
+    ClientData clientData)    	/* The type-specific data. */
 {
-    Tcl_Event *evPtr, *prevPtr, *hold;
+    Tcl_Event *evPtr;		/* Pointer to the event being examined */
+    Tcl_Event *prevPtr;		/* Pointer to evPtr's predecessor, or NULL if
+				 * evPtr designates the first event in the
+				 * queue for the thread. */
+    Tcl_Event* hold;
+
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
-    for (prevPtr = (Tcl_Event *) NULL, evPtr = tsdPtr->firstEventPtr;
-             evPtr != (Tcl_Event *) NULL;
-             ) {
-        if ((*proc) (evPtr, clientData) == 1) {
-            if (tsdPtr->firstEventPtr == evPtr) {
-                tsdPtr->firstEventPtr = evPtr->nextPtr;
-            } else {
-                prevPtr->nextPtr = evPtr->nextPtr;
-            }
-            if (evPtr->nextPtr == (Tcl_Event *) NULL) {
-                tsdPtr->lastEventPtr = prevPtr;
-            }
-            if (tsdPtr->markerEventPtr == evPtr) {
-                tsdPtr->markerEventPtr = prevPtr;
-            }
-            hold = evPtr;
-            evPtr = evPtr->nextPtr;
-            ckfree((char *) hold);
-        } else {
-            prevPtr = evPtr;
-            evPtr = evPtr->nextPtr;
-        }
+
+    /*
+     * Walk the queue of events for the thread, applying 'proc' to each to
+     * decide whether to eliminate the event.
+     */
+
+    prevPtr = NULL;
+    evPtr = tsdPtr->firstEventPtr;
+    while (evPtr != NULL) {
+	if ((*proc)(evPtr, clientData) == 1) {
+	    /*
+	     * This event should be deleted. Unlink it.
+	     */
+
+	    if (prevPtr == NULL) {
+		tsdPtr->firstEventPtr = evPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = evPtr->nextPtr;
+	    }
+
+	    /*
+	     * Update 'last' and 'marker' events if either has been deleted.
+	     */
+
+	    if (evPtr->nextPtr == NULL) {
+		tsdPtr->lastEventPtr = prevPtr;
+	    }
+	    if (tsdPtr->markerEventPtr == evPtr) {
+		tsdPtr->markerEventPtr = prevPtr;
+	    }
+
+	    /*
+	     * Delete the event data structure.
+	     */
+
+	    hold = evPtr;
+	    evPtr = evPtr->nextPtr;
+	    ckfree((char *) hold);
+	} else {
+	    /*
+	     * Event is to be retained.
+	     */
+
+	    prevPtr = evPtr;
+	    evPtr = evPtr->nextPtr;
+	}
     }
     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 }
@@ -550,30 +586,29 @@ Tcl_DeleteEvents(proc, clientData)
  *
  * Tcl_ServiceEvent --
  *
- *	Process one event from the event queue, or invoke an
- *	asynchronous event handler.  Operates on event queue for
- *	current thread.
+ *	Process one event from the event queue, or invoke an asynchronous
+ *	event handler. Operates on event queue for current thread.
  *
  * Results:
- *	The return value is 1 if the procedure actually found an event
- *	to process.  If no processing occurred, then 0 is returned.
+ *	The return value is 1 if the function actually found an event to
+ *	process. If no processing occurred, then 0 is returned.
  *
  * Side effects:
- *	Invokes all of the event handlers for the highest priority
- *	event in the event queue.  May collapse some events into a
- *	single event or discard stale events.
+ *	Invokes all of the event handlers for the highest priority event in
+ *	the event queue. May collapse some events into a single event or
+ *	discard stale events.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ServiceEvent(flags)
-    int flags;			/* Indicates what events should be processed.
+Tcl_ServiceEvent(
+    int flags)			/* Indicates what events should be processed.
 				 * May be any combination of TCL_WINDOW_EVENTS
 				 * TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
-				 * flags defined elsewhere.  Events not
-				 * matching this will be skipped for processing
-				 * later. */
+				 * flags defined elsewhere. Events not
+				 * matching this will be skipped for
+				 * processing later. */
 {
     Tcl_Event *evPtr, *prevPtr;
     Tcl_EventProc *proc;
@@ -581,46 +616,46 @@ Tcl_ServiceEvent(flags)
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
-     * Asynchronous event handlers are considered to be the highest
-     * priority events, and so must be invoked before we process events
-     * on the event queue.
+     * Asynchronous event handlers are considered to be the highest priority
+     * events, and so must be invoked before we process events on the event
+     * queue.
      */
-    
+
     if (Tcl_AsyncReady()) {
-	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+	(void) Tcl_AsyncInvoke(NULL, 0);
 	return 1;
     }
 
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
      */
-    
+
     if ((flags & TCL_ALL_EVENTS) == 0) {
 	flags |= TCL_ALL_EVENTS;
     }
 
     /*
-     * Loop through all the events in the queue until we find one
-     * that can actually be handled.
+     * Loop through all the events in the queue until we find one that can
+     * actually be handled.
      */
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
     for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL;
-	 evPtr = evPtr->nextPtr) {
+	    evPtr = evPtr->nextPtr) {
 	/*
-	 * Call the handler for the event.  If it actually handles the
-	 * event then free the storage for the event.  There are two
-	 * tricky things here, both stemming from the fact that the event
-	 * code may be re-entered while servicing the event:
+	 * Call the handler for the event. If it actually handles the event
+	 * then free the storage for the event. There are two tricky things
+	 * here, both stemming from the fact that the event code may be
+	 * re-entered while servicing the event:
 	 *
 	 * 1. Set the "proc" field to NULL.  This is a signal to ourselves
-	 *    that we shouldn't reexecute the handler if the event loop
-	 *    is re-entered.
+	 *    that we shouldn't reexecute the handler if the event loop is
+	 *    re-entered.
 	 * 2. When freeing the event, must search the queue again from the
-	 *    front to find it.  This is because the event queue could
-	 *    change almost arbitrarily while handling the event, so we
-	 *    can't depend on pointers found now still being valid when
-	 *    the handler returns.
+	 *    front to find it. This is because the event queue could change
+	 *    almost arbitrarily while handling the event, so we can't depend
+	 *    on pointers found now still being valid when the handler
+	 *    returns.
 	 */
 
 	proc = evPtr->proc;
@@ -630,10 +665,10 @@ Tcl_ServiceEvent(flags)
 	evPtr->proc = NULL;
 
 	/*
-	 * Release the lock before calling the event procedure.  This
-	 * allows other threads to post events if we enter a recursive
-	 * event loop in this thread.  Note that we are making the assumption
-	 * that if the proc returns 0, the event is still in the list.
+	 * Release the lock before calling the event function. This allows
+	 * other threads to post events if we enter a recursive event loop in
+	 * this thread. Note that we are making the assumption that if the
+	 * proc returns 0, the event is still in the list.
 	 */
 
 	Tcl_MutexUnlock(&(tsdPtr->queueMutex));
@@ -655,8 +690,8 @@ Tcl_ServiceEvent(flags)
 		}
 	    } else {
 		for (prevPtr = tsdPtr->firstEventPtr;
-		     prevPtr && prevPtr->nextPtr != evPtr;
-		     prevPtr = prevPtr->nextPtr) {
+			prevPtr && prevPtr->nextPtr != evPtr;
+			prevPtr = prevPtr->nextPtr) {
 		    /* Empty loop body. */
 		}
 		if (prevPtr) {
@@ -678,8 +713,8 @@ Tcl_ServiceEvent(flags)
 	    return 1;
 	} else {
 	    /*
-	     * The event wasn't actually handled, so we have to restore
-	     * the proc field to allow the event to be attempted again.
+	     * The event wasn't actually handled, so we have to restore the
+	     * proc field to allow the event to be attempted again.
 	     */
 
 	    evPtr->proc = proc;
@@ -706,7 +741,7 @@ Tcl_ServiceEvent(flags)
  */
 
 int
-Tcl_GetServiceMode()
+Tcl_GetServiceMode(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -724,14 +759,14 @@ Tcl_GetServiceMode()
  *	Returns the previous service mode.
  *
  * Side effects:
- *	Invokes the notifier service mode hook procedure.
+ *	Invokes the notifier service mode hook function.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_SetServiceMode(mode)
-    int mode;			/* New service mode: TCL_SERVICE_ALL or
+Tcl_SetServiceMode(
+    int mode)			/* New service mode: TCL_SERVICE_ALL or
 				 * TCL_SERVICE_NONE */
 {
     int oldMode;
@@ -750,10 +785,10 @@ Tcl_SetServiceMode(mode)
  *
  * Tcl_SetMaxBlockTime --
  *
- *	This procedure is invoked by event sources to tell the notifier
- *	how long it may block the next time it blocks.  The timePtr
- *	argument gives a maximum time;  the actual time may be less if
- *	some other event source requested a smaller time.
+ *	This function is invoked by event sources to tell the notifier how
+ *	long it may block the next time it blocks. The timePtr argument gives
+ *	a maximum time; the actual time may be less if some other event source
+ *	requested a smaller time.
  *
  * Results:
  *	None.
@@ -765,10 +800,10 @@ Tcl_SetServiceMode(mode)
  */
 
 void
-Tcl_SetMaxBlockTime(timePtr)
-    Tcl_Time *timePtr;		/* Specifies a maximum elapsed time for
-				 * the next blocking operation in the
-				 * event tsdPtr-> */
+Tcl_SetMaxBlockTime(
+    Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
+				 * next blocking operation in the event
+				 * tsdPtr-> */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -780,8 +815,8 @@ Tcl_SetMaxBlockTime(timePtr)
     }
 
     /*
-     * If we are called outside an event source traversal, set the
-     * timeout immediately.
+     * If we are called outside an event source traversal, set the timeout
+     * immediately.
      */
 
     if (!tsdPtr->inTraversal) {
@@ -798,27 +833,27 @@ Tcl_SetMaxBlockTime(timePtr)
  *
  * Tcl_DoOneEvent --
  *
- *	Process a single event of some sort.  If there's no work to
- *	do, wait for an event to occur, then process it.
+ *	Process a single event of some sort. If there's no work to do, wait
+ *	for an event to occur, then process it.
  *
  * Results:
- *	The return value is 1 if the procedure actually found an event
- *	to process.  If no processing occurred, then 0 is returned (this
- *	can happen if the TCL_DONT_WAIT flag is set or if there are no
- *	event handlers to wait for in the set specified by flags).
+ *	The return value is 1 if the function actually found an event to
+ *	process. If no processing occurred, then 0 is returned (this can
+ *	happen if the TCL_DONT_WAIT flag is set or if there are no event
+ *	handlers to wait for in the set specified by flags).
  *
  * Side effects:
- *	May delay execution of process while waiting for an event,
- *	unless TCL_DONT_WAIT is set in the flags argument.  Event
- *	sources are invoked to check for and queue events.  Event
- *	handlers may produce arbitrary side effects.
+ *	May delay execution of process while waiting for an event, unless
+ *	TCL_DONT_WAIT is set in the flags argument. Event sources are invoked
+ *	to check for and queue events. Event handlers may produce arbitrary
+ *	side effects.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_DoOneEvent(flags)
-    int flags;			/* Miscellaneous flag values:  may be any
+Tcl_DoOneEvent(
+    int flags)			/* Miscellaneous flag values: may be any
 				 * combination of TCL_DONT_WAIT,
 				 * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
 				 * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
@@ -830,47 +865,45 @@ Tcl_DoOneEvent(flags)
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
-     * The first thing we do is to service any asynchronous event
-     * handlers.
+     * The first thing we do is to service any asynchronous event handlers.
      */
-    
+
     if (Tcl_AsyncReady()) {
-	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+	(void) Tcl_AsyncInvoke(NULL, 0);
 	return 1;
     }
 
     /*
      * No event flags is equivalent to TCL_ALL_EVENTS.
      */
-    
+
     if ((flags & TCL_ALL_EVENTS) == 0) {
 	flags |= TCL_ALL_EVENTS;
     }
 
     /*
-     * Set the service mode to none so notifier event routines won't
-     * try to service events recursively.
+     * Set the service mode to none so notifier event routines won't try to
+     * service events recursively.
      */
 
     oldMode = tsdPtr->serviceMode;
     tsdPtr->serviceMode = TCL_SERVICE_NONE;
 
     /*
-     * The core of this procedure is an infinite loop, even though
-     * we only service one event.  The reason for this is that we
-     * may be processing events that don't do anything inside of Tcl.
+     * The core of this function is an infinite loop, even though we only
+     * service one event. The reason for this is that we may be processing
+     * events that don't do anything inside of Tcl.
      */
 
     while (1) {
-
 	/*
-	 * If idle events are the only things to service, skip the
-	 * main part of the loop and go directly to handle idle
-	 * events (i.e. don't wait even if TCL_DONT_WAIT isn't set).
+	 * If idle events are the only things to service, skip the main part
+	 * of the loop and go directly to handle idle events (i.e. don't wait
+	 * even if TCL_DONT_WAIT isn't set).
 	 */
 
 	if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
-	    flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	    flags = TCL_IDLE_EVENTS | TCL_DONT_WAIT;
 	    goto idleEvents;
 	}
 
@@ -884,8 +917,8 @@ Tcl_DoOneEvent(flags)
 	}
 
 	/*
-	 * If TCL_DONT_WAIT is set, be sure to poll rather than
-	 * blocking, otherwise reset the block time to infinity.
+	 * If TCL_DONT_WAIT is set, be sure to poll rather than blocking,
+	 * otherwise reset the block time to infinity.
 	 */
 
 	if (flags & TCL_DONT_WAIT) {
@@ -897,13 +930,13 @@ Tcl_DoOneEvent(flags)
 	}
 
 	/*
-	 * Set up all the event sources for new events.  This will
-	 * cause the block time to be updated if necessary.
+	 * Set up all the event sources for new events. This will cause the
+	 * block time to be updated if necessary.
 	 */
 
 	tsdPtr->inTraversal = 1;
 	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
-	     sourcePtr = sourcePtr->nextPtr) {
+		sourcePtr = sourcePtr->nextPtr) {
 	    if (sourcePtr->setupProc) {
 		(sourcePtr->setupProc)(sourcePtr->clientData, flags);
 	    }
@@ -917,8 +950,8 @@ Tcl_DoOneEvent(flags)
 	}
 
 	/*
-	 * Wait for a new event or a timeout.  If Tcl_WaitForEvent
-	 * returns -1, we should abort Tcl_DoOneEvent.
+	 * Wait for a new event or a timeout. If Tcl_WaitForEvent returns -1,
+	 * we should abort Tcl_DoOneEvent.
 	 */
 
 	result = Tcl_WaitForEvent(timePtr);
@@ -932,7 +965,7 @@ Tcl_DoOneEvent(flags)
 	 */
 
 	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
-	     sourcePtr = sourcePtr->nextPtr) {
+		sourcePtr = sourcePtr->nextPtr) {
 	    if (sourcePtr->checkProc) {
 		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
 	    }
@@ -948,12 +981,12 @@ Tcl_DoOneEvent(flags)
 	}
 
 	/*
-	 * We've tried everything at this point, but nobody we know
-	 * about had anything to do.  Check for idle events.  If none,
-	 * either quit or go back to the top and try again.
+	 * We've tried everything at this point, but nobody we know about had
+	 * anything to do. Check for idle events. If none, either quit or go
+	 * back to the top and try again.
 	 */
 
-	idleEvents:
+    idleEvents:
 	if (flags & TCL_IDLE_EVENTS) {
 	    if (TclServiceIdle()) {
 		result = 1;
@@ -965,23 +998,21 @@ Tcl_DoOneEvent(flags)
 	}
 
 	/*
-	 * If Tcl_WaitForEvent has returned 1,
-	 * indicating that one system event has been dispatched
-	 * (and thus that some Tcl code might have been indirectly executed),
-	 * we break out of the loop.
-	 * We do this to give VwaitCmd for instance a chance to check 
-	 * if that system event had the side effect of changing the 
-	 * variable (so the vwait can return and unwind properly).
+	 * If Tcl_WaitForEvent has returned 1, indicating that one system
+	 * event has been dispatched (and thus that some Tcl code might have
+	 * been indirectly executed), we break out of the loop. We do this to
+	 * give VwaitCmd for instance a chance to check if that system event
+	 * had the side effect of changing the variable (so the vwait can
+	 * return and unwind properly).
 	 *
-	 * NB: We will process idle events if any first, because
-	 *     otherwise we might never do the idle events if the notifier
-	 *     always gets system events.
+	 * NB: We will process idle events if any first, because otherwise we
+	 *     might never do the idle events if the notifier always gets
+	 *     system events.
 	 */
 
 	if (result) {
 	    break;
 	}
-
     }
 
     tsdPtr->serviceMode = oldMode;
@@ -993,12 +1024,11 @@ Tcl_DoOneEvent(flags)
  *
  * Tcl_ServiceAll --
  *
- *	This routine checks all of the event sources, processes
- *	events that are on the Tcl event queue, and then calls the
- *	any idle handlers.  Platform specific notifier callbacks that
- *	generate events should call this routine before returning to
- *	the system in order to ensure that Tcl gets a chance to
- *	process the new events.
+ *	This routine checks all of the event sources, processes events that
+ *	are on the Tcl event queue, and then calls the any idle handlers.
+ *	Platform specific notifier callbacks that generate events should call
+ *	this routine before returning to the system in order to ensure that
+ *	Tcl gets a chance to process the new events.
  *
  * Results:
  *	Returns 1 if an event or idle handler was invoked, else 0.
@@ -1010,7 +1040,7 @@ Tcl_DoOneEvent(flags)
  */
 
 int
-Tcl_ServiceAll()
+Tcl_ServiceAll(void)
 {
     int result = 0;
     EventSource *sourcePtr;
@@ -1021,10 +1051,10 @@ Tcl_ServiceAll()
     }
 
     /*
-     * We need to turn off event servicing like we to in Tcl_DoOneEvent,
-     * to avoid recursive calls.
+     * We need to turn off event servicing like we to in Tcl_DoOneEvent, to
+     * avoid recursive calls.
      */
-    
+
     tsdPtr->serviceMode = TCL_SERVICE_NONE;
 
     /*
@@ -1032,26 +1062,26 @@ Tcl_ServiceAll()
      */
 
     if (Tcl_AsyncReady()) {
-	(void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+	(void) Tcl_AsyncInvoke(NULL, 0);
     }
 
     /*
-     * Make a single pass through all event sources, queued events,
-     * and idle handlers.  Note that we wait to update the notifier
-     * timer until the end so we can avoid multiple changes.
+     * Make a single pass through all event sources, queued events, and idle
+     * handlers. Note that we wait to update the notifier timer until the end
+     * so we can avoid multiple changes.
      */
 
     tsdPtr->inTraversal = 1;
     tsdPtr->blockTimeSet = 0;
 
     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
-	 sourcePtr = sourcePtr->nextPtr) {
+	    sourcePtr = sourcePtr->nextPtr) {
 	if (sourcePtr->setupProc) {
 	    (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
 	}
     }
     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
-	 sourcePtr = sourcePtr->nextPtr) {
+	    sourcePtr = sourcePtr->nextPtr) {
 	if (sourcePtr->checkProc) {
 	    (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
 	}
@@ -1079,8 +1109,8 @@ Tcl_ServiceAll()
  *
  * Tcl_ThreadAlert --
  *
- *	This function wakes up the notifier associated with the
- *	specified thread (if there is one).  
+ *	This function wakes up the notifier associated with the specified
+ *	thread (if there is one).
  *
  * Results:
  *	None.
@@ -1092,16 +1122,15 @@ Tcl_ServiceAll()
  */
 
 void
-Tcl_ThreadAlert(threadId)
-    Tcl_ThreadId threadId;	/* Identifier for thread to use. */
+Tcl_ThreadAlert(
+    Tcl_ThreadId threadId)	/* Identifier for thread to use. */
 {
     ThreadSpecificData *tsdPtr;
 
     /*
-     * Find the notifier associated with the specified thread.
-     * Note that we need to hold the listLock while calling
-     * Tcl_AlertNotifier to avoid a race condition where
-     * the specified thread might destroy its notifier.
+     * Find the notifier associated with the specified thread. Note that we
+     * need to hold the listLock while calling Tcl_AlertNotifier to avoid a
+     * race condition where the specified thread might destroy its notifier.
      */
 
     Tcl_MutexLock(&listLock);
@@ -1115,3 +1144,11 @@ Tcl_ThreadAlert(threadId)
     }
     Tcl_MutexUnlock(&listLock);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 7b9bb61..e14c740 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,28 +1,30 @@
-/* 
+/*
  * tclObj.c --
  *
- *	This file contains Tcl object-related procedures that are used by
- * 	many Tcl commands.
+ *	This file contains Tcl object-related functions that are used by many
+ *	Tcl commands.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
  * Copyright (c) 2001 by ActiveState Corporation.
+ * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclCompile.h"
-#include "tclPort.h"
+#include "tommath.h"
+#include <float.h>
+#include <math.h>
 
 /*
  * Table of all object types.
  */
 
 static Tcl_HashTable typeTable;
-static int typeTableInitialized = 0;    /* 0 means not yet initialized. */
+static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
 TCL_DECLARE_MUTEX(tableMutex)
 
 /*
@@ -32,259 +34,379 @@ TCL_DECLARE_MUTEX(tableMutex)
 Tcl_Obj *tclFreeObjList = NULL;
 
 /*
- * The object allocator is single threaded.  This mutex is referenced
- * by the TclNewObj macro, however, so must be visible.
+ * The object allocator is single threaded. This mutex is referenced by the
+ * TclNewObj macro, however, so must be visible.
  */
 
 #ifdef TCL_THREADS
+MODULE_SCOPE Tcl_Mutex tclObjMutex;
 Tcl_Mutex tclObjMutex;
 #endif
 
 /*
- * Pointer to a heap-allocated string of length zero that the Tcl core uses
- * as the value of an empty string representation for an object. This value
- * is shared by all new objects allocated by Tcl_NewObj.
+ * Pointer to a heap-allocated string of length zero that the Tcl core uses as
+ * the value of an empty string representation for an object. This value is
+ * shared by all new objects allocated by Tcl_NewObj.
  */
 
 char tclEmptyString = '\0';
 char *tclEmptyStringRep = &tclEmptyString;
+
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+/*
+ * Structure for tracking the source file and line number where a given Tcl_Obj
+ * was allocated.  We also track the pointer to the Tcl_Obj itself, for sanity
+ * checking purposes.
+ */
 
+typedef struct ObjData {
+    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
+    CONST char *file;		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line;			/* Line number in the source file; used for
+				 * debugging. */
+} ObjData;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
 
-#ifdef TCL_TIP280
 /*
- * All static variables used in this file are collected into a single
- * instance of the following structure.  For multi-threaded implementations,
- * there is one instance of this structure for each thread.
+ * All static variables used in this file are collected into a single instance
+ * of the following structure.  For multi-threaded implementations, there is
+ * one instance of this structure for each thread.
  *
- * Notice that different structures with the same name appear in other
- * files.  The structure defined below is used in this file only.
+ * Notice that different structures with the same name appear in other files.
+ * The structure defined below is used in this file only.
  */
 
 typedef struct ThreadSpecificData {
-  Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj generated
-			     * by a call to the function EvalTokensStandard()
-			     * from a literal text where bs+nl sequences
-			     * occured in it, if any. I.e. this table keeps
-			     * track of invisible/stripped continuation
-			     * lines. Its keys are Tcl_Obj pointers, the
-			     * values are ContLineLoc pointers.  See the file
-			     * tclCompile.h for the definition of this
-			     * structure, and for references to all related
-			     * places in the core.
-			     */
+    Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
+			       * generated by a call to the function
+			       * TclSubstTokens() from a literal text
+			       * where bs+nl sequences occured in it, if
+			       * any. I.e. this table keeps track of
+			       * invisible/stripped continuation lines. Its
+			       * keys are Tcl_Obj pointers, the values are
+			       * ContLineLoc pointers.  See the file
+			       * tclCompile.h for the definition of this
+			       * structure, and for references to all related
+			       * places in the core.
+			       */
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+    /*
+     * Thread local table that is used to check that a Tcl_Obj was not
+     * allocated by some other thread.
+     */
+
+    Tcl_HashTable *objThreadMap;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
 
-static void ContLineLocFree _ANSI_ARGS_((char* clientData));
-static void TclThreadFinalizeObjects _ANSI_ARGS_((ClientData clientData));
-static ThreadSpecificData* TclGetContinuationTable _ANSI_ARGS_(());
+static void ContLineLocFree (char* clientData);
+static void TclThreadFinalizeContLines (ClientData clientData);
+static ThreadSpecificData* TclGetContLineTable (void);
+
+/*
+ * Nested Tcl_Obj deletion management support
+ *
+ * All context references used in the object freeing code are pointers to this
+ * structure; every thread will have its own structure instance. The purpose
+ * of this structure is to allow deeply nested collections of Tcl_Objs to be
+ * freed without taking a vast depth of C stack (which could cause all sorts
+ * of breakage.)
+ */
+
+typedef struct PendingObjData {
+    int deletionCount;		/* Count of the number of invokations of
+				 * TclFreeObj() are on the stack (at least
+				 * conceptually; many are actually expanded
+				 * macros). */
+    Tcl_Obj *deletionStack;	/* Stack of objects that have had TclFreeObj()
+				 * invoked upon them but which can't be
+				 * deleted yet because they are in a nested
+				 * invokation of TclFreeObj(). By postponing
+				 * this way, we limit the maximum overall C
+				 * stack depth when deleting a complex object.
+				 * The down-side is that we alter the overall
+				 * behaviour by altering the order in which
+				 * objects are deleted, and we change the
+				 * order in which the string rep and the
+				 * internal rep of an object are deleted. Note
+				 * that code which assumes the previous
+				 * behaviour in either of these respects is
+				 * unsafe anyway; it was never documented as
+				 * to exactly what would happen in these
+				 * cases, and the overall contract of a
+				 * user-level Tcl_DecrRefCount() is still
+				 * preserved (assuming that a particular T_DRC
+				 * would delete an object is not very
+				 * safe). */
+} PendingObjData;
+
+/*
+ * These are separated out so that some semantic content is attached
+ * to them.
+ */
+#define ObjDeletionLock(contextPtr)	((contextPtr)->deletionCount++)
+#define ObjDeletionUnlock(contextPtr)	((contextPtr)->deletionCount--)
+#define ObjDeletePending(contextPtr)	((contextPtr)->deletionCount > 0)
+#define ObjOnStack(contextPtr)		((contextPtr)->deletionStack != NULL)
+#define PushObjToDelete(contextPtr,objPtr) \
+    /* The string rep is already invalidated so we can use the bytes value \
+     * for our pointer chain: push onto the head of the stack. */ \
+    (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
+    (contextPtr)->deletionStack = (objPtr)
+#define PopObjToDelete(contextPtr,objPtrVar) \
+    (objPtrVar) = (contextPtr)->deletionStack; \
+    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
+
+/*
+ * Macro to set up the local reference to the deletion context.
+ */
+#ifndef TCL_THREADS
+static PendingObjData pendingObjData;
+#define ObjInitDeletionContext(contextPtr) \
+    PendingObjData *CONST contextPtr = &pendingObjData
+#else
+static Tcl_ThreadDataKey pendingObjDataKey;
+#define ObjInitDeletionContext(contextPtr) \
+    PendingObjData *CONST contextPtr = (PendingObjData *) \
+	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
 #endif
 
 /*
- * Prototypes for procedures defined later in this file:
+ * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
  */
 
-static int		SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static int		SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static int		SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static int		SetIntOrWideFromAny _ANSI_ARGS_((Tcl_Interp* interp,
-							 Tcl_Obj *objPtr));
-static void		UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void		UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void		UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int		SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
+#define PACK_BIGNUM(bignum, objPtr) \
+    if ((bignum).used > 0x7fff) { \
+	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
+	*temp = bignum; \
+	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) temp; \
+	(objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
+    } else { \
+	if ((bignum).alloc > 0x7fff) { \
+	    mp_shrink(&(bignum)); \
+	} \
+	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) (bignum).dp; \
+	(objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
+		| ((bignum).alloc << 15) | ((bignum).used)); \
+    }
+
+#define UNPACK_BIGNUM(objPtr, bignum) \
+    if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
+	(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
+    } else { \
+	(bignum).dp = (mp_digit*) (objPtr)->internalRep.ptrAndLongRep.ptr; \
+	(bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
+	(bignum).alloc = \
+		((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
+	(bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
+    }
 
-#ifndef TCL_WIDE_INT_IS_LONG
-static void		UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+/*
+ * Prototypes for functions defined later in this file:
+ */
+
+static int		ParseBoolean(Tcl_Obj *objPtr);
+static int		SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int		SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int		SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
+static void		UpdateStringOfInt(Tcl_Obj *objPtr);
+#ifndef NO_WIDE_TYPE
+static void		UpdateStringOfWideInt(Tcl_Obj *objPtr);
+static int		SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 #endif
+static void		FreeBignum(Tcl_Obj *objPtr);
+static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
+static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    int copy, mp_int *bignumValue);
 
 /*
  * Prototypes for the array hash key methods.
  */
 
-static Tcl_HashEntry *	AllocObjEntry _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int		CompareObjKeys _ANSI_ARGS_((
-			    VOID *keyPtr, Tcl_HashEntry *hPtr));
-static void		FreeObjEntry _ANSI_ARGS_((
-			    Tcl_HashEntry *hPtr));
-static unsigned int	HashObjKey _ANSI_ARGS_((
-			    Tcl_HashTable *tablePtr,
-			    VOID *keyPtr));
+static Tcl_HashEntry *	AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
 
 /*
  * Prototypes for the CommandName object type.
  */
 
-static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr));
-static void		FreeCmdNameInternalRep _ANSI_ARGS_((
-    			    Tcl_Obj *objPtr));
-static int		SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-
+static void		DupCmdNameInternalRep(Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr);
+static void		FreeCmdNameInternalRep(Tcl_Obj *objPtr);
+static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
  * The structures below defines the Tcl object types defined in this file by
- * means of procedures that can be invoked by generic object code. See also
+ * means of functions that can be invoked by generic object code. See also
  * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
  * implementations.
  */
 
-Tcl_ObjType tclBooleanType = {
+static Tcl_ObjType oldBooleanType = {
     "boolean",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
-    UpdateStringOfBoolean,		/* updateStringProc */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
+    NULL,				/* updateStringProc */
+    SetBooleanFromAny			/* setFromAnyProc */
+};
+Tcl_ObjType tclBooleanType = {
+    "booleanString",			/* name */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
+    NULL,				/* updateStringProc */
     SetBooleanFromAny			/* setFromAnyProc */
 };
-
 Tcl_ObjType tclDoubleType = {
     "double",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
     UpdateStringOfDouble,		/* updateStringProc */
     SetDoubleFromAny			/* setFromAnyProc */
 };
-
 Tcl_ObjType tclIntType = {
     "int",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
     UpdateStringOfInt,			/* updateStringProc */
     SetIntFromAny			/* setFromAnyProc */
 };
-
+#ifndef NO_WIDE_TYPE
 Tcl_ObjType tclWideIntType = {
     "wideInt",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
-#ifdef TCL_WIDE_INT_IS_LONG
-    UpdateStringOfInt,			/* updateStringProc */
-#else /* !TCL_WIDE_INT_IS_LONG */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
     UpdateStringOfWideInt,		/* updateStringProc */
-#endif
     SetWideIntFromAny			/* setFromAnyProc */
 };
+#endif
+Tcl_ObjType tclBignumType = {
+    "bignum",				/* name */
+    FreeBignum,				/* freeIntRepProc */
+    DupBignum,				/* dupIntRepProc */
+    UpdateStringOfBignum,		/* updateStringProc */
+    NULL				/* setFromAnyProc */
+};
 
 /*
  * The structure below defines the Tcl obj hash key type.
  */
+
 Tcl_HashKeyType tclObjHashKeyType = {
-    TCL_HASH_KEY_TYPE_VERSION,		/* version */
-    0,					/* flags */
-    HashObjKey,				/* hashKeyProc */
-    CompareObjKeys,			/* compareKeysProc */
-    AllocObjEntry,			/* allocEntryProc */
-    FreeObjEntry			/* freeEntryProc */
+    TCL_HASH_KEY_TYPE_VERSION,	/* version */
+    0,				/* flags */
+    TclHashObjKey,		/* hashKeyProc */
+    TclCompareObjKeys,		/* compareKeysProc */
+    AllocObjEntry,		/* allocEntryProc */
+    TclFreeObjEntry		/* freeEntryProc */
 };
 
 /*
  * The structure below defines the command name Tcl object type by means of
- * procedures that can be invoked by generic object code. Objects of this
- * type cache the Command pointer that results from looking up command names
- * in the command hashtable. Such objects appear as the zeroth ("command
- * name") argument in a Tcl command.
+ * functions that can be invoked by generic object code. Objects of this type
+ * cache the Command pointer that results from looking up command names in the
+ * command hashtable. Such objects appear as the zeroth ("command name")
+ * argument in a Tcl command.
  *
  * NOTE: the ResolvedCmdName that gets cached is stored in the
- * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused.
- * You might think you could use the simpler otherValuePtr field to
- * store the single ResolvedCmdName pointer, but DO NOT DO THIS.  It
- * seems that some extensions use the second internal pointer field
- * of the twoPtrValue field for their own purposes.
+ * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. You might
+ * think you could use the simpler otherValuePtr field to store the single
+ * ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions
+ * use the second internal pointer field of the twoPtrValue field for their
+ * own purposes.
  */
 
 static Tcl_ObjType tclCmdNameType = {
     "cmdName",				/* name */
     FreeCmdNameInternalRep,		/* freeIntRepProc */
     DupCmdNameInternalRep,		/* dupIntRepProc */
-    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
+    NULL,				/* updateStringProc */
     SetCmdNameFromAny			/* setFromAnyProc */
 };
 
-
 /*
- * Structure containing a cached pointer to a command that is the result
- * of resolving the command's name in some namespace. It is the internal
- * representation for a cmdName object. It contains the pointer along
- * with some information that is used to check the pointer's validity.
+ * Structure containing a cached pointer to a command that is the result of
+ * resolving the command's name in some namespace. It is the internal
+ * representation for a cmdName object. It contains the pointer along with
+ * some information that is used to check the pointer's validity.
  */
 
 typedef struct ResolvedCmdName {
     Command *cmdPtr;		/* A cached Command pointer. */
     Namespace *refNsPtr;	/* Points to the namespace containing the
-				 * reference (not the namespace that
-				 * contains the referenced command). */
+				 * reference (not the namespace that contains
+				 * the referenced command). NULL if the name
+				 * is fully qualified.*/
     long refNsId;		/* refNsPtr's unique namespace id. Used to
-				 * verify that refNsPtr is still valid
-				 * (e.g., it's possible that the cmd's
-				 * containing namespace was deleted and a
-				 * new one created at the same address). */
+				 * verify that refNsPtr is still valid (e.g.,
+				 * it's possible that the cmd's containing
+				 * namespace was deleted and a new one created
+				 * at the same address). */
     int refNsCmdEpoch;		/* Value of the referencing namespace's
 				 * cmdRefEpoch when the pointer was cached.
 				 * Before using the cached pointer, we check
 				 * if the namespace's epoch was incremented;
 				 * if so, this cached pointer is invalid. */
     int cmdEpoch;		/* Value of the command's cmdEpoch when this
-				 * pointer was cached. Before using the
-				 * cached pointer, we check if the cmd's
-				 * epoch was incremented; if so, the cmd was
-				 * renamed, deleted, hidden, or exposed, and
-				 * so the pointer is invalid. */
-    int refCount;		/* Reference count: 1 for each cmdName
-				 * object that has a pointer to this
-				 * ResolvedCmdName structure as its internal
-				 * rep. This structure can be freed when
-				 * refCount becomes zero. */
+				 * pointer was cached. Before using the cached
+				 * pointer, we check if the cmd's epoch was
+				 * incremented; if so, the cmd was renamed,
+				 * deleted, hidden, or exposed, and so the
+				 * pointer is invalid. */
+    int refCount;		/* Reference count: 1 for each cmdName object
+				 * that has a pointer to this ResolvedCmdName
+				 * structure as its internal rep. This
+				 * structure can be freed when refCount
+				 * becomes zero. */
 } ResolvedCmdName;
-
 
 /*
  *-------------------------------------------------------------------------
  *
  * TclInitObjectSubsystem --
  *
- *	This procedure is invoked to perform once-only initialization of
- *	the type table. It also registers the object types defined in 
- *	this file.
+ *	This function is invoked to perform once-only initialization of the
+ *	type table. It also registers the object types defined in this file.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Initializes the table of defined object types "typeTable" with
- *	builtin object types defined in this file.  
+ *	Initializes the table of defined object types "typeTable" with builtin
+ *	object types defined in this file.
  *
  *-------------------------------------------------------------------------
  */
 
 void
-TclInitObjSubsystem()
+TclInitObjSubsystem(void)
 {
     Tcl_MutexLock(&tableMutex);
     typeTableInitialized = 1;
     Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
     Tcl_MutexUnlock(&tableMutex);
 
-    Tcl_RegisterObjType(&tclBooleanType);
     Tcl_RegisterObjType(&tclByteArrayType);
     Tcl_RegisterObjType(&tclDoubleType);
     Tcl_RegisterObjType(&tclEndOffsetType);
     Tcl_RegisterObjType(&tclIntType);
-    Tcl_RegisterObjType(&tclWideIntType);
     Tcl_RegisterObjType(&tclStringType);
     Tcl_RegisterObjType(&tclListType);
+    Tcl_RegisterObjType(&tclDictType);
     Tcl_RegisterObjType(&tclByteCodeType);
-    Tcl_RegisterObjType(&tclProcBodyType);
     Tcl_RegisterObjType(&tclArraySearchType);
-    Tcl_RegisterObjType(&tclIndexType);
-    Tcl_RegisterObjType(&tclNsNameType);
     Tcl_RegisterObjType(&tclCmdNameType);
+    Tcl_RegisterObjType(&tclRegexpType);
+    Tcl_RegisterObjType(&tclProcBodyType);
+
+    /* For backward compatibility only ... */
+    Tcl_RegisterObjType(&oldBooleanType);
+#ifndef NO_WIDE_TYPE
+    Tcl_RegisterObjType(&tclWideIntType);
+#endif
 
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
@@ -292,7 +414,7 @@ TclInitObjSubsystem()
     tclObjsFreed = 0;
     {
 	int i;
-	for (i = 0;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
+	for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
 	    tclObjsShared[i] = 0;
 	}
     }
@@ -303,10 +425,53 @@ TclInitObjSubsystem()
 /*
  *----------------------------------------------------------------------
  *
+ * TclFinalizeThreadObjects --
+ *
+ *	This function is called by Tcl_FinalizeThread to clean up thread
+ *	specific Tcl_Obj information.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadObjects(void)
+{
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+
+    if (tablePtr != NULL) {
+	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
+		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+	    ObjData *objData = Tcl_GetHashValue(hPtr);
+
+	    if (objData != NULL) {
+		ckfree((char *) objData);
+	    }
+	}
+
+	Tcl_DeleteHashTable(tablePtr);
+	ckfree((char *) tablePtr);
+	tsdPtr->objThreadMap = NULL;
+    }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclFinalizeObjects --
  *
- *	This procedure is called by Tcl_Finalize to clean up all
- *	registered Tcl_ObjType's and to reset the tclFreeObjList.
+ *	This function is called by Tcl_Finalize to clean up all registered
+ *	Tcl_ObjType's and to reset the tclFreeObjList.
  *
  * Results:
  *	None.
@@ -318,37 +483,36 @@ TclInitObjSubsystem()
  */
 
 void
-TclFinalizeObjects()
+TclFinalizeObjects(void)
 {
     Tcl_MutexLock(&tableMutex);
     if (typeTableInitialized) {
-        Tcl_DeleteHashTable(&typeTable);
-        typeTableInitialized = 0;
+	Tcl_DeleteHashTable(&typeTable);
+	typeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
 
-    /* 
-     * All we do here is reset the head pointer of the linked list of
-     * free Tcl_Obj's to NULL;  the memory finalization will take care
-     * of releasing memory for us.
+    /*
+     * All we do here is reset the head pointer of the linked list of free
+     * Tcl_Obj's to NULL; the memory finalization will take care of releasing
+     * memory for us.
      */
     Tcl_MutexLock(&tclObjMutex);
     tclFreeObjList = NULL;
     Tcl_MutexUnlock(&tclObjMutex);
 }
 
-#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  *
- * TclGetContinuationTable --
+ * TclGetContLineTable --
  *
  *	This procedure is a helper which returns the thread-specific
  *	hash-table used to track continuation line information associated with
- *	Tcl_Obj*.
+ *	Tcl_Obj*, and the objThreadMap, etc.
  *
  * Results:
- *	A reference to the continuation line thread-data.
+ *	A reference to the thread-data.
  *
  * Side effects:
  *	May allocate memory for the thread-data.
@@ -358,7 +522,7 @@ TclFinalizeObjects()
  */
 
 static ThreadSpecificData*
-TclGetContinuationTable()
+TclGetContLineTable()
 {
     /*
      * Initialize the hashtable tracking invisible continuation lines.  For
@@ -372,7 +536,7 @@ TclGetContinuationTable()
     if (!tsdPtr->lineCLPtr) {
 	tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
 	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
-	Tcl_CreateThreadExitHandler (TclThreadFinalizeObjects,NULL);
+	Tcl_CreateThreadExitHandler (TclThreadFinalizeContLines,NULL);
     }
     return tsdPtr;
 }
@@ -396,36 +560,49 @@ TclGetContinuationTable()
  */
 
 ContLineLoc*
-TclContinuationsEnter(objPtr,num,loc)
-     Tcl_Obj* objPtr;
-     int num;
-     int* loc;
+TclContinuationsEnter(Tcl_Obj* objPtr,
+		      int num,
+		      int* loc)
 {
-  int newEntry;
-  ThreadSpecificData *tsdPtr = TclGetContinuationTable();
-  Tcl_HashEntry* hPtr =
-    Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
+    int newEntry;
+    ThreadSpecificData *tsdPtr = TclGetContLineTable();
+    Tcl_HashEntry* hPtr =
+	Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
 
-  ContLineLoc* clLocPtr = 
-    (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
+    ContLineLoc* clLocPtr = 
+	(ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
 
     if (!newEntry) {
 	/*
-	 * Somehow we're entering ContLineLoc data for the same value (objPtr)
-	 * more than one time.  Not sure whether that's expected, or a sign of
-	 * trouble, but at a minimum, we should take care not to leak the old
-	 * entry.
+	 * We're entering ContLineLoc data for the same value more than one
+	 * time. Taking care not to leak the old entry.
+	 *
+	 * This can happen when literals in a proc body are shared. See for
+	 * example test info-30.19 where the action (code) for all branches of
+	 * the switch command is identical, mapping them all to the same
+	 * literal. An interesting result of this is that the number and
+	 * locations (offset) of invisible continuation lines in the literal
+	 * are the same for all occurences.
+	 *
+	 * Note that while reusing the existing entry is possible it requires
+	 * the same actions as for a new entry because we have to copy the
+	 * incoming num/loc data even so. Because we are called from
+	 * TclContinuationsEnterDerived for this case, which modified the
+	 * stored locations (Rebased to the proper relative offset). Just
+	 * returning the stored entry and data would rebase them a second
+	 * time, or more, hosing the data. It is easier to simply replace, as
+	 * we are doing.
 	 */
 
 	ckfree((char *) Tcl_GetHashValue(hPtr));
     }
 
-  clLocPtr->num = num;
-  memcpy (&clLocPtr->loc, loc, num*sizeof(int));
-  clLocPtr->loc[num] = CLL_END; /* Sentinel */
-  Tcl_SetHashValue (hPtr, clLocPtr);
+    clLocPtr->num = num;
+    memcpy (&clLocPtr->loc, loc, num*sizeof(int));
+    clLocPtr->loc[num] = CLL_END; /* Sentinel */
+    Tcl_SetHashValue (hPtr, clLocPtr);
 
-  return clLocPtr;
+    return clLocPtr;
 }
 
 /*
@@ -448,19 +625,16 @@ TclContinuationsEnter(objPtr,num,loc)
  */
 
 void
-TclContinuationsEnterDerived(objPtr, start, clNext)
-     Tcl_Obj* objPtr;
-     int start;
-     int* clNext;
+TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
 {
     /*
      * We have to handle invisible continuations lines here as well, despite
-     * the code we have in EvalTokensStandard (ETS) for that. Why ?
-     * Nesting. If our script is the sole argument to an 'eval' command, for
-     * example, the scriptCLLocPtr we are using here was generated by a
-     * previous call to ETS, and while the words we have here may contain
-     * continuation lines they are invisible already, and the call to ETS
-     * above had no bs+nl sequences to trigger its code.
+     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
+     * our script is the sole argument to an 'eval' command, for example, the
+     * scriptCLLocPtr we are using was generated by a previous call to TST,
+     * and while the words we have here may contain continuation lines they
+     * are invisible already, and the inner call to TST had no bs+nl sequences
+     * to trigger its code.
      *
      * Luckily for us, the table we have to create here for the current word
      * has to be a slice of the table currently in use, with the locations
@@ -501,7 +675,7 @@ TclContinuationsEnterDerived(objPtr, start, clNext)
     num = wordCLLast - clNext;
     if (num) {
 	int i;
-	ContLineLoc* clLocPtr =
+	ContLineLoc* clLocPtr = 
 	    TclContinuationsEnter(objPtr, num, clNext);
 
 	/*
@@ -547,7 +721,7 @@ TclContinuationsEnterDerived(objPtr, start, clNext)
 void
 TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
 {
-    ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+    ThreadSpecificData *tsdPtr = TclGetContLineTable();
     Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr);
 
     if (hPtr) {
@@ -577,10 +751,9 @@ TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
  */
 
 ContLineLoc*
-TclContinuationsGet(objPtr)
-     Tcl_Obj* objPtr;
+TclContinuationsGet(Tcl_Obj* objPtr)
 {
-    ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+    ThreadSpecificData *tsdPtr = TclGetContLineTable();
     Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
 
     if (hPtr) {
@@ -593,7 +766,7 @@ TclContinuationsGet(objPtr)
 /*
  *----------------------------------------------------------------------
  *
- * TclThreadFinalizeObjects --
+ * TclThreadFinalizeContLines --
  *
  *	This procedure is a helper which releases all continuation line
  *	information currently known. It is run as a thread exit handler.
@@ -609,31 +782,30 @@ TclContinuationsGet(objPtr)
  */
 
 static void
-TclThreadFinalizeObjects (clientData)
-     ClientData clientData;
+TclThreadFinalizeContLines (ClientData clientData)
 {
     /*
      * Release the hashtable tracking invisible continuation lines.
      */
 
+    ThreadSpecificData *tsdPtr = TclGetContLineTable();
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch hSearch;
-    ThreadSpecificData *tsdPtr = TclGetContinuationTable();
 
     for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
 	 hPtr != NULL;
 	 hPtr = Tcl_NextHashEntry(&hSearch)) {
 	/*
-	 * We are not using Tcl_EventuallyFree (as in
-	 * TclFreeObj()) because here we can be sure that the
-	 * compiler will not hold references to the data in the
-	 * hashtable, and using TEF might bork the finalization
-	 * sequence.
+	 * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
+	 * here we can be sure that the compiler will not hold references to
+	 * the data in the hashtable, and using TEF might bork the
+	 * finalization sequence.
 	 */
 	ContLineLocFree (Tcl_GetHashValue (hPtr));
 	Tcl_DeleteHashEntry (hPtr);
     }
     Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
+    ckfree((char *) tsdPtr->lineCLPtr);
     tsdPtr->lineCLPtr = NULL;
 }
 
@@ -655,41 +827,41 @@ TclThreadFinalizeObjects (clientData)
  */
 
 static void
-ContLineLocFree (clientData)
-     char* clientData;
+ContLineLocFree (char* clientData)
 {
-  ckfree (clientData);
+    ckfree (clientData);
 }
-#endif
+
 /*
  *--------------------------------------------------------------
  *
  * Tcl_RegisterObjType --
  *
- *	This procedure is called to register a new Tcl object type
- *	in the table of all object types supported by Tcl.
+ *	This function is called to register a new Tcl object type in the table
+ *	of all object types supported by Tcl.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The type is registered in the Tcl type table. If there was already
- *	a type with the same name as in typePtr, it is replaced with the
- *	new type.
+ *	The type is registered in the Tcl type table. If there was already a
+ *	type with the same name as in typePtr, it is replaced with the new
+ *	type.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_RegisterObjType(typePtr)
-    Tcl_ObjType *typePtr;	/* Information about object type;
-				 * storage must be statically
-				 * allocated (must live forever). */
+Tcl_RegisterObjType(
+    Tcl_ObjType *typePtr)	/* Information about object type; storage must
+				 * be statically allocated (must live
+				 * forever). */
 {
-    int new;
+    int isNew;
+
     Tcl_MutexLock(&tableMutex);
     Tcl_SetHashValue(
-	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr);
+	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
     Tcl_MutexUnlock(&tableMutex);
 }
 
@@ -698,56 +870,54 @@ Tcl_RegisterObjType(typePtr)
  *
  * Tcl_AppendAllObjTypes --
  *
- *	This procedure appends onto the argument object the name of each
- *	object type as a list element. This includes the builtin object
- *	types (e.g. int, list) as well as those added using
- *	Tcl_NewObj. These names can be used, for example, with
- *	Tcl_GetObjType to get pointers to the corresponding Tcl_ObjType
- *	structures.
+ *	This function appends onto the argument object the name of each object
+ *	type as a list element. This includes the builtin object types (e.g.
+ *	int, list) as well as those added using Tcl_NewObj. These names can be
+ *	used, for example, with Tcl_GetObjType to get pointers to the
+ *	corresponding Tcl_ObjType structures.
  *
  * Results:
  *	The return value is normally TCL_OK; in this case the object
- *	referenced by objPtr has each type name appended to it. If an
- *	error occurs, TCL_ERROR is returned and the interpreter's result
- *	holds an error message.
+ *	referenced by objPtr has each type name appended to it. If an error
+ *	occurs, TCL_ERROR is returned and the interpreter's result holds an
+ *	error message.
  *
  * Side effects:
- *	If necessary, the object referenced by objPtr is converted into
- *	a list object.
+ *	If necessary, the object referenced by objPtr is converted into a list
+ *	object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_AppendAllObjTypes(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter used for error reporting. */
-    Tcl_Obj *objPtr;		/* Points to the Tcl object onto which the
-				 * name of each registered type is appended
-				 * as a list element. */
+Tcl_AppendAllObjTypes(
+    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
+    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
+				 * name of each registered type is appended as
+				 * a list element. */
 {
     register Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    int objc;
-    Tcl_Obj **objv;
+    int numElems;
 
     /*
      * Get the test for a valid list out of the way first.
      */
 
-    if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+    if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     /*
-     * Type names are NUL-terminated, not counted strings.
-     * This code relies on that.
+     * Type names are NUL-terminated, not counted strings. This code relies on
+     * that.
      */
 
     Tcl_MutexLock(&tableMutex);
     for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
-	    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 	Tcl_ListObjAppendElement(NULL, objPtr,
-	        Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
+		Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
     }
     Tcl_MutexUnlock(&tableMutex);
     return TCL_OK;
@@ -758,12 +928,11 @@ Tcl_AppendAllObjTypes(interp, objPtr)
  *
  * Tcl_GetObjType --
  *
- *	This procedure looks up an object type by name.
+ *	This function looks up an object type by name.
  *
  * Results:
- *	If an object type with name matching "typeName" is found, a pointer
- *	to its Tcl_ObjType structure is returned; otherwise, NULL is
- *	returned.
+ *	If an object type with name matching "typeName" is found, a pointer to
+ *	its Tcl_ObjType structure is returned; otherwise, NULL is returned.
  *
  * Side effects:
  *	None.
@@ -772,16 +941,16 @@ Tcl_AppendAllObjTypes(interp, objPtr)
  */
 
 Tcl_ObjType *
-Tcl_GetObjType(typeName)
-    CONST char *typeName;	/* Name of Tcl object type to look up. */
+Tcl_GetObjType(
+    CONST char *typeName)	/* Name of Tcl object type to look up. */
 {
     register Tcl_HashEntry *hPtr;
     Tcl_ObjType *typePtr = NULL;
 
     Tcl_MutexLock(&tableMutex);
     hPtr = Tcl_FindHashEntry(&typeTable, typeName);
-    if (hPtr != (Tcl_HashEntry *) NULL) {
-        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+    if (hPtr != NULL) {
+	typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
     }
     Tcl_MutexUnlock(&tableMutex);
     return typePtr;
@@ -796,10 +965,10 @@ Tcl_GetObjType(typeName)
  *
  * Results:
  *	The return value is TCL_OK on success and TCL_ERROR on failure. If
- *	TCL_ERROR is returned, then the interpreter's result contains an
- *	error message unless "interp" is NULL. Passing a NULL "interp"
- *	allows this procedure to be used as a test whether the conversion
- *	could be done (and in fact was done).
+ *	TCL_ERROR is returned, then the interpreter's result contains an error
+ *	message unless "interp" is NULL. Passing a NULL "interp" allows this
+ *	function to be used as a test whether the conversion could be done
+ *	(and in fact was done).
  *
  * Side effects:
  *	Any internal representation for the old type is freed.
@@ -808,46 +977,169 @@ Tcl_GetObjType(typeName)
  */
 
 int
-Tcl_ConvertToType(interp, objPtr, typePtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object to convert. */
-    Tcl_ObjType *typePtr;	/* The target type. */
+Tcl_ConvertToType(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,		/* The object to convert. */
+    Tcl_ObjType *typePtr)	/* The target type. */
 {
     if (objPtr->typePtr == typePtr) {
 	return TCL_OK;
     }
 
     /*
-     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal
-     * form as appropriate for the target type. This frees the old internal
+     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
+     * as appropriate for the target type. This frees the old internal
      * representation.
      */
 
+    if (typePtr->setFromAnyProc == NULL) {
+	Tcl_Panic("may not convert object to type %s", typePtr->name);
+    }
+
     return typePtr->setFromAnyProc(interp, objPtr);
 }
 
 /*
+ *--------------------------------------------------------------
+ *
+ * TclDbDumpActiveObjects --
+ *
+ *	This function is called to dump all of the active Tcl_Obj structs this
+ *	allocator knows about.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclDbDumpActiveObjects(
+    FILE *outFile)
+{
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+    Tcl_HashSearch hSearch;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashTable *tablePtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    tablePtr = tsdPtr->objThreadMap;
+
+    if (tablePtr != NULL) {
+	fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
+	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&hSearch)) {
+	    ObjData *objData = Tcl_GetHashValue(hPtr);
+
+	    if (objData != NULL) {
+		fprintf(outFile,
+			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
+			Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr,
+			objData->file, objData->line);
+	    } else {
+		fprintf(outFile, "key = 0x%p\n",
+			Tcl_GetHashKey(tablePtr, hPtr));
+	    }
+	}
+    }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDbInitNewObj --
+ *
+ *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is
+ *	enabled. This function will initialize the members of a Tcl_Obj
+ *	struct. Initilization would be done inline via the TclNewObj macro
+ *	when compiling without TCL_MEM_DEBUG.
+ *
+ * Results:
+ *	The Tcl_Obj struct members are initialized.
+ *
+ * Side effects:
+ *	None.
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+void
+TclDbInitNewObj(
+    register Tcl_Obj *objPtr,
+    register CONST char *file,	/* The name of the source file calling this
+				 * function; used for debugging. */
+    register int line)		/* Line number in the source file; used for
+				 * debugging. */
+{
+    objPtr->refCount = 0;
+    objPtr->bytes = tclEmptyStringRep;
+    objPtr->length = 0;
+    objPtr->typePtr = NULL;
+
+#ifdef TCL_THREADS
+    /*
+     * Add entry to a thread local map used to check if a Tcl_Obj was
+     * allocated by the currently executing thread.
+     */
+
+    if (!TclInExit()) {
+	Tcl_HashEntry *hPtr;
+	Tcl_HashTable *tablePtr;
+	int isNew;
+	ObjData *objData;
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+	if (tsdPtr->objThreadMap == NULL) {
+	    tsdPtr->objThreadMap = (Tcl_HashTable *)
+		    ckalloc(sizeof(Tcl_HashTable));
+	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
+	}
+	tablePtr = tsdPtr->objThreadMap;
+	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) objPtr, &isNew);
+	if (!isNew) {
+	    Tcl_Panic("expected to create new entry for object map");
+	}
+
+	/*
+	 * Record the debugging information.
+	 */
+
+	objData = (ObjData *) ckalloc(sizeof(ObjData));
+	objData->objPtr = objPtr;
+	objData->file = file;
+	objData->line = line;
+	Tcl_SetHashValue(hPtr, objData);
+    }
+#endif /* TCL_THREADS */
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_NewObj --
  *
- *	This procedure is normally called when not debugging: i.e., when
+ *	This function is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
  *	the empty string. These objects have a NULL object type and NULL
- *	string representation byte pointer. Type managers call this routine
- *	to allocate new objects that they further initialize.
+ *	string representation byte pointer. Type managers call this routine to
+ *	allocate new objects that they further initialize.
  *
- *	When TCL_MEM_DEBUG is defined, this procedure just returns the
- *	result of calling the debugging version Tcl_DbNewObj.
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewObj.
  *
  * Results:
  *	The result is a newly allocated object that represents the empty
- *	string. The new object's typePtr is set NULL and its ref count
- *	is set to 0.
+ *	string. The new object's typePtr is set NULL and its ref count is set
+ *	to 0.
  *
  * Side effects:
- *	If compiling with TCL_COMPILE_STATS, this procedure increments
- *	the global count of allocated objects (tclObjsAlloced).
+ *	If compiling with TCL_COMPILE_STATS, this function increments the
+ *	global count of allocated objects (tclObjsAlloced).
  *
  *----------------------------------------------------------------------
  */
@@ -856,7 +1148,7 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
 #undef Tcl_NewObj
 
 Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
 {
     return Tcl_DbNewObj("unknown", 0);
 }
@@ -864,13 +1156,12 @@ Tcl_NewObj()
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
 {
     register Tcl_Obj *objPtr;
 
     /*
-     * Use the macro defined in tclInt.h - it will use the
-     * correct allocator.
+     * Use the macro defined in tclInt.h - it will use the correct allocator.
      */
 
     TclNewObj(objPtr);
@@ -883,24 +1174,24 @@ Tcl_NewObj()
  *
  * Tcl_DbNewObj --
  *
- *	This procedure is normally called when debugging: i.e., when
+ *	This function is normally called when debugging: i.e., when
  *	TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
- *	empty string. It is the same as the Tcl_NewObj procedure above
- *	except that it calls Tcl_DbCkalloc directly with the file name and
- *	line number from its caller. This simplifies debugging since then
- *	the [memory active] command will report the correct file name and line
+ *	empty string. It is the same as the Tcl_NewObj function above except
+ *	that it calls Tcl_DbCkalloc directly with the file name and line
+ *	number from its caller. This simplifies debugging since then the
+ *	[memory active] command will report the correct file name and line
  *	number when reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
  *	result of calling Tcl_NewObj.
  *
  * Results:
- *	The result is a newly allocated that represents the empty string.
- *	The new object's typePtr is set NULL and its ref count is set to 0.
+ *	The result is a newly allocated that represents the empty string. The
+ *	new object's typePtr is set NULL and its ref count is set to 0.
  *
  * Side effects:
- *	If compiling with TCL_COMPILE_STATS, this procedure increments
- *	the global count of allocated objects (tclObjsAlloced).
+ *	If compiling with TCL_COMPILE_STATS, this function increments the
+ *	global count of allocated objects (tclObjsAlloced).
  *
  *----------------------------------------------------------------------
  */
@@ -908,17 +1199,16 @@ Tcl_NewObj()
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewObj(file, line)
-    register CONST char *file;	/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    register int line;		/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewObj(
+    register CONST char *file,	/* The name of the source file calling this
+				 * function; used for debugging. */
+    register int line)		/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
     /*
-     * Use the macro defined in tclInt.h - it will use the
-     * correct allocator.
+     * Use the macro defined in tclInt.h - it will use the correct allocator.
      */
 
     TclDbNewObj(objPtr, file, line);
@@ -927,11 +1217,11 @@ Tcl_DbNewObj(file, line)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewObj(file, line)
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewObj(
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewObj();
 }
@@ -942,8 +1232,8 @@ Tcl_DbNewObj(file, line)
  *
  * TclAllocateFreeObjects --
  *
- *	Procedure to allocate a number of free Tcl_Objs. This is done using
- *	a single ckalloc to reduce the overhead for Tcl_Obj allocation.
+ *	Function to allocate a number of free Tcl_Objs. This is done using a
+ *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
  *
  *	Assumes mutex is held.
  *
@@ -953,7 +1243,7 @@ Tcl_DbNewObj(file, line)
  * Side effects:
  *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
  *	first of a number of free Tcl_Obj's linked together by their
- *	internalRep.otherValuePtrs.
+ *	internalRep.twoPtrValue.ptr1's.
  *
  *----------------------------------------------------------------------
  */
@@ -961,7 +1251,7 @@ Tcl_DbNewObj(file, line)
 #define OBJS_TO_ALLOC_EACH_TIME 100
 
 void
-TclAllocateFreeObjects()
+TclAllocateFreeObjects(void)
 {
     size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
     char *basePtr;
@@ -969,22 +1259,20 @@ TclAllocateFreeObjects()
     register int i;
 
     /*
-     * This has been noted by Purify to be a potential leak.  The problem is
+     * This has been noted by Purify to be a potential leak. The problem is
      * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
-     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of
-     * actually freeing the memory.  TclFinalizeObjects() does not ckfree()
-     * this memory, but leaves it to Tcl's memory subsystem finalziation to
-     * release it.  Purify apparently can't figure that out, and fires a
-     * false alarm.
+     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
+     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
+     * but leaves it to Tcl's memory subsystem finalization to release it.
+     * Purify apparently can't figure that out, and fires a false alarm.
      */
 
     basePtr = (char *) ckalloc(bytesToAlloc);
-    memset(basePtr, 0, bytesToAlloc);
 
     prevPtr = NULL;
     objPtr = (Tcl_Obj *) basePtr;
     for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
-	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) prevPtr;
 	prevPtr = objPtr;
 	objPtr++;
     }
@@ -997,64 +1285,166 @@ TclAllocateFreeObjects()
  *
  * TclFreeObj --
  *
- *	This procedure frees the memory associated with the argument
- *	object. It is called by the tcl.h macro Tcl_DecrRefCount when an
- *	object's ref count is zero. It is only "public" since it must
- *	be callable by that macro wherever the macro is used. It should not
- *	be directly called by clients.
+ *	This function frees the memory associated with the argument object.
+ *	It is called by the tcl.h macro Tcl_DecrRefCount when an object's ref
+ *	count is zero. It is only "public" since it must be callable by that
+ *	macro wherever the macro is used. It should not be directly called by
+ *	clients.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Deallocates the storage for the object's Tcl_Obj structure
- *	after deallocating the string representation and calling the
- *	type-specific Tcl_FreeInternalRepProc to deallocate the object's
- *	internal representation. If compiling with TCL_COMPILE_STATS,
- *	this procedure increments the global count of freed objects
- *	(tclObjsFreed).
+ *	Deallocates the storage for the object's Tcl_Obj structure after
+ *	deallocating the string representation and calling the type-specific
+ *	Tcl_FreeInternalRepProc to deallocate the object's internal
+ *	representation. If compiling with TCL_COMPILE_STATS, this function
+ *	increments the global count of freed objects (tclObjsFreed).
  *
  *----------------------------------------------------------------------
  */
 
+#ifdef TCL_MEM_DEBUG
 void
-TclFreeObj(objPtr)
-    register Tcl_Obj *objPtr;	/* The object to be freed. */
+TclFreeObj(
+    register Tcl_Obj *objPtr)	/* The object to be freed. */
 {
     register Tcl_ObjType *typePtr = objPtr->typePtr;
-    
-#ifdef TCL_MEM_DEBUG
-    if ((objPtr)->refCount < -1) {
-	panic("Reference count for %lx was negative", objPtr);
+
+    /*
+     * This macro declares a variable, so must come here...
+     */
+
+    ObjInitDeletionContext(context);
+
+    if (objPtr->refCount < -1) {
+	Tcl_Panic("Reference count for %lx was negative", objPtr);
     }
-#endif /* TCL_MEM_DEBUG */
 
-    TCL_DTRACE_OBJ_FREE(objPtr);
-    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	typePtr->freeIntRepProc(objPtr);
+    /* Invalidate the string rep first so we can use the bytes value 
+     * for our pointer chain, and signal an obj deletion (as opposed
+     * to shimmering) with 'length == -1' */ 
+    
+    TclInvalidateStringRep(objPtr);
+    objPtr->length = -1;
+
+    if (ObjDeletePending(context)) {
+	PushObjToDelete(context, objPtr);
+    } else {
+	TCL_DTRACE_OBJ_FREE(objPtr);
+	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	    ObjDeletionLock(context);
+	    typePtr->freeIntRepProc(objPtr);
+	    ObjDeletionUnlock(context);
+	}
+
+	Tcl_MutexLock(&tclObjMutex);
+	ckfree((char *) objPtr);
+	Tcl_MutexUnlock(&tclObjMutex);
+	TclIncrObjsFreed();
+	ObjDeletionLock(context);
+	while (ObjOnStack(context)) {
+	    Tcl_Obj *objToFree;
+
+	    PopObjToDelete(context,objToFree);
+	    TCL_DTRACE_OBJ_FREE(objToFree);
+	    TclFreeIntRep(objToFree);
+
+	    Tcl_MutexLock(&tclObjMutex);
+	    ckfree((char *) objToFree);
+	    Tcl_MutexUnlock(&tclObjMutex);
+	    TclIncrObjsFreed();
+	}
+	ObjDeletionUnlock(context);
     }
-    Tcl_InvalidateStringRep(objPtr);
 
     /*
-     * If debugging Tcl's memory usage, deallocate the object using ckfree.
-     * Otherwise, deallocate it by adding it onto the list of free
-     * Tcl_Obj structs we maintain.
+     * We cannot use TclGetContinuationTable() here, because that may
+     * re-initialize the thread-data for calls coming after the
+     * finalization. We have to access it using the low-level call and then
+     * check for validity. This function can be called after
+     * TclFinalizeThreadData() has already killed the thread-global data
+     * structures. Performing TCL_TSD_INIT will leave us with an
+     * un-initialized memory block upon which we crash (if we where to access
+     * the uninitialized hashtable).
      */
 
-#if defined(TCL_MEM_DEBUG) || defined(PURIFY)
-    Tcl_MutexLock(&tclObjMutex);
-    ckfree((char *) objPtr);
-    Tcl_MutexUnlock(&tclObjMutex);
-#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) 
-    TclThreadFreeObj(objPtr); 
-#else 
-    Tcl_MutexLock(&tclObjMutex);
-    objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
-    tclFreeObjList = objPtr;
-    Tcl_MutexUnlock(&tclObjMutex);
-#endif /* TCL_MEM_DEBUG */
+    {
+	ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
+	if (tsdPtr->lineCLPtr) {
+	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+	    if (hPtr) {
+		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
+		Tcl_DeleteHashEntry (hPtr);
+	    }
+	}
+    }
+}
+#else /* TCL_MEM_DEBUG */
+
+void
+TclFreeObj(
+    register Tcl_Obj *objPtr)	/* The object to be freed. */
+{
+    /* Invalidate the string rep first so we can use the bytes value 
+     * for our pointer chain, and signal an obj deletion (as opposed
+     * to shimmering) with 'length == -1' */ 
+
+    TclInvalidateStringRep(objPtr);
+    objPtr->length = -1;
+    
+    if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
+	/*
+	 * objPtr can be freed safely, as it will not attempt to free any
+	 * other objects: it will not cause recursive calls to this function.
+	 */
+
+	TCL_DTRACE_OBJ_FREE(objPtr);
+	TclFreeObjStorage(objPtr);
+	TclIncrObjsFreed();
+    } else {
+	/*
+	 * This macro declares a variable, so must come here...
+	 */
+
+	ObjInitDeletionContext(context);
+
+	if (ObjDeletePending(context)) {
+	    PushObjToDelete(context, objPtr);
+	} else {
+	    /*
+	     * Note that the contents of the while loop assume that the string
+	     * rep has already been freed and we don't want to do anything
+	     * fancy with adding to the queue inside ourselves. Must take care
+	     * to unstack the object first since freeing the internal rep can
+	     * add further objects to the stack. The code assumes that it is
+	     * the first thing in a block; all current usages in the core
+	     * satisfy this.
+	     */
+
+	    TCL_DTRACE_OBJ_FREE(objPtr);
+	    ObjDeletionLock(context);
+	    objPtr->typePtr->freeIntRepProc(objPtr);
+	    ObjDeletionUnlock(context);
+
+	    TclFreeObjStorage(objPtr);
+	    TclIncrObjsFreed();
+	    ObjDeletionLock(context);
+	    while (ObjOnStack(context)) {
+		Tcl_Obj *objToFree;
+		PopObjToDelete(context,objToFree);
+		TCL_DTRACE_OBJ_FREE(objToFree);
+		if ((objToFree->typePtr != NULL)
+			&& (objToFree->typePtr->freeIntRepProc != NULL)) {
+		    objToFree->typePtr->freeIntRepProc(objToFree);
+		}
+		TclFreeObjStorage(objToFree);
+		TclIncrObjsFreed();
+	    }
+	    ObjDeletionUnlock(context);
+	}
+    }
 
-#ifdef TCL_TIP280
     /*
      * We cannot use TclGetContinuationTable() here, because that may
      * re-initialize the thread-data for calls coming after the
@@ -1076,9 +1466,34 @@ TclFreeObj(objPtr)
 	    }
 	}
     }
+}
 #endif
-    TclIncrObjsFreed();
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjBeingDeleted --
+ *
+ *	This function returns 1 when the Tcl_Obj is being deleted. It is
+ *	provided for the rare cases where the reason for the loss of an
+ *	internal rep might be relevant. [FR 1512138]
+ *
+ * Results:
+ *	1 if being deleted, 0 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjBeingDeleted(
+    Tcl_Obj *objPtr)
+{
+    return (objPtr->length == -1);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1089,29 +1504,29 @@ TclFreeObj(objPtr)
  *	object.
  *
  * Results:
- *	The return value is a pointer to a newly created Tcl_Obj. This
- *	object has reference count 0 and the same type, if any, as the
- *	source object objPtr. Also:
+ *	The return value is a pointer to a newly created Tcl_Obj. This object
+ *	has reference count 0 and the same type, if any, as the source object
+ *	objPtr. Also:
  *	  1) If the source object has a valid string rep, we copy it;
- *	     otherwise, the duplicate's string rep is set NULL to mark
- *	     it invalid.
+ *	     otherwise, the duplicate's string rep is set NULL to mark it
+ *	     invalid.
  *	  2) If the source object has an internal representation (i.e. its
- *	     typePtr is non-NULL), the new object's internal rep is set to
- *	     a copy; otherwise the new internal rep is marked invalid.
+ *	     typePtr is non-NULL), the new object's internal rep is set to a
+ *	     copy; otherwise the new internal rep is marked invalid.
  *
  * Side effects:
- *      What constitutes "copying" the internal representation depends on
- *	the type. For example, if the argument object is a list,
- *	the element objects it points to will not actually be copied but
- *	will be shared with the duplicate list. That is, the ref counts of
- *	the element objects will be incremented.
+ *	What constitutes "copying" the internal representation depends on the
+ *	type. For example, if the argument object is a list, the element
+ *	objects it points to will not actually be copied but will be shared
+ *	with the duplicate list. That is, the ref counts of the element
+ *	objects will be incremented.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_DuplicateObj(objPtr)
-    register Tcl_Obj *objPtr;		/* The object to duplicate. */
+Tcl_DuplicateObj(
+    register Tcl_Obj *objPtr)		/* The object to duplicate. */
 {
     register Tcl_ObjType *typePtr = objPtr->typePtr;
     register Tcl_Obj *dupPtr;
@@ -1123,7 +1538,7 @@ Tcl_DuplicateObj(objPtr)
     } else if (objPtr->bytes != tclEmptyStringRep) {
 	TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
     }
-    
+
     if (typePtr != NULL) {
 	if (typePtr->dupIntRepProc == NULL) {
 	    dupPtr->internalRep = objPtr->internalRep;
@@ -1157,16 +1572,16 @@ Tcl_DuplicateObj(objPtr)
  */
 
 char *
-Tcl_GetString(objPtr)
-    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
-				 * should be returned. */
+Tcl_GetString(
+    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
+				 * be returned. */
 {
     if (objPtr->bytes != NULL) {
 	return objPtr->bytes;
     }
 
     if (objPtr->typePtr->updateStringProc == NULL) {
-	panic("UpdateStringProc should not be invoked for type %s",
+	Tcl_Panic("UpdateStringProc should not be invoked for type %s",
 		objPtr->typePtr->name);
     }
     (*objPtr->typePtr->updateStringProc)(objPtr);
@@ -1178,16 +1593,16 @@ Tcl_GetString(objPtr)
  *
  * Tcl_GetStringFromObj --
  *
- *	Returns the string representation's byte array pointer and length
- *	for an object.
+ *	Returns the string representation's byte array pointer and length for
+ *	an object.
  *
  * Results:
- *	Returns a pointer to the string representation of objPtr. If
- *	lengthPtr isn't NULL, the length of the string representation is
- *	stored at *lengthPtr. The byte array referenced by the returned
- *	pointer must not be modified by the caller. Furthermore, the
- *	caller must copy the bytes if they need to retain them since the
- *	object's string rep can change as a result of other operations.
+ *	Returns a pointer to the string representation of objPtr. If lengthPtr
+ *	isn't NULL, the length of the string representation is stored at
+ *	*lengthPtr. The byte array referenced by the returned pointer must not
+ *	be modified by the caller. Furthermore, the caller must copy the bytes
+ *	if they need to retain them since the object's string rep can change
+ *	as a result of other operations.
  *
  * Side effects:
  *	May call the object's updateStringProc to update the string
@@ -1197,16 +1612,16 @@ Tcl_GetString(objPtr)
  */
 
 char *
-Tcl_GetStringFromObj(objPtr, lengthPtr)
-    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer should
+Tcl_GetStringFromObj(
+    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
 				 * be returned. */
-    register int *lengthPtr;	/* If non-NULL, the location where the string
+    register int *lengthPtr)	/* If non-NULL, the location where the string
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
     if (objPtr->bytes == NULL) {
 	if (objPtr->typePtr->updateStringProc == NULL) {
-	    panic("UpdateStringProc should not be invoked for type %s",
+	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
 		    objPtr->typePtr->name);
 	}
 	(*objPtr->typePtr->updateStringProc)(objPtr);
@@ -1223,48 +1638,44 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
  *
  * Tcl_InvalidateStringRep --
  *
- *	This procedure is called to invalidate an object's string
- *	representation. 
+ *	This function is called to invalidate an object's string
+ *	representation.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Deallocates the storage for any old string representation, then
- *	sets the string representation NULL to mark it invalid.
+ *	Deallocates the storage for any old string representation, then sets
+ *	the string representation NULL to mark it invalid.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_InvalidateStringRep(objPtr)
-     register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
-				 * should be freed. */
+Tcl_InvalidateStringRep(
+    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
+				 * be freed. */
 {
-    if (objPtr->bytes != NULL) {
-	if (objPtr->bytes != tclEmptyStringRep) {
-	    ckfree((char *) objPtr->bytes);
-	}
-	objPtr->bytes = NULL;
-    }
+    TclInvalidateStringRep(objPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_NewBooleanObj --
  *
- *	This procedure is normally called when not debugging: i.e., when
+ *	This function is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
- *	initializes it from the argument boolean value. A nonzero
- *	"boolValue" is coerced to 1.
+ *	initializes it from the argument boolean value. A nonzero "boolValue"
+ *	is coerced to 1.
  *
- *	When TCL_MEM_DEBUG is defined, this procedure just returns the
- *	result of calling the debugging version Tcl_DbNewBooleanObj.
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewBooleanObj.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -1276,8 +1687,8 @@ Tcl_InvalidateStringRep(objPtr)
 #undef Tcl_NewBooleanObj
 
 Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
-    register int boolValue;	/* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+    register int boolValue)	/* Boolean used to initialize new object. */
 {
     return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
 }
@@ -1285,16 +1696,12 @@ Tcl_NewBooleanObj(boolValue)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
-    register int boolValue;	/* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+    register int boolValue)	/* Boolean used to initialize new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewObj(objPtr);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclBooleanType;
+    TclNewBooleanObj(objPtr, boolValue);
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -1304,20 +1711,20 @@ Tcl_NewBooleanObj(boolValue)
  *
  * Tcl_DbNewBooleanObj --
  *
- *	This procedure is normally called when debugging: i.e., when
+ *	This function is normally called when debugging: i.e., when
  *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- *	same as the Tcl_NewBooleanObj procedure above except that it calls
+ *	same as the Tcl_NewBooleanObj function above except that it calls
  *	Tcl_DbCkalloc directly with the file name and line number from its
  *	caller. This simplifies debugging since then the [memory active]
- *	command	will report the correct file name and line number when
+ *	command will report the correct file name and line number when
  *	reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
  *	result of calling Tcl_NewBooleanObj.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -1328,32 +1735,32 @@ Tcl_NewBooleanObj(boolValue)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
-    register int boolValue;	/* Boolean used to initialize new object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewBooleanObj(
+    register int boolValue,	/* Boolean used to initialize new object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-    
+
     objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclBooleanType;
+    objPtr->typePtr = &tclIntType;
     return objPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
-    register int boolValue;	/* Boolean used to initialize new object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewBooleanObj(
+    register int boolValue,	/* Boolean used to initialize new object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewBooleanObj(boolValue);
 }
@@ -1371,30 +1778,22 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
  *	None.
  *
  * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old
- *	internal rep is freed.
+ *	The object's old string rep, if any, is freed. Also, any old internal
+ *	rep is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetBooleanObj(objPtr, boolValue)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
-    register int boolValue;	/* Boolean used to set object's value. */
+Tcl_SetBooleanObj(
+    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    register int boolValue)	/* Boolean used to set object's value. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetBooleanObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
     }
-    
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
-    objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclBooleanType;
-    Tcl_InvalidateStringRep(objPtr);
+
+    TclSetBooleanObj(objPtr, boolValue);
 }
 
 /*
@@ -1402,9 +1801,8 @@ Tcl_SetBooleanObj(objPtr, boolValue)
  *
  * Tcl_GetBooleanFromObj --
  *
- *	Attempt to return a boolean from the Tcl object "objPtr". If the
- *	object is not already a boolean, an attempt will be made to convert
- *	it to one.
+ *	Attempt to return a boolean from the Tcl object "objPtr". This
+ *	includes conversion from any of Tcl's numeric types.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -1412,30 +1810,56 @@ Tcl_SetBooleanObj(objPtr, boolValue)
  *	result unless "interp" is NULL.
  *
  * Side effects:
- *	If the object is not already a boolean, the conversion will free
- *	any old internal representation. 
+ *	The intrep of *objPtr may be changed.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
-    register int *boolPtr;	/* Place to store resulting boolean. */
+Tcl_GetBooleanFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr,	/* The object from which to get boolean. */
+    register int *boolPtr)	/* Place to store resulting boolean. */
 {
-    register int result;
+    do {
+	if (objPtr->typePtr == &tclIntType) {
+	    *boolPtr = (objPtr->internalRep.longValue != 0);
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclBooleanType) {
+	    *boolPtr = (int) objPtr->internalRep.longValue;
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclDoubleType) {
+	    /*
+	     * Caution: Don't be tempted to check directly for the "double"
+	     * Tcl_ObjType and then compare the intrep to 0.0. This isn't
+	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
+	     * Use the API Tcl_GetDoubleFromObj, which does the checking and
+	     * sets the proper error message for us.
+	     */
 
-    if (objPtr->typePtr == &tclBooleanType) {
-	result = TCL_OK;
-    } else {
-	result = SetBooleanFromAny(interp, objPtr);
-    }
+            double d;
 
-    if (result == TCL_OK) {
-	*boolPtr = (int) objPtr->internalRep.longValue;
-    }
-    return result;
+	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    *boolPtr = (d != 0.0);
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclBignumType) {
+	    *boolPtr = 1;
+	    return TCL_OK;
+	}
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    *boolPtr = (objPtr->internalRep.wideValue != 0);
+	    return TCL_OK;
+	}
+#endif
+    } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
+	    TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
+    return TCL_ERROR;
 }
 
 /*
@@ -1452,218 +1876,174 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
  *	unless "interp" is NULL.
  *
  * Side effects:
- *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s
- *	internal representation and the type of "objPtr" is set to boolean.
+ *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
+ *	representation and the type of "objPtr" is set to boolean.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetBooleanFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
-{
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *string, *end;
-    register char c;
-    char lowerCase[10];
-    int newBool, length;
-    register int i;
-
+SetBooleanFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
+{
     /*
-     * Get the string representation. Make it up-to-date if necessary.
+     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
+     * whether a boolean conversion is possible without generating the string
+     * rep.
      */
-    
-    string = Tcl_GetStringFromObj(objPtr, &length);
+
+    if (objPtr->bytes == NULL) {
+	if (objPtr->typePtr == &tclIntType) {
+	    switch (objPtr->internalRep.longValue) {
+	    case 0L: case 1L:
+		return TCL_OK;
+	    }
+	    goto badBoolean;
+	}
+
+	if (objPtr->typePtr == &tclBignumType) {
+	    goto badBoolean;
+	}
+
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    goto badBoolean;
+	}
+#endif
+
+	if (objPtr->typePtr == &tclDoubleType) {
+	    goto badBoolean;
+	}
+    }
+
+    if (ParseBoolean(objPtr) == TCL_OK) {
+	return TCL_OK;
+    }
+
+  badBoolean:
+    if (interp != NULL) {
+	int length;
+	char *str = Tcl_GetStringFromObj(objPtr, &length);
+	Tcl_Obj *msg;
+
+	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
+	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
+	Tcl_AppendToObj(msg, "\"", -1);
+	Tcl_SetObjResult(interp, msg);
+    }
+    return TCL_ERROR;
+}
+
+static int
+ParseBoolean(
+    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
+{
+    int i, length, newBool;
+    char lowerCase[6], *str = TclGetStringFromObj(objPtr, &length);
+
+    if ((length == 0) || (length > 5)) {
+	/* longest valid boolean string rep. is "false" */
+	return TCL_ERROR;
+    }
+
+    switch (str[0]) {
+    case '0':
+	if (length == 1) {
+	    newBool = 0;
+	    goto numericBoolean;
+	}
+	return TCL_ERROR;
+    case '1':
+	if (length == 1) {
+	    newBool = 1;
+	    goto numericBoolean;
+	}
+	return TCL_ERROR;
+    }
 
     /*
-     * Use the obvious shortcuts for numerical values; if objPtr is not
-     * of numerical type, parse its string rep.
+     * Force to lower case for case-insensitive detection. Filter out known
+     * invalid characters at the same time.
      */
-	
-    if (objPtr->typePtr == &tclIntType) {
-	newBool = (objPtr->internalRep.longValue != 0);
-    } else if (objPtr->typePtr == &tclDoubleType) {
-	newBool = (objPtr->internalRep.doubleValue != 0.0);
-    } else if (objPtr->typePtr == &tclWideIntType) {
-	newBool = (objPtr->internalRep.wideValue != 0);
-    } else {
-	/*
-	 * Copy the string converting its characters to lower case.
-	 */
-	
-	for (i = 0;  (i < 9) && (i < length);  i++) {
-	    c = string[i];
-	    /*
-	     * Weed out international characters so we can safely operate
-	     * on single bytes.
-	     */
-	    
-	    if (c & 0x80) {
-		goto badBoolean;
-	    }
-	    if (Tcl_UniCharIsUpper(UCHAR(c))) {
-		c = (char) Tcl_UniCharToLower(UCHAR(c));
-	    }
+
+    for (i=0; i < length; i++) {
+	char c = str[i];
+	switch (c) {
+	case 'A': case 'E': case 'F': case 'L': case 'N':
+	case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y':
+	    lowerCase[i] = c + (char) ('a' - 'A');
+	    break;
+	case 'a': case 'e': case 'f': case 'l': case 'n':
+	case 'o': case 'r': case 's': case 't': case 'u': case 'y':
 	    lowerCase[i] = c;
+	    break;
+	default:
+	    return TCL_ERROR;
 	}
-	lowerCase[i] = 0;
-	
+    }
+    lowerCase[length] = 0;
+    switch (lowerCase[0]) {
+    case 'y':
 	/*
-	 * Parse the string as a boolean. We use an implementation here that
-	 * doesn't report errors in interp if interp is NULL.
+	 * Checking the 'y' is redundant, but makes the code clearer.
 	 */
-	
-	c = lowerCase[0];
-	if ((c == '0') && (lowerCase[1] == '\0')) {
-	    newBool = 0;
-	} else if ((c == '1') && (lowerCase[1] == '\0')) {
+	if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
 	    newBool = 1;
-	} else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+	    goto goodBoolean;
+	}
+	return TCL_ERROR;
+    case 'n':
+	if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+	    newBool = 0;
+	    goto goodBoolean;
+	}
+	return TCL_ERROR;
+    case 't':
+	if (strncmp(lowerCase, "true", (size_t) length) == 0) {
 	    newBool = 1;
-	} else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
+	    goto goodBoolean;
+	}
+	return TCL_ERROR;
+    case 'f':
+	if (strncmp(lowerCase, "false", (size_t) length) == 0) {
 	    newBool = 0;
-	} else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
+	    goto goodBoolean;
+	}
+	return TCL_ERROR;
+    case 'o':
+	if (length < 2) {
+	    return TCL_ERROR;
+	}
+	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
 	    newBool = 1;
-	} else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
+	    goto goodBoolean;
+	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
 	    newBool = 0;
-	} else if ((c == 'o') && (length >= 2)) {
-	    if (strncmp(lowerCase, "on", (size_t) length) == 0) {
-		newBool = 1;
-	    } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
-		newBool = 0;
-	    } else {
-		goto badBoolean;
-	    }
-	} else {
-	    double dbl;
-	    /*
-	     * Boolean values can be extracted from ints or doubles.  Note
-	     * that we don't use strtoul or strtoull here because we don't
-	     * care about what the value is, just whether it is equal to
-	     * zero or not.
-	     */
-#ifdef TCL_WIDE_INT_IS_LONG
-	    newBool = strtol(string, &end, 0);
-	    if (end != string) {
-		/*
-		 * Make sure the string has no garbage after the end of
-		 * the int.
-		 */
-		while ((end < (string+length))
-		       && isspace(UCHAR(*end))) { /* INTL: ISO only */
-		    end++;
-		}
-		if (end == (string+length)) {
-		    newBool = (newBool != 0);
-		    goto goodBoolean;
-		}
-	    }
-#else /* !TCL_WIDE_INT_IS_LONG */
-	    Tcl_WideInt wide = strtoll(string, &end, 0);
-	    if (end != string) {
-		/*
-		 * Make sure the string has no garbage after the end of
-		 * the wide int.
-		 */
-		while ((end < (string+length))
-		       && isspace(UCHAR(*end))) { /* INTL: ISO only */
-		    end++;
-		}
-		if (end == (string+length)) {
-		    newBool = (wide != Tcl_LongAsWide(0));
-		    goto goodBoolean;
-		}
-	    }
-#endif /* TCL_WIDE_INT_IS_LONG */
-	    /*
-	     * Still might be a string containing the characters representing an
-	     * int or double that wasn't handled above. This would be a string
-	     * like "27" or "1.0" that is non-zero and not "1". Such a string
-	     * would result in the boolean value true. We try converting to
-	     * double. If that succeeds and the resulting double is non-zero, we
-	     * have a "true". Note that numbers can't have embedded NULLs.
-	     */
-	    
-	    dbl = strtod(string, &end);
-	    if (end == string) {
-		goto badBoolean;
-	    }
-	    
-	    /*
-	     * Make sure the string has no garbage after the end of the double.
-	     */
-	    
-	    while ((end < (string+length))
-		   && isspace(UCHAR(*end))) { /* INTL: ISO only */
-		end++;
-	    }
-	    if (end != (string+length)) {
-		goto badBoolean;
-	    }
-	    newBool = (dbl != 0.0);
+	    goto goodBoolean;
 	}
+	return TCL_ERROR;
+    default:
+	return TCL_ERROR;
     }
 
     /*
-     * Free the old internalRep before setting the new one. We do this as
-     * late as possible to allow the conversion code, in particular
+     * Free the old internalRep before setting the new one. We do this as late
+     * as possible to allow the conversion code, in particular
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    goodBoolean:
-    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-
+  goodBoolean:
+    TclFreeIntRep(objPtr);
     objPtr->internalRep.longValue = newBool;
     objPtr->typePtr = &tclBooleanType;
     return TCL_OK;
 
-    badBoolean:
-    if (interp != NULL) {
-	/*
-	 * Must copy string before resetting the result in case a caller
-	 * is trying to convert the interpreter's result to a boolean.
-	 */
-	
-	char buf[100];
-	sprintf(buf, "expected boolean value but got \"%.50s\"", string);
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfBoolean --
- *
- *	Update the string representation for a boolean object.
- *	Note: This procedure does not free an existing old string rep
- *	so storage will be lost if this has not already been done. 
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's string is set to a valid string that results from
- *	the boolean-to-string conversion.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfBoolean(objPtr)
-    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
-{
-    char *s = ckalloc((unsigned) 2);
-    
-    s[0] = (char) (objPtr->internalRep.longValue? '1' : '0');
-    s[1] = '\0';
-    objPtr->bytes = s;
-    objPtr->length = 1;
+  numericBoolean:
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.longValue = newBool;
+    objPtr->typePtr = &tclIntType;
+    return TCL_OK;
 }
 
 /*
@@ -1671,12 +2051,12 @@ UpdateStringOfBoolean(objPtr)
  *
  * Tcl_NewDoubleObj --
  *
- *	This procedure is normally called when not debugging: i.e., when
+ *	This function is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates a new double object and
  *	initializes it from the argument double value.
  *
- *	When TCL_MEM_DEBUG is defined, this procedure just returns the
- *	result of calling the debugging version Tcl_DbNewDoubleObj.
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewDoubleObj.
  *
  * Results:
  *	The newly created object is returned. This object will have an
@@ -1692,8 +2072,8 @@ UpdateStringOfBoolean(objPtr)
 #undef Tcl_NewDoubleObj
 
 Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
-    register double dblValue;	/* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+    register double dblValue)	/* Double used to initialize the object. */
 {
     return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
 }
@@ -1701,16 +2081,12 @@ Tcl_NewDoubleObj(dblValue)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
-    register double dblValue;	/* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+    register double dblValue)	/* Double used to initialize the object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewObj(objPtr);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = &tclDoubleType;
+    TclNewDoubleObj(objPtr, dblValue);
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -1720,20 +2096,20 @@ Tcl_NewDoubleObj(dblValue)
  *
  * Tcl_DbNewDoubleObj --
  *
- *	This procedure is normally called when debugging: i.e., when
+ *	This function is normally called when debugging: i.e., when
  *	TCL_MEM_DEBUG is defined. It creates new double objects. It is the
- *	same as the Tcl_NewDoubleObj procedure above except that it calls
+ *	same as the Tcl_NewDoubleObj function above except that it calls
  *	Tcl_DbCkalloc directly with the file name and line number from its
  *	caller. This simplifies debugging since then the [memory active]
- *	command	will report the correct file name and line number when
+ *	command will report the correct file name and line number when
  *	reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
  *	result of calling Tcl_NewDoubleObj.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -1744,18 +2120,18 @@ Tcl_NewDoubleObj(dblValue)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
-    register double dblValue;	/* Double used to initialize the object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewDoubleObj(
+    register double dblValue,	/* Double used to initialize the object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-    
+
     objPtr->internalRep.doubleValue = dblValue;
     objPtr->typePtr = &tclDoubleType;
     return objPtr;
@@ -1764,12 +2140,12 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
-    register double dblValue;	/* Double used to initialize the object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewDoubleObj(
+    register double dblValue,	/* Double used to initialize the object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewDoubleObj(dblValue);
 }
@@ -1787,30 +2163,22 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
  *	None.
  *
  * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old
- *	internal rep is freed.
+ *	The object's old string rep, if any, is freed. Also, any old internal
+ *	rep is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetDoubleObj(objPtr, dblValue)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
-    register double dblValue;	/* Double used to set the object's value. */
+Tcl_SetDoubleObj(
+    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    register double dblValue)	/* Double used to set the object's value. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetDoubleObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
     }
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
-    objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = &tclDoubleType;
-    Tcl_InvalidateStringRep(objPtr);
+    TclSetDoubleObj(objPtr, dblValue);
 }
 
 /*
@@ -1818,9 +2186,8 @@ Tcl_SetDoubleObj(objPtr, dblValue)
  *
  * Tcl_GetDoubleFromObj --
  *
- *	Attempt to return a double from the Tcl object "objPtr". If the
- *	object is not already a double, an attempt will be made to convert
- *	it to one.
+ *	Attempt to return a double from the Tcl object "objPtr". If the object
+ *	is not already a double, an attempt will be made to convert it to one.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -1828,30 +2195,48 @@ Tcl_SetDoubleObj(objPtr, dblValue)
  *	result unless "interp" is NULL.
  *
  * Side effects:
- *	If the object is not already a double, the conversion will free
- *	any old internal representation.
+ *	If the object is not already a double, the conversion will free any
+ *	old internal representation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object from which to get a double. */
-    register double *dblPtr;	/* Place to store resulting double. */
+Tcl_GetDoubleFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr,	/* The object from which to get a double. */
+    register double *dblPtr)	/* Place to store resulting double. */
 {
-    register int result;
-    
-    if (objPtr->typePtr == &tclDoubleType) {
-	*dblPtr = objPtr->internalRep.doubleValue;
-	return TCL_OK;
-    }
-
-    result = SetDoubleFromAny(interp, objPtr);
-    if (result == TCL_OK) {
-	*dblPtr = objPtr->internalRep.doubleValue;
-    }
-    return result;
+    do {
+	if (objPtr->typePtr == &tclDoubleType) {
+	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
+		if (interp != NULL) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "floating point value is Not a Number", -1));
+		}
+		return TCL_ERROR;
+	    }
+	    *dblPtr = (double) objPtr->internalRep.doubleValue;
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclIntType) {
+	    *dblPtr = objPtr->internalRep.longValue;
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclBignumType) {
+	    mp_int big;
+	    UNPACK_BIGNUM( objPtr, big );
+	    *dblPtr = TclBignumToDouble( &big );
+	    return TCL_OK;
+	}
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    *dblPtr = (double) objPtr->internalRep.wideValue;
+	    return TCL_OK;
+	}
+#endif
+    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
+    return TCL_ERROR;
 }
 
 /*
@@ -1875,78 +2260,12 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
  */
 
 static int
-SetDoubleFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
+SetDoubleFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *string, *end;
-    double newDouble;
-    int length;
-
-    /*
-     * Get the string representation. Make it up-to-date if necessary.
-     */
-
-    string = Tcl_GetStringFromObj(objPtr, &length);
-
-    /*
-     * Now parse "objPtr"s string as an double. Numbers can't have embedded
-     * NULLs. We use an implementation here that doesn't report errors in
-     * interp if interp is NULL.
-     */
-
-    errno = 0;
-    newDouble = strtod(string, &end);
-    if (end == string) {
-	badDouble:
-	if (interp != NULL) {
-	    /*
-	     * Must copy string before resetting the result in case a caller
-	     * is trying to convert the interpreter's result to an int.
-	     */
-	    
-	    char buf[100];
-	    sprintf(buf, "expected floating-point number but got \"%.50s\"",
-	            string);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
-	}
-	return TCL_ERROR;
-    }
-    if (errno != 0) {
-	if (interp != NULL) {
-	    TclExprFloatError(interp, newDouble);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make sure that the string has no garbage after the end of the double.
-     */
-    
-    while ((end < (string+length))
-	    && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (end != (string+length)) {
-	goto badDouble;
-    }
-    
-    /*
-     * The conversion to double succeeded. Free the old internalRep before
-     * setting the new one. We do this as late as possible to allow the
-     * conversion code, in particular Tcl_GetStringFromObj, to use that old
-     * internalRep.
-     */
-    
-    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-
-    objPtr->internalRep.doubleValue = newDouble;
-    objPtr->typePtr = &tclDoubleType;
-    return TCL_OK;
+    return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
+	    NULL, 0);
 }
 
 /*
@@ -1954,9 +2273,9 @@ SetDoubleFromAny(interp, objPtr)
  *
  * UpdateStringOfDouble --
  *
- *	Update the string representation for a double-precision floating
- *	point object. This must obey the current tcl_precision value for
- *	double-to-string conversions. Note: This procedure does not free an
+ *	Update the string representation for a double-precision floating point
+ *	object. This must obey the current tcl_precision value for
+ *	double-to-string conversions. Note: This function does not free an
  *	existing old string rep so storage will be lost if this has not
  *	already been done.
  *
@@ -1964,23 +2283,22 @@ SetDoubleFromAny(interp, objPtr)
  *	None.
  *
  * Side effects:
- *	The object's string is set to a valid string that results from
- *	the double-to-string conversion.
+ *	The object's string is set to a valid string that results from the
+ *	double-to-string conversion.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfDouble(objPtr)
-    register Tcl_Obj *objPtr;	/* Double obj with string rep to update. */
+UpdateStringOfDouble(
+    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
 {
     char buffer[TCL_DOUBLE_SPACE];
     register int len;
-    
-    Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
-	    buffer);
+
+    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
     len = strlen(buffer);
-    
+
     objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
     strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
@@ -1993,22 +2311,22 @@ UpdateStringOfDouble(objPtr)
  *
  *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
  *	Tcl_NewIntObj to create a new integer object end up calling the
- *	debugging procedure Tcl_DbNewLongObj instead.
+ *	debugging function Tcl_DbNewLongObj instead.
  *
  *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
  *	calls to Tcl_NewIntObj result in a call to one of the two
- *	Tcl_NewIntObj implementations below. We provide two implementations
- *	so that the Tcl core can be compiled to do memory debugging of the 
- *	core even if a client does not request it for itself.
+ *	Tcl_NewIntObj implementations below. We provide two implementations so
+ *	that the Tcl core can be compiled to do memory debugging of the core
+ *	even if a client does not request it for itself.
  *
  *	Integer and long integer objects share the same "integer" type
  *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by
- *	an int.
+ *	checks whether the current value of the long can be represented by an
+ *	int.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -2020,8 +2338,8 @@ UpdateStringOfDouble(objPtr)
 #undef Tcl_NewIntObj
 
 Tcl_Obj *
-Tcl_NewIntObj(intValue)
-    register int intValue;	/* Int used to initialize the new object. */
+Tcl_NewIntObj(
+    register int intValue)	/* Int used to initialize the new object. */
 {
     return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
 }
@@ -2029,16 +2347,12 @@ Tcl_NewIntObj(intValue)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewIntObj(intValue)
-    register int intValue;	/* Int used to initialize the new object. */
+Tcl_NewIntObj(
+    register int intValue)	/* Int used to initialize the new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewObj(objPtr);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.longValue = (long)intValue;
-    objPtr->typePtr = &tclIntType;
+    TclNewIntObj(objPtr, intValue);
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2055,30 +2369,22 @@ Tcl_NewIntObj(intValue)
  *	None.
  *
  * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old
- *	internal rep is freed. 
+ *	The object's old string rep, if any, is freed. Also, any old internal
+ *	rep is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetIntObj(objPtr, intValue)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
-    register int intValue;	/* Integer used to set object's value. */
+Tcl_SetIntObj(
+    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    register int intValue)	/* Integer used to set object's value. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetIntObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
     }
-    
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
-    objPtr->internalRep.longValue = (long) intValue;
-    objPtr->typePtr = &tclIntType;
-    Tcl_InvalidateStringRep(objPtr);
+
+    TclSetIntObj(objPtr, intValue);
 }
 
 /*
@@ -2091,67 +2397,48 @@ Tcl_SetIntObj(objPtr, intValue)
  *
  *	Integer and long integer objects share the same "integer" type
  *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by
- *	an int.
+ *	checks whether the current value of the long can be represented by an
+ *	int.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion or if the long integer held by the object
- *	can not be represented by an int, an error message is left in
- *	the interpreter's result unless "interp" is NULL.
+ *	during conversion or if the long integer held by the object can not be
+ *	represented by an int, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
  *
  * Side effects:
- *	If the object is not already an int, the conversion will free
- *	any old internal representation.
+ *	If the object is not already an int, the conversion will free any old
+ *	internal representation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetIntFromObj(interp, objPtr, intPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object from which to get a int. */
-    register int *intPtr;	/* Place to store resulting int. */
+Tcl_GetIntFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
+    register int *intPtr)	/* Place to store resulting int. */
 {
-    int result;
-    Tcl_WideInt w = 0;
-
-    /*
-     * If the object isn't already an integer of any width, try to
-     * convert it to one.
-     */
-
-    if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
-	result = SetIntOrWideFromAny(interp, objPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
-    }
-
-    /*
-     * Object should now be either int or wide. Get its value.
-     */
+#if (LONG_MAX == INT_MAX)
+    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
+#else
+    long l;
 
-#ifndef TCL_WIDE_INT_IS_LONG
-    if (objPtr->typePtr == &tclWideIntType) {
-	w = objPtr->internalRep.wideValue;
-    } else
-#endif
-    {
-	w = Tcl_LongAsWide(objPtr->internalRep.longValue);
+    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
+	return TCL_ERROR;
     }
-
-    if ((LLONG_MAX > UINT_MAX)
-	    && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) {
+    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
 	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"integer value too large to represent as non-long integer",
-		-1));
+	    CONST char *s =
+		    "integer value too large to represent as non-long integer";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
 	}
 	return TCL_ERROR;
     }
-    *intPtr = (int)w;
+    *intPtr = (int) l;
     return TCL_OK;
+#endif
 }
 
 /*
@@ -2159,173 +2446,24 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
  *
  * SetIntFromAny --
  *
- *	Attempts to force the internal representation for a Tcl object
- *	to tclIntType, specifically.
- *
- * Results:
- *	The return value is a standard object Tcl result.  If an
- *	error occurs during conversion, an error message is left in
- *	the interpreter's result unless "interp" is NULL.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetIntFromAny( Tcl_Interp* interp, 
-				/* Tcl interpreter */
-	       Tcl_Obj* objPtr )
-				/* Pointer to the object to convert */
-{
-    int result;
-
-    result = SetIntOrWideFromAny( interp, objPtr );
-    if ( result != TCL_OK ) {
-	return result;
-    }
-    if ( objPtr->typePtr != &tclIntType ) {
-	if ( interp != NULL ) {
-	    char *s = "integer value too large to represent";
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
-	}
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetIntOrWideFromAny --
- *
- *	Attempt to generate an integer internal form for the Tcl object
- *	"objPtr".
+ *	Attempts to force the internal representation for a Tcl object to
+ *	tclIntType, specifically.
  *
  * Results:
  *	The return value is a standard object Tcl result. If an error occurs
  *	during conversion, an error message is left in the interpreter's
  *	result unless "interp" is NULL.
  *
- * Side effects:
- *	If no error occurs, an int is stored as "objPtr"s internal
- *	representation. 
- *
  *----------------------------------------------------------------------
  */
 
 static int
-SetIntOrWideFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
-{
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *string, *end;
-    int length;
-    register char *p;
-    unsigned long newLong;
-    int isNegative = 0;
-    int isWide = 0;
-
-    /*
-     * Get the string representation. Make it up-to-date if necessary.
-     */
-
-    p = string = Tcl_GetStringFromObj(objPtr, &length);
-
-    /*
-     * Now parse "objPtr"s string as an int. We use an implementation here
-     * that doesn't report errors in interp if interp is NULL. 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.
-     */
-
-    errno = 0;
-    for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
-	/* Empty loop body. */
-    }
-    if (*p == '-') {
-	p++;
-	isNegative = 1;
-    } else if (*p == '+') {
-	p++;
-    }
-    if (!isdigit(UCHAR(*p))) {
-	badInteger:
-	if (interp != NULL) {
-	    /*
-	     * Must copy string before resetting the result in case a caller
-	     * is trying to convert the interpreter's result to an int.
-	     */
-	    
-	    char buf[100];
-	    sprintf(buf, "expected integer but got \"%.50s\"", string);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
-	    TclCheckBadOctal(interp, string);
-	}
-	return TCL_ERROR;
-    }
-    newLong = strtoul(p, &end, 0);
-    if (end == p) {
-	goto badInteger;
-    }
-    if (errno == ERANGE) {
-	if (interp != NULL) {
-	    char *s = "integer value too large to represent";
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make sure that the string has no garbage after the end of the int.
-     */
-    
-    while ((end < (string+length))
-	    && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (end != (string+length)) {
-	goto badInteger;
-    }
-
-    /*
-     * If the resulting integer will exceed the range of a long,
-     * put it into a wide instead.  (Tcl Bug #868489)
-     */
-
-#ifndef TCL_WIDE_INT_IS_LONG
-    if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1)
-	    || (!isNegative && newLong > LONG_MAX)) {
-	isWide = 1;
-    }
-#endif
-
-    /*
-     * The conversion to int succeeded. Free the old internalRep before
-     * setting the new one. We do this as late as possible to allow the
-     * conversion code, in particular Tcl_GetStringFromObj, to use that old
-     * internalRep.
-     */
-
-    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-
-    if (isWide) {
-	objPtr->internalRep.wideValue =
-		(isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong);
-	objPtr->typePtr = &tclWideIntType;
-    } else {
-	objPtr->internalRep.longValue =
-		(isNegative ? -(long)newLong : (long)newLong);
-	objPtr->typePtr = &tclIntType;
-    }
-    return TCL_OK;
+SetIntFromAny(
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
+{
+    long l;
+    return TclGetLongFromObj(interp, objPtr, &l);
 }
 
 /*
@@ -2333,29 +2471,29 @@ SetIntOrWideFromAny(interp, objPtr)
  *
  * UpdateStringOfInt --
  *
- *	Update the string representation for an integer object.
- *	Note: This procedure does not free an existing old string rep
- *	so storage will be lost if this has not already been done. 
+ *	Update the string representation for an integer object. Note: This
+ *	function does not free an existing old string rep so storage will be
+ *	lost if this has not already been done.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's string is set to a valid string that results from
- *	the int-to-string conversion.
+ *	The object's string is set to a valid string that results from the
+ *	int-to-string conversion.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfInt(objPtr)
-    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+UpdateStringOfInt(
+    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
 {
     char buffer[TCL_INTEGER_SPACE];
     register int len;
-    
+
     len = TclFormatInt(buffer, objPtr->internalRep.longValue);
-    
+
     objPtr->bytes = ckalloc((unsigned) len + 1);
     strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
@@ -2367,23 +2505,23 @@ UpdateStringOfInt(objPtr)
  * Tcl_NewLongObj --
  *
  *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewLongObj to create a new long integer object end up calling
- *	the debugging procedure Tcl_DbNewLongObj instead.
+ *	Tcl_NewLongObj to create a new long integer object end up calling the
+ *	debugging function Tcl_DbNewLongObj instead.
  *
  *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
  *	calls to Tcl_NewLongObj result in a call to one of the two
  *	Tcl_NewLongObj implementations below. We provide two implementations
- *	so that the Tcl core can be compiled to do memory debugging of the 
+ *	so that the Tcl core can be compiled to do memory debugging of the
  *	core even if a client does not request it for itself.
  *
  *	Integer and long integer objects share the same "integer" type
  *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by
- *	an int.
+ *	checks whether the current value of the long can be represented by an
+ *	int.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -2395,8 +2533,8 @@ UpdateStringOfInt(objPtr)
 #undef Tcl_NewLongObj
 
 Tcl_Obj *
-Tcl_NewLongObj(longValue)
-    register long longValue;	/* Long integer used to initialize the
+Tcl_NewLongObj(
+    register long longValue)	/* Long integer used to initialize the
 				 * new object. */
 {
     return Tcl_DbNewLongObj(longValue, "unknown", 0);
@@ -2405,17 +2543,13 @@ Tcl_NewLongObj(longValue)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewLongObj(longValue)
-    register long longValue;	/* Long integer used to initialize the
+Tcl_NewLongObj(
+    register long longValue)	/* Long integer used to initialize the
 				 * new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewObj(objPtr);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.longValue = longValue;
-    objPtr->typePtr = &tclIntType;
+    TclNewLongObj(objPtr, longValue);
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2426,26 +2560,25 @@ Tcl_NewLongObj(longValue)
  * Tcl_DbNewLongObj --
  *
  *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or
- *	long integer objects end up calling the debugging procedure
- *	Tcl_DbNewLongObj instead. We provide two implementations of
- *	Tcl_DbNewLongObj so that whether the Tcl core is compiled to do
- *	memory debugging of the core is independent of whether a client
- *	requests debugging for itself.
- *
- *	When the core is compiled with TCL_MEM_DEBUG defined,
- *	Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and
- *	line number from its caller. This simplifies debugging since then
- *	the [memory active] command will report the caller's file name and
- *	line number when reporting objects that haven't been freed.
+ *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
+ *	objects end up calling the debugging function Tcl_DbNewLongObj
+ *	instead. We provide two implementations of Tcl_DbNewLongObj so that
+ *	whether the Tcl core is compiled to do memory debugging of the core is
+ *	independent of whether a client requests debugging for itself.
+ *
+ *	When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
+ *	calls Tcl_DbCkalloc directly with the file name and line number from
+ *	its caller. This simplifies debugging since then the [memory active]
+ *	command will report the caller's file name and line number when
+ *	reporting objects that haven't been freed.
  *
  *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *	this procedure just returns the result of calling Tcl_NewLongObj.
+ *	this function just returns the result of calling Tcl_NewLongObj.
  *
  * Results:
- *	The newly created long integer object is returned. This object
- *	will have an invalid string representation. The returned object has
- *	ref count 0.
+ *	The newly created long integer object is returned. This object will
+ *	have an invalid string representation. The returned object has ref
+ *	count 0.
  *
  * Side effects:
  *	Allocates memory.
@@ -2456,19 +2589,19 @@ Tcl_NewLongObj(longValue)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
-    register long longValue;	/* Long integer used to initialize the
-				 * new object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewLongObj(
+    register long longValue,	/* Long integer used to initialize the new
+				 * object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-    
+
     objPtr->internalRep.longValue = longValue;
     objPtr->typePtr = &tclIntType;
     return objPtr;
@@ -2477,13 +2610,13 @@ Tcl_DbNewLongObj(longValue, file, line)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
-    register long longValue;	/* Long integer used to initialize the
-				 * new object. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbNewLongObj(
+    register long longValue,	/* Long integer used to initialize the new
+				 * object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewLongObj(longValue);
 }
@@ -2501,31 +2634,23 @@ Tcl_DbNewLongObj(longValue, file, line)
  *	None.
  *
  * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old
- *	internal rep is freed. 
+ *	The object's old string rep, if any, is freed. Also, any old internal
+ *	rep is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetLongObj(objPtr, longValue)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
-    register long longValue;	/* Long integer used to initialize the
+Tcl_SetLongObj(
+    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    register long longValue)	/* Long integer used to initialize the
 				 * object's value. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetLongObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
     }
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
-    objPtr->internalRep.longValue = longValue;
-    objPtr->typePtr = &tclIntType;
-    Tcl_InvalidateStringRep(objPtr);
+    TclSetLongObj(objPtr, longValue);
 }
 
 /*
@@ -2533,8 +2658,8 @@ Tcl_SetLongObj(objPtr, longValue)
  *
  * Tcl_GetLongFromObj --
  *
- *	Attempt to return an long integer from the Tcl object "objPtr". If
- *	the object is not already an int object, an attempt will be made to
+ *	Attempt to return an long integer from the Tcl object "objPtr". If the
+ *	object is not already an int object, an attempt will be made to
  *	convert it to one.
  *
  * Results:
@@ -2550,211 +2675,133 @@ Tcl_SetLongObj(objPtr, longValue)
  */
 
 int
-Tcl_GetLongFromObj(interp, objPtr, longPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object from which to get a long. */
-    register long *longPtr;	/* Place to store resulting long. */
+Tcl_GetLongFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr,	/* The object from which to get a long. */
+    register long *longPtr)	/* Place to store resulting long. */
 {
-    register int result;
-    
-    if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
-	result = SetIntOrWideFromAny(interp, objPtr);
-	if (result != TCL_OK) {
-	    return result;
+    do {
+	if (objPtr->typePtr == &tclIntType) {
+	    *longPtr = objPtr->internalRep.longValue;
+	    return TCL_OK;
 	}
-    }
-
-#ifndef TCL_WIDE_INT_IS_LONG
-    if (objPtr->typePtr == &tclWideIntType) {
-	/*
-	 * If the object is already a wide integer, don't convert it.
-	 * This code allows for any integer in the range -ULONG_MAX to
-	 * ULONG_MAX to be converted to a long, ignoring overflow.
-	 * The rule preserves existing semantics for conversion of
-	 * integers on input, but avoids inadvertent demotion of
-	 * wide integers to 32-bit ones in the internal rep.
-	 */
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    /*
+	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
+	     * converted to a long, ignoring overflow. The rule preserves
+	     * existing semantics for conversion of integers on input, but
+	     * avoids inadvertent demotion of wide integers to 32-bit ones in
+	     * the internal rep.
+	     */
 
-	Tcl_WideInt w = objPtr->internalRep.wideValue;
-	if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) {
-	    *longPtr = Tcl_WideAsLong(w);
-	    return TCL_OK;
-	} else {
-	    if (interp != NULL) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp),
-			"integer value too large to represent", -1);
+	    Tcl_WideInt w = objPtr->internalRep.wideValue;
+	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
+		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
+		*longPtr = Tcl_WideAsLong(w);
+		return TCL_OK;
 	    }
-	    return TCL_ERROR;
+	    goto tooLarge;
 	}
-    }
-#endif
-
-    *longPtr = objPtr->internalRep.longValue;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWideIntFromAny --
- *
- *	Attempt to generate an integer internal form for the Tcl object
- *	"objPtr".
- *
- * Results:
- *	The return value is a standard object Tcl result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If no error occurs, an int is stored as "objPtr"s internal
- *	representation. 
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetWideIntFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
-{
-#ifndef TCL_WIDE_INT_IS_LONG
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-    char *string, *end;
-    int length;
-    register char *p;
-    Tcl_WideInt newWide;
-
-    /*
-     * Get the string representation. Make it up-to-date if necessary.
-     */
-
-    p = string = Tcl_GetStringFromObj(objPtr, &length);
-
-    /*
-     * Now parse "objPtr"s string as an int. We use an implementation here
-     * that doesn't report errors in interp if interp is NULL. Note: use
-     * strtoull instead of strtoll for integer conversions to allow full-size
-     * unsigned numbers, but don't depend on strtoull to handle sign
-     * characters; it won't in some implementations.
-     */
-
-    errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
-    for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
-	/* Empty loop body. */
-    }
-    if (*p == '-') {
-	p++;
-	newWide = -((Tcl_WideInt)strtoull(p, &end, 0));
-    } else if (*p == '+') {
-	p++;
-	newWide = strtoull(p, &end, 0);
-    } else
-#else
-	newWide = strtoull(p, &end, 0);
 #endif
-    if (end == p) {
-	badInteger:
-	if (interp != NULL) {
+        if (objPtr->typePtr == &tclDoubleType) {
+            if (interp != NULL) {
+		Tcl_Obj *msg;
+
+		TclNewLiteralStringObj(msg, "expected integer but got \"");
+		Tcl_AppendObjToObj(msg, objPtr);
+		Tcl_AppendToObj(msg, "\"", -1);
+		Tcl_SetObjResult(interp, msg);
+	    }
+	    return TCL_ERROR;
+	}
+        if (objPtr->typePtr == &tclBignumType) {
 	    /*
-	     * Must copy string before resetting the result in case a caller
-	     * is trying to convert the interpreter's result to an int.
+	     * Must check for those bignum values that can fit in a long, even
+	     * when auto-narrowing is enabled. Only those values in the signed
+	     * long range get auto-narrowed to tclIntType, while all the
+	     * values in the unsigned long range will fit in a long.
 	     */
-	    
-	    char buf[100];
-	    sprintf(buf, "expected integer but got \"%.50s\"", string);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
-	    TclCheckBadOctal(interp, string);
-	}
-	return TCL_ERROR;
-    }
-    if (errno == ERANGE) {
-	if (interp != NULL) {
-	    char *s = "integer value too large to represent";
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
-	}
-	return TCL_ERROR;
-    }
 
-    /*
-     * Make sure that the string has no garbage after the end of the int.
-     */
-    
-    while ((end < (string+length))
-	    && isspace(UCHAR(*end))) { /* INTL: ISO space. */
-	end++;
-    }
-    if (end != (string+length)) {
-	goto badInteger;
-    }
-
-    /*
-     * The conversion to int succeeded. Free the old internalRep before
-     * setting the new one. We do this as late as possible to allow the
-     * conversion code, in particular Tcl_GetStringFromObj, to use that old
-     * internalRep.
-     */
-
-    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
-    objPtr->internalRep.wideValue = newWide;
-#else 
-    if (TCL_ERROR == SetIntFromAny(interp, objPtr)) {
-	return TCL_ERROR;
-    }
+	    mp_int big;
+
+	    UNPACK_BIGNUM(objPtr, big);
+	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
+		    / DIGIT_BIT) {
+		unsigned long value = 0, numBytes = sizeof(long);
+		long scratch;
+		unsigned char *bytes = (unsigned char *)&scratch;
+		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
+		    while (numBytes-- > 0) {
+			value = (value << CHAR_BIT) | *bytes++;
+		    }
+		    if (big.sign) {
+			*longPtr = - (long) value;
+		    } else {
+			*longPtr = (long) value;
+		    }
+		    return TCL_OK;
+		}
+	    }
+#ifndef NO_WIDE_TYPE
+	tooLarge:
 #endif
-    objPtr->typePtr = &tclWideIntType;
-    return TCL_OK;
+	    if (interp != NULL) {
+		char *s = "integer value too large to represent";
+		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+
+		Tcl_SetObjResult(interp, msg);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+	    }
+	    return TCL_ERROR;
+	}
+    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+    return TCL_ERROR;
 }
+#ifndef NO_WIDE_TYPE
 
 /*
  *----------------------------------------------------------------------
  *
  * UpdateStringOfWideInt --
  *
- *	Update the string representation for a wide integer object.
- *	Note: This procedure does not free an existing old string rep
- *	so storage will be lost if this has not already been done. 
+ *	Update the string representation for a wide integer object. Note: this
+ *	function does not free an existing old string rep so storage will be
+ *	lost if this has not already been done.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's string is set to a valid string that results from
- *	the wideInt-to-string conversion.
+ *	The object's string is set to a valid string that results from the
+ *	wideInt-to-string conversion.
  *
  *----------------------------------------------------------------------
  */
 
-#ifndef TCL_WIDE_INT_IS_LONG
 static void
-UpdateStringOfWideInt(objPtr)
-    register Tcl_Obj *objPtr;	/* Int object whose string rep to update. */
+UpdateStringOfWideInt(
+    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
 {
     char buffer[TCL_INTEGER_SPACE+2];
     register unsigned len;
     register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
 
     /*
-     * Note that sprintf will generate a compiler warning under
-     * Mingw claiming %I64 is an unknown format specifier.
-     * Just ignore this warning. We can't use %L as the format
-     * specifier since that gets printed as a 32 bit value.
+     * Note that sprintf will generate a compiler warning under Mingw claiming
+     * %I64 is an unknown format specifier. Just ignore this warning. We can't
+     * use %L as the format specifier since that gets printed as a 32 bit
+     * value.
      */
+
     sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
     len = strlen(buffer);
     objPtr->bytes = ckalloc((unsigned) len + 1);
     memcpy(objPtr->bytes, buffer, len + 1);
     objPtr->length = len;
 }
-#endif /* TCL_WIDE_INT_IS_LONG */
+#endif /* !NO_WIDE_TYPE */
 
 /*
  *----------------------------------------------------------------------
@@ -2763,17 +2810,17 @@ UpdateStringOfWideInt(objPtr)
  *
  *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
  *	Tcl_NewWideIntObj to create a new 64-bit integer object end up calling
- *	the debugging procedure Tcl_DbNewWideIntObj instead.
+ *	the debugging function Tcl_DbNewWideIntObj instead.
  *
  *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
  *	calls to Tcl_NewWideIntObj result in a call to one of the two
- *	Tcl_NewWideIntObj implementations below. We provide two implementations
- *	so that the Tcl core can be compiled to do memory debugging of the 
- *	core even if a client does not request it for itself.
+ *	Tcl_NewWideIntObj implementations below. We provide two
+ *	implementations so that the Tcl core can be compiled to do memory
+ *	debugging of the core even if a client does not request it for itself.
  *
  * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
+ *	The newly created object is returned. This object will have an invalid
+ *	string representation. The returned object has ref count 0.
  *
  * Side effects:
  *	None.
@@ -2785,9 +2832,10 @@ UpdateStringOfWideInt(objPtr)
 #undef Tcl_NewWideIntObj
 
 Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
-    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
-					 * the new object. */
+Tcl_NewWideIntObj(
+    register Tcl_WideInt wideValue)
+				/* Wide integer used to initialize the new
+				 * object. */
 {
     return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
 }
@@ -2795,17 +2843,15 @@ Tcl_NewWideIntObj(wideValue)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
-    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
-					 * the new object. */
+Tcl_NewWideIntObj(
+    register Tcl_WideInt wideValue)
+				/* Wide integer used to initialize the new
+				 * object. */
 {
     register Tcl_Obj *objPtr;
 
     TclNewObj(objPtr);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.wideValue = wideValue;
-    objPtr->typePtr = &tclWideIntType;
+    Tcl_SetWideIntObj(objPtr, wideValue);
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2816,27 +2862,25 @@ Tcl_NewWideIntObj(wideValue)
  * Tcl_DbNewWideIntObj --
  *
  *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewWideIntObj to create new wide integer end up calling
- *	the debugging procedure Tcl_DbNewWideIntObj instead. We
- *	provide two implementations of Tcl_DbNewWideIntObj so that
- *	whether the Tcl core is compiled to do memory debugging of the
- *	core is independent of whether a client requests debugging for
- *	itself.
+ *	Tcl_NewWideIntObj to create new wide integer end up calling the
+ *	debugging function Tcl_DbNewWideIntObj instead. We provide two
+ *	implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is
+ *	compiled to do memory debugging of the core is independent of whether
+ *	a client requests debugging for itself.
  *
  *	When the core is compiled with TCL_MEM_DEBUG defined,
- *	Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file
- *	name and line number from its caller. This simplifies
- *	debugging since then the checkmem command will report the
- *	caller's file name and line number when reporting objects that
- *	haven't been freed.
+ *	Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file name
+ *	and line number from its caller. This simplifies debugging since then
+ *	the checkmem command will report the caller's file name and line
+ *	number when reporting objects that haven't been freed.
  *
  *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *	this procedure just returns the result of calling Tcl_NewWideIntObj.
+ *	this function just returns the result of calling Tcl_NewWideIntObj.
  *
  * Results:
- *	The newly created wide integer object is returned. This object
- *	will have an invalid string representation. The returned object has
- *	ref count 0.
+ *	The newly created wide integer object is returned. This object will
+ *	have an invalid string representation. The returned object has ref
+ *	count 0.
  *
  * Side effects:
  *	Allocates memory.
@@ -2847,36 +2891,33 @@ Tcl_NewWideIntObj(wideValue)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
-    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
-					 * the new object. */
-    CONST char *file;			/* The name of the source file
-					 * calling this procedure; used for
-					 * debugging. */
-    int line;				/* Line number in the source file;
-					 * used for debugging. */
+Tcl_DbNewWideIntObj(
+    register Tcl_WideInt wideValue,
+				/* Wide integer used to initialize the new
+				 * object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.wideValue = wideValue;
-    objPtr->typePtr = &tclWideIntType;
+    Tcl_SetWideIntObj(objPtr, wideValue);
     return objPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
-    register Tcl_WideInt wideValue;	/* Long integer used to initialize
-					 * the new object. */
-    CONST char *file;			/* The name of the source file
-					 * calling this procedure; used for
-					 * debugging. */
-    int line;				/* Line number in the source file;
-					 * used for debugging. */
+Tcl_DbNewWideIntObj(
+    register Tcl_WideInt wideValue,
+				/* Long integer used to initialize the new
+				 * object. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewWideIntObj(wideValue);
 }
@@ -2887,38 +2928,43 @@ Tcl_DbNewWideIntObj(wideValue, file, line)
  *
  * Tcl_SetWideIntObj --
  *
- *	Modify an object to be a wide integer object and to have the
- *	specified wide integer value.
+ *	Modify an object to be a wide integer object and to have the specified
+ *	wide integer value.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old
- *	internal rep is freed. 
+ *	The object's old string rep, if any, is freed. Also, any old internal
+ *	rep is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetWideIntObj(objPtr, wideValue)
-    register Tcl_Obj *objPtr;		/* Object w. internal rep to init. */
-    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
-					 * the object's value. */
+Tcl_SetWideIntObj(
+    register Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
+    register Tcl_WideInt wideValue)
+				/* Wide integer used to initialize the
+				 * object's value. */
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetWideIntObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
     }
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
+    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
+	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
+	TclSetLongObj(objPtr, (long) wideValue);
+    } else {
+#ifndef NO_WIDE_TYPE
+	TclSetWideIntObj(objPtr, wideValue);
+#else
+	mp_int big;
+
+	TclBNInitBignumFromWideInt(&big, wideValue);
+	Tcl_SetBignumObj(objPtr, &big);
+#endif
     }
-    
-    objPtr->internalRep.wideValue = wideValue;
-    objPtr->typePtr = &tclWideIntType;
-    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -2926,9 +2972,9 @@ Tcl_SetWideIntObj(objPtr, wideValue)
  *
  * Tcl_GetWideIntFromObj --
  *
- *	Attempt to return a wide integer from the Tcl object "objPtr". If
- *	the object is not already a wide int object, an attempt will be made
- *	to convert it to one.
+ *	Attempt to return a wide integer from the Tcl object "objPtr". If the
+ *	object is not already a wide int object, an attempt will be made to
+ *	convert it to one.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -2943,33 +2989,589 @@ Tcl_SetWideIntObj(objPtr, wideValue)
  */
 
 int
-Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
-    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* Object from which to get a wide int. */
-    register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */
+Tcl_GetWideIntFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
+    register Tcl_WideInt *wideIntPtr)
+				/* Place to store resulting long. */
 {
-    register int result;
+    do {
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    *wideIntPtr = objPtr->internalRep.wideValue;
+	    return TCL_OK;
+	}
+#endif
+	if (objPtr->typePtr == &tclIntType) {
+	    *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
+	    return TCL_OK;
+	}
+        if (objPtr->typePtr == &tclDoubleType) {
+            if (interp != NULL) {
+		Tcl_Obj *msg;
+
+		TclNewLiteralStringObj(msg, "expected integer but got \"");
+		Tcl_AppendObjToObj(msg, objPtr);
+		Tcl_AppendToObj(msg, "\"", -1);
+		Tcl_SetObjResult(interp, msg);
+	    }
+	    return TCL_ERROR;
+	}
+        if (objPtr->typePtr == &tclBignumType) {
+	    /*
+	     * Must check for those bignum values that can fit in a
+	     * Tcl_WideInt, even when auto-narrowing is enabled.
+	     */
 
-    if (objPtr->typePtr == &tclWideIntType) {
-    gotWide:
-	*wideIntPtr = objPtr->internalRep.wideValue;
-	return TCL_OK;
+	    mp_int big;
+
+	    UNPACK_BIGNUM(objPtr, big);
+	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(Tcl_WideInt)
+		     + DIGIT_BIT - 1) / DIGIT_BIT) {
+		Tcl_WideUInt value = 0;
+		unsigned long numBytes = sizeof(Tcl_WideInt);
+		Tcl_WideInt scratch;
+		unsigned char *bytes = (unsigned char *) &scratch;
+
+		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
+		    while (numBytes-- > 0) {
+			value = (value << CHAR_BIT) | *bytes++;
+		    }
+		    if (big.sign) {
+			*wideIntPtr = - (Tcl_WideInt) value;
+		    } else {
+			*wideIntPtr = (Tcl_WideInt) value;
+		    }
+		    return TCL_OK;
+		}
+	    }
+	    if (interp != NULL) {
+		char *s = "integer value too large to represent";
+		Tcl_Obj* msg = Tcl_NewStringObj(s, -1);
+
+		Tcl_SetObjResult(interp, msg);
+		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+	    }
+	    return TCL_ERROR;
+	}
+    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+    return TCL_ERROR;
+}
+#ifndef NO_WIDE_TYPE
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWideIntFromAny --
+ *
+ *	Attempts to force the internal representation for a Tcl object to
+ *	tclWideIntType, specifically.
+ *
+ * Results:
+ *	The return value is a standard object Tcl result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWideIntFromAny(
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
+{
+    Tcl_WideInt w;
+    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
+}
+#endif /* !NO_WIDE_TYPE */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeBignum --
+ *
+ *	This function frees the internal rep of a bignum.
+ *
+ * Results:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeBignum(
+    Tcl_Obj *objPtr)
+{
+    mp_int toFree;		/* Bignum to free */
+
+    UNPACK_BIGNUM(objPtr, toFree);
+    mp_clear(&toFree);
+    if ((long)(objPtr->internalRep.ptrAndLongRep.value) < 0) {
+	ckfree((char *)objPtr->internalRep.ptrAndLongRep.ptr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupBignum --
+ *
+ *	This function duplicates the internal rep of a bignum.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The destination object receies a copy of the source object
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupBignum(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *copyPtr)
+{
+    mp_int bignumVal;
+    mp_int bignumCopy;
+
+    copyPtr->typePtr = &tclBignumType;
+    UNPACK_BIGNUM(srcPtr, bignumVal);
+    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
+	Tcl_Panic("initialization failure in DupBignum");
     }
-    if (objPtr->typePtr == &tclIntType) {
+    PACK_BIGNUM(bignumCopy, copyPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfBignum --
+ *
+ *	This function updates the string representation of a bignum object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to whatever results from the bignum-
+ *	to-string conversion.
+ *
+ * The object's existing string representation is NOT freed; memory will leak
+ * if the string rep is still valid at the time this function is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfBignum(
+    Tcl_Obj *objPtr)
+{
+    mp_int bignumVal;
+    int size;
+    int status;
+    char* stringVal;
+
+    UNPACK_BIGNUM(objPtr, bignumVal);
+    status = mp_radix_size(&bignumVal, 10, &size);
+    if (status != MP_OKAY) {
+	Tcl_Panic("radix size failure in UpdateStringOfBignum");
+    }
+    if (size == 3) {
 	/*
-	 * This cast is safe; all valid ints/longs are wides.
+	 * mp_radix_size() returns 3 when more than INT_MAX bytes would be
+	 * needed to hold the string rep (because mp_radix_size ignores
+	 * integer overflow issues). When we know the string rep will be more
+	 * than 3, we can conclude the string rep would overflow our string
+	 * length limits.
+	 *
+	 * Note that so long as we enforce our bignums to the size that fits
+	 * in a packed bignum, this branch will never be taken.
 	 */
 
-	objPtr->internalRep.wideValue =
-		Tcl_LongAsWide(objPtr->internalRep.longValue);
-	objPtr->typePtr = &tclWideIntType;
-	goto gotWide;
+	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
     }
-    result = SetWideIntFromAny(interp, objPtr);
-    if (result == TCL_OK) {
-	*wideIntPtr = objPtr->internalRep.wideValue;
+    stringVal = ckalloc((size_t) size);
+    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
+    if (status != MP_OKAY) {
+	Tcl_Panic("conversion failure in UpdateStringOfBignum");
     }
-    return result;
+    objPtr->bytes = stringVal;
+    objPtr->length = size - 1;	/* size includes a trailing null byte */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewBignumObj --
+ *
+ *	Creates an initializes a bignum object.
+ *
+ * Results:
+ *	Returns the newly created object.
+ *
+ * Side effects:
+ *	The bignum value is cleared, since ownership has transferred to Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewBignumObj
+
+Tcl_Obj *
+Tcl_NewBignumObj(
+    mp_int *bignumValue)
+{
+    return Tcl_DbNewBignumObj(bignumValue, "unknown", 0);
+}
+#else
+Tcl_Obj *
+Tcl_NewBignumObj(
+    mp_int *bignumValue)
+{
+    Tcl_Obj* objPtr;
+
+    TclNewObj(objPtr);
+    Tcl_SetBignumObj(objPtr, bignumValue);
+    return objPtr;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewBignumObj --
+ *
+ *	This function is normally called when debugging: that is, when
+ *	TCL_MEM_DEBUG is defined. It constructs a bignum object, recording the
+ *	creation point so that [memory active] can report it.
+ *
+ * Results:
+ *	Returns the newly created object.
+ *
+ * Side effects:
+ *	The bignum value is cleared, since ownership has transferred to Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+    mp_int *bignumValue,
+    CONST char *file,
+    int line)
+{
+    Tcl_Obj *objPtr;
+
+    TclDbNewObj(objPtr, file, line);
+    Tcl_SetBignumObj(objPtr, bignumValue);
+    return objPtr;
+}
+#else
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+    mp_int *bignumValue,
+    CONST char *file,
+    int line)
+{
+    return Tcl_NewBignumObj(bignumValue);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBignumFromObj --
+ *
+ *	This function retrieves a 'bignum' value from a Tcl object, converting
+ *	the object if necessary. Either copies or transfers the mp_int value
+ *	depending on the copy flag value passed in.
+ *
+ * Results:
+ *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *	A copy of bignum is stored in *bignumValue, which is expected to be
+ *	uninitialized or cleared. If conversion fails, and the 'interp'
+ *	argument is not NULL, an error message is stored in the interpreter
+ *	result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetBignumFromObj(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
+    Tcl_Obj *objPtr,		/* Object to read */
+    int copy,			/* Whether to copy the returned bignum value */
+    mp_int *bignumValue)	/* Returned bignum value. */
+{
+    do {
+	if (objPtr->typePtr == &tclBignumType) {
+	    if (copy || Tcl_IsShared(objPtr)) {
+		mp_int temp;
+		UNPACK_BIGNUM(objPtr, temp);
+		mp_init_copy(bignumValue, &temp);
+	    } else {
+		UNPACK_BIGNUM(objPtr, *bignumValue);
+		objPtr->internalRep.ptrAndLongRep.ptr = NULL;
+		objPtr->internalRep.ptrAndLongRep.value = 0;
+		objPtr->typePtr = NULL;
+		if (objPtr->bytes == NULL) {
+		    TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+		}
+	    }
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclIntType) {
+	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
+	    return TCL_OK;
+	}
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    TclBNInitBignumFromWideInt(bignumValue,
+		    objPtr->internalRep.wideValue);
+	    return TCL_OK;
+	}
+#endif
+	if (objPtr->typePtr == &tclDoubleType) {
+	    if (interp != NULL) {
+		Tcl_Obj *msg;
+
+		TclNewLiteralStringObj(msg, "expected integer but got \"");
+		Tcl_AppendObjToObj(msg, objPtr);
+		Tcl_AppendToObj(msg, "\"", -1);
+		Tcl_SetObjResult(interp, msg);
+	    }
+	    return TCL_ERROR;
+	}
+    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetBignumFromObj --
+ *
+ *	This function retrieves a 'bignum' value from a Tcl object, converting
+ *	the object if necessary.
+ *
+ * Results:
+ *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *	A copy of bignum is stored in *bignumValue, which is expected to be
+ *	uninitialized or cleared. If conversion fails, an the 'interp'
+ *	argument is not NULL, an error message is stored in the interpreter
+ *	result.
+ *
+ *	It is expected that the caller will NOT have invoked mp_init on the
+ *	bignum value before passing it in. Tcl will initialize the mp_int as
+ *	it sets the value. The value is a copy of the value in objPtr, so it
+ *	becomes the responsibility of the caller to call mp_clear on it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetBignumFromObj(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
+    Tcl_Obj *objPtr,		/* Object to read */
+    mp_int *bignumValue)	/* Returned bignum value. */
+{
+    return GetBignumFromObj(interp, objPtr, 1, bignumValue);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TakeBignumFromObj --
+ *
+ *	This function retrieves a 'bignum' value from a Tcl object, converting
+ *	the object if necessary.
+ *
+ * Results:
+ *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *	A copy of bignum is stored in *bignumValue, which is expected to be
+ *	uninitialized or cleared. If conversion fails, an the 'interp'
+ *	argument is not NULL, an error message is stored in the interpreter
+ *	result.
+ *
+ *	It is expected that the caller will NOT have invoked mp_init on the
+ *	bignum value before passing it in. Tcl will initialize the mp_int as
+ *	it sets the value. The value is transferred from the internals of
+ *	objPtr to the caller, passing responsibility of the caller to call
+ *	mp_clear on it. The objPtr is cleared to hold an empty value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TakeBignumFromObj(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
+    Tcl_Obj *objPtr,		/* Object to read */
+    mp_int *bignumValue)	/* Returned bignum value. */
+{
+    return GetBignumFromObj(interp, objPtr, 0, bignumValue);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetBignumObj --
+ *
+ *	This function sets the value of a Tcl_Obj to a large integer.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Object value is stored. The bignum value is cleared, since ownership
+ *	has transferred to Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetBignumObj(
+    Tcl_Obj *objPtr,		/* Object to set */
+    mp_int *bignumValue)	/* Value to store */
+{
+    if (Tcl_IsShared(objPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
+    }
+    if ((size_t)(bignumValue->used)
+	    <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
+	unsigned long value = 0, numBytes = sizeof(long);
+	long scratch;
+	unsigned char *bytes = (unsigned char *)&scratch;
+	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
+	    goto tooLargeForLong;
+	}
+	while (numBytes-- > 0) {
+	    value = (value << CHAR_BIT) | *bytes++;
+	}
+	if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
+	    goto tooLargeForLong;
+	}
+	if (bignumValue->sign) {
+	    TclSetLongObj(objPtr, -(long)value);
+	} else {
+	    TclSetLongObj(objPtr, (long)value);
+	}
+	mp_clear(bignumValue);
+	return;
+    }
+  tooLargeForLong:
+#ifndef NO_WIDE_TYPE
+    if ((size_t)(bignumValue->used)
+	    <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
+	Tcl_WideUInt value = 0;
+	unsigned long numBytes = sizeof(Tcl_WideInt);
+	Tcl_WideInt scratch;
+	unsigned char *bytes = (unsigned char *)&scratch;
+	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
+	    goto tooLargeForWide;
+	}
+	while (numBytes-- > 0) {
+	    value = (value << CHAR_BIT) | *bytes++;
+	}
+	if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
+	    goto tooLargeForWide;
+	}
+	if (bignumValue->sign) {
+	    TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
+	} else {
+	    TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
+	}
+	mp_clear(bignumValue);
+	return;
+    }
+  tooLargeForWide:
+#endif
+    TclInvalidateStringRep(objPtr);
+    TclFreeIntRep(objPtr);
+    TclSetBignumIntRep(objPtr, bignumValue);
+}
+
+void
+TclSetBignumIntRep(
+    Tcl_Obj *objPtr,
+    mp_int *bignumValue)
+{
+    objPtr->typePtr = &tclBignumType;
+    PACK_BIGNUM(*bignumValue, objPtr);
+
+    /*
+     * Clear the mp_int value.
+     * Don't call mp_clear() because it would free the digit array
+     * we just packed into the Tcl_Obj.
+     */
+
+    bignumValue->dp = NULL;
+    bignumValue->alloc = bignumValue->used = 0;
+    bignumValue->sign = MP_NEG;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetNumberFromObj --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+int TclGetNumberFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    ClientData *clientDataPtr,
+    int *typePtr)
+{
+    do {
+	if (objPtr->typePtr == &tclDoubleType) {
+	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
+		*typePtr = TCL_NUMBER_NAN;
+	    } else {
+		*typePtr = TCL_NUMBER_DOUBLE;
+	    }
+	    *clientDataPtr = &(objPtr->internalRep.doubleValue);
+	    return TCL_OK;
+	}
+	if (objPtr->typePtr == &tclIntType) {
+	    *typePtr = TCL_NUMBER_LONG;
+	    *clientDataPtr = &(objPtr->internalRep.longValue);
+	    return TCL_OK;
+	}
+#ifndef NO_WIDE_TYPE
+	if (objPtr->typePtr == &tclWideIntType) {
+	    *typePtr = TCL_NUMBER_WIDE;
+	    *clientDataPtr = &(objPtr->internalRep.wideValue);
+	    return TCL_OK;
+	}
+#endif
+	if (objPtr->typePtr == &tclBignumType) {
+	    static Tcl_ThreadDataKey bignumKey;
+	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
+		    (int) sizeof(mp_int));
+	    UNPACK_BIGNUM( objPtr, *bigPtr );
+	    *typePtr = TCL_NUMBER_BIG;
+	    *clientDataPtr = bigPtr;
+	    return TCL_OK;
+	}
+    } while (TCL_OK ==
+	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
+    return TCL_ERROR;
 }
 
 /*
@@ -2977,12 +3579,12 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
  *
  * Tcl_DbIncrRefCount --
  *
- *	This procedure is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. This checks to see whether or not
- *	the memory has been freed before incrementing the ref count.
+ *	This function is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
+ *	has been freed before incrementing the ref count.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just increments
- *	the reference count of the object.
+ *	When TCL_MEM_DEBUG is not defined, this function just increments the
+ *	reference count of the object.
  *
  * Results:
  *	None.
@@ -2994,20 +3596,45 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
  */
 
 void
-Tcl_DbIncrRefCount(objPtr, file, line)
-    register Tcl_Obj *objPtr;	/* The object we are registering a
-				 * reference to. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbIncrRefCount(
+    register Tcl_Obj *objPtr,	/* The object we are registering a reference
+				 * to. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	panic("Trying to increment refCount of previously disposed object.");
+	Tcl_Panic("incrementing refCount of previously disposed object");
     }
+
+# ifdef TCL_THREADS
+    /*
+     * Check to make sure that the Tcl_Obj was allocated by the current
+     * thread. Don't do this check when shutting down since thread local
+     * storage can be finalized before the last Tcl_Obj is freed.
+     */
+
+    if (!TclInExit()) {
+	Tcl_HashTable *tablePtr;
+	Tcl_HashEntry *hPtr;
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+	tablePtr = tsdPtr->objThreadMap;
+	if (!tablePtr) {
+	    Tcl_Panic("object table not initialized");
+	}
+	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	if (!hPtr) {
+	    Tcl_Panic("%s%s",
+		    "Trying to incr ref count of "
+		    "Tcl_Obj allocated in another thread");
+	}
+    }
+# endif
 #endif
     ++(objPtr)->refCount;
 }
@@ -3017,12 +3644,12 @@ Tcl_DbIncrRefCount(objPtr, file, line)
  *
  * Tcl_DbDecrRefCount --
  *
- *	This procedure is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. This checks to see whether or not
- *	the memory has been freed before decrementing the ref count.
+ *	This function is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
+ *	has been freed before decrementing the ref count.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just decrements
- *	the reference count of the object.
+ *	When TCL_MEM_DEBUG is not defined, this function just decrements the
+ *	reference count of the object.
  *
  * Results:
  *	None.
@@ -3034,20 +3661,59 @@ Tcl_DbIncrRefCount(objPtr, file, line)
  */
 
 void
-Tcl_DbDecrRefCount(objPtr, file, line)
-    register Tcl_Obj *objPtr;	/* The object we are releasing a reference
+Tcl_DbDecrRefCount(
+    register Tcl_Obj *objPtr,	/* The object we are releasing a reference
 				 * to. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	panic("Trying to decrement refCount of previously disposed object.");
+	Tcl_Panic("decrementing refCount of previously disposed object");
     }
+
+# ifdef TCL_THREADS
+    /*
+     * Check to make sure that the Tcl_Obj was allocated by the current
+     * thread. Don't do this check when shutting down since thread local
+     * storage can be finalized before the last Tcl_Obj is freed.
+     */
+
+    if (!TclInExit()) {
+	Tcl_HashTable *tablePtr;
+	Tcl_HashEntry *hPtr;
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+	tablePtr = tsdPtr->objThreadMap;
+	if (!tablePtr) {
+	    Tcl_Panic("object table not initialized");
+	}
+	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	if (!hPtr) {
+	    Tcl_Panic("%s%s",
+		    "Trying to decr ref count of "
+		    "Tcl_Obj allocated in another thread");
+	}
+
+	/*
+	 * If the Tcl_Obj is going to be deleted, remove the entry.
+	 */
+
+	if ((objPtr->refCount - 1) <= 0) {
+	    ObjData *objData = Tcl_GetHashValue(hPtr);
+
+	    if (objData != NULL) {
+		ckfree((char *) objData);
+	    }
+
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+    }
+# endif
 #endif
     if (--(objPtr)->refCount <= 0) {
 	TclFreeObj(objPtr);
@@ -3059,12 +3725,12 @@ Tcl_DbDecrRefCount(objPtr, file, line)
  *
  * Tcl_DbIsShared --
  *
- *	This procedure is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. It tests whether the object has a ref
- *	count greater than one.
+ *	This function is normally called when debugging: i.e., when
+ *	TCL_MEM_DEBUG is defined. It tests whether the object has a ref count
+ *	greater than one.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just tests
- *	if the object has a ref count greater than one.
+ *	When TCL_MEM_DEBUG is not defined, this function just tests if the
+ *	object has a ref count greater than one.
  *
  * Results:
  *	None.
@@ -3076,20 +3742,45 @@ Tcl_DbDecrRefCount(objPtr, file, line)
  */
 
 int
-Tcl_DbIsShared(objPtr, file, line)
-    register Tcl_Obj *objPtr;	/* The object to test for being shared. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+Tcl_DbIsShared(
+    register Tcl_Obj *objPtr,	/* The object to test for being shared. */
+    CONST char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	panic("Trying to check whether previously disposed object is shared.");
+	Tcl_Panic("checking whether previously disposed object is shared");
+    }
+
+# ifdef TCL_THREADS
+    /*
+     * Check to make sure that the Tcl_Obj was allocated by the current
+     * thread. Don't do this check when shutting down since thread local
+     * storage can be finalized before the last Tcl_Obj is freed.
+     */
+
+    if (!TclInExit()) {
+	Tcl_HashTable *tablePtr;
+	Tcl_HashEntry *hPtr;
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+	tablePtr = tsdPtr->objThreadMap;
+	if (!tablePtr) {
+	    Tcl_Panic("object table not initialized");
+	}
+	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	if (!hPtr) {
+	    Tcl_Panic("%s%s",
+		    "Trying to check shared status of"
+		    "Tcl_Obj allocated in another thread");
+	}
     }
+# endif
 #endif
+
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
     if ((objPtr)->refCount <= 1) {
@@ -3101,6 +3792,7 @@ Tcl_DbIsShared(objPtr, file, line)
     }
     Tcl_MutexUnlock(&tclObjMutex);
 #endif
+
     return ((objPtr)->refCount > 1);
 }
 
@@ -3109,8 +3801,8 @@ Tcl_DbIsShared(objPtr, file, line)
  *
  * Tcl_InitObjHashTable --
  *
- *	Given storage for a hash table, set up the fields to prepare
- *	the hash table for use, the keys are Tcl_Obj *.
+ *	Given storage for a hash table, set up the fields to prepare the hash
+ *	table for use, the keys are Tcl_Obj *.
  *
  * Results:
  *	None.
@@ -3123,9 +3815,10 @@ Tcl_DbIsShared(objPtr, file, line)
  */
 
 void
-Tcl_InitObjHashTable(tablePtr)
-    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
-					 * is supplied by the caller. */
+Tcl_InitObjHashTable(
+    register Tcl_HashTable *tablePtr)
+				/* Pointer to table record, which is supplied
+				 * by the caller. */
 {
     Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
 	    &tclObjHashKeyType);
@@ -3148,16 +3841,17 @@ Tcl_InitObjHashTable(tablePtr)
  */
 
 static Tcl_HashEntry *
-AllocObjEntry(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key to store in the hash table entry. */
+AllocObjEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    void *keyPtr)		/* Key to store in the hash table entry. */
 {
     Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
     Tcl_HashEntry *hPtr;
 
     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
     hPtr->key.oneWordValue = (char *) objPtr;
-    Tcl_IncrRefCount (objPtr);
+    Tcl_IncrRefCount(objPtr);
+    hPtr->clientData = NULL;
 
     return hPtr;
 }
@@ -3165,13 +3859,13 @@ AllocObjEntry(tablePtr, keyPtr)
 /*
  *----------------------------------------------------------------------
  *
- * CompareObjKeys --
+ * TclCompareObjKeys --
  *
  *	Compares two Tcl_Obj * keys.
  *
  * Results:
- *	The return value is 0 if they are different and 1 if they are
- *	the same.
+ *	The return value is 0 if they are different and 1 if they are the
+ *	same.
  *
  * Side effects:
  *	None.
@@ -3179,10 +3873,10 @@ AllocObjEntry(tablePtr, keyPtr)
  *----------------------------------------------------------------------
  */
 
-static int
-CompareObjKeys(keyPtr, hPtr)
-    VOID *keyPtr;		/* New key to compare. */
-    Tcl_HashEntry *hPtr;		/* Existing key to compare. */
+int
+TclCompareObjKeys(
+    void *keyPtr,		/* New key to compare. */
+    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
     Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
     Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
@@ -3192,6 +3886,7 @@ CompareObjKeys(keyPtr, hPtr)
     /*
      * If the object pointers are the same then they match.
      */
+
     if (objPtr1 == objPtr2) {
 	return 1;
     }
@@ -3200,14 +3895,16 @@ CompareObjKeys(keyPtr, hPtr)
      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
      * in a register.
      */
+
     p1 = TclGetString(objPtr1);
     l1 = objPtr1->length;
     p2 = TclGetString(objPtr2);
     l2 = objPtr2->length;
-    
+
     /*
      * Only compare if the string representations are of the same length.
      */
+
     if (l1 == l2) {
 	for (;; p1++, p2++, l1--) {
 	    if (*p1 != *p2) {
@@ -3225,7 +3922,7 @@ CompareObjKeys(keyPtr, hPtr)
 /*
  *----------------------------------------------------------------------
  *
- * FreeObjEntry --
+ * TclFreeObjEntry --
  *
  *	Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
  *
@@ -3238,27 +3935,27 @@ CompareObjKeys(keyPtr, hPtr)
  *----------------------------------------------------------------------
  */
 
-static void
-FreeObjEntry(hPtr)
-    Tcl_HashEntry *hPtr;	/* Hash entry to free. */
+void
+TclFreeObjEntry(
+    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
 {
     Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
 
-    Tcl_DecrRefCount (objPtr);
-    ckfree ((char *) hPtr);
+    Tcl_DecrRefCount(objPtr);
+    ckfree((char *) hPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * HashObjKey --
+ * TclHashObjKey --
  *
  *	Compute a one-word summary of the string representation of the
  *	Tcl_Obj, which can be used to generate a hash index.
  *
  * Results:
- *	The return value is a one-word summary of the information in
- *	the string representation of the Tcl_Obj.
+ *	The return value is a one-word summary of the information in the
+ *	string representation of the Tcl_Obj.
  *
  * Side effects:
  *	None.
@@ -3266,36 +3963,35 @@ FreeObjEntry(hPtr)
  *----------------------------------------------------------------------
  */
 
-static unsigned int
-HashObjKey(tablePtr, keyPtr)
-    Tcl_HashTable *tablePtr;	/* Hash table. */
-    VOID *keyPtr;		/* Key from which to compute hash value. */
+unsigned int
+TclHashObjKey(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    void *keyPtr)		/* Key from which to compute hash value. */
 {
     Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
     CONST char *string = TclGetString(objPtr);
     int length = objPtr->length;
-    unsigned int result;
+    unsigned int result = 0;
     int i;
 
     /*
-     * I tried a zillion different hash functions and asked many other
-     * people for advice.  Many people had their own favorite functions,
-     * all different, but no-one had much idea why they were good ones.
-     * I chose the one below (multiply by 9 and add new character)
-     * because of the following reasons:
+     * I tried a zillion different hash functions and asked many other people
+     * for advice. Many people had their own favorite functions, all
+     * different, but no-one had much idea why they were good ones. I chose
+     * the one below (multiply by 9 and add new character) because of the
+     * following reasons:
      *
-     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
-     *    and multiplying by 9 is just about as good.
-     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
-     *    character's bits hang around in the low-order bits of the
-     *    hash value for ever, plus they spread fairly rapidly up to
-     *    the high-order bits to fill out the hash value.  This seems
-     *    works well both for decimal and non-decimal strings.
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
+     *	  multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old). This means that each
+     *	  character's bits hang around in the low-order bits of the hash value
+     *	  for ever, plus they spread fairly rapidly up to the high-order bits
+     *	  to fill out the hash value. This seems works well both for decimal
+     *	  and *non-decimal strings.
      */
 
-    result = 0;
     for (i=0 ; i<length ; i++) {
-	result += (result<<3) + string[i];
+	result += (result << 3) + string[i];
     }
     return result;
 }
@@ -3305,111 +4001,78 @@ HashObjKey(tablePtr, keyPtr)
  *
  * Tcl_GetCommandFromObj --
  *
- *      Returns the command specified by the name in a Tcl_Obj.
+ *	Returns the command specified by the name in a Tcl_Obj.
  *
  * Results:
- *	Returns a token for the command if it is found. Otherwise, if it
- *	can't be found or there is an error, returns NULL.
+ *	Returns a token for the command if it is found. Otherwise, if it can't
+ *	be found or there is an error, returns NULL.
  *
  * Side effects:
- *      May update the internal representation for the object, caching
- *      the command reference so that the next time this procedure is
- *	called with the same object, the command can be found quickly.
+ *	May update the internal representation for the object, caching the
+ *	command reference so that the next time this function is called with
+ *	the same object, the command can be found quickly.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_GetCommandFromObj(interp, objPtr)
-    Tcl_Interp *interp;		/* The interpreter in which to resolve the
+Tcl_GetCommandFromObj(
+    Tcl_Interp *interp,		/* The interpreter in which to resolve the
 				 * command and to report errors. */
-    register Tcl_Obj *objPtr;	/* The object containing the command's
-				 * name. If the name starts with "::", will
-				 * be looked up in global namespace. Else,
-				 * looked up first in the current namespace,
-				 * then in global namespace. */
+    register Tcl_Obj *objPtr)	/* The object containing the command's name.
+				 * If the name starts with "::", will be
+				 * looked up in global namespace. Else, looked
+				 * up first in the current namespace, then in
+				 * global namespace. */
 {
-    Interp *iPtr = (Interp *) interp;
     register ResolvedCmdName *resPtr;
     register Command *cmdPtr;
-    Namespace *currNsPtr;
+    Namespace *refNsPtr;
     int result;
-    CallFrame *savedFramePtr;
-    char *name;
-
-    /*
-     * If the variable name is fully qualified, do as if the lookup were
-     * done from the global namespace; this helps avoid repeated lookups 
-     * of fully qualified names. It costs close to nothing, and may be very
-     * helpful for OO applications which pass along a command name ("this"),
-     * [Patch 456668]
-     */
-
-    savedFramePtr = iPtr->varFramePtr;
-    name = Tcl_GetString(objPtr);
-    if ((*name++ == ':') && (*name == ':')) {
-	iPtr->varFramePtr = NULL;
-    }
 
     /*
      * Get the internal representation, converting to a command type if
-     * needed. The internal representation is a ResolvedCmdName that points
-     * to the actual command.
+     * needed. The internal representation is a ResolvedCmdName that points to
+     * the actual command.
+     *
+     * Check the context namespace and the namespace epoch of the resolved
+     * symbol to make sure that it is fresh. Note that we verify that the
+     * namespace id of the context namespace is the same as the one we cached;
+     * this insures that the namespace wasn't deleted and a new one created at
+     * the same address with the same command epoch. Note that fully qualified
+     * names have a NULL refNsPtr, these checks needn't be made.
+     *
+     * Check also that the command's epoch is up to date, and that the command
+     * is not deleted.
+     *
+     * If any check fails, then force another conversion to the command type,
+     * to discard the old rep and create a new one.      
      */
-    
-    if (objPtr->typePtr != &tclCmdNameType) {
-        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
-        if (result != TCL_OK) {
-	    iPtr->varFramePtr = savedFramePtr;
-            return (Tcl_Command) NULL;
-        }
-    }
-    resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
 
-    /*
-     * Get the current namespace.
-     */
-    
-    if (iPtr->varFramePtr != NULL) {
-	currNsPtr = iPtr->varFramePtr->nsPtr;
-    } else {
-	currNsPtr = iPtr->globalNsPtr;
+    resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+    if ((objPtr->typePtr != &tclCmdNameType)
+	    || (resPtr == NULL)
+	    || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch)
+	    || (cmdPtr->flags & CMD_IS_DELETED)
+	    || (interp != cmdPtr->nsPtr->interp)
+	    || (cmdPtr->nsPtr->flags & 	NS_DYING)
+	    || ((resPtr->refNsPtr != NULL) && 
+		     (((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))
+			     != resPtr->refNsPtr)
+		     || (resPtr->refNsId != refNsPtr->nsId)
+		     || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch)))
+	) {
+	
+	result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+	
+	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+	if ((result == TCL_OK) && resPtr) {
+	    cmdPtr = resPtr->cmdPtr;
+	} else {
+	    cmdPtr = NULL;
+	}
     }
-
-    /*
-     * Check the context namespace and the namespace epoch of the resolved
-     * symbol to make sure that it is fresh. If not, then force another
-     * conversion to the command type, to discard the old rep and create a
-     * new one. Note that we verify that the namespace id of the context
-     * namespace is the same as the one we cached; this insures that the
-     * namespace wasn't deleted and a new one created at the same address
-     * with the same command epoch.
-     */
     
-    cmdPtr = NULL;
-    if ((resPtr != NULL)
-	    && (resPtr->refNsPtr == currNsPtr)
-	    && (resPtr->refNsId == currNsPtr->nsId)
-	    && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
-        cmdPtr = resPtr->cmdPtr;
-        if (cmdPtr->cmdEpoch != resPtr->cmdEpoch
-		|| (cmdPtr->flags & CMD_IS_DELETED)) {
-            cmdPtr = NULL;
-        }
-    }
-
-    if (cmdPtr == NULL) {
-        result = tclCmdNameType.setFromAnyProc(interp, objPtr);
-        if (result != TCL_OK) {
-	    iPtr->varFramePtr = savedFramePtr;
-            return (Tcl_Command) NULL;
-        }
-        resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
-        if (resPtr != NULL) {
-            cmdPtr = resPtr->cmdPtr;
-        }
-    }
-    iPtr->varFramePtr = savedFramePtr;
     return (Tcl_Command) cmdPtr;
 }
 
@@ -3426,54 +4089,59 @@ Tcl_GetCommandFromObj(interp, objPtr)
  *
  * Side effects:
  *	The object's old internal rep is freed. It's string rep is not
- *	changed. The refcount in the Command structure is incremented to
- *	keep it from being freed if the command is later deleted until
+ *	changed. The refcount in the Command structure is incremented to keep
+ *	it from being freed if the command is later deleted until
  *	TclExecuteByteCode has a chance to recognize that it was deleted.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclSetCmdNameObj(interp, objPtr, cmdPtr)
-    Tcl_Interp *interp;		/* Points to interpreter containing command
+TclSetCmdNameObj(
+    Tcl_Interp *interp,		/* Points to interpreter containing command
 				 * that should be cached in objPtr. */
-    register Tcl_Obj *objPtr;	/* Points to Tcl object to be changed to
-				 * a CmdName object. */
-    Command *cmdPtr;		/* Points to Command structure that the
+    register Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
+				 * CmdName object. */
+    Command *cmdPtr)		/* Points to Command structure that the
 				 * CmdName object should refer to. */
 {
     Interp *iPtr = (Interp *) interp;
     register ResolvedCmdName *resPtr;
-    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
     register Namespace *currNsPtr;
+    char *name;
 
-    if (oldTypePtr == &tclCmdNameType) {
+    if (objPtr->typePtr == &tclCmdNameType) {
 	return;
     }
-    
-    /*
-     * Get the current namespace.
-     */
-    
-    if (iPtr->varFramePtr != NULL) {
-	currNsPtr = iPtr->varFramePtr->nsPtr;
-    } else {
-	currNsPtr = iPtr->globalNsPtr;
-    }
-    
+
     cmdPtr->refCount++;
     resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
     resPtr->cmdPtr = cmdPtr;
-    resPtr->refNsPtr = currNsPtr;
-    resPtr->refNsId  = currNsPtr->nsId;
-    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
     resPtr->cmdEpoch = cmdPtr->cmdEpoch;
     resPtr->refCount = 1;
-    
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
+
+    name = TclGetString(objPtr);
+    if ((*name++ == ':') && (*name == ':')) {
+	/*
+	 * The name is fully qualified: set the referring namespace to
+	 * NULL. 
+	 */
+
+	resPtr->refNsPtr = NULL;
+    } else {
+	/*
+	 * Get the current namespace.
+	 */
+
+	currNsPtr = iPtr->varFramePtr->nsPtr;
+	
+	resPtr->refNsPtr = currNsPtr;
+	resPtr->refNsId = currNsPtr->nsId;
+	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
     }
-    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+
+    TclFreeIntRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclCmdNameType;
 }
@@ -3491,17 +4159,17 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
  *
  * Side effects:
  *	Decrements the ref count of any cached ResolvedCmdName structure
- *	pointed to by the cmdName's internal representation. If this is 
- *	the last use of the ResolvedCmdName, it is freed. This in turn
- *	decrements the ref count of the Command structure pointed to by 
- *	the ResolvedSymbol, which may free the Command structure.
+ *	pointed to by the cmdName's internal representation. If this is the
+ *	last use of the ResolvedCmdName, it is freed. This in turn decrements
+ *	the ref count of the Command structure pointed to by the
+ *	ResolvedSymbol, which may free the Command structure.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeCmdNameInternalRep(objPtr)
-    register Tcl_Obj *objPtr;	/* CmdName object with internal
+FreeCmdNameInternalRep(
+    register Tcl_Obj *objPtr)	/* CmdName object with internal
 				 * representation to free. */
 {
     register ResolvedCmdName *resPtr =
@@ -3509,23 +4177,24 @@ FreeCmdNameInternalRep(objPtr)
 
     if (resPtr != NULL) {
 	/*
-	 * Decrement the reference count of the ResolvedCmdName structure.
-	 * If there are no more uses, free the ResolvedCmdName structure.
+	 * Decrement the reference count of the ResolvedCmdName structure. If
+	 * there are no more uses, free the ResolvedCmdName structure.
 	 */
-    
-        resPtr->refCount--;
-        if (resPtr->refCount == 0) {
-            /*
-	     * Now free the cached command, unless it is still in its
-             * hash table or if there are other references to it
-             * from other cmdName objects.
+
+	resPtr->refCount--;
+	if (resPtr->refCount == 0) {
+	    /*
+	     * Now free the cached command, unless it is still in its hash
+	     * table or if there are other references to it from other cmdName
+	     * objects.
 	     */
-	    
-            Command *cmdPtr = resPtr->cmdPtr;
-            TclCleanupCommand(cmdPtr);
-            ckfree((char *) resPtr);
-        }
+
+	    Command *cmdPtr = resPtr->cmdPtr;
+	    TclCleanupCommandMacro(cmdPtr);
+	    ckfree((char *) resPtr);
+	}
     }
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -3533,33 +4202,33 @@ FreeCmdNameInternalRep(objPtr)
  *
  * DupCmdNameInternalRep --
  *
- *	Initialize the internal representation of an cmdName Tcl_Obj to a
- *	copy of the internal representation of an existing cmdName object. 
+ *	Initialize the internal representation of an cmdName Tcl_Obj to a copy
+ *	of the internal representation of an existing cmdName object.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	"copyPtr"s internal rep is set to point to the ResolvedCmdName
- *	structure corresponding to "srcPtr"s internal rep. Increments the
- *	ref count of the ResolvedCmdName structure pointed to by the
- *	cmdName's internal representation.
+ *	structure corresponding to "srcPtr"s internal rep. Increments the ref
+ *	count of the ResolvedCmdName structure pointed to by the cmdName's
+ *	internal representation.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DupCmdNameInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
-    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
+DupCmdNameInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    register ResolvedCmdName *resPtr =
-        (ResolvedCmdName *) srcPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedCmdName *resPtr = (ResolvedCmdName *)
+	    srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     if (resPtr != NULL) {
-        resPtr->refCount++;
+	resPtr->refCount++;
     }
     copyPtr->typePtr = &tclCmdNameType;
 }
@@ -3577,22 +4246,21 @@ DupCmdNameInternalRep(srcPtr, copyPtr)
  *
  * Side effects:
  *	A pointer to a ResolvedCmdName structure that holds a cached pointer
- *	to the command with a name that matches objPtr's string rep is
- *	stored as objPtr's internal representation. This ResolvedCmdName
- *	pointer will be NULL if no matching command was found. The ref count
- *	of the cached Command's structure (if any) is also incremented.
+ *	to the command with a name that matches objPtr's string rep is stored
+ *	as objPtr's internal representation. This ResolvedCmdName pointer will
+ *	be NULL if no matching command was found. The ref count of the cached
+ *	Command's structure (if any) is also incremented.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetCmdNameFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
+SetCmdNameFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     Interp *iPtr = (Interp *) interp;
     char *name;
-    Tcl_Command cmd;
     register Command *cmdPtr;
     Namespace *currNsPtr;
     register ResolvedCmdName *resPtr;
@@ -3602,15 +4270,6 @@ SetCmdNameFromAny(interp, objPtr)
     }
 
     /*
-     * Get "objPtr"s string representation. Make it up-to-date if necessary.
-     */
-
-    name = objPtr->bytes;
-    if (name == NULL) {
-	name = Tcl_GetString(objPtr);
-    }
-
-    /*
      * Find the Command structure, if any, that describes the command called
      * "name". Build a ResolvedCmdName that holds a cached pointer to this
      * Command, and bump the reference count in the referenced Command
@@ -3618,47 +4277,62 @@ SetCmdNameFromAny(interp, objPtr)
      * referenced from a CmdName object.
      */
 
-    cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
-	    /*flags*/ 0);
-    cmdPtr = (Command *) cmd;
-    if (cmdPtr != NULL) {
-	/*
-	 * Get the current namespace.
-	 */
-	
-	if (iPtr->varFramePtr != NULL) {
-	    currNsPtr = iPtr->varFramePtr->nsPtr;
-	} else {
-	    currNsPtr = iPtr->globalNsPtr;
-	}
-	
-	cmdPtr->refCount++;
-        resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
-        resPtr->cmdPtr        = cmdPtr;
-        resPtr->refNsPtr      = currNsPtr;
-        resPtr->refNsId       = currNsPtr->nsId;
-        resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
-        resPtr->cmdEpoch      = cmdPtr->cmdEpoch;
-        resPtr->refCount      = 1;
-    } else {
-	resPtr = NULL;	/* no command named "name" was found */
-    }
+    name = TclGetString(objPtr);
+    cmdPtr = (Command *) Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
 
     /*
-     * Free the old internalRep before setting the new one. We do this as
-     * late as possible to allow the conversion code, in particular
-     * GetStringFromObj, to use that old internalRep. If no Command
-     * structure was found, leave NULL as the cached value.
+     * Free the old internalRep before setting the new one. Do this after
+     * getting the string rep to allow the conversion code (in particular,
+     * Tcl_GetStringFromObj) to use that old internalRep.
      */
 
-    if ((objPtr->typePtr != NULL)
-	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
-	objPtr->typePtr->freeIntRepProc(objPtr);
+    if (cmdPtr) {
+	cmdPtr->refCount++;
+	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+	if ((objPtr->typePtr == &tclCmdNameType)
+		&& resPtr && (resPtr->refCount == 1)) {
+	    /*
+	     * Reuse the old ResolvedCmdName struct instead of freeing it
+	     */
+	    
+	    Command *oldCmdPtr = resPtr->cmdPtr;
+	    if (--oldCmdPtr->refCount == 0) {
+		TclCleanupCommandMacro(oldCmdPtr);
+	    }
+	} else {
+	    TclFreeIntRep(objPtr);
+	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+	    resPtr->refCount = 1;
+	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
+	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	    objPtr->typePtr = &tclCmdNameType;
+	}
+	resPtr->cmdPtr = cmdPtr;
+	resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+	if ((*name++ == ':') && (*name == ':')) {
+	    /*
+	     * The name is fully qualified: set the referring namespace to 
+	     * NULL. 
+	     */
+
+	    resPtr->refNsPtr = NULL;
+	} else {
+	    /*
+	     * Get the current namespace.
+	     */
+
+	    currNsPtr = iPtr->varFramePtr->nsPtr;
+	    
+	    resPtr->refNsPtr = currNsPtr;
+	    resPtr->refNsId = currNsPtr->nsId;
+	    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+	}
+    } else {
+	TclFreeIntRep(objPtr);
+	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	objPtr->typePtr = &tclCmdNameType;
     }
-    
-    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    objPtr->typePtr = &tclCmdNameType;
     return TCL_OK;
 }
 
@@ -3669,4 +4343,3 @@ SetCmdNameFromAny(interp, objPtr)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 4614edc..600307e 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -1,43 +1,40 @@
-/* 
+/*
  * tclPanic.c --
  *
- *	Source code for the "Tcl_Panic" library procedure for Tcl;
- *	individual applications will probably call Tcl_SetPanicProc()
- *	to set an application-specific panic procedure.
+ *	Source code for the "Tcl_Panic" library procedure for Tcl; individual
+ *	applications will probably call Tcl_SetPanicProc() to set an
+ *	application-specific panic procedure.
  *
  * Copyright (c) 1988-1993 The Regents of the University of California.
  * Copyright (c) 1994 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * The panicProc variable contains a pointer to an application
- * specific panic procedure.
+ * The panicProc variable contains a pointer to an application specific panic
+ * procedure.
  */
 
 static Tcl_PanicProc *panicProc = NULL;
 
 /*
- * The platformPanicProc variable contains a pointer to a platform
- * specific panic procedure, if any.  ( TclpPanic may be NULL via
- * a macro. )
+ * The platformPanicProc variable contains a pointer to a platform specific
+ * panic procedure, if any. (TclpPanic may be NULL via a macro.)
  */
 
-static Tcl_PanicProc * CONST platformPanicProc = TclpPanic;
-
+static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SetPanicProc --
  *
- *	Replace the default panic behavior with the specified functiion.
+ *	Replace the default panic behavior with the specified function.
  *
  * Results:
  *	None.
@@ -49,8 +46,8 @@ static Tcl_PanicProc * CONST platformPanicProc = TclpPanic;
  */
 
 void
-Tcl_SetPanicProc(proc)
-    Tcl_PanicProc *proc;
+Tcl_SetPanicProc(
+    Tcl_PanicProc *proc)
 {
     panicProc = proc;
 }
@@ -72,10 +69,10 @@ Tcl_SetPanicProc(proc)
  */
 
 void
-Tcl_PanicVA (format, argList)
-    CONST char *format;		/* Format string, suitable for passing to
+Tcl_PanicVA(
+    CONST char *format,		/* Format string, suitable for passing to
 				 * fprintf. */
-    va_list argList;		/* Variable argument list. */
+    va_list argList)		/* Variable argument list. */
 {
     char *arg1, *arg2, *arg3, *arg4;	/* Additional arguments (variable in
 					 * number) to pass to fprintf. */
@@ -89,7 +86,7 @@ Tcl_PanicVA (format, argList)
     arg6 = va_arg(argList, char *);
     arg7 = va_arg(argList, char *);
     arg8 = va_arg(argList, char *);
-    
+
     if (panicProc != NULL) {
 	(void) (*panicProc)(format, arg1, arg2, arg3, arg4,
 		arg5, arg6, arg7, arg8);
@@ -121,14 +118,23 @@ Tcl_PanicVA (format, argList)
  *----------------------------------------------------------------------
  */
 
-	/* VARARGS ARGSUSED */
+	/* ARGSUSED */
 void
-Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
+Tcl_Panic(
+    CONST char *format,
+    ...)
 {
     va_list argList;
-    CONST char *format;
 
-    format = TCL_VARARGS_START(CONST char *,arg1,argList);
+    va_start(argList, format);
     Tcl_PanicVA(format, argList);
     va_end (argList);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclParse.c b/generic/tclParse.c
index a3f8433..96c2a10 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1,61 +1,58 @@
-/* 
+/*
  * tclParse.c --
  *
- *	This file contains procedures that parse Tcl scripts.  They
- *	do so in a general-purpose fashion that can be used for many
- *	different purposes, including compilation, direct execution,
- *	code analysis, etc.  
+ *	This file contains functions that parse Tcl scripts. They do so in a
+ *	general-purpose fashion that can be used for many different purposes,
+ *	including compilation, direct execution, code analysis, etc.
  *
  * Copyright (c) 1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 Ajuba Solutions.
  * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * The following table provides parsing information about each possible
- * 8-bit character.  The table is designed to be referenced with either
- * signed or unsigned characters, so it has 384 entries.  The first 128
- * entries correspond to negative character values, the next 256 correspond
- * to positive character values.  The last 128 entries are identical to the
- * first 128.  The table is always indexed with a 128-byte offset (the 128th
- * entry corresponds to a character value of 0).
- *
- * The macro CHAR_TYPE is used to index into the table and return
- * information about its character argument.  The following return
- * values are defined.
- *
- * TYPE_NORMAL -        All characters that don't have special significance
- *                      to the Tcl parser.
- * TYPE_SPACE -         The character is a whitespace character other
- *                      than newline.
- * TYPE_COMMAND_END -   Character is newline or semicolon.
- * TYPE_SUBS -          Character begins a substitution or has other
- *                      special meaning in ParseTokens: backslash, dollar
- *                      sign, or open bracket.
- * TYPE_QUOTE -         Character is a double quote.
- * TYPE_CLOSE_PAREN -   Character is a right parenthesis.
- * TYPE_CLOSE_BRACK -   Character is a right square bracket.
- * TYPE_BRACE -         Character is a curly brace (either left or right).
+ * The following table provides parsing information about each possible 8-bit
+ * character. The table is designed to be referenced with either signed or
+ * unsigned characters, so it has 384 entries. The first 128 entries
+ * correspond to negative character values, the next 256 correspond to
+ * positive character values. The last 128 entries are identical to the first
+ * 128. The table is always indexed with a 128-byte offset (the 128th entry
+ * corresponds to a character value of 0).
+ *
+ * The macro CHAR_TYPE is used to index into the table and return information
+ * about its character argument. The following return values are defined.
+ *
+ * TYPE_NORMAL -	All characters that don't have special significance to
+ *			the Tcl parser.
+ * TYPE_SPACE -		The character is a whitespace character other than
+ *			newline.
+ * TYPE_COMMAND_END -	Character is newline or semicolon.
+ * TYPE_SUBS -		Character begins a substitution or has other special
+ *			meaning in ParseTokens: backslash, dollar sign, or
+ *			open bracket.
+ * TYPE_QUOTE -		Character is a double quote.
+ * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
+ * TYPE_CLOSE_BRACK -	Character is a right square bracket.
+ * TYPE_BRACE -		Character is a curly brace (either left or right).
  */
 
-#define TYPE_NORMAL             0
-#define TYPE_SPACE              0x1
-#define TYPE_COMMAND_END        0x2
-#define TYPE_SUBS               0x4
-#define TYPE_QUOTE              0x8
-#define TYPE_CLOSE_PAREN        0x10
-#define TYPE_CLOSE_BRACK        0x20
-#define TYPE_BRACE              0x40
+#define TYPE_NORMAL		0
+#define TYPE_SPACE		0x1
+#define TYPE_COMMAND_END	0x2
+#define TYPE_SUBS		0x4
+#define TYPE_QUOTE		0x8
+#define TYPE_CLOSE_PAREN	0x10
+#define TYPE_CLOSE_BRACK	0x20
+#define TYPE_BRACE		0x40
 
 #define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
 
-static CONST char charTypeTable[] = {
+static const char charTypeTable[] = {
     /*
      * Negative character values, from -128 to -1:
      */
@@ -169,96 +166,120 @@ static CONST char charTypeTable[] = {
 };
 
 /*
- * Prototypes for local procedures defined in this file:
+ * Prototypes for local functions defined in this file:
  */
 
-static int		CommandComplete _ANSI_ARGS_((CONST char *script,
-			    int numBytes));
-static int		ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
-			    Tcl_Parse *parsePtr));
-static int		ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
-			    int mask, Tcl_Parse *parsePtr));
+static inline int	CommandComplete(const char *script, int numBytes);
+static int		ParseComment(const char *src, int numBytes,
+			    Tcl_Parse *parsePtr);
+static int		ParseTokens(const char *src, int numBytes, int mask,
+			    int flags, Tcl_Parse *parsePtr);
+static int		ParseWhiteSpace(const char *src, int numBytes,
+			    int *incompletePtr, char *typePtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseInit --
+ *
+ * 	Initialize the fields of a Tcl_Parse struct.
+ *
+ * Results:
+ * 	None.
+ *
+ * Side effects:
+ * 	The Tcl_Parse struct pointed to by parsePtr gets initialized.
+ *
+ *----------------------------------------------------------------------
+ */
 
+void
+TclParseInit(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
+    const char *start,		/* Start of string to be parsed. */
+    int numBytes,		/* Total number of bytes in string. If < 0,
+				 * the script consists of all bytes up to the
+				 * first null character. */
+    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
+{
+    parsePtr->numWords = 0;
+    parsePtr->tokenPtr = parsePtr->staticTokens;
+    parsePtr->numTokens = 0;
+    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+    parsePtr->string = start;
+    parsePtr->end = start + numBytes;
+    parsePtr->term = parsePtr->end;
+    parsePtr->interp = interp;
+    parsePtr->incomplete = 0;
+    parsePtr->errorType = TCL_PARSE_SUCCESS;
+}
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ParseCommand --
  *
- *	Given a string, this procedure parses the first Tcl command
- *	in the string and returns information about the structure of
- *	the command.
+ *	Given a string, this function parses the first Tcl command in the
+ *	string and returns information about the structure of the command.
  *
  * Results:
- *	The return value is TCL_OK if the command was parsed
- *	successfully and TCL_ERROR otherwise.  If an error occurs
- *	and interp isn't NULL then an error message is left in
- *	its result.  On a successful return, parsePtr is filled in
- *	with information about the command that was parsed.
+ *	The return value is TCL_OK if the command was parsed successfully and
+ *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
+ *	error message is left in its result. On a successful return, parsePtr
+ *	is filled in with information about the command that was parsed.
  *
  * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the command, then additional space is
- *	malloc-ed.  If the procedure returns TCL_OK then the caller must
- *	eventually invoke Tcl_FreeParse to release any additional space
- *	that was allocated.
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the command, then additional space is malloc-ed. If the function
+ *	returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
+ *	release any additional space that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting;
-				 * if NULL, then no error message is
-				 * provided. */
-    CONST char *string;		/* First character of string containing
-				 * one or more Tcl commands. */
-    register int numBytes;	/* Total number of bytes in string.  If < 0,
-				 * the script consists of all bytes up to 
-				 * the first null character. */
-    int nested;			/* Non-zero means this is a nested command:
-				 * close bracket should be considered
-				 * a command terminator. If zero, then close
+Tcl_ParseCommand(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
+				 * NULL, then no error message is provided. */
+    const char *start,		/* First character of string containing one or
+				 * more Tcl commands. */
+    register int numBytes,	/* Total number of bytes in string. If < 0,
+				 * the script consists of all bytes up to the
+				 * first null character. */
+    int nested,			/* Non-zero means this is a nested command:
+				 * close bracket should be considered a
+				 * command terminator. If zero, then close
 				 * bracket has no special meaning. */
-    register Tcl_Parse *parsePtr;
-    				/* Structure to fill in with information
-				 * about the parsed command; any previous
-				 * information in the structure is
-				 * ignored. */
+    register Tcl_Parse *parsePtr)
+    				/* Structure to fill in with information about
+				 * the parsed command; any previous
+				 * information in the structure is ignored. */
 {
-    register CONST char *src;	/* Points to current character
-				 * in the command. */
+    register const char *src;	/* Points to current character in the
+				 * command. */
     char type;			/* Result returned by CHAR_TYPE(*src). */
     Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
     int wordIndex;		/* Index of word token for current word. */
-    int terminators;		/* CHAR_TYPE bits that indicate the end
-				 * of a command. */
-    CONST char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
+    int terminators;		/* CHAR_TYPE bits that indicate the end of a
+				 * command. */
+    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
 				 * point to char after terminating one. */
     int scanned;
-    
-    if ((string == NULL) && (numBytes!=0)) {
+
+    if ((start == NULL) && (numBytes != 0)) {
 	if (interp != NULL) {
 	    Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
 	}
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(string);
+	numBytes = strlen(start);
     }
+    TclParseInit(interp, start, numBytes, parsePtr);
     parsePtr->commentStart = NULL;
     parsePtr->commentSize = 0;
     parsePtr->commandStart = NULL;
     parsePtr->commandSize = 0;
-    parsePtr->numWords = 0;
-    parsePtr->tokenPtr = parsePtr->staticTokens;
-    parsePtr->numTokens = 0;
-    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
-    parsePtr->string = string;
-    parsePtr->end = string + numBytes;
-    parsePtr->term = parsePtr->end;
-    parsePtr->interp = interp;
-    parsePtr->incomplete = 0;
-    parsePtr->errorType = TCL_PARSE_SUCCESS;
     if (nested != 0) {
 	terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
     } else {
@@ -270,8 +291,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
      * command.
      */
 
-    scanned = ParseComment(string, numBytes, parsePtr);
-    src = (string + scanned); numBytes -= scanned;
+    scanned = ParseComment(start, numBytes, parsePtr);
+    src = (start + scanned);
+    numBytes -= scanned;
     if (numBytes == 0) {
 	if (nested) {
 	    parsePtr->incomplete = nested;
@@ -279,19 +301,19 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
     }
 
     /*
-     * The following loop parses the words of the command, one word
-     * in each iteration through the loop.
+     * The following loop parses the words of the command, one word in each
+     * iteration through the loop.
      */
 
     parsePtr->commandStart = src;
     while (1) {
+	int expandWord = 0;
+
 	/*
 	 * Create the token for the word.
 	 */
 
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
+	TclGrowParseTokenArray(parsePtr, 1);
 	wordIndex = parsePtr->numTokens;
 	tokenPtr = &parsePtr->tokenPtr[wordIndex];
 	tokenPtr->type = TCL_TOKEN_WORD;
@@ -301,8 +323,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	 * sequence: it should be treated just like white space.
 	 */
 
-	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
-	src += scanned; numBytes -= scanned;
+	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
+	src += scanned;
+	numBytes -= scanned;
 	if (numBytes == 0) {
 	    parsePtr->term = src;
 	    break;
@@ -317,60 +340,229 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	parsePtr->numWords++;
 
 	/*
-	 * At this point the word can have one of three forms: something
-	 * enclosed in quotes, something enclosed in braces, or an
-	 * unquoted word (anything else).
+	 * At this point the word can have one of four forms: something
+	 * enclosed in quotes, something enclosed in braces, and expanding
+	 * word, or an unquoted word (anything else).
 	 */
 
+    parseWord:
 	if (*src == '"') {
-	    if (Tcl_ParseQuotedString(interp, src, numBytes,
-		    parsePtr, 1, &termPtr) != TCL_OK) {
+	    if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1,
+		    &termPtr) != TCL_OK) {
 		goto error;
 	    }
-	    src = termPtr; numBytes = parsePtr->end - src;
+	    src = termPtr;
+	    numBytes = parsePtr->end - src;
 	} else if (*src == '{') {
-	    if (Tcl_ParseBraces(interp, src, numBytes,
-		    parsePtr, 1, &termPtr) != TCL_OK) {
+	    int expIdx = wordIndex + 1;
+	    Tcl_Token *expPtr;
+
+	    if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
+		    &termPtr) != TCL_OK) {
 		goto error;
 	    }
-	    src = termPtr; numBytes = parsePtr->end - src;
+	    src = termPtr;
+	    numBytes = parsePtr->end - src;
+
+	    /*
+	     * Check whether the braces contained the word expansion prefix
+	     * {*}
+	     */
+
+	    expPtr = &parsePtr->tokenPtr[expIdx];
+	    if ((0 == expandWord)
+		    /* Haven't seen prefix already */
+		    && (1 == parsePtr->numTokens - expIdx)
+		    /* Only one token */
+		    && (((1 == (size_t) expPtr->size)
+			    /* Same length as prefix */
+			    && (expPtr->start[0] == '*')))
+			    /* Is the prefix */
+		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
+			    numBytes, &parsePtr->incomplete, &type))
+		    && (type != TYPE_COMMAND_END)
+		    /* Non-whitespace follows */) {
+		expandWord = 1;
+		parsePtr->numTokens--;
+		goto parseWord;
+	    }
 	} else {
 	    /*
-	     * This is an unquoted word.  Call ParseTokens and let it do
-	     * all of the work.
+	     * This is an unquoted word. Call ParseTokens and let it do all of
+	     * the work.
 	     */
 
 	    if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
-		    parsePtr) != TCL_OK) {
+		    TCL_SUBST_ALL, parsePtr) != TCL_OK) {
 		goto error;
 	    }
-	    src = parsePtr->term; numBytes = parsePtr->end - src;
+	    src = parsePtr->term;
+	    numBytes = parsePtr->end - src;
 	}
 
 	/*
-	 * Finish filling in the token for the word and check for the
-	 * special case of a word consisting of a single range of
-	 * literal text.
+	 * Finish filling in the token for the word and check for the special
+	 * case of a word consisting of a single range of literal text.
 	 */
 
 	tokenPtr = &parsePtr->tokenPtr[wordIndex];
 	tokenPtr->size = src - tokenPtr->start;
 	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
-	if ((tokenPtr->numComponents == 1)
+	if (expandWord) {
+	    int i, isLiteral = 1;
+
+	    /*
+	     * When a command includes a word that is an expanded literal; for
+	     * example, {*}{1 2 3}, the parser performs that expansion
+	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
+	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
+	     * caller might have to expand. This notably makes it simpler for
+	     * those callers that wish to track line endings, such as those
+	     * that implement key parts of TIP 280.
+	     *
+	     * First check whether the thing to be expanded is a literal,
+	     * in the sense of being composed entirely of TCL_TOKEN_TEXT
+	     * tokens.
+	     */
+
+	    for (i = 1; i <= tokenPtr->numComponents; i++) {
+		if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
+		    isLiteral = 0;
+		    break;
+		}
+	    }
+
+	    if (isLiteral) {
+		int elemCount = 0, code = TCL_OK, literal = 1;
+		const char *nextElem, *listEnd, *elemStart;
+
+		/*
+		 * The word to be expanded is a literal, so determine the
+		 * boundaries of the literal string to be treated as a list
+		 * and expanded. That literal string starts at
+		 * tokenPtr[1].start, and includes all bytes up to, but not
+		 * including (tokenPtr[tokenPtr->numComponents].start +
+		 * tokenPtr[tokenPtr->numComponents].size)
+		 */
+
+		listEnd = (tokenPtr[tokenPtr->numComponents].start +
+			tokenPtr[tokenPtr->numComponents].size);
+		nextElem = tokenPtr[1].start;
+
+		/*
+		 * Step through the literal string, parsing and counting list
+		 * elements.
+		 */
+
+		while (nextElem < listEnd) {
+		    int size;
+
+		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
+			    &elemStart, &nextElem, &size, &literal);
+		    if ((code != TCL_OK) || !literal) {
+			break;
+		    }
+		    if (elemStart < listEnd) {
+			elemCount++;
+		    }
+		}
+
+		if ((code != TCL_OK) || !literal) {
+		    /*
+		     * Some list element could not be parsed, or is not
+		     * present as a literal substring of the script.  The
+		     * compiler cannot handle list elements that get generated
+		     * by a call to TclCopyAndCollapse(). Defer  the
+		     * handling of  this to  compile/eval time, where  code is
+		     * already  in place to  report the  "attempt to  expand a
+		     * non-list" error or expand lists that require
+		     * substitution.
+		     */
+
+		    tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
+		} else if (elemCount == 0) {
+		    /*
+		     * We are expanding a literal empty list. This means that
+		     * the expanding word completely disappears, leaving no
+		     * word generated this pass through the loop. Adjust
+		     * accounting appropriately.
+		     */
+
+		    parsePtr->numWords--;
+		    parsePtr->numTokens = wordIndex;
+		} else {
+		    /*
+		     * Recalculate the number of Tcl_Tokens needed to store
+		     * tokens representing the expanded list.
+		     */
+
+		    CONST char *listStart;
+		    int growthNeeded = wordIndex + 2*elemCount
+			    - parsePtr->numTokens;
+		    parsePtr->numWords += elemCount - 1;
+		    if (growthNeeded > 0) {
+			TclGrowParseTokenArray(parsePtr, growthNeeded);
+			tokenPtr = &parsePtr->tokenPtr[wordIndex];
+		    }
+		    parsePtr->numTokens = wordIndex + 2*elemCount;
+
+		    /*
+		     * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for
+		     * each element of the literal list we are expanding in
+		     * place. Take care with the start and size fields of each
+		     * token so they point to the right literal characters in
+		     * the original script to represent the right expanded
+		     * word value.
+		     */
+
+		    listStart = nextElem = tokenPtr[1].start;
+		    while (nextElem < listEnd) {
+			int quoted;
+	
+			tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
+			tokenPtr->numComponents = 1;
+
+			tokenPtr++;
+			tokenPtr->type = TCL_TOKEN_TEXT;
+			tokenPtr->numComponents = 0;
+			TclFindElement(NULL, nextElem, listEnd - nextElem,
+				&(tokenPtr->start), &nextElem,
+				&(tokenPtr->size), NULL);
+
+			quoted = (tokenPtr->start[-1] == '{'
+				|| tokenPtr->start[-1] == '"')
+				&& tokenPtr->start > listStart;
+			tokenPtr[-1].start = tokenPtr->start - quoted;
+			tokenPtr[-1].size = tokenPtr->start + tokenPtr->size
+				- tokenPtr[-1].start + quoted;
+
+			tokenPtr++;
+		    }
+		}
+	    } else {
+		/*
+		 * The word to be expanded is not a literal, so defer
+		 * expansion to compile/eval time by marking with a
+		 * TCL_TOKEN_EXPAND_WORD token.
+		 */
+
+		tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
+	    }
+	} else if ((tokenPtr->numComponents == 1)
 		&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
 	    tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
 	}
 
 	/*
-	 * Do two additional checks: (a) make sure we're really at the
-	 * end of a word (there might have been garbage left after a
-	 * quoted or braced word), and (b) check for the end of the
-	 * command.
+	 * Do two additional checks: (a) make sure we're really at the end of
+	 * a word (there might have been garbage left after a quoted or braced
+	 * word), and (b) check for the end of the command.
 	 */
 
-	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
 	if (scanned) {
-	    src += scanned; numBytes -= scanned;
+	    src += scanned;
+	    numBytes -= scanned;
 	    continue;
 	}
 
@@ -380,10 +572,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	}
 	if ((type & terminators) != 0) {
 	    parsePtr->term = src;
-	    src++; 
+	    src++;
 	    break;
 	}
-	if (src[-1] == '"') { 
+	if (src[-1] == '"') {
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "extra characters after close-quote",
 			TCL_STATIC);
@@ -403,51 +595,72 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
     parsePtr->commandSize = src - parsePtr->commandStart;
     return TCL_OK;
 
-    error:
+  error:
     Tcl_FreeParse(parsePtr);
-    if (parsePtr->commandStart == NULL) {
-	parsePtr->commandStart = string;
-    }
     parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
- * TclParseWhiteSpace --
+ * TclIsSpaceProc --
  *
- *	Scans up to numBytes bytes starting at src, consuming white
- *	space as defined by Tcl's parsing rules.  
+ *	Report whether byte is in the set of whitespace characters used by
+ *	Tcl to separate words in scripts or elements in lists.
  *
  * Results:
- *	Returns the number of bytes recognized as white space.  Records
- *	at parsePtr, information about the parse.  Records at typePtr
- *	the character type of the non-whitespace character that terminated
- *	the scan.
+ *	Returns 1, if byte is in the set, 0 otherwise.
  *
  * Side effects:
  *	None.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
-    CONST char *src;		/* First character to parse. */
-    register int numBytes;	/* Max number of bytes to scan. */
-    Tcl_Parse *parsePtr;	/* Information about parse in progress.
-				 * Updated if parsing indicates
-				 * an incomplete command. */
-    char *typePtr;		/* Points to location to store character
-				 * type of character that ends run
-				 * of whitespace */
+TclIsSpaceProc(
+    char byte)
+{
+    return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseWhiteSpace --
+ *
+ *	Scans up to numBytes bytes starting at src, consuming white space
+ *	between words as defined by Tcl's parsing rules.
+ *
+ * Results:
+ *	Returns the number of bytes recognized as white space. Records at
+ *	parsePtr, information about the parse. Records at typePtr the
+ *	character type of the non-whitespace character that terminated the
+ *	scan.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseWhiteSpace(
+    const char *src,		/* First character to parse. */
+    register int numBytes,	/* Max number of bytes to scan. */
+    int *incompletePtr,		/* Set this boolean memory to true if parsing
+				 * indicates an incomplete command. */
+    char *typePtr)		/* Points to location to store character type
+				 * of character that ends run of whitespace */
 {
     register char type = TYPE_NORMAL;
-    register CONST char *p = src;
+    register const char *p = src;
 
     while (1) {
 	while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
-	    numBytes--; p++;
+	    numBytes--;
+	    p++;
 	}
 	if (numBytes && (type & TYPE_SUBS)) {
 	    if (*p != '\\') {
@@ -461,7 +674,7 @@ TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
 	    }
 	    p+=2;
 	    if (--numBytes == 0) {
-		parsePtr->incomplete = 1;
+		*incompletePtr = 1;
 		break;
 	    }
 	    continue;
@@ -475,42 +688,74 @@ TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclParseAllWhiteSpace --
+ *
+ *	Scans up to numBytes bytes starting at src, consuming all white space
+ *	including the command-terminating newline characters.
+ *
+ * Results:
+ *	Returns the number of bytes recognized as white space.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclParseAllWhiteSpace(
+    const char *src,		/* First character to parse. */
+    int numBytes)		/* Max number of byes to scan */
+{
+    int dummy;
+    char type;
+    const char *p = src;
+
+    do {
+	int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);
+
+	p += scanned;
+	numBytes -= scanned;
+    } while (numBytes && (*p == '\n') && (p++, --numBytes));
+    return (p-src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclParseHex --
  *
- *	Scans a hexadecimal number as a Tcl_UniChar value.
- *	(e.g., for parsing \x and \u escape sequences).
- *	At most numBytes bytes are scanned.
+ *	Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing
+ *	\x and \u escape sequences). At most numBytes bytes are scanned.
  *
  * Results:
- *	The numeric value is stored in *resultPtr.
- *	Returns the number of bytes consumed.
+ *	The numeric value is stored in *resultPtr. Returns the number of bytes
+ *	consumed.
  *
  * Notes:
- *	Relies on the following properties of the ASCII
- *	character set, with which UTF-8 is compatible:
+ *	Relies on the following properties of the ASCII character set, with
+ *	which UTF-8 is compatible:
  *
- *	The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' 
- *	occupy consecutive code points, and '0' < 'A' < 'a'.
+ *	The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' occupy
+ *	consecutive code points, and '0' < 'A' < 'a'.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclParseHex(src, numBytes, resultPtr)
-    CONST char *src;		/* First character to parse. */
-    int numBytes;		/* Max number of byes to scan */
-    Tcl_UniChar *resultPtr;	/* Points to storage provided by
-				 * caller where the Tcl_UniChar
-				 * resulting from the conversion is
-				 * to be written. */
+TclParseHex(
+    const char *src,		/* First character to parse. */
+    int numBytes,		/* Max number of byes to scan */
+    Tcl_UniChar *resultPtr)	/* Points to storage provided by caller where
+				 * the Tcl_UniChar resulting from the
+				 * conversion is to be written. */
 {
     Tcl_UniChar result = 0;
-    register CONST char *p = src;
+    register const char *p = src;
 
     while (numBytes--) {
 	unsigned char digit = UCHAR(*p);
 
-	if (!isxdigit(digit))
+	if (!isxdigit(digit)) {
 	    break;
+	}
 
 	++p;
 	result <<= 4;
@@ -533,35 +778,35 @@ TclParseHex(src, numBytes, resultPtr)
  *
  * TclParseBackslash --
  *
- *	Scans up to numBytes bytes starting at src, consuming a
- *	backslash sequence as defined by Tcl's parsing rules.  
+ *	Scans up to numBytes bytes starting at src, consuming a backslash
+ *	sequence as defined by Tcl's parsing rules.
  *
  * Results:
  * 	Records at readPtr the number of bytes making up the backslash
- * 	sequence.  Records at dst the UTF-8 encoded equivalent of
- * 	that backslash sequence.  Returns the number of bytes written
- * 	to dst, at most TCL_UTF_MAX.  Either readPtr or dst may be
- * 	NULL, if the results are not needed, but the return value is
- * 	the same either way.
+ * 	sequence. Records at dst the UTF-8 encoded equivalent of that
+ * 	backslash sequence. Returns the number of bytes written to dst, at
+ * 	most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results
+ * 	are not needed, but the return value is the same either way.
  *
  * Side effects:
  * 	None.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclParseBackslash(src, numBytes, readPtr, dst)
-    CONST char * src;	/* Points to the backslash character of a
-			 * a backslash sequence */
-    int numBytes;	/* Max number of bytes to scan */
-    int *readPtr;	/* NULL, or points to storage where the
-			 * number of bytes scanned should be written. */
-    char *dst;		/* NULL, or points to buffer where the UTF-8
-			 * encoding of the backslash sequence is to be
-			 * written.  At most TCL_UTF_MAX bytes will be
-			 * written there. */
+TclParseBackslash(
+    const char *src,		/* Points to the backslash character of a a
+				 * backslash sequence. */
+    int numBytes,		/* Max number of bytes to scan. */
+    int *readPtr,		/* NULL, or points to storage where the number
+				 * of bytes scanned should be written. */
+    char *dst)			/* NULL, or points to buffer where the UTF-8
+				 * encoding of the backslash sequence is to be
+				 * written. At most TCL_UTF_MAX bytes will be
+				 * written there. */
 {
-    register CONST char *p = src+1;
+    register const char *p = src+1;
     Tcl_UniChar result;
     int count;
     char buf[TCL_UTF_MAX];
@@ -574,11 +819,14 @@ TclParseBackslash(src, numBytes, readPtr, dst)
     }
 
     if (dst == NULL) {
-        dst = buf;
+	dst = buf;
     }
 
     if (numBytes == 1) {
-	/* Can only scan the backslash.  Return it. */
+	/*
+	 * Can only scan the backslash, so return it.
+	 */
+
 	result = '\\';
 	count = 1;
 	goto done;
@@ -586,105 +834,117 @@ TclParseBackslash(src, numBytes, readPtr, dst)
 
     count = 2;
     switch (*p) {
-        /*
-         * Note: in the conversions below, use absolute values (e.g.,
-         * 0xa) rather than symbolic values (e.g. \n) that get converted
-         * by the compiler.  It's possible that compilers on some
-         * platforms will do the symbolic conversions differently, which
-         * could result in non-portable Tcl scripts.
-         */
-
-        case 'a':
-            result = 0x7;
-            break;
-        case 'b':
-            result = 0x8;
-            break;
-        case 'f':
-            result = 0xc;
-            break;
-        case 'n':
-            result = 0xa;
-            break;
-        case 'r':
-            result = 0xd;
-            break;
-        case 't':
-            result = 0x9;
-            break;
-        case 'v':
-            result = 0xb;
-            break;
-        case 'x':
-	    count += TclParseHex(p+1, numBytes-2, &result);
-	    if (count == 2) {
-		/* No hexadigits -> This is just "x". */
-		result = 'x';
-	    } else {
-		/* Keep only the last byte (2 hex digits) */
-		result = (unsigned char) result;
-	    }
-            break;
-        case 'u':
-	    count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
-	    if (count == 2) {
-		/* No hexadigits -> This is just "u". */
-		result = 'u';
+	/*
+	 * Note: in the conversions below, use absolute values (e.g., 0xa)
+	 * rather than symbolic values (e.g. \n) that get converted by the
+	 * compiler. It's possible that compilers on some platforms will do
+	 * the symbolic conversions differently, which could result in
+	 * non-portable Tcl scripts.
+	 */
+
+    case 'a':
+	result = 0x7;
+	break;
+    case 'b':
+	result = 0x8;
+	break;
+    case 'f':
+	result = 0xc;
+	break;
+    case 'n':
+	result = 0xa;
+	break;
+    case 'r':
+	result = 0xd;
+	break;
+    case 't':
+	result = 0x9;
+	break;
+    case 'v':
+	result = 0xb;
+	break;
+    case 'x':
+	count += TclParseHex(p+1, numBytes-2, &result);
+	if (count == 2) {
+	    /*
+	     * No hexadigits -> This is just "x".
+	     */
+
+	    result = 'x';
+	} else {
+	    /*
+	     * Keep only the last byte (2 hex digits).
+	     */
+	    result = (unsigned char) result;
+	}
+	break;
+    case 'u':
+	count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
+	if (count == 2) {
+	    /*
+	     * No hexadigits -> This is just "u".
+	     */
+	    result = 'u';
+	}
+	break;
+    case '\n':
+	count--;
+	do {
+	    p++;
+	    count++;
+	} while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
+	result = ' ';
+	break;
+    case 0:
+	result = '\\';
+	count = 1;
+	break;
+    default:
+	/*
+	 * Check for an octal number \oo?o?
+	 */
+
+	if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) {	/* INTL: digit */
+	    result = (unsigned char)(*p - '0');
+	    p++;
+	    if ((numBytes == 2) || !isdigit(UCHAR(*p))	/* INTL: digit */
+		    || (UCHAR(*p) >= '8')) {
+		break;
 	    }
-            break;
-        case '\n':
-            count--;
-            do {
-                p++; count++;
-            } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
-            result = ' ';
-            break;
-        case 0:
-            result = '\\';
-            count = 1;
-            break;
-        default:
-            /*
-             * Check for an octal number \oo?o?
-             */
-            if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
-                result = (unsigned char)(*p - '0');
-                p++;
-                if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
-			|| (UCHAR(*p) >= '8')) { 
-                    break;
-                }
-                count = 3;
-                result = (unsigned char)((result << 3) + (*p - '0'));
-                p++;
-                if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
-			|| (UCHAR(*p) >= '8')) {
-                    break;
-                }
-                count = 4;
-                result = (unsigned char)((result << 3) + (*p - '0'));
-                break;
-            }
-            /*
-             * We have to convert here in case the user has put a
-             * backslash in front of a multi-byte utf-8 character.
-             * While this means nothing special, we shouldn't break up
-             * a correct utf-8 character. [Bug #217987] test subst-3.2
-             */
-	    if (Tcl_UtfCharComplete(p, numBytes - 1)) {
-	        count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
-	    } else {
-		char utfBytes[TCL_UTF_MAX];
-		memcpy(utfBytes, p, (size_t) (numBytes - 1));
-		utfBytes[numBytes - 1] = '\0';
-	        count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
+	    count = 3;
+	    result = (unsigned char)((result << 3) + (*p - '0'));
+	    p++;
+	    if ((numBytes == 3) || !isdigit(UCHAR(*p))	/* INTL: digit */
+		    || (UCHAR(*p) >= '8')) {
+		break;
 	    }
-            break;
+	    count = 4;
+	    result = (unsigned char)((result << 3) + (*p - '0'));
+	    break;
+	}
+
+	/*
+	 * We have to convert here in case the user has put a backslash in
+	 * front of a multi-byte utf-8 character. While this means nothing
+	 * special, we shouldn't break up a correct utf-8 character. [Bug
+	 * #217987] test subst-3.2
+	 */
+
+	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
+	    count = Tcl_UtfToUniChar(p, &result) + 1;	/* +1 for '\' */
+	} else {
+	    char utfBytes[TCL_UTF_MAX];
+
+	    memcpy(utfBytes, p, (size_t) (numBytes - 1));
+	    utfBytes[numBytes - 1] = '\0';
+	    count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
+	}
+	break;
     }
 
-    done:
+  done:
     if (readPtr != NULL) {
-        *readPtr = count;
+	*readPtr = count;
     }
     return Tcl_UniCharToUtf((int) result, dst);
 }
@@ -694,57 +954,69 @@ TclParseBackslash(src, numBytes, readPtr, dst)
  *
  * ParseComment --
  *
- *	Scans up to numBytes bytes starting at src, consuming a
- *	Tcl comment as defined by Tcl's parsing rules.  
+ *	Scans up to numBytes bytes starting at src, consuming a Tcl comment as
+ *	defined by Tcl's parsing rules.
  *
  * Results:
- * 	Records in parsePtr information about the parse.  Returns the
- * 	number of bytes consumed.
+ * 	Records in parsePtr information about the parse. Returns the number of
+ * 	bytes consumed.
  *
  * Side effects:
  * 	None.
  *
  *----------------------------------------------------------------------
  */
+
 static int
-ParseComment(src, numBytes, parsePtr)
-    CONST char *src;		/* First character to parse. */
-    register int numBytes;	/* Max number of bytes to scan. */
-    Tcl_Parse *parsePtr;	/* Information about parse in progress.
-				 * Updated if parsing indicates
-				 * an incomplete command. */
+ParseComment(
+    const char *src,		/* First character to parse. */
+    register int numBytes,	/* Max number of bytes to scan. */
+    Tcl_Parse *parsePtr)	/* Information about parse in progress.
+				 * Updated if parsing indicates an incomplete
+				 * command. */
 {
-    register CONST char *p = src;
+    register const char *p = src;
+
     while (numBytes) {
 	char type;
 	int scanned;
+
 	do {
-	    scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
-	    p += scanned; numBytes -= scanned;
+	    scanned = ParseWhiteSpace(p, numBytes,
+		    &parsePtr->incomplete, &type);
+	    p += scanned;
+	    numBytes -= scanned;
 	} while (numBytes && (*p == '\n') && (p++,numBytes--));
+
 	if ((numBytes == 0) || (*p != '#')) {
 	    break;
 	}
 	if (parsePtr->commentStart == NULL) {
 	    parsePtr->commentStart = p;
 	}
+
 	while (numBytes) {
 	    if (*p == '\\') {
-		scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+		scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
+			&type);
 		if (scanned) {
-		    p += scanned; numBytes -= scanned;
+		    p += scanned;
+		    numBytes -= scanned;
 		} else {
 		    /*
-		     * General backslash substitution in comments isn't
-		     * part of the formal spec, but test parse-15.47
-		     * and history indicate that it has been the de facto
-		     * rule.  Don't change it now.
+		     * General backslash substitution in comments isn't part
+		     * of the formal spec, but test parse-15.47 and history
+		     * indicate that it has been the de facto rule. Don't
+		     * change it now.
 		     */
+
 		    TclParseBackslash(p, numBytes, &scanned, NULL);
-		    p += scanned; numBytes -= scanned;
+		    p += scanned;
+		    numBytes -= scanned;
 		}
 	    } else {
-		p++; numBytes--;
+		p++;
+		numBytes--;
 		if (p[-1] == '\n') {
 		    break;
 		}
@@ -754,27 +1026,25 @@ ParseComment(src, numBytes, parsePtr)
     }
     return (p - src);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * ParseTokens --
  *
- *	This procedure forms the heart of the Tcl parser.  It parses one
- *	or more tokens from a string, up to a termination point
- *	specified by the caller.  This procedure is used to parse
- *	unquoted command words (those not in quotes or braces), words in
- *	quotes, and array indices for variables.  No more than numBytes
- *	bytes will be scanned.
+ *	This function forms the heart of the Tcl parser. It parses one or more
+ *	tokens from a string, up to a termination point specified by the
+ *	caller. This function is used to parse unquoted command words (those
+ *	not in quotes or braces), words in quotes, and array indices for
+ *	variables. No more than numBytes bytes will be scanned.
  *
  * Results:
- *	Tokens are added to parsePtr and parsePtr->term is filled in
- *	with the address of the character that terminated the parse (the
- *	first one whose CHAR_TYPE matched mask or the character at
- *	parsePtr->end).  The return value is TCL_OK if the parse
- *	completed successfully and TCL_ERROR otherwise.  If a parse
- *	error occurs and parsePtr->interp isn't NULL, then an error
- *	message is left in the interpreter's result.
+ *	Tokens are added to parsePtr and parsePtr->term is filled in with the
+ *	address of the character that terminated the parse (the first one
+ *	whose CHAR_TYPE matched mask or the character at parsePtr->end). The
+ *	return value is TCL_OK if the parse completed successfully and
+ *	TCL_ERROR otherwise. If a parse error occurs and parsePtr->interp is
+ *	not NULL, then an error message is left in the interpreter's result.
  *
  * Side effects:
  *	None.
@@ -783,45 +1053,49 @@ ParseComment(src, numBytes, parsePtr)
  */
 
 static int
-ParseTokens(src, numBytes, mask, parsePtr)
-    register CONST char *src;	/* First character to parse. */
-    register int numBytes;	/* Max number of bytes to scan. */
-    int mask;			/* Specifies when to stop parsing.  The
-				 * parse stops at the first unquoted
-				 * character whose CHAR_TYPE contains
-				 * any of the bits in mask. */
-    Tcl_Parse *parsePtr;	/* Information about parse in progress.
+ParseTokens(
+    register const char *src,	/* First character to parse. */
+    register int numBytes,	/* Max number of bytes to scan. */
+    int mask,			/* Specifies when to stop parsing. The parse
+				 * stops at the first unquoted character whose
+				 * CHAR_TYPE contains any of the bits in
+				 * mask. */
+    int flags,			/* OR-ed bits indicating what substitutions to
+				 * perform: TCL_SUBST_COMMANDS,
+				 * TCL_SUBST_VARIABLES, and
+				 * TCL_SUBST_BACKSLASHES */
+    Tcl_Parse *parsePtr)	/* Information about parse in progress.
 				 * Updated with additional tokens and
 				 * termination information. */
 {
-    char type; 
-    int originalTokens, varToken;
+    char type;
+    int originalTokens;
+    int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
+    int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
+    int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
     Tcl_Token *tokenPtr;
-    Tcl_Parse nested;
 
     /*
-     * Each iteration through the following loop adds one token of
-     * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
-     * TCL_TOKEN_VARIABLE to parsePtr.  For TCL_TOKEN_VARIABLE tokens,
-     * additional tokens are added for the parsed variable name.
+     * Each iteration through the following loop adds one token of type
+     * TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or TCL_TOKEN_VARIABLE
+     * to parsePtr. For TCL_TOKEN_VARIABLE tokens, additional tokens are added
+     * for the parsed variable name.
      */
 
     originalTokens = parsePtr->numTokens;
     while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
+	TclGrowParseTokenArray(parsePtr, 1);
 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
 	tokenPtr->start = src;
 	tokenPtr->numComponents = 0;
 
 	if ((type & TYPE_SUBS) == 0) {
 	    /*
-	     * This is a simple range of characters.  Scan to find the end
-	     * of the range.
+	     * This is a simple range of characters. Scan to find the end of
+	     * the range.
 	     */
 
-	    while ((++src, --numBytes) 
+	    while ((++src, --numBytes)
 		    && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
 		/* empty loop */
 	    }
@@ -829,81 +1103,116 @@ ParseTokens(src, numBytes, mask, parsePtr)
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
 	} else if (*src == '$') {
+	    int varToken;
+
+	    if (noSubstVars) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++;
+		numBytes--;
+		continue;
+	    }
+
 	    /*
-	     * This is a variable reference.  Call Tcl_ParseVarName to do
-	     * all the dirty work of parsing the name.
+	     * This is a variable reference.  Call Tcl_ParseVarName to do all
+	     * the dirty work of parsing the name.
 	     */
 
 	    varToken = parsePtr->numTokens;
-	    if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
-		    parsePtr, 1) != TCL_OK) {
+	    if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr,
+		    1) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	    src += parsePtr->tokenPtr[varToken].size;
 	    numBytes -= parsePtr->tokenPtr[varToken].size;
 	} else if (*src == '[') {
+	    Tcl_Parse *nestedPtr;
+
+	    if (noSubstCmds) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++;
+		numBytes--;
+		continue;
+	    }
+
 	    /*
-	     * Command substitution.  Call Tcl_ParseCommand recursively
-	     * (and repeatedly) to parse the nested command(s), then
-	     * throw away the parse information.
+	     * Command substitution.  Call Tcl_ParseCommand recursively (and
+	     * repeatedly) to parse the nested command(s), then throw away the
+	     * parse information.
 	     */
 
-	    src++; numBytes--;
+	    src++;
+	    numBytes--;
+	    nestedPtr = (Tcl_Parse *)
+		    TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
 	    while (1) {
-		if (Tcl_ParseCommand(parsePtr->interp, src,
-			numBytes, 1, &nested) != TCL_OK) {
-		    parsePtr->errorType = nested.errorType;
-		    parsePtr->term = nested.term;
-		    parsePtr->incomplete = nested.incomplete;
+		if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
+			nestedPtr) != TCL_OK) {
+		    parsePtr->errorType = nestedPtr->errorType;
+		    parsePtr->term = nestedPtr->term;
+		    parsePtr->incomplete = nestedPtr->incomplete;
+		    TclStackFree(parsePtr->interp, nestedPtr);
 		    return TCL_ERROR;
 		}
-		src = nested.commandStart + nested.commandSize;
+		src = nestedPtr->commandStart + nestedPtr->commandSize;
 		numBytes = parsePtr->end - src;
-
-		/*
-		 * This is equivalent to Tcl_FreeParse(&nested), but
-		 * presumably inlined here for sake of runtime optimization
-		 */
-
-		if (nested.tokenPtr != nested.staticTokens) {
-		    ckfree((char *) nested.tokenPtr);
-		}
+		Tcl_FreeParse(nestedPtr);
 
 		/*
 		 * Check for the closing ']' that ends the command
-		 * substitution.  It must have been the last character of
-		 * the parsed command.
+		 * substitution. It must have been the last character of the
+		 * parsed command.
 		 */
 
-		if ((nested.term < parsePtr->end) && (*nested.term == ']')
-			&& !nested.incomplete) {
+		if ((nestedPtr->term < parsePtr->end)
+			&& (*(nestedPtr->term) == ']')
+			&& !(nestedPtr->incomplete)) {
 		    break;
 		}
 		if (numBytes == 0) {
 		    if (parsePtr->interp != NULL) {
 			Tcl_SetResult(parsePtr->interp,
-			    "missing close-bracket", TCL_STATIC);
+				"missing close-bracket", TCL_STATIC);
 		    }
 		    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 		    parsePtr->term = tokenPtr->start;
 		    parsePtr->incomplete = 1;
+		    TclStackFree(parsePtr->interp, nestedPtr);
 		    return TCL_ERROR;
 		}
 	    }
+	    TclStackFree(parsePtr->interp, nestedPtr);
 	    tokenPtr->type = TCL_TOKEN_COMMAND;
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
 	} else if (*src == '\\') {
+	    if (noSubstBS) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++;
+		numBytes--;
+		continue;
+	    }
+
 	    /*
 	     * Backslash substitution.
 	     */
+
 	    TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
 
 	    if (tokenPtr->size == 1) {
-		/* Just a backslash, due to end of string */
+		/*
+		 * Just a backslash, due to end of string.
+		 */
+
 		tokenPtr->type = TCL_TOKEN_TEXT;
 		parsePtr->numTokens++;
-		src++; numBytes--;
+		src++;
+		numBytes--;
 		continue;
 	    }
 
@@ -913,9 +1222,9 @@ ParseTokens(src, numBytes, mask, parsePtr)
 		}
 
 		/*
-		 * Note: backslash-newline is special in that it is
-		 * treated the same as a space character would be.  This
-		 * means that it could terminate the token.
+		 * Note: backslash-newline is special in that it is treated
+		 * the same as a space character would be. This means that it
+		 * could terminate the token.
 		 */
 
 		if (mask & TYPE_SPACE) {
@@ -934,25 +1243,24 @@ ParseTokens(src, numBytes, mask, parsePtr)
 	    tokenPtr->type = TCL_TOKEN_TEXT;
 	    tokenPtr->size = 1;
 	    parsePtr->numTokens++;
-	    src++; numBytes--;
+	    src++;
+	    numBytes--;
 	} else {
-	    panic("ParseTokens encountered unknown character");
+	    Tcl_Panic("ParseTokens encountered unknown character");
 	}
     }
     if (parsePtr->numTokens == originalTokens) {
 	/*
-	 * There was nothing in this range of text.  Add an empty token
-	 * for the empty range, so that there is always at least one
-	 * token added.
+	 * There was nothing in this range of text. Add an empty token for the
+	 * empty range, so that there is always at least one token added.
 	 */
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
+
+	TclGrowParseTokenArray(parsePtr, 1);
 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
 	tokenPtr->start = src;
 	tokenPtr->numComponents = 0;
 
-	finishToken:
+    finishToken:
 	tokenPtr->type = TCL_TOKEN_TEXT;
 	tokenPtr->size = 0;
 	parsePtr->numTokens++;
@@ -960,171 +1268,112 @@ ParseTokens(src, numBytes, mask, parsePtr)
     parsePtr->term = src;
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_FreeParse --
  *
- *	This procedure is invoked to free any dynamic storage that may
- *	have been allocated by a previous call to Tcl_ParseCommand.
+ *	This function is invoked to free any dynamic storage that may have
+ *	been allocated by a previous call to Tcl_ParseCommand.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If there is any dynamically allocated memory in *parsePtr,
- *	it is freed.
+ *	If there is any dynamically allocated memory in *parsePtr, it is
+ *	freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_FreeParse(parsePtr)
-    Tcl_Parse *parsePtr;	/* Structure that was filled in by a
-				 * previous call to Tcl_ParseCommand. */
+Tcl_FreeParse(
+    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
+				 * call to Tcl_ParseCommand. */
 {
     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
 	ckfree((char *) parsePtr->tokenPtr);
 	parsePtr->tokenPtr = parsePtr->staticTokens;
     }
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclExpandTokenArray --
- *
- *	This procedure is invoked when the current space for tokens in
- *	a Tcl_Parse structure fills up; it allocates memory to grow the
- *	token array
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Memory is allocated for a new larger token array; the memory
- *	for the old array is freed, if it had been dynamically allocated.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclExpandTokenArray(parsePtr)
-    Tcl_Parse *parsePtr;	/* Parse structure whose token space
-				 * has overflowed. */
-{
-    int newCount;
-    Tcl_Token *newPtr;
-
-#define MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
-
-    if (parsePtr->tokensAvailable == MAX_TOKENS) {
-	Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", MAX_TOKENS);
-    }
-    newCount = parsePtr->tokensAvailable*2;
-    if (newCount > MAX_TOKENS) {
-	newCount = MAX_TOKENS;
-    }
-    newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
-    memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
-	    (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
-    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
-	ckfree((char *) parsePtr->tokenPtr);
-    }
-    parsePtr->tokenPtr = newPtr;
-    parsePtr->tokensAvailable = newCount;
-}
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ParseVarName --
  *
- *	Given a string starting with a $ sign, parse off a variable
- *	name and return information about the parse.  No more than
- *	numBytes bytes will be scanned.
+ *	Given a string starting with a $ sign, parse off a variable name and
+ *	return information about the parse. No more than numBytes bytes will
+ *	be scanned.
  *
  * Results:
- *	The return value is TCL_OK if the command was parsed
- *	successfully and TCL_ERROR otherwise.  If an error occurs and
- *	interp isn't NULL then an error message is left in its result. 
- *	On a successful return, tokenPtr and numTokens fields of
- *	parsePtr are filled in with information about the variable name
- *	that was parsed.  The "size" field of the first new token gives
- *	the total number of bytes in the variable name.  Other fields in
- *	parsePtr are undefined.
+ *	The return value is TCL_OK if the command was parsed successfully and
+ *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
+ *	error message is left in its result. On a successful return, tokenPtr
+ *	and numTokens fields of parsePtr are filled in with information about
+ *	the variable name that was parsed. The "size" field of the first new
+ *	token gives the total number of bytes in the variable name. Other
+ *	fields in parsePtr are undefined.
  *
  * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the command, then additional space is
- *	malloc-ed.  If the procedure returns TCL_OK then the caller must
- *	eventually invoke Tcl_FreeParse to release any additional space
- *	that was allocated.
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the command, then additional space is malloc-ed. If the function
+ *	returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
+ *	release any additional space that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting;
-				 * if NULL, then no error message is
-				 * provided. */
-    CONST char *string;		/* String containing variable name.  First
-				 * character must be "$". */
-    register int numBytes;	/* Total number of bytes in string.  If < 0,
+Tcl_ParseVarName(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
+				 * NULL, then no error message is provided. */
+    const char *start,		/* Start of variable substitution string.
+				 * First character must be "$". */
+    register int numBytes,	/* Total number of bytes in string. If < 0,
 				 * the string consists of all bytes up to the
 				 * first null character. */
-    Tcl_Parse *parsePtr;	/* Structure to fill in with information
-				 * about the variable name. */
-    int append;			/* Non-zero means append tokens to existing
+    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
+				 * the variable name. */
+    int append)			/* Non-zero means append tokens to existing
 				 * information in parsePtr; zero means ignore
-				 * existing tokens in parsePtr and reinitialize
-				 * it. */
+				 * existing tokens in parsePtr and
+				 * reinitialize it. */
 {
     Tcl_Token *tokenPtr;
-    register CONST char *src;
+    register const char *src;
     unsigned char c;
     int varIndex, offset;
     Tcl_UniChar ch;
     unsigned array;
 
-    if ((numBytes == 0) || (string == NULL)) {
+    if ((numBytes == 0) || (start == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(string);
+	numBytes = strlen(start);
     }
 
     if (!append) {
-	parsePtr->numWords = 0;
-	parsePtr->tokenPtr = parsePtr->staticTokens;
-	parsePtr->numTokens = 0;
-	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
-	parsePtr->string = string;
-	parsePtr->end = (string + numBytes);
-	parsePtr->interp = interp;
-	parsePtr->errorType = TCL_PARSE_SUCCESS;
-	parsePtr->incomplete = 0;
+	TclParseInit(interp, start, numBytes, parsePtr);
     }
 
     /*
-     * Generate one token for the variable, an additional token for the
-     * name, plus any number of additional tokens for the index, if
-     * there is one.
+     * Generate one token for the variable, an additional token for the name,
+     * plus any number of additional tokens for the index, if there is one.
      */
 
-    src = string;
-    if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
-	TclExpandTokenArray(parsePtr);
-    }
+    src = start;
+    TclGrowParseTokenArray(parsePtr, 2);
     tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
     tokenPtr->type = TCL_TOKEN_VARIABLE;
     tokenPtr->start = src;
     varIndex = parsePtr->numTokens;
     parsePtr->numTokens++;
     tokenPtr++;
-    src++; numBytes--;
+    src++;
+    numBytes--;
     if (numBytes == 0) {
 	goto justADollarSign;
     }
@@ -1134,29 +1383,30 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 
     /*
      * The name of the variable can have three forms:
-     * 1. The $ sign is followed by an open curly brace.  Then 
-     *    the variable name is everything up to the next close
-     *    curly brace, and the variable is a scalar variable.
-     * 2. The $ sign is not followed by an open curly brace.  Then
-     *    the variable name is everything up to the next
-     *    character that isn't a letter, digit, or underscore.
-     *    :: sequences are also considered part of the variable
-     *    name, in order to support namespaces. If the following
-     *    character is an open parenthesis, then the information
-     *    between parentheses is the array element name.
-     * 3. The $ sign is followed by something that isn't a letter,
-     *    digit, or underscore:  in this case, there is no variable
-     *    name and the token is just "$".
+     * 1. The $ sign is followed by an open curly brace. Then the variable
+     *	  name is everything up to the next close curly brace, and the
+     *	  variable is a scalar variable.
+     * 2. The $ sign is not followed by an open curly brace. Then the variable
+     *	  name is everything up to the next character that isn't a letter,
+     *	  digit, or underscore. :: sequences are also considered part of the
+     *	  variable name, in order to support namespaces. If the following
+     *	  character is an open parenthesis, then the information between
+     *	  parentheses is the array element name.
+     * 3. The $ sign is followed by something that isn't a letter, digit, or
+     *	  underscore: in this case, there is no variable name and the token is
+     *	  just "$".
      */
 
     if (*src == '{') {
-	src++; numBytes--;
+	src++;
+	numBytes--;
 	tokenPtr->type = TCL_TOKEN_TEXT;
 	tokenPtr->start = src;
 	tokenPtr->numComponents = 0;
 
 	while (numBytes && (*src != '}')) {
-	    numBytes--; src++;
+	    numBytes--;
+	    src++;
 	}
 	if (numBytes == 0) {
 	    if (parsePtr->interp != NULL) {
@@ -1176,24 +1426,29 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 	tokenPtr->type = TCL_TOKEN_TEXT;
 	tokenPtr->start = src;
 	tokenPtr->numComponents = 0;
+
 	while (numBytes) {
 	    if (Tcl_UtfCharComplete(src, numBytes)) {
-	        offset = Tcl_UtfToUniChar(src, &ch);
+		offset = Tcl_UtfToUniChar(src, &ch);
 	    } else {
 		char utfBytes[TCL_UTF_MAX];
+
 		memcpy(utfBytes, src, (size_t) numBytes);
 		utfBytes[numBytes] = '\0';
-	        offset = Tcl_UtfToUniChar(utfBytes, &ch);
+		offset = Tcl_UtfToUniChar(utfBytes, &ch);
 	    }
 	    c = UCHAR(ch);
-	    if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
-		src += offset;  numBytes -= offset;
+	    if (isalnum(c) || (c == '_')) {	/* INTL: ISO only, UCHAR. */
+		src += offset;
+		numBytes -= offset;
 		continue;
 	    }
 	    if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
-		src += 2; numBytes -= 2;
+		src += 2;
+		numBytes -= 2;
 		while (numBytes && (*src == ':')) {
-		    src++; numBytes--; 
+		    src++;
+		    numBytes--;
 		}
 		continue;
 	    }
@@ -1203,6 +1458,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 	/*
 	 * Support for empty array names here.
 	 */
+
 	array = (numBytes && (*src == '('));
 	tokenPtr->size = src - tokenPtr->start;
 	if ((tokenPtr->size == 0) && !array) {
@@ -1211,17 +1467,16 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 	parsePtr->numTokens++;
 	if (array) {
 	    /*
-	     * This is a reference to an array element.  Call
-	     * ParseTokens recursively to parse the element name,
-	     * since it could contain any number of substitutions.
+	     * This is a reference to an array element. Call ParseTokens
+	     * recursively to parse the element name, since it could contain
+	     * any number of substitutions.
 	     */
 
-	    if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
-		    != TCL_OK) {
+	    if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
+		    TCL_SUBST_ALL, parsePtr)) {
 		goto error;
 	    }
-	    if ((parsePtr->term == (src + numBytes)) 
-		    || (*parsePtr->term != ')')) { 
+	    if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
 		if (parsePtr->interp != NULL) {
 		    Tcl_SetResult(parsePtr->interp, "missing )",
 			    TCL_STATIC);
@@ -1240,38 +1495,37 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
     return TCL_OK;
 
     /*
-     * The dollar sign isn't followed by a variable name.
-     * replace the TCL_TOKEN_VARIABLE token with a
-     * TCL_TOKEN_TEXT token for the dollar sign.
+     * The dollar sign isn't followed by a variable name. Replace the
+     * TCL_TOKEN_VARIABLE token with a TCL_TOKEN_TEXT token for the dollar
+     * sign.
      */
 
-    justADollarSign:
+  justADollarSign:
     tokenPtr = &parsePtr->tokenPtr[varIndex];
     tokenPtr->type = TCL_TOKEN_TEXT;
     tokenPtr->size = 1;
     tokenPtr->numComponents = 0;
     return TCL_OK;
 
-    error:
+  error:
     Tcl_FreeParse(parsePtr);
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ParseVar --
  *
- *	Given a string starting with a $ sign, parse off a variable
- *	name and return its value.
+ *	Given a string starting with a $ sign, parse off a variable name and
+ *	return its value.
  *
  * Results:
- *	The return value is the contents of the variable given by
- *	the leading characters of string.  If termPtr isn't NULL,
- *	*termPtr gets filled in with the address of the character
- *	just after the last one in the variable specifier.  If the
- *	variable doesn't exist, then the return value is NULL and
- *	an error message will be left in interp's result.
+ *	The return value is the contents of the variable given by the leading
+ *	characters of string. If termPtr isn't NULL, *termPtr gets filled in
+ *	with the address of the character just after the last one in the
+ *	variable specifier. If the variable doesn't exist, then the return
+ *	value is NULL and an error message will be left in interp's result.
  *
  * Side effects:
  *	None.
@@ -1279,50 +1533,54 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_ParseVar(interp, string, termPtr)
-    Tcl_Interp *interp;			/* Context for looking up variable. */
-    register CONST char *string;	/* String containing variable name.
-					 * First character must be "$". */
-    CONST char **termPtr;		/* If non-NULL, points to word to fill
-					 * in with character just after last
-					 * one in the variable specifier. */
-
+const char *
+Tcl_ParseVar(
+    Tcl_Interp *interp,		/* Context for looking up variable. */
+    register const char *start,	/* Start of variable substitution. First
+				 * character must be "$". */
+    const char **termPtr)	/* If non-NULL, points to word to fill in with
+				 * character just after last one in the
+				 * variable specifier. */
 {
-    Tcl_Parse parse;
     register Tcl_Obj *objPtr;
     int code;
+    Tcl_Parse *parsePtr = (Tcl_Parse *)
+	    TclStackAlloc(interp, sizeof(Tcl_Parse));
 
-    if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
+    if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
+	TclStackFree(interp, parsePtr);
 	return NULL;
     }
 
     if (termPtr != NULL) {
-	*termPtr = string + parse.tokenPtr->size;
+	*termPtr = start + parsePtr->tokenPtr->size;
     }
-    if (parse.numTokens == 1) {
+    if (parsePtr->numTokens == 1) {
 	/*
 	 * There isn't a variable name after all: the $ is just a $.
 	 */
 
+	TclStackFree(interp, parsePtr);
 	return "$";
     }
 
-    code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
+    code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
+	    NULL, 1, NULL, NULL);
+    TclStackFree(interp, parsePtr);
     if (code != TCL_OK) {
 	return NULL;
     }
     objPtr = Tcl_GetObjResult(interp);
 
     /*
-     * At this point we should have an object containing the value of
-     * a variable.  Just return the string from that object.
+     * At this point we should have an object containing the value of a
+     * variable. Just return the string from that object.
      *
      * This should have returned the object for the user to manage, but
-     * instead we have some weak reference to the string value in the
-     * object, which is why we make sure the object exists after resetting
-     * the result.  This isn't ideal, but it's the best we can do with the
-     * current documented interface. -- hobbs
+     * instead we have some weak reference to the string value in the object,
+     * which is why we make sure the object exists after resetting the result.
+     * This isn't ideal, but it's the best we can do with the current
+     * documented interface. -- hobbs
      */
 
     if (!Tcl_IsShared(objPtr)) {
@@ -1331,87 +1589,75 @@ Tcl_ParseVar(interp, string, termPtr)
     Tcl_ResetResult(interp);
     return TclGetString(objPtr);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ParseBraces --
  *
  *	Given a string in braces such as a Tcl command argument or a string
- *	value in a Tcl expression, this procedure parses the string and
- *	returns information about the parse.  No more than numBytes bytes
- *	will be scanned.
+ *	value in a Tcl expression, this function parses the string and returns
+ *	information about the parse. No more than numBytes bytes will be
+ *	scanned.
  *
  * Results:
  *	The return value is TCL_OK if the string was parsed successfully and
- *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
- *	an error message is left in its result. On a successful return,
- *	tokenPtr and numTokens fields of parsePtr are filled in with
- *	information about the string that was parsed. Other fields in
- *	parsePtr are undefined. termPtr is set to point to the character
- *	just after the last one in the braced string.
+ *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
+ *	error message is left in its result. On a successful return, tokenPtr
+ *	and numTokens fields of parsePtr are filled in with information about
+ *	the string that was parsed. Other fields in parsePtr are undefined.
+ *	termPtr is set to point to the character just after the last one in
+ *	the braced string.
  *
  * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the command, then additional space is
- *	malloc-ed. If the procedure returns TCL_OK then the caller must
- *	eventually invoke Tcl_FreeParse to release any additional space
- *	that was allocated.
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the command, then additional space is malloc-ed. If the function
+ *	returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
+ *	release any additional space that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting;
-				 * if NULL, then no error message is
-				 * provided. */
-    CONST char *string;		/* String containing the string in braces.
-				 * The first character must be '{'. */
-    register int numBytes;	/* Total number of bytes in string. If < 0,
-				 * the string consists of all bytes up to
-				 * the first null character. */
-    register Tcl_Parse *parsePtr;
-    				/* Structure to fill in with information
-				 * about the string. */
-    int append;			/* Non-zero means append tokens to existing
-				 * information in parsePtr; zero means
-				 * ignore existing tokens in parsePtr and
+Tcl_ParseBraces(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
+				 * NULL, then no error message is provided. */
+    const char *start,		/* Start of string enclosed in braces. The
+				 * first character must be {'. */
+    register int numBytes,	/* Total number of bytes in string. If < 0,
+				 * the string consists of all bytes up to the
+				 * first null character. */
+    register Tcl_Parse *parsePtr,
+    				/* Structure to fill in with information about
+				 * the string. */
+    int append,			/* Non-zero means append tokens to existing
+				 * information in parsePtr; zero means ignore
+				 * existing tokens in parsePtr and
 				 * reinitialize it. */
-    CONST char **termPtr;	/* If non-NULL, points to word in which to
-				 * store a pointer to the character just
-				 * after the terminating '}' if the parse
-				 * was successful. */
-
+    const char **termPtr)	/* If non-NULL, points to word in which to
+				 * store a pointer to the character just after
+				 * the terminating '}' if the parse was
+				 * successful. */
 {
     Tcl_Token *tokenPtr;
-    register CONST char *src;
+    register const char *src;
     int startIndex, level, length;
 
-    if ((numBytes == 0) || (string == NULL)) {
+    if ((numBytes == 0) || (start == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(string);
+	numBytes = strlen(start);
     }
 
     if (!append) {
-	parsePtr->numWords = 0;
-	parsePtr->tokenPtr = parsePtr->staticTokens;
-	parsePtr->numTokens = 0;
-	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
-	parsePtr->string = string;
-	parsePtr->end = (string + numBytes);
-	parsePtr->interp = interp;
-	parsePtr->errorType = TCL_PARSE_SUCCESS;
+	TclParseInit(interp, start, numBytes, parsePtr);
     }
 
-    src = string;
+    src = start;
     startIndex = parsePtr->numTokens;
 
-    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	TclExpandTokenArray(parsePtr);
-    }
+    TclGrowParseTokenArray(parsePtr, 1);
     tokenPtr = &parsePtr->tokenPtr[startIndex];
     tokenPtr->type = TCL_TOKEN_TEXT;
     tokenPtr->start = src+1;
@@ -1424,195 +1670,189 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
 	    }
 	}
 	if (numBytes == 0) {
-	    register int openBrace = 0;
+	    goto missingBraceError;
+	}
 
-	    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
-	    parsePtr->term = string;
-	    parsePtr->incomplete = 1;
-	    if (parsePtr->interp == NULL) {
+	switch (*src) {
+	case '{':
+	    level++;
+	    break;
+	case '}':
+	    if (--level == 0) {
 		/*
-		 * Skip straight to the exit code since we have no
-		 * interpreter to put error message in.
+		 * Decide if we need to finish emitting a partially-finished
+		 * token. There are 3 cases:
+		 *     {abc \newline xyz} or {xyz}
+		 *		- finish emitting "xyz" token
+		 *     {abc \newline}
+		 *		- don't emit token after \newline
+		 *     {}	- finish emitting zero-sized token
+		 *
+		 * The last case ensures that there is a token (even if empty)
+		 * that describes the braced string.
 		 */
-		goto error;
-	    }
-
-	    Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
-
-	    /*
-	     *  Guess if the problem is due to comments by searching
-	     *  the source string for a possible open brace within the
-	     *  context of a comment.  Since we aren't performing a
-	     *  full Tcl parse, just look for an open brace preceded
-	     *  by a '<whitespace>#' on the same line.
-	     */
 
-	    while (--src > string) {
-		switch (*src) {
-		    case '{':
-			openBrace = 1;
-			break;
-		    case '\n':
-			openBrace = 0;
-			break;
-		    case '#' :
-			if (openBrace && (isspace(UCHAR(src[-1])))) {
-			    Tcl_AppendResult(parsePtr->interp,
-				    ": possible unbalanced brace in comment",
-				    (char *) NULL);
-			    goto error;
-			}
-			break;
+		if ((src != tokenPtr->start)
+			|| (parsePtr->numTokens == startIndex)) {
+		    tokenPtr->size = (src - tokenPtr->start);
+		    parsePtr->numTokens++;
 		}
+		if (termPtr != NULL) {
+		    *termPtr = src+1;
+		}
+		return TCL_OK;
 	    }
+	    break;
+	case '\\':
+	    TclParseBackslash(src, numBytes, &length, NULL);
+	    if ((length > 1) && (src[1] == '\n')) {
+		/*
+		 * A backslash-newline sequence must be collapsed, even inside
+		 * braces, so we have to split the word into multiple tokens
+		 * so that the backslash-newline can be represented
+		 * explicitly.
+		 */
 
-	    error:
-	    Tcl_FreeParse(parsePtr);
-	    return TCL_ERROR;
+		if (numBytes == 2) {
+		    parsePtr->incomplete = 1;
+		}
+		tokenPtr->size = (src - tokenPtr->start);
+		if (tokenPtr->size != 0) {
+		    parsePtr->numTokens++;
+		}
+		TclGrowParseTokenArray(parsePtr, 2);
+		tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+		tokenPtr->type = TCL_TOKEN_BS;
+		tokenPtr->start = src;
+		tokenPtr->size = length;
+		tokenPtr->numComponents = 0;
+		parsePtr->numTokens++;
+
+		src += length - 1;
+		numBytes -= length - 1;
+		tokenPtr++;
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->start = src + 1;
+		tokenPtr->numComponents = 0;
+	    } else {
+		src += length - 1;
+		numBytes -= length - 1;
+	    }
+	    break;
 	}
-	switch (*src) {
+    }
+
+  missingBraceError:
+    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
+    parsePtr->term = start;
+    parsePtr->incomplete = 1;
+    if (parsePtr->interp == NULL) {
+	/*
+	 * Skip straight to the exit code since we have no interpreter to put
+	 * error message in.
+	 */
+
+	goto error;
+    }
+
+    Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
+
+    /*
+     * Guess if the problem is due to comments by searching the source string
+     * for a possible open brace within the context of a comment. Since we
+     * aren't performing a full Tcl parse, just look for an open brace
+     * preceded by a '<whitespace>#' on the same line.
+     */
+
+    {
+	register int openBrace = 0;
+
+	while (--src > start) {
+	    switch (*src) {
 	    case '{':
-		level++;
+		openBrace = 1;
 		break;
-	    case '}':
-		if (--level == 0) {
-
-		    /*
-		     * Decide if we need to finish emitting a
-		     * partially-finished token.  There are 3 cases:
-		     *     {abc \newline xyz} or {xyz}
-		     *		- finish emitting "xyz" token
-		     *     {abc \newline}
-		     *		- don't emit token after \newline
-		     *     {}	- finish emitting zero-sized token
-		     *
-		     * The last case ensures that there is a token
-		     * (even if empty) that describes the braced string.
-		     */
-    
-		    if ((src != tokenPtr->start)
-			    || (parsePtr->numTokens == startIndex)) {
-			tokenPtr->size = (src - tokenPtr->start);
-			parsePtr->numTokens++;
-		    }
-		    if (termPtr != NULL) {
-			*termPtr = src+1;
-		    }
-		    return TCL_OK;
-		}
+	    case '\n':
+		openBrace = 0;
 		break;
-	    case '\\':
-		TclParseBackslash(src, numBytes, &length, NULL);
-		if ((length > 1) && (src[1] == '\n')) {
-		    /*
-		     * A backslash-newline sequence must be collapsed, even
-		     * inside braces, so we have to split the word into
-		     * multiple tokens so that the backslash-newline can be
-		     * represented explicitly.
-		     */
-		
-		    if (numBytes == 2) {
-			parsePtr->incomplete = 1;
-		    }
-		    tokenPtr->size = (src - tokenPtr->start);
-		    if (tokenPtr->size != 0) {
-			parsePtr->numTokens++;
-		    }
-		    if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
-			TclExpandTokenArray(parsePtr);
-		    }
-		    tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
-		    tokenPtr->type = TCL_TOKEN_BS;
-		    tokenPtr->start = src;
-		    tokenPtr->size = length;
-		    tokenPtr->numComponents = 0;
-		    parsePtr->numTokens++;
-		
-		    src += length - 1;
-		    numBytes -= length - 1;
-		    tokenPtr++;
-		    tokenPtr->type = TCL_TOKEN_TEXT;
-		    tokenPtr->start = src + 1;
-		    tokenPtr->numComponents = 0;
-		} else {
-		    src += length - 1;
-		    numBytes -= length - 1;
+	    case '#' :
+		if (openBrace && TclIsSpaceProc(src[-1])) {
+		    Tcl_AppendResult(parsePtr->interp,
+			    ": possible unbalanced brace in comment", NULL);
+		    goto error;
 		}
 		break;
+	    }
 	}
     }
-}
 
+  error:
+    Tcl_FreeParse(parsePtr);
+    return TCL_ERROR;
+}
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ParseQuotedString --
  *
- *	Given a double-quoted string such as a quoted Tcl command argument
- *	or a quoted value in a Tcl expression, this procedure parses the
- *	string and returns information about the parse.  No more than
- *	numBytes bytes will be scanned.
+ *	Given a double-quoted string such as a quoted Tcl command argument or
+ *	a quoted value in a Tcl expression, this function parses the string
+ *	and returns information about the parse. No more than numBytes bytes
+ *	will be scanned.
  *
  * Results:
  *	The return value is TCL_OK if the string was parsed successfully and
- *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
- *	an error message is left in its result. On a successful return,
- *	tokenPtr and numTokens fields of parsePtr are filled in with
- *	information about the string that was parsed. Other fields in
- *	parsePtr are undefined. termPtr is set to point to the character
- *	just after the quoted string's terminating close-quote.
+ *	TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an
+ *	error message is left in its result. On a successful return, tokenPtr
+ *	and numTokens fields of parsePtr are filled in with information about
+ *	the string that was parsed. Other fields in parsePtr are undefined.
+ *	termPtr is set to point to the character just after the quoted
+ *	string's terminating close-quote.
  *
  * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the command, then additional space is
- *	malloc-ed. If the procedure returns TCL_OK then the caller must
- *	eventually invoke Tcl_FreeParse to release any additional space
- *	that was allocated.
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the command, then additional space is malloc-ed. If the function
+ *	returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to
+ *	release any additional space that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting;
-				 * if NULL, then no error message is
-				 * provided. */
-    CONST char *string;		/* String containing the quoted string. 
-				 * The first character must be '"'. */
-    register int numBytes;	/* Total number of bytes in string. If < 0,
-				 * the string consists of all bytes up to
-				 * the first null character. */
-    register Tcl_Parse *parsePtr;
-    				/* Structure to fill in with information
-				 * about the string. */
-    int append;			/* Non-zero means append tokens to existing
-				 * information in parsePtr; zero means
-				 * ignore existing tokens in parsePtr and
+Tcl_ParseQuotedString(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
+				 * NULL, then no error message is provided. */
+    const char *start,		/* Start of the quoted string. The first
+				 * character must be '"'. */
+    register int numBytes,	/* Total number of bytes in string. If < 0,
+				 * the string consists of all bytes up to the
+				 * first null character. */
+    register Tcl_Parse *parsePtr,
+    				/* Structure to fill in with information about
+				 * the string. */
+    int append,			/* Non-zero means append tokens to existing
+				 * information in parsePtr; zero means ignore
+				 * existing tokens in parsePtr and
 				 * reinitialize it. */
-    CONST char **termPtr;	/* If non-NULL, points to word in which to
-				 * store a pointer to the character just
-				 * after the quoted string's terminating
-				 * close-quote if the parse succeeds. */
+    const char **termPtr)	/* If non-NULL, points to word in which to
+				 * store a pointer to the character just after
+				 * the quoted string's terminating close-quote
+				 * if the parse succeeds. */
 {
-    if ((numBytes == 0) || (string == NULL)) {
+    if ((numBytes == 0) || (start == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(string);
+	numBytes = strlen(start);
     }
 
     if (!append) {
-	parsePtr->numWords = 0;
-	parsePtr->tokenPtr = parsePtr->staticTokens;
-	parsePtr->numTokens = 0;
-	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
-	parsePtr->string = string;
-	parsePtr->end = (string + numBytes);
-	parsePtr->interp = interp;
-	parsePtr->errorType = TCL_PARSE_SUCCESS;
+	TclParseInit(interp, start, numBytes, parsePtr);
     }
-    
-    if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+
+    if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
+	    parsePtr)) {
 	goto error;
     }
     if (*parsePtr->term != '"') {
@@ -1620,7 +1860,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
 	    Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
 	}
 	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
-	parsePtr->term = string;
+	parsePtr->term = start;
 	parsePtr->incomplete = 1;
 	goto error;
     }
@@ -1629,24 +1869,579 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
     }
     return TCL_OK;
 
-    error:
+  error:
     Tcl_FreeParse(parsePtr);
     return TCL_ERROR;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SubstObj --
+ *
+ *	This function performs the substitutions specified on the given string
+ *	as described in the user documentation for the "subst" Tcl command.
+ *
+ * Results:
+ *	A Tcl_Obj* containing the substituted string, or NULL to indicate that
+ *	an error occurred.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_SubstObj(
+    Tcl_Interp *interp,		/* Interpreter in which substitution occurs */
+    Tcl_Obj *objPtr,		/* The value to be substituted. */
+    int flags)			/* What substitutions to do. */
+{
+    int length, tokensLeft, code;
+    Tcl_Token *endTokenPtr;
+    Tcl_Obj *result, *errMsg = NULL;
+    const char *p = TclGetStringFromObj(objPtr, &length);
+    Tcl_Parse *parsePtr = (Tcl_Parse *)
+	    TclStackAlloc(interp, sizeof(Tcl_Parse));
+
+    TclParseInit(interp, p, length, parsePtr);
+
+    /*
+     * First parse the string rep of objPtr, as if it were enclosed as a
+     * "-quoted word in a normal Tcl command. Honor flags that selectively
+     * inhibit types of substitution.
+     */
+
+    if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
+	/*
+	 * There was a parse error. Save the error message for possible
+	 * reporting later.
+	 */
+
+	errMsg = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(errMsg);
+
+	/*
+	 * We need to re-parse to get the portion of the string we can [subst]
+	 * before the parse error. Sadly, all the Tcl_Token's created by the
+	 * first parse attempt are gone, freed according to the public spec
+	 * for the Tcl_Parse* routines. The only clue we have is parse.term,
+	 * which points to either the unmatched opener, or to characters that
+	 * follow a close brace or close quote.
+	 *
+	 * Call ParseTokens again, working on the string up to parse.term.
+	 * Keep repeating until we get a good parse on a prefix.
+	 */
+
+	do {
+	    parsePtr->numTokens = 0;
+	    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+	    parsePtr->end = parsePtr->term;
+	    parsePtr->incomplete = 0;
+	    parsePtr->errorType = TCL_PARSE_SUCCESS;
+	} while (TCL_OK !=
+		ParseTokens(p, parsePtr->end - p, 0, flags, parsePtr));
+
+	/*
+	 * The good parse will have to be followed by {, (, or [.
+	 */
+
+	switch (*(parsePtr->term)) {
+	case '{':
+	    /*
+	     * Parse error was a missing } in a ${varname} variable
+	     * substitution at the toplevel. We will subst everything up to
+	     * that broken variable substitution before reporting the parse
+	     * error. Substituting the leftover '$' will have no side-effects,
+	     * so the current token stream is fine.
+	     */
+	    break;
+
+	case '(':
+	    /*
+	     * Parse error was during the parsing of the index part of an
+	     * array variable substitution at the toplevel.
+	     */
+
+	    if (*(parsePtr->term - 1) == '$') {
+		/*
+		 * Special case where removing the array index left us with
+		 * just a dollar sign (array variable with name the empty
+		 * string as its name), instead of with a scalar variable
+		 * reference.
+		 *
+		 * As in the previous case, existing token stream is OK.
+		 */
+	    } else {
+		/*
+		 * The current parse includes a successful parse of a scalar
+		 * variable substitution where there should have been an array
+		 * variable substitution. We remove that mistaken part of the
+		 * parse before moving on. A scalar variable substitution is
+		 * two tokens.
+		 */
+
+		Tcl_Token *varTokenPtr =
+			parsePtr->tokenPtr + parsePtr->numTokens - 2;
+
+		if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
+		    Tcl_Panic("Tcl_SubstObj: programming error");
+		}
+		if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
+		    Tcl_Panic("Tcl_SubstObj: programming error");
+		}
+		parsePtr->numTokens -= 2;
+	    }
+	    break;
+	case '[':
+	    /*
+	     * Parse error occurred during parsing of a toplevel command
+	     * substitution.
+	     */
+
+	    parsePtr->end = p + length;
+	    p = parsePtr->term + 1;
+	    length = parsePtr->end - p;
+	    if (length == 0) {
+		/*
+		 * No commands, just an unmatched [. As in previous cases,
+		 * existing token stream is OK.
+		 */
+	    } else {
+		/*
+		 * We want to add the parsing of as many commands as we can
+		 * within that substitution until we reach the actual parse
+		 * error. We'll do additional parsing to determine what length
+		 * to claim for the final TCL_TOKEN_COMMAND token.
+		 */
+
+		Tcl_Token *tokenPtr;
+		const char *lastTerm = parsePtr->term;
+		Tcl_Parse *nestedPtr = (Tcl_Parse *)
+			TclStackAlloc(interp, sizeof(Tcl_Parse));
+
+		while (TCL_OK ==
+			Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
+		    Tcl_FreeParse(nestedPtr);
+		    p = nestedPtr->term + (nestedPtr->term < nestedPtr->end);
+		    length = nestedPtr->end - p;
+		    if ((length == 0) && (nestedPtr->term == nestedPtr->end)) {
+			/*
+			 * If we run out of string, blame the missing close
+			 * bracket on the last command, and do not evaluate it
+			 * during substitution.
+			 */
+
+			break;
+		    }
+		    lastTerm = nestedPtr->term;
+		}
+		TclStackFree(interp, nestedPtr);
+
+		if (lastTerm == parsePtr->term) {
+		    /*
+		     * Parse error in first command. No commands to subst, add
+		     * no more tokens.
+		     */
+		    break;
+		}
+
+		/*
+		 * Create a command substitution token for whatever commands
+		 * got parsed.
+		 */
+
+		TclGrowParseTokenArray(parsePtr, 1);
+		tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]);
+		tokenPtr->start = parsePtr->term;
+		tokenPtr->numComponents = 0;
+		tokenPtr->type = TCL_TOKEN_COMMAND;
+		tokenPtr->size = lastTerm - tokenPtr->start + 1;
+		parsePtr->numTokens++;
+	    }
+	    break;
+
+	default:
+	    Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
+	}
+    }
 
+    /*
+     * Next, substitute the parsed tokens just as in normal Tcl evaluation.
+     */
+
+    endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+    tokensLeft = parsePtr->numTokens;
+    code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+	    &tokensLeft, 1, NULL, NULL);
+    if (code == TCL_OK) {
+	Tcl_FreeParse(parsePtr);
+	TclStackFree(interp, parsePtr);
+	if (errMsg != NULL) {
+	    Tcl_SetObjResult(interp, errMsg);
+	    Tcl_DecrRefCount(errMsg);
+	    return NULL;
+	}
+	return Tcl_GetObjResult(interp);
+    }
+
+    result = Tcl_NewObj();
+    while (1) {
+	switch (code) {
+	case TCL_ERROR:
+	    Tcl_FreeParse(parsePtr);
+	    TclStackFree(interp, parsePtr);
+	    Tcl_DecrRefCount(result);
+	    if (errMsg != NULL) {
+		Tcl_DecrRefCount(errMsg);
+	    }
+	    return NULL;
+	case TCL_BREAK:
+	    tokensLeft = 0;		/* Halt substitution */
+	default:
+	    Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
+	}
+
+	if (tokensLeft == 0) {
+	    Tcl_FreeParse(parsePtr);
+	    TclStackFree(interp, parsePtr);
+	    if (errMsg != NULL) {
+		if (code != TCL_BREAK) {
+		    Tcl_DecrRefCount(result);
+		    Tcl_SetObjResult(interp, errMsg);
+		    Tcl_DecrRefCount(errMsg);
+		    return NULL;
+		}
+		Tcl_DecrRefCount(errMsg);
+	    }
+	    return result;
+	}
+
+	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+		&tokensLeft, 1, NULL, NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSubstTokens --
+ *
+ *	Accepts an array of count Tcl_Token's, and creates a result value in
+ *	the interp from concatenating the results of performing Tcl
+ *	substitution on each Tcl_Token. Substitution is interrupted if any
+ *	non-TCL_OK completion code arises.
+ *
+ * Results:
+ * 	The return value is a standard Tcl completion code. The result in
+ * 	interp is the substituted value, or an error message if TCL_ERROR is
+ * 	returned. If tokensLeftPtr is not NULL, then it points to an int where
+ * 	the number of tokens remaining to be processed is written.
+ *
+ * Side effects:
+ * 	Can be anything, depending on the types of substitution done.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSubstTokens(
+    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
+				 * execute nested commands, and report
+				 * errors. */
+    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
+				 * evaluate and concatenate. */
+    int count,			/* Number of tokens to consider at tokenPtr.
+				 * Must be at least 1. */
+    int *tokensLeftPtr,		/* If not NULL, points to memory where an
+				 * integer representing the number of tokens
+				 * left to be substituted will be written */
+    int line,			/* The line the script starts on. */
+    int*  clNextOuter,       /* Information about an outer context for */
+    CONST char* outerScript) /* continuation line data. This is set by
+			      * EvalEx() to properly handle [...]-nested
+			      * commands. The 'outerScript' refers to the
+			      * most-outer script containing the embedded
+			      * command, which is refered to by 'script'. The
+			      * 'clNextOuter' refers to the current entry in
+			      * the table of continuation lines in this
+			      * "master script", and the character offsets are
+			      * relative to the 'outerScript' as well.
+			      *
+			      * If outerScript == script, then this call is for
+			      * words in the outer-most script/command. See
+			      * Tcl_EvalEx() and TclEvalObjEx() for the places
+			      * generating arguments for which this is true.
+			      */
+{
+    Tcl_Obj *result;
+    int code = TCL_OK;
+#define NUM_STATIC_POS 20
+    int isLiteral, maxNumCL, numCL, i, adjust;
+    int* clPosition = NULL;
+    Interp* iPtr = (Interp*) interp;
+    int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
+
+    /*
+     * Each pass through this loop will substitute one token, and its
+     * components, if any. The only thing tricky here is that we go to some
+     * effort to pass Tcl_Obj's through untouched, to avoid string copying and
+     * Tcl_Obj creation if possible, to aid performance and limit shimmering.
+     *
+     * Further optimization opportunities might be to check for the equivalent
+     * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
+     */
+
+    /*
+     * For the handling of continuation lines in literals we first check if
+     * this is actually a literal. For if not we can forego the additional
+     * processing. Otherwise we pre-allocate a small table to store the
+     * locations of all continuation lines we find in this literal, if
+     * any. The table is extended if needed.
+     */
+
+    numCL     = 0;
+    maxNumCL  = 0;
+    isLiteral = 1;
+    for (i=0 ; i < count; i++) {
+	if ((tokenPtr[i].type != TCL_TOKEN_TEXT) &&
+	    (tokenPtr[i].type != TCL_TOKEN_BS)) {
+	    isLiteral = 0;
+	    break;
+	}
+    }
+
+    if (isLiteral) {
+	maxNumCL   = NUM_STATIC_POS;
+	clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
+    }
+
+    adjust = 0;
+    result = NULL;
+    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
+	Tcl_Obj *appendObj = NULL;
+	const char *append = NULL;
+	int appendByteLength = 0;
+	char utfCharBytes[TCL_UTF_MAX];
+
+	switch (tokenPtr->type) {
+	case TCL_TOKEN_TEXT:
+	    append = tokenPtr->start;
+	    appendByteLength = tokenPtr->size;
+	    break;
+
+	case TCL_TOKEN_BS:
+	    appendByteLength = TclParseBackslash(tokenPtr->start,
+		    tokenPtr->size, NULL, utfCharBytes);
+	    append = utfCharBytes;
+	    /*
+	     * If the backslash sequence we found is in a literal, and
+	     * represented a continuation line, we compute and store its
+	     * location (as char offset to the beginning of the _result_
+	     * script). We may have to extend the table of locations.
+	     *
+	     * Note that the continuation line information is relevant even if
+	     * the word we are processing is not a literal, as it can affect
+	     * nested commands. See the branch for TCL_TOKEN_COMMAND below,
+	     * where the adjustment we are tracking here is taken into
+	     * account. The good thing is that we do not need a table of
+	     * everything, just the number of lines we have to add as
+	     * correction.
+	     */
+
+	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') &&
+		(tokenPtr->start[1] == '\n')) {
+		if (isLiteral) {
+		    int clPos;
+		    if (result == 0) {
+			clPos = 0;
+		    } else {
+			Tcl_GetStringFromObj(result, &clPos);
+		    }
+
+		    if (numCL >= maxNumCL) {
+			maxNumCL *= 2;
+			clPosition = (int*) ckrealloc ((char*)clPosition,
+						       maxNumCL*sizeof(int));
+		    }
+		    clPosition[numCL] = clPos;
+		    numCL ++;
+		}
+		adjust ++;
+	    }
+	    break;
+
+	case TCL_TOKEN_COMMAND: {
+	    Interp *iPtr = (Interp *) interp;
+
+	    iPtr->numLevels++;
+	    code = TclInterpReady(interp);
+	    if (code == TCL_OK) {
+		/*
+		 * Test cases: info-30.{6,8,9}
+		 */
+
+		int theline;
+		TclAdvanceContinuations (&line, &clNextOuter,
+					 tokenPtr->start - outerScript);
+		theline = line + adjust;
+		/* TIP #280: Transfer line information to nested command */
+		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+			0, theline, clNextOuter, outerScript);
+		/*
+		 * Restore flag reset by nested eval for future bracketed
+		 * commands and their cmdframe setup
+		 */
+	        if (inFile) {
+		    iPtr->evalFlags |= TCL_EVAL_FILE;
+		}
+	    }
+	    iPtr->numLevels--;
+	    appendObj = Tcl_GetObjResult(interp);
+	    break;
+	}
+
+	case TCL_TOKEN_VARIABLE: {
+	    Tcl_Obj *arrayIndex = NULL;
+	    Tcl_Obj *varName = NULL;
+
+	    if (tokenPtr->numComponents > 1) {
+		/*
+		 * Subst the index part of an array variable reference.
+		 */
+
+		code = TclSubstTokens(interp, tokenPtr+2,
+			tokenPtr->numComponents - 1, NULL, line, NULL, NULL);
+		arrayIndex = Tcl_GetObjResult(interp);
+		Tcl_IncrRefCount(arrayIndex);
+	    }
+
+	    if (code == TCL_OK) {
+		varName = Tcl_NewStringObj(tokenPtr[1].start,
+			tokenPtr[1].size);
+		appendObj = Tcl_ObjGetVar2(interp, varName, arrayIndex,
+			TCL_LEAVE_ERR_MSG);
+		Tcl_DecrRefCount(varName);
+		if (appendObj == NULL) {
+		    code = TCL_ERROR;
+		}
+	    }
+
+	    switch (code) {
+	    case TCL_OK:	/* Got value */
+	    case TCL_ERROR:	/* Already have error message */
+	    case TCL_BREAK:	/* Will not substitute anyway */
+	    case TCL_CONTINUE:	/* Will not substitute anyway */
+		break;
+	    default:
+		/*
+		 * All other return codes, we will subst the result from the
+		 * code-throwing evaluation.
+		 */
+
+		appendObj = Tcl_GetObjResult(interp);
+	    }
+
+	    if (arrayIndex != NULL) {
+		Tcl_DecrRefCount(arrayIndex);
+	    }
+	    count -= tokenPtr->numComponents;
+	    tokenPtr += tokenPtr->numComponents;
+	    break;
+	}
+
+	default:
+	    Tcl_Panic("unexpected token type in TclSubstTokens: %d",
+		    tokenPtr->type);
+	}
+
+	if ((code == TCL_BREAK) || (code == TCL_CONTINUE)) {
+	    /*
+	     * Inhibit substitution.
+	     */
+	    continue;
+	}
+
+	if (result == NULL) {
+	    /*
+	     * First pass through. If we have a Tcl_Obj, just use it. If not,
+	     * create one from our string.
+	     */
+
+	    if (appendObj != NULL) {
+		result = appendObj;
+	    } else {
+		result = Tcl_NewStringObj(append, appendByteLength);
+	    }
+	    Tcl_IncrRefCount(result);
+	} else {
+	    /*
+	     * Subsequent passes. Append to result.
+	     */
+
+	    if (Tcl_IsShared(result)) {
+		Tcl_DecrRefCount(result);
+		result = Tcl_DuplicateObj(result);
+		Tcl_IncrRefCount(result);
+	    }
+	    if (appendObj != NULL) {
+		Tcl_AppendObjToObj(result, appendObj);
+	    } else {
+		Tcl_AppendToObj(result, append, appendByteLength);
+	    }
+	}
+    }
+
+    if (code != TCL_ERROR) {		/* Keep error message in result! */
+	if (result != NULL) {
+	    Tcl_SetObjResult(interp, result);
+	    /*
+	     * If the code found continuation lines (which implies that this
+	     * word is a literal), then we store the accumulated table of
+	     * locations in the thread-global data structure for the bytecode
+	     * compiler to find later, assuming that the literal is a script
+	     * which will be compiled.
+	     */
+
+	    if (numCL) {
+		TclContinuationsEnter(result, numCL, clPosition);
+	    }
+
+	    /*
+	     * Release the temp table we used to collect the locations of
+	     * continuation lines, if any.
+	     */
+
+	    if (maxNumCL) {
+		ckfree ((char*) clPosition);
+	    }
+	} else {
+	    Tcl_ResetResult(interp);
+	}
+    }
+    if (tokensLeftPtr != NULL) {
+	*tokensLeftPtr = count;
+    }
+    if (result != NULL) {
+	Tcl_DecrRefCount(result);
+    }
+    return code;
+}
+
 /*
  *----------------------------------------------------------------------
  *
  * CommandComplete --
  *
- *	This procedure is shared by TclCommandComplete and
- *	Tcl_ObjCommandcoComplete; it does all the real work of seeing
- *	whether a script is complete
+ *	This function is shared by TclCommandComplete and
+ *	Tcl_ObjCommandComplete; it does all the real work of seeing whether a
+ *	script is complete
  *
  * Results:
  *	1 is returned if the script is complete, 0 if there are open
- *	delimiters such as " or (. 1 is also returned if there is a
- *	parse error in the script other than unmatched delimiters.
+ *	delimiters such as " or (. 1 is also returned if there is a parse
+ *	error in the script other than unmatched delimiters.
  *
  * Side effects:
  *	None.
@@ -1654,19 +2449,18 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
  *----------------------------------------------------------------------
  */
 
-static int
-CommandComplete(script, numBytes)
-    CONST char *script;			/* Script to check. */
-    int numBytes;			/* Number of bytes in script. */
+static inline int
+CommandComplete(
+    const char *script,		/* Script to check. */
+    int numBytes)		/* Number of bytes in script. */
 {
     Tcl_Parse parse;
-    CONST char *p, *end;
+    const char *p, *end;
     int result;
 
     p = script;
     end = p + numBytes;
-    while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
-	    == TCL_OK) {
+    while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) {
 	p = parse.commandStart + parse.commandSize;
 	if (p >= end) {
 	    break;
@@ -1681,20 +2475,20 @@ CommandComplete(script, numBytes)
     Tcl_FreeParse(&parse);
     return result;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_CommandComplete --
  *
- *	Given a partial or complete Tcl script, this procedure
- *	determines whether the script is complete in the sense
- *	of having matched braces and quotes and brackets.
+ *	Given a partial or complete Tcl script, this function determines
+ *	whether the script is complete in the sense of having matched braces
+ *	and quotes and brackets.
  *
  * Results:
- *	1 is returned if the script is complete, 0 otherwise.
- *	1 is also returned if there is a parse error in the script
- *	other than unmatched delimiters.
+ *	1 is returned if the script is complete, 0 otherwise. 1 is also
+ *	returned if there is a parse error in the script other than unmatched
+ *	delimiters.
  *
  * Side effects:
  *	None.
@@ -1703,20 +2497,20 @@ CommandComplete(script, numBytes)
  */
 
 int
-Tcl_CommandComplete(script)
-    CONST char *script;			/* Script to check. */
+Tcl_CommandComplete(
+    const char *script)		/* Script to check. */
 {
     return CommandComplete(script, (int) strlen(script));
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * TclObjCommandComplete --
  *
- *	Given a partial or complete Tcl command in a Tcl object, this
- *	procedure determines whether the command is complete in the sense of
- *	having matched braces and quotes and brackets.
+ *	Given a partial or complete Tcl command in a Tcl object, this function
+ *	determines whether the command is complete in the sense of having
+ *	matched braces and quotes and brackets.
  *
  * Results:
  *	1 is returned if the command is complete, 0 otherwise.
@@ -1728,24 +2522,23 @@ Tcl_CommandComplete(script)
  */
 
 int
-TclObjCommandComplete(objPtr)
-    Tcl_Obj *objPtr;			/* Points to object holding script
-					 * to check. */
+TclObjCommandComplete(
+    Tcl_Obj *objPtr)		/* Points to object holding script to
+				 * check. */
 {
-    CONST char *script;
     int length;
+    const char *script = Tcl_GetStringFromObj(objPtr, &length);
 
-    script = Tcl_GetStringFromObj(objPtr, &length);
     return CommandComplete(script, length);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * TclIsLocalScalar --
  *
- *	Check to see if a given string is a legal scalar variable
- *	name with no namespace qualifiers or substitutions.
+ *	Check to see if a given string is a legal scalar variable name with no
+ *	namespace qualifiers or substitutions.
  *
  * Results:
  *	Returns 1 if the variable is a local scalar.
@@ -1757,34 +2550,42 @@ TclObjCommandComplete(objPtr)
  */
 
 int
-TclIsLocalScalar(src, len)
-    CONST char *src;
-    int len;
+TclIsLocalScalar(
+    const char *src,
+    int len)
 {
-    CONST char *p;
-    CONST char *lastChar = src + (len - 1);
+    const char *p;
+    const char *lastChar = src + (len - 1);
 
-    for (p = src; p <= lastChar; p++) {
+    for (p=src ; p<=lastChar ; p++) {
 	if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
 		(CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
 	    /*
-	     * TCL_COMMAND_END is returned for the last character
-	     * of the string.  By this point we know it isn't
-	     * an array or namespace reference.
+	     * TCL_COMMAND_END is returned for the last character of the
+	     * string. By this point we know it isn't an array or namespace
+	     * reference.
 	     */
 
 	    return 0;
 	}
-	if  (*p == '(') {
-	    if (*lastChar == ')') { /* we have an array element */
+	if (*p == '(') {
+	    if (*lastChar == ')') {	/* We have an array element */
 		return 0;
 	    }
 	} else if (*p == ':') {
-	    if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+	    if ((p != lastChar) && *(p+1) == ':') {	/* qualified name */
 		return 0;
 	    }
 	}
     }
-	
+
     return 1;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
deleted file mode 100644
index e07b7e7..0000000
--- a/generic/tclParseExpr.c
+++ /dev/null
@@ -1,2083 +0,0 @@
-/* 
- * tclParseExpr.c --
- *
- *	This file contains procedures that parse Tcl expressions. They
- *	do so in a general-purpose fashion that can be used for many
- *	different purposes, including compilation, direct execution,
- *	code analysis, etc.
- *
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-/*
- * 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 arrange to use
- * the errno from tclExecute.c here.
- */
-
-#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#else
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-extern int errno;			/* Use errno from tclExecute.c. */
-#define ERANGE 34
-#endif
-
-/*
- * Boolean variable that controls whether expression parse tracing
- * is enabled.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static int traceParseExpr = 0;
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- * The ParseInfo structure holds state while parsing an expression.
- * A pointer to an ParseInfo record is passed among the routines in
- * this module.
- */
-
-typedef struct ParseInfo {
-    Tcl_Parse *parsePtr;	/* Points to structure to fill in with
-				 * information about the expression. */
-    int lexeme;			/* Type of last lexeme scanned in expr.
-				 * See below for definitions. Corresponds to
-				 * size characters beginning at start. */
-    CONST char *start;		/* First character in lexeme. */
-    int size;			/* Number of bytes in lexeme. */
-    CONST char *next;		/* Position of the next character to be
-				 * scanned in the expression string. */
-    CONST char *prevEnd;	/* Points to the character just after the
-				 * last one in the previous lexeme. Used to
-				 * compute size of subexpression tokens. */
-    CONST char *originalExpr;	/* Points to the start of the expression
-				 * originally passed to Tcl_ParseExpr. */
-    CONST char *lastChar;	/* Points just after last byte of expr. */
-} ParseInfo;
-
-/*
- * Definitions of the different lexemes that appear in expressions. The
- * order of these must match the corresponding entries in the
- * operatorStrings array below.
- *
- * Basic lexemes:
- */
-
-#define LITERAL		0
-#define FUNC_NAME	1
-#define OPEN_BRACKET	2
-#define OPEN_BRACE	3
-#define OPEN_PAREN	4
-#define CLOSE_PAREN	5
-#define DOLLAR		6
-#define QUOTE		7
-#define COMMA		8
-#define END		9
-#define UNKNOWN		10
-#define UNKNOWN_CHAR	11
-
-/*
- * Binary numeric operators:
- */
-
-#define MULT		12
-#define DIVIDE		13
-#define MOD		14
-#define PLUS		15
-#define MINUS		16
-#define LEFT_SHIFT	17
-#define RIGHT_SHIFT	18
-#define LESS		19
-#define GREATER		20
-#define LEQ		21
-#define GEQ		22
-#define EQUAL		23
-#define NEQ		24
-#define BIT_AND		25
-#define BIT_XOR		26
-#define BIT_OR		27
-#define AND		28
-#define OR		29
-#define QUESTY		30
-#define COLON		31
-
-/*
- * Unary operators. Unary minus and plus are represented by the (binary)
- * lexemes MINUS and PLUS.
- */
-
-#define NOT		32
-#define BIT_NOT		33
-
-/*
- * Binary string operators:
- */
-
-#define STREQ		34
-#define STRNEQ		35
-
-/*
- * Mapping from lexemes to strings; used for debugging messages. These
- * entries must match the order and number of the lexeme definitions above.
- */
-
-static CONST char *CONST lexemeStrings[] = {
-    "LITERAL", "FUNCNAME",
-    "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
-    "*", "/", "%", "+", "-",
-    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
-    "&", "^", "|", "&&", "||", "?", ":",
-    "!", "~", "eq", "ne",
-};
-
-/*
- * Declarations for local procedures to this file:
- */
-
-static int		GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
-static void		LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
-				CONST char *extraInfo));
-static int		ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
-				CONST char *end));
-static int		ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static int		ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static void		PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
-				int opBytes, CONST char *src, int srcBytes,
-				int firstIndex, ParseInfo *infoPtr));
-
-/*
- * Macro used to debug the execution of the recursive descent parser used
- * to parse expressions.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-#define HERE(production, level) \
-    if (traceParseExpr) { \
-	fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
-		(level), " ", (production), \
-		lexemeStrings[infoPtr->lexeme], infoPtr->next); \
-    }
-#else
-#define HERE(production, level)
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ParseExpr --
- *
- *	Given a string, this procedure parses the first Tcl expression
- *	in the string and returns information about the structure of
- *	the expression. This procedure is the top-level interface to the
- *	the expression parsing module.  No more that numBytes bytes will
- *	be scanned.
- *
- * Results:
- *	The return value is TCL_OK if the command was parsed successfully
- *	and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
- *	then an error message is left in its result. On a successful return,
- *	parsePtr is filled in with information about the expression that 
- *	was parsed.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the expression, then additional space is
- *	malloc-ed. If the procedure returns TCL_OK then the caller must
- *	eventually invoke Tcl_FreeParse to release any additional space
- *	that was allocated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ParseExpr(interp, string, numBytes, parsePtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    CONST char *string;		/* The source string to parse. */
-    int numBytes;		/* Number of bytes in string. If < 0, the
-				 * string consists of all bytes up to the
-				 * first null character. */
-    Tcl_Parse *parsePtr;	/* Structure to fill with information about
-				 * the parsed expression; any previous
-				 * information in the structure is
-				 * ignored. */
-{
-    ParseInfo info;
-    int code;
-
-    if (numBytes < 0) {
-	numBytes = (string? strlen(string) : 0);
-    }
-#ifdef TCL_COMPILE_DEBUG
-    if (traceParseExpr) {
-	fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
-	        numBytes, string);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-    
-    parsePtr->commentStart = NULL;
-    parsePtr->commentSize = 0;
-    parsePtr->commandStart = NULL;
-    parsePtr->commandSize = 0;
-    parsePtr->numWords = 0;
-    parsePtr->tokenPtr = parsePtr->staticTokens;
-    parsePtr->numTokens = 0;
-    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
-    parsePtr->string = string;
-    parsePtr->end = (string + numBytes);
-    parsePtr->interp = interp;
-    parsePtr->term = string;
-    parsePtr->incomplete = 0;
-
-    /*
-     * Initialize the ParseInfo structure that holds state while parsing
-     * the expression.
-     */
-
-    info.parsePtr = parsePtr;
-    info.lexeme = UNKNOWN;
-    info.start = NULL;
-    info.size = 0;
-    info.next = string;
-    info.prevEnd = string;
-    info.originalExpr = string;
-    info.lastChar = (string + numBytes); /* just after last char of expr */
-
-    /*
-     * Get the first lexeme then parse the expression.
-     */
-
-    code = GetLexeme(&info);
-    if (code != TCL_OK) {
-	goto error;
-    }
-    code = ParseCondExpr(&info);
-    if (code != TCL_OK) {
-	goto error;
-    }
-    if (info.lexeme != END) {
-	LogSyntaxError(&info, "extra tokens at end of expression");
-	goto error;
-    }
-    return TCL_OK;
-    
-    error:
-    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
-	ckfree((char *) parsePtr->tokenPtr);
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseCondExpr --
- *
- *	This procedure parses a Tcl conditional expression:
- *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
- *
- *	Note that this is the topmost recursive-descent parsing routine used
- *	by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
- *	call since such a procedure would only return the result of calling
- *	ParseCondExpr. Other recursive-descent procedures that need to parse
- *	complete expressions also call ParseCondExpr.
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseCondExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
-    int firstIndex, numToMove, code;
-    CONST char *srcStart;
-    
-    HERE("condExpr", 1);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseLorExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-    
-    if (infoPtr->lexeme == QUESTY) {
-	/*
-	 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
-	 * conditional expression, and a TCL_TOKEN_OPERATOR token for 
-	 * the "?" operator. Note that these two tokens must be inserted
-	 * before the LOR operand tokens generated above.
-	 */
-
-	if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
-	firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
-	tokenPtr = (firstTokenPtr + 2);
-	numToMove = (parsePtr->numTokens - firstIndex);
-	memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
-	        (size_t) (numToMove * sizeof(Tcl_Token)));
-	parsePtr->numTokens += 2;
-	
-	tokenPtr = firstTokenPtr;
-	tokenPtr->type = TCL_TOKEN_SUB_EXPR;
-	tokenPtr->start = srcStart;
-	
-	tokenPtr++;
-	tokenPtr->type = TCL_TOKEN_OPERATOR;
-	tokenPtr->start = infoPtr->start;
-	tokenPtr->size = 1;
-	tokenPtr->numComponents = 0;
-    
-	/*
-	 * Skip over the '?'.
-	 */
-	
-	code = GetLexeme(infoPtr); 
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Parse the "then" expression.
-	 */
-
-	code = ParseCondExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	if (infoPtr->lexeme != COLON) {
-	    LogSyntaxError(infoPtr, "missing colon from ternary conditional");
-	    return TCL_ERROR;
-	}
-	code = GetLexeme(infoPtr); /* skip over the ':' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Parse the "else" expression.
-	 */
-
-	code = ParseCondExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Now set the size-related fields in the '?' subexpression token.
-	 */
-
-	condTokenPtr = &parsePtr->tokenPtr[firstIndex];
-	condTokenPtr->size = (infoPtr->prevEnd - srcStart);
-	condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLorExpr --
- *
- *	This procedure parses a Tcl logical or expression:
- *	lorExpr ::= landExpr {'||' landExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseLorExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, code;
-    CONST char *srcStart, *operator;
-    
-    HERE("lorExpr", 2);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseLandExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    while (infoPtr->lexeme == OR) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the '||' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseLandExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the LOR subexpression and the '||' operator.
-	 */
-
-	PrependSubExprTokens(operator, 2, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseLandExpr --
- *
- *	This procedure parses a Tcl logical and expression:
- *	landExpr ::= bitOrExpr {'&&' bitOrExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseLandExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, code;
-    CONST char *srcStart, *operator;
-
-    HERE("landExpr", 3);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseBitOrExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    while (infoPtr->lexeme == AND) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the '&&' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseBitOrExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the LAND subexpression and the '&&' operator.
-	 */
-
-	PrependSubExprTokens(operator, 2, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitOrExpr --
- *
- *	This procedure parses a Tcl bitwise or expression:
- *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitOrExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, code;
-    CONST char *srcStart, *operator;
-
-    HERE("bitOrExpr", 4);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseBitXorExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-    
-    while (infoPtr->lexeme == BIT_OR) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the '|' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	code = ParseBitXorExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	
-	/*
-	 * Generate tokens for the BITOR subexpression and the '|' operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitXorExpr --
- *
- *	This procedure parses a Tcl bitwise exclusive or expression:
- *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitXorExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, code;
-    CONST char *srcStart, *operator;
-
-    HERE("bitXorExpr", 5);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseBitAndExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-    
-    while (infoPtr->lexeme == BIT_XOR) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the '^' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	code = ParseBitAndExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	
-	/*
-	 * Generate tokens for the XOR subexpression and the '^' operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseBitAndExpr --
- *
- *	This procedure parses a Tcl bitwise and expression:
- *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseBitAndExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, code;
-    CONST char *srcStart, *operator;
-
-    HERE("bitAndExpr", 6);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseEqualityExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-    
-    while (infoPtr->lexeme == BIT_AND) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the '&' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseEqualityExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	
-	/*
-	 * Generate tokens for the BITAND subexpression and '&' operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseEqualityExpr --
- *
- *	This procedure parses a Tcl equality (inequality) expression:
- *	equalityExpr ::= relationalExpr
- *		{('==' | '!=' | 'ne' | 'eq') relationalExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseEqualityExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, code;
-    CONST char *srcStart, *operator;
-
-    HERE("equalityExpr", 7);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseRelationalExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    lexeme = infoPtr->lexeme;
-    while ((lexeme == EQUAL) || (lexeme == NEQ)
-	    || (lexeme == STREQ) || (lexeme == STRNEQ)) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseRelationalExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
-	 * operator.
-	 */
-
-	PrependSubExprTokens(operator, 2, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-	lexeme = infoPtr->lexeme;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseRelationalExpr --
- *
- *	This procedure parses a Tcl relational expression:
- *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseRelationalExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, operatorSize, code;
-    CONST char *srcStart, *operator;
-
-    HERE("relationalExpr", 8);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseShiftExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    lexeme = infoPtr->lexeme;
-    while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
-            || (lexeme == GEQ)) {
-	operator = infoPtr->start;
-	if ((lexeme == LEQ) || (lexeme == GEQ)) {
-	    operatorSize = 2;
-	} else {
-	    operatorSize = 1;
-	}
-	code = GetLexeme(infoPtr); /* skip over the operator */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseShiftExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and the operator.
-	 */
-
-	PrependSubExprTokens(operator, operatorSize, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-	lexeme = infoPtr->lexeme;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseShiftExpr --
- *
- *	This procedure parses a Tcl shift expression:
- *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseShiftExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, code;
-    CONST char *srcStart, *operator;
-
-    HERE("shiftExpr", 9);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseAddExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    lexeme = infoPtr->lexeme;
-    while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over << or >> */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseAddExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and '<<' or '>>' operator.
-	 */
-
-	PrependSubExprTokens(operator, 2, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-	lexeme = infoPtr->lexeme;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseAddExpr --
- *
- *	This procedure parses a Tcl addition expression:
- *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseAddExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, code;
-    CONST char *srcStart, *operator;
-
-    HERE("addExpr", 10);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseMultiplyExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    lexeme = infoPtr->lexeme;
-    while ((lexeme == PLUS) || (lexeme == MINUS)) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over + or - */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseMultiplyExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and '+' or '-' operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-	lexeme = infoPtr->lexeme;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseMultiplyExpr --
- *
- *	This procedure parses a Tcl multiply expression:
- *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseMultiplyExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, code;
-    CONST char *srcStart, *operator;
-
-    HERE("multiplyExpr", 11);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    code = ParseUnaryExpr(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    lexeme = infoPtr->lexeme;
-    while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over * or / or % */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseUnaryExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and * or / or % operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-	lexeme = infoPtr->lexeme;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseUnaryExpr --
- *
- *	This procedure parses a Tcl unary expression:
- *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseUnaryExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    int firstIndex, lexeme, code;
-    CONST char *srcStart, *operator;
-
-    HERE("unaryExpr", 12);
-    srcStart = infoPtr->start;
-    firstIndex = parsePtr->numTokens;
-    
-    lexeme = infoPtr->lexeme;
-    if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
-            || (lexeme == NOT)) {
-	operator = infoPtr->start;
-	code = GetLexeme(infoPtr); /* skip over the unary operator */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseUnaryExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	/*
-	 * Generate tokens for the subexpression and the operator.
-	 */
-
-	PrependSubExprTokens(operator, 1, srcStart,
-	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
-    } else {			/* must be a primaryExpr */
-	code = ParsePrimaryExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParsePrimaryExpr --
- *
- *	This procedure parses a Tcl primary expression:
- *	primaryExpr ::= literal | varReference | quotedString |
- *			'[' command ']' | mathFuncCall | '(' condExpr ')'
- *
- * Results:
- *	The return value is TCL_OK on a successful parse and TCL_ERROR
- *	on failure. If TCL_ERROR is returned, then the interpreter's result
- *	contains an error message.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParsePrimaryExpr(infoPtr)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    Tcl_Interp *interp = parsePtr->interp;
-    Tcl_Token *tokenPtr, *exprTokenPtr;
-    Tcl_Parse nested;
-    CONST char *dollarPtr, *stringStart, *termPtr, *src;
-    int lexeme, exprIndex, firstIndex, numToMove, code;
-
-    /*
-     * We simply recurse on parenthesized subexpressions.
-     */
-
-    HERE("primaryExpr", 13);
-    lexeme = infoPtr->lexeme;
-    if (lexeme == OPEN_PAREN) {
-	code = GetLexeme(infoPtr); /* skip over the '(' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	code = ParseCondExpr(infoPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	if (infoPtr->lexeme != CLOSE_PAREN) {
-	    LogSyntaxError(infoPtr, "looking for close parenthesis");
-	    return TCL_ERROR;
-	}
-	code = GetLexeme(infoPtr); /* skip over the ')' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	return TCL_OK;
-    }
-
-    /*
-     * Start a TCL_TOKEN_SUB_EXPR token for the primary.
-     */
-
-    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	TclExpandTokenArray(parsePtr);
-    }
-    exprIndex = parsePtr->numTokens;
-    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-    exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
-    exprTokenPtr->start = infoPtr->start;
-    parsePtr->numTokens++;
-
-    /*
-     * Process the primary then finish setting the fields of the
-     * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
-     * stored in "exprTokenPtr" in the code below since the token array
-     * might be reallocated.
-     */
-
-    firstIndex = parsePtr->numTokens;
-    switch (lexeme) {
-    case LITERAL:
-	/*
-	 * Int or double number.
-	 */
-	
-	tokenizeLiteral:
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
-	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
-	tokenPtr->type = TCL_TOKEN_TEXT;
-	tokenPtr->start = infoPtr->start;
-	tokenPtr->size = infoPtr->size;
-	tokenPtr->numComponents = 0;
-	parsePtr->numTokens++;
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = infoPtr->size;
-	exprTokenPtr->numComponents = 1;
-	break;
-
-    case DOLLAR:
-	/*
-	 * $var variable reference.
-	 */
-	
-	dollarPtr = (infoPtr->next - 1);
-	code = Tcl_ParseVarName(interp, dollarPtr,
-	        (infoPtr->lastChar - dollarPtr), parsePtr, 1);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
-	exprTokenPtr->numComponents =
-	        (parsePtr->tokenPtr[firstIndex].numComponents + 1);
-	break;
-	
-    case QUOTE:
-	/*
-	 * '"' string '"'
-	 */
-	
-	stringStart = infoPtr->next;
-	code = Tcl_ParseQuotedString(interp, infoPtr->start,
-	        (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	infoPtr->next = termPtr;
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = (termPtr - exprTokenPtr->start);
-	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
-
-	/*
-	 * If parsing the quoted string resulted in more than one token,
-	 * insert a TCL_TOKEN_WORD token before them. This indicates that
-	 * the quoted string represents a concatenation of multiple tokens.
-	 */
-
-	if (exprTokenPtr->numComponents > 1) {
-	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
-		TclExpandTokenArray(parsePtr);
-	    }
-	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
-	    numToMove = (parsePtr->numTokens - firstIndex);
-	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
-	            (size_t) (numToMove * sizeof(Tcl_Token)));
-	    parsePtr->numTokens++;
-
-	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	    exprTokenPtr->numComponents++;
-
-	    tokenPtr->type = TCL_TOKEN_WORD;
-	    tokenPtr->start = exprTokenPtr->start;
-	    tokenPtr->size = exprTokenPtr->size;
-	    tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
-	}
-	break;
-	
-    case OPEN_BRACKET:
-	/*
-	 * '[' command {command} ']'
-	 */
-
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
-	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
-	tokenPtr->type = TCL_TOKEN_COMMAND;
-	tokenPtr->start = infoPtr->start;
-	tokenPtr->numComponents = 0;
-	parsePtr->numTokens++;
-
-	/*
-	 * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
-	 * to find their end, then throw away that parse information.
-	 */
-	
-	src = infoPtr->next;
-	while (1) {
-	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
-		    &nested) != TCL_OK) {
-		parsePtr->term = nested.term;
-		parsePtr->errorType = nested.errorType;
-		parsePtr->incomplete = nested.incomplete;
-		return TCL_ERROR;
-	    }
-	    src = (nested.commandStart + nested.commandSize);
-
-	    /*
-	     * This is equivalent to Tcl_FreeParse(&nested), but
-	     * presumably inlined here for sake of runtime optimization
-	     */
-
-	    if (nested.tokenPtr != nested.staticTokens) {
-		ckfree((char *) nested.tokenPtr);
-	    }
-
-	    /*
-	     * Check for the closing ']' that ends the command substitution.
-	     * It must have been the last character of the parsed command.
-	     */
-
-	    if ((nested.term < parsePtr->end) && (*nested.term == ']') 
-		    && !nested.incomplete) {
-		break;
-	    }
-	    if (src == parsePtr->end) {
-		if (parsePtr->interp != NULL) {
-		    Tcl_SetResult(interp, "missing close-bracket",
-			    TCL_STATIC);
-		}
-		parsePtr->term = tokenPtr->start;
-		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
-		parsePtr->incomplete = 1;
-		return TCL_ERROR;
-	    }
-	}
-	tokenPtr->size = (src - tokenPtr->start);
-	infoPtr->next = src;
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = (src - tokenPtr->start);
-	exprTokenPtr->numComponents = 1;
-	break;
-
-    case OPEN_BRACE:
-	/*
-	 * '{' string '}'
-	 */
-
-	code = Tcl_ParseBraces(interp, infoPtr->start,
-	        (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
-		&termPtr);
-	if (code != TCL_OK) {
-	    return code;
-	}
-	infoPtr->next = termPtr;
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = (termPtr - infoPtr->start);
-	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
-
-	/*
-	 * If parsing the braced string resulted in more than one token,
-	 * insert a TCL_TOKEN_WORD token before them. This indicates that
-	 * the braced string represents a concatenation of multiple tokens.
-	 */
-
-	if (exprTokenPtr->numComponents > 1) {
-	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
-		TclExpandTokenArray(parsePtr);
-	    }
-	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
-	    numToMove = (parsePtr->numTokens - firstIndex);
-	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
-	            (size_t) (numToMove * sizeof(Tcl_Token)));
-	    parsePtr->numTokens++;
-
-	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	    exprTokenPtr->numComponents++;
-	    
-	    tokenPtr->type = TCL_TOKEN_WORD;
-	    tokenPtr->start = exprTokenPtr->start;
-	    tokenPtr->size = exprTokenPtr->size;
-	    tokenPtr->numComponents = exprTokenPtr->numComponents-1;
-	}
-	break;
-	
-/*
- *	Disable attempt to support functions named "eq" or "ne".  This
- *	is unworkable in the Tcl 8.4.* releases.  See Tcl Bugs 1971879
- *	and 1201589.
- *
-    case STREQ:
-    case STRNEQ:
-*/
-    case FUNC_NAME: {
-	/*
-	 * math_func '(' expr {',' expr} ')'
-	 */
-
-	ParseInfo savedInfo = *infoPtr;
-	
-	code = GetLexeme(infoPtr); /* skip over function name */
-	if (code != TCL_OK) {
-	    return code;
-	}
-	if (infoPtr->lexeme != OPEN_PAREN) {
-	    int code;
-	    Tcl_DString functionName;
-	    Tcl_HashEntry *hPtr;
-	    Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
-	    Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);
-
-	    /* Check for boolean literals (true, false, yes, no, on, off) */
-	    Tcl_IncrRefCount(objPtr);
-	    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
-	    Tcl_DecrRefCount(objPtr);
-	    if (code == TCL_OK) {
-		*infoPtr = savedInfo;
-		goto tokenizeLiteral;
-	    }
-
-	    /*
-	     * Guess what kind of error we have by trying to tell
-	     * whether we have a function or variable name here.
-	     * Alas, this makes the parser more tightly bound with the
-	     * rest of the interpreter, but that is the only way to
-	     * give a sensible message here.  Still, it is not too
-	     * serious as this is only done when generating an error.
-	     */
-
-	    /*
-	     * Look up the name as a function name.  We need a writable
-	     * copy (DString) so we can terminate it with a NULL for
-	     * the benefit of Tcl_FindHashEntry which operates on
-	     * NULL-terminated string keys.
-	     */
-	    Tcl_DStringInit(&functionName);
-	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, 
-	    	Tcl_DStringAppend(&functionName,
-			savedInfo.start, savedInfo.size));
-	    Tcl_DStringFree(&functionName);
-
-	    /*
-	     * Assume that we have an attempted variable reference
-	     * unless we've got a function name, as the set of
-	     * potential function names is typically much smaller.
-	     */
-	    if (hPtr != NULL) {
-		LogSyntaxError(infoPtr,
-			"expected parenthesis enclosing function arguments");
-	    } else {
-		LogSyntaxError(infoPtr,
-			"variable references require preceding $");
-	    }
-	    return TCL_ERROR;
-	}
-
-	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
-	    TclExpandTokenArray(parsePtr);
-	}
-	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
-	tokenPtr->type = TCL_TOKEN_OPERATOR;
-	tokenPtr->start = savedInfo.start;
-	tokenPtr->size = savedInfo.size;
-	tokenPtr->numComponents = 0;
-	parsePtr->numTokens++;
-	
-	code = GetLexeme(infoPtr); /* skip over '(' */
-	if (code != TCL_OK) {
-	    return code;
-	}
-
-	while (infoPtr->lexeme != CLOSE_PAREN) {
-	    code = ParseCondExpr(infoPtr);
-	    if (code != TCL_OK) {
-		return code;
-	    }
-	    
-	    if (infoPtr->lexeme == COMMA) {
-		code = GetLexeme(infoPtr); /* skip over , */
-		if (code != TCL_OK) {
-		    return code;
-		}
-	    } else if (infoPtr->lexeme != CLOSE_PAREN) {
-		LogSyntaxError(infoPtr,
-			"missing close parenthesis at end of function call");
-		return TCL_ERROR;
-	    }
-	}
-
-	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
-	exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
-	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
-	break;
-    }
-
-    case COMMA:
-	LogSyntaxError(infoPtr,
-		"commas can only separate function arguments");
-	return TCL_ERROR;
-    case END:
-	LogSyntaxError(infoPtr, "premature end of expression");
-	return TCL_ERROR;
-    case UNKNOWN:
-	LogSyntaxError(infoPtr, "single equality character not legal in expressions");
-	return TCL_ERROR;
-    case UNKNOWN_CHAR:
-	LogSyntaxError(infoPtr, "character not legal in expressions");
-	return TCL_ERROR;
-    case QUESTY:
-	LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
-	return TCL_ERROR;
-    case COLON:
-	LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
-	return TCL_ERROR;
-    case CLOSE_PAREN:
-	LogSyntaxError(infoPtr, "unexpected close parenthesis");
-	return TCL_ERROR;
-
-    default: {
-	char buf[64];
-
-	sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
-	LogSyntaxError(infoPtr, buf);
-	return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Advance to the next lexeme before returning.
-     */
-    
-    code = GetLexeme(infoPtr);
-    if (code != TCL_OK) {
-	return code;
-    }
-    parsePtr->term = infoPtr->next;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetLexeme --
- *
- *	Lexical scanner for Tcl expressions: scans a single operator or
- *	other syntactic element from an expression string.
- *
- * Results:
- *	TCL_OK is returned unless an error occurred. In that case a standard
- *	Tcl error code is returned and, if infoPtr->parsePtr->interp is
- *	non-NULL, the interpreter's result is set to hold an error
- *	message. TCL_ERROR is returned if an integer overflow, or a
- *	floating-point overflow or underflow occurred while reading in a
- *	number. If the lexical analysis is successful, infoPtr->lexeme
- *	refers to the next symbol in the expression string, and
- *	infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
- *	LITERAL or FUNC_NAME, then infoPtr->start is set to the first
- *	character of the lexeme; otherwise it is set NULL.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold all the
- *	information about the subexpression, then additional space is
- *	malloc-ed..
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetLexeme(infoPtr)
-    ParseInfo *infoPtr;		/* Holds state needed to parse the expr,
-				 * including the resulting lexeme. */
-{
-    register CONST char *src;	/* Points to current source char. */
-    char c;
-    int offset, length, numBytes;
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    Tcl_Interp *interp = parsePtr->interp;
-    Tcl_UniChar ch;
-
-    /*
-     * Record where the previous lexeme ended. Since we always read one
-     * lexeme ahead during parsing, this helps us know the source length of
-     * subexpression tokens.
-     */
-
-    infoPtr->prevEnd = infoPtr->next;
-
-    /*
-     * Scan over leading white space at the start of a lexeme. 
-     */
-
-    src = infoPtr->next;
-    numBytes = parsePtr->end - src;
-    do {
-	char type;
-	int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
-	src += scanned; numBytes -= scanned;
-    } while  (numBytes && (*src == '\n') && (src++,numBytes--));
-    parsePtr->term = src;
-    if (numBytes == 0) {
-	infoPtr->lexeme = END;
-	infoPtr->next = src;
-	return TCL_OK;
-    }
-
-    /*
-     * Try to parse the lexeme first as an integer or floating-point
-     * number. Don't check for a number if the first character c is
-     * "+" or "-". If we did, we might treat a binary operator as unary
-     * by mistake, which would eventually cause a syntax error.
-     */
-
-    c = *src;
-    if ((c != '+') && (c != '-')) {
-	CONST char *end = infoPtr->lastChar;
-	if ((length = TclParseInteger(src, (end - src)))) {
-	    /*
-	     * First length bytes look like an integer.  Verify by
-	     * attempting the conversion to the largest integer we have.
-	     */
-	    int code;
-	    Tcl_WideInt wide;
-	    Tcl_Obj *value = Tcl_NewStringObj(src, length);
-
-	    Tcl_IncrRefCount(value);
-	    code = Tcl_GetWideIntFromObj(interp, value, &wide);
-	    Tcl_DecrRefCount(value);
-	    if (code == TCL_ERROR) {
-		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
-		return TCL_ERROR;
-	    }
-            infoPtr->lexeme = LITERAL;
-	    infoPtr->start = src;
-	    infoPtr->size = length;
-            infoPtr->next = (src + length);
-	    parsePtr->term = infoPtr->next;
-            return TCL_OK;
-	} else if ((length = ParseMaxDoubleLength(src, end))) {
-	    /*
-	     * There are length characters that could be a double.
-	     * Let strtod() tells us for sure.  Need a writable copy
-	     * so we can set an terminating NULL to keep strtod from
-	     * scanning too far.
-	     */
-	    char *startPtr, *termPtr;
-	    double doubleValue;
-	    Tcl_DString toParse;
-
-	    errno = 0;
-	    Tcl_DStringInit(&toParse);
-	    startPtr = Tcl_DStringAppend(&toParse, src, length);
-	    doubleValue = strtod(startPtr, &termPtr);
-	    Tcl_DStringFree(&toParse);
-	    if (termPtr != startPtr) {
-		if (errno != 0) {
-		    if (interp != NULL) {
-			TclExprFloatError(interp, doubleValue);
-		    }
-		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
-		    return TCL_ERROR;
-		}
-		
-		/*
-                 * startPtr was the start of a valid double, copied
-		 * from src.
-                 */
-		
-		infoPtr->lexeme = LITERAL;
-		infoPtr->start = src;
-		if ((termPtr - startPtr) > length) {
-		    infoPtr->size = length;
-		} else {
-		    infoPtr->size = (termPtr - startPtr);
-		}
-		infoPtr->next = src + infoPtr->size;
-		parsePtr->term = infoPtr->next;
-		return TCL_OK;
-	    }
-	}
-    }
-
-    /*
-     * Not an integer or double literal. Initialize the lexeme's fields
-     * assuming the common case of a single character lexeme.
-     */
-
-    infoPtr->start = src;
-    infoPtr->size = 1;
-    infoPtr->next = src+1;
-    parsePtr->term = infoPtr->next;
-    
-    switch (*src) {
-	case '[':
-	    infoPtr->lexeme = OPEN_BRACKET;
-	    return TCL_OK;
-
-        case '{':
-	    infoPtr->lexeme = OPEN_BRACE;
-	    return TCL_OK;
-
-	case '(':
-	    infoPtr->lexeme = OPEN_PAREN;
-	    return TCL_OK;
-
-	case ')':
-	    infoPtr->lexeme = CLOSE_PAREN;
-	    return TCL_OK;
-
-	case '$':
-	    infoPtr->lexeme = DOLLAR;
-	    return TCL_OK;
-
-	case '\"':
-	    infoPtr->lexeme = QUOTE;
-	    return TCL_OK;
-
-	case ',':
-	    infoPtr->lexeme = COMMA;
-	    return TCL_OK;
-
-	case '*':
-	    infoPtr->lexeme = MULT;
-	    return TCL_OK;
-
-	case '/':
-	    infoPtr->lexeme = DIVIDE;
-	    return TCL_OK;
-
-	case '%':
-	    infoPtr->lexeme = MOD;
-	    return TCL_OK;
-
-	case '+':
-	    infoPtr->lexeme = PLUS;
-	    return TCL_OK;
-
-	case '-':
-	    infoPtr->lexeme = MINUS;
-	    return TCL_OK;
-
-	case '?':
-	    infoPtr->lexeme = QUESTY;
-	    return TCL_OK;
-
-	case ':':
-	    infoPtr->lexeme = COLON;
-	    return TCL_OK;
-
-	case '<':
-	    infoPtr->lexeme = LESS;
-	    if ((infoPtr->lastChar - src) > 1) {
-		switch (src[1]) {
-		    case '<':
-			infoPtr->lexeme = LEFT_SHIFT;
-			infoPtr->size = 2;
-			infoPtr->next = src+2;
-			break;
-		    case '=':
-			infoPtr->lexeme = LEQ;
-			infoPtr->size = 2;
-			infoPtr->next = src+2;
-			break;
-		}
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '>':
-	    infoPtr->lexeme = GREATER;
-	    if ((infoPtr->lastChar - src) > 1) {
-		switch (src[1]) {
-		    case '>':
-			infoPtr->lexeme = RIGHT_SHIFT;
-			infoPtr->size = 2;
-			infoPtr->next = src+2;
-			break;
-		    case '=':
-			infoPtr->lexeme = GEQ;
-			infoPtr->size = 2;
-			infoPtr->next = src+2;
-			break;
-		}
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '=':
-	    infoPtr->lexeme = UNKNOWN;
-	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = EQUAL;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '!':
-	    infoPtr->lexeme = NOT;
-	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = NEQ;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '&':
-	    infoPtr->lexeme = BIT_AND;
-	    if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = AND;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '^':
-	    infoPtr->lexeme = BIT_XOR;
-	    return TCL_OK;
-
-	case '|':
-	    infoPtr->lexeme = BIT_OR;
-	    if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = OR;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-	    }
-	    parsePtr->term = infoPtr->next;
-	    return TCL_OK;
-
-	case '~':
-	    infoPtr->lexeme = BIT_NOT;
-	    return TCL_OK;
-
-	case 'e':
-	    if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = STREQ;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-		parsePtr->term = infoPtr->next;
-		return TCL_OK;
-	    } else {
-		goto checkFuncName;
-	    }
-
-	case 'n':
-	    if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
-		infoPtr->lexeme = STRNEQ;
-		infoPtr->size = 2;
-		infoPtr->next = src+2;
-		parsePtr->term = infoPtr->next;
-		return TCL_OK;
-	    } else {
-		goto checkFuncName;
-	    }
-
-	default:
-	checkFuncName:
-	    length = (infoPtr->lastChar - src);
-	    if (Tcl_UtfCharComplete(src, length)) {
-		offset = Tcl_UtfToUniChar(src, &ch);
-	    } else {
-		char utfBytes[TCL_UTF_MAX];
-		memcpy(utfBytes, src, (size_t) length);
-		utfBytes[length] = '\0';
-		offset = Tcl_UtfToUniChar(utfBytes, &ch);
-	    }
-	    c = UCHAR(ch);
-	    if (isalpha(UCHAR(c))) {	/* INTL: ISO only. */
-		infoPtr->lexeme = FUNC_NAME;
-		while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
-		    src += offset; length -= offset;
-		    if (Tcl_UtfCharComplete(src, length)) {
-			offset = Tcl_UtfToUniChar(src, &ch);
-		    } else {
-			char utfBytes[TCL_UTF_MAX];
-			memcpy(utfBytes, src, (size_t) length);
-			utfBytes[length] = '\0';
-			offset = Tcl_UtfToUniChar(utfBytes, &ch);
-		    }
-		    c = UCHAR(ch);
-		}
-		infoPtr->size = (src - infoPtr->start);
-		infoPtr->next = src;
-		parsePtr->term = infoPtr->next;
-		return TCL_OK;
-	    }
-	    infoPtr->lexeme = UNKNOWN_CHAR;
-	    return TCL_OK;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclParseInteger --
- *
- *	Scans up to numBytes bytes starting at src, and checks whether
- *	the leading bytes look like an integer's string representation.
- *
- * Results:
- *	Returns 0 if the leading bytes do not look like an integer.
- *	Otherwise, returns the number of bytes examined that look
- *	like an integer.  This may be less than numBytes if the integer
- *	is only the leading part of the string.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclParseInteger(string, numBytes)
-    register CONST char *string;/* The string to examine. */
-    register int numBytes;	/* Max number of bytes to scan. */
-{
-    register CONST char *p = string;
-
-    /* Take care of introductory "0x" */
-    if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
-	int scanned;
-	Tcl_UniChar ch;
-	p+=2; numBytes -= 2;
- 	scanned = TclParseHex(p, numBytes, &ch);
-	if (scanned) {
-	    return scanned + 2;
-	}
-
-	/* Recognize the 0 as valid integer, but x is left behind */
-	return 1;
-    }
-    while (numBytes && isdigit(UCHAR(*p))) {	/* INTL: digit */
-	numBytes--; p++;
-    }
-    if (numBytes == 0) {
-        return (p - string);
-    }
-    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
-        return (p - string);
-    }
-    return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseMaxDoubleLength --
- *
- *      Scans a sequence of bytes checking that the characters could
- *	be in a string rep of a double.
- *
- * Results:
- *	Returns the number of bytes starting with string, runing to, but
- *	not including end, all of which could be part of a string rep.
- *	of a double.  Only character identity is used, no actual
- *	parsing is done.
- *
- *	The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', 
- *	'.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x',  and 'X'.
- *	This covers the values "Inf" and "Nan" as well as the
- *	decimal and hexadecimal representations recognized by a
- *	C99-compliant strtod().
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseMaxDoubleLength(string, end)
-    register CONST char *string;/* The string to examine. */
-    CONST char *end;		/* Point to the first character past the end
-				 * of the string we are examining. */
-{
-    CONST char *p = string;
-    while (p < end) {
-	switch (*p) {
-	    case '0': case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9': case 'A': case 'B':
-	    case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
-	    case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
-	    case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
-	    case '.': case '+': case '-':
-		p++;
-		break;
-	    default:
-		goto done;
-	}
-    }
-    done:
-    return (p - string);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrependSubExprTokens --
- *
- *	This procedure is called after the operands of an subexpression have
- *	been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
- *	the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
- *	These two tokens are inserted before the operand tokens.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If there is insufficient space in parsePtr to hold the new tokens,
- *	additional space is malloc-ed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
-    CONST char *op;		/* Points to first byte of the operator
-				 * in the source script. */
-    int opBytes;		/* Number of bytes in the operator. */
-    CONST char *src;		/* Points to first byte of the subexpression
-				 * in the source script. */
-    int srcBytes;		/* Number of bytes in subexpression's
-				 * source. */
-    int firstIndex;		/* Index of first token already emitted for
-				 * operator's first (or only) operand. */
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-{
-    Tcl_Parse *parsePtr = infoPtr->parsePtr;
-    Tcl_Token *tokenPtr, *firstTokenPtr;
-    int numToMove;
-
-    if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
-	TclExpandTokenArray(parsePtr);
-    }
-    firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
-    tokenPtr = (firstTokenPtr + 2);
-    numToMove = (parsePtr->numTokens - firstIndex);
-    memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
-            (size_t) (numToMove * sizeof(Tcl_Token)));
-    parsePtr->numTokens += 2;
-    
-    tokenPtr = firstTokenPtr;
-    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
-    tokenPtr->start = src;
-    tokenPtr->size = srcBytes;
-    tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
-    
-    tokenPtr++;
-    tokenPtr->type = TCL_TOKEN_OPERATOR;
-    tokenPtr->start = op;
-    tokenPtr->size = opBytes;
-    tokenPtr->numComponents = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * LogSyntaxError --
- *
- *	This procedure is invoked after an error occurs when parsing an
- *	expression. It sets the interpreter result to an error message
- *	describing the error.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Sets the interpreter result to an error message describing the
- *	expression that was being parsed when the error occurred, and why
- *	the parser considers that to be a syntax error at all.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-LogSyntaxError(infoPtr, extraInfo)
-    ParseInfo *infoPtr;		/* Holds the parse state for the
-				 * expression being parsed. */
-    CONST char *extraInfo;	/* String to provide extra information
-				 * about the syntax error. */
-{
-    int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
-    char buffer[100];
-
-    if (numBytes > 60) {
-	sprintf(buffer, "syntax error in expression \"%.60s...\"",
-		infoPtr->originalExpr);
-    } else {
-	sprintf(buffer, "syntax error in expression \"%.*s\"",
-		numBytes, infoPtr->originalExpr);
-    }
-    Tcl_ResetResult(infoPtr->parsePtr->interp);
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
-	    buffer, ": ", extraInfo, (char *) NULL);
-    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
-    infoPtr->parsePtr->term = infoPtr->start;
-}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
new file mode 100644
index 0000000..95c57bf
--- /dev/null
+++ b/generic/tclPathObj.c
@@ -0,0 +1,2761 @@
+/*
+ * tclPathObj.c --
+ *
+ *	This file contains the implementation of Tcl's "path" object type used
+ *	to represent and manipulate a general (virtual) filesystem entity in
+ *	an efficient manner.
+ *
+ * Copyright (c) 2003 Vince Darley.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tclFileSystem.h"
+
+/*
+ * Prototypes for functions defined later in this file.
+ */
+
+static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
+static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
+static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
+static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
+static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static int		FindSplitPos(const char *path, int separator);
+static int		IsSeparatorOrNull(int ch);
+static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
+static int		MakePathFromNormalized(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr);
+
+/*
+ * Define the 'path' object type, which Tcl uses to represent file paths
+ * internally.
+ */
+
+static Tcl_ObjType tclFsPathType = {
+    "path",				/* name */
+    FreeFsPathInternalRep,		/* freeIntRepProc */
+    DupFsPathInternalRep,		/* dupIntRepProc */
+    UpdateStringOfFsPath,		/* updateStringProc */
+    SetFsPathFromAny			/* setFromAnyProc */
+};
+
+/*
+ * struct FsPath --
+ *
+ * Internal representation of a Tcl_Obj of "path" type. This can be used to
+ * represent relative or absolute paths, and has certain optimisations when
+ * used to represent paths which are already normalized and absolute.
+ *
+ * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
+ * reference to the container Tcl_Obj of this FsPath.
+ *
+ * There are two cases, with the first being the most common:
+ *
+ * (i) flags == 0, => Ordinary path.
+ *
+ * translatedPathPtr contains the translated path (which may be a circular
+ * reference to the object itself). If it is NULL then the path is pure
+ * normalized (and the normPathPtr will be a circular reference). cwdPtr is
+ * null for an absolute path, and non-null for a relative path (unless the cwd
+ * has never been set, in which case the cwdPtr may also be null for a
+ * relative path).
+ *
+ * (ii) flags != 0, => Special path, see TclNewFSPathObj
+ *
+ * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir
+ * and normPathPtr is the $tail.
+ *
+ */
+
+typedef struct FsPath {
+    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
+				 * is NULL, then this is a pure normalized,
+				 * absolute path object, in which the parent
+				 * Tcl_Obj's string rep is already both
+				 * translated and normalized. */
+    Tcl_Obj *normPathPtr;	/* Normalized absolute path, without ., .. or
+				 * ~user sequences. If the Tcl_Obj containing
+				 * this FsPath is already normalized, this may
+				 * be a circular reference back to the
+				 * container. If that is NOT the case, we have
+				 * a refCount on the object. */
+    Tcl_Obj *cwdPtr;		/* If null, path is absolute, else this points
+				 * to the cwd object used for this path. We
+				 * have a refCount on the object. */
+    int flags;			/* Flags to describe interpretation - see
+				 * below. */
+    ClientData nativePathPtr;	/* Native representation of this path, which
+				 * is filesystem dependent. */
+    int filesystemEpoch;	/* Used to ensure the path representation was
+				 * generated during the correct filesystem
+				 * epoch. The epoch changes when
+				 * filesystem-mounts are changed. */
+    Tcl_Filesystem *fsPtr;	/* The Tcl_Filesystem that claims this path */
+} FsPath;
+
+/*
+ * Flag values for FsPath->flags.
+ */
+
+#define TCLPATH_APPENDED 1
+#define TCLPATH_NEEDNORM 4
+
+/*
+ * Define some macros to give us convenient access to path-object specific
+ * fields.
+ */
+
+#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
+#define SETPATHOBJ(pathPtr,fsPathPtr) \
+	((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFSNormalizeAbsolutePath --
+ *
+ *	Takes an absolute path specification and computes a 'normalized' path
+ *	from it.
+ *
+ *	A normalized path is one which has all '../', './' removed. Also it is
+ *	one which is in the 'standard' format for the native platform. On
+ *	Unix, this means the path must be free of symbolic links/aliases, and
+ *	on Windows it means we want the long form, with that long form's
+ *	case-dependence (which gives us a unique, case-dependent path).
+ *
+ *	The behaviour of this function if passed a non-absolute path is NOT
+ *	defined.
+ *
+ *	pathPtr may have a refCount of zero, or may be a shared object.
+ *
+ * Results:
+ *	The result is returned in a Tcl_Obj with a refCount of 1, which is
+ *	therefore owned by the caller. It must be freed (with
+ *	Tcl_DecrRefCount) by the caller when no longer needed.
+ *
+ * Side effects:
+ *	None (beyond the memory allocation for the result).
+ *
+ * Special note:
+ *	This code was originally based on code from Matt Newman and
+ *	Jean-Claude Wippler, but has since been totally rewritten by Vince
+ *	Darley to deal with symbolic links.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFSNormalizeAbsolutePath(
+    Tcl_Interp *interp,		/* Interpreter to use */
+    Tcl_Obj *pathPtr)		/* Absolute path to normalize */
+{
+    const char *dirSep, *oldDirSep;
+    int first = 1;		/* Set to zero once we've passed the first
+				 * directory separator - we can't use '..' to
+				 * remove the volume in a path. */
+    Tcl_Obj *retVal = NULL;
+    dirSep = TclGetString(pathPtr);
+
+    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+	if (   (dirSep[0] == '/' || dirSep[0] == '\\')
+	    && (dirSep[1] == '/' || dirSep[1] == '\\')
+	    && (dirSep[2] == '?')
+	    && (dirSep[3] == '/' || dirSep[3] == '\\')) {
+	    /* NT extended path */
+	    dirSep += 4;
+
+	    if (   (dirSep[0] == 'U' || dirSep[0] == 'u')
+		&& (dirSep[1] == 'N' || dirSep[1] == 'n')
+		&& (dirSep[2] == 'C' || dirSep[2] == 'c')
+		&& (dirSep[3] == '/' || dirSep[3] == '\\')) {
+		/* NT extended UNC path */
+		dirSep += 4;
+	    }
+	}
+	if (dirSep[0] != 0 && dirSep[1] == ':' &&
+		(dirSep[2] == '/' || dirSep[2] == '\\')) {
+	    /* Do nothing */
+	} else if ((dirSep[0] == '/' || dirSep[0] == '\\')
+		&& (dirSep[1] == '/' || dirSep[1] == '\\')) {
+	    /*
+	     * UNC style path, where we must skip over the first separator,
+	     * since the first two segments are actually inseparable.
+	     */
+
+	    dirSep += 2;
+	    dirSep += FindSplitPos(dirSep, '/');
+	    if (*dirSep != 0) {
+		dirSep++;
+	    }
+	}
+    }
+
+    /*
+     * Scan forward from one directory separator to the next, checking for
+     * '..' and '.' sequences which must be handled specially. In particular
+     * handling of '..' can be complicated if the directory before is a link,
+     * since we will have to expand the link to be able to back up one level.
+     */
+
+    while (*dirSep != 0) {
+	oldDirSep = dirSep;
+	if (!first) {
+	    dirSep++;
+	}
+	dirSep += FindSplitPos(dirSep, '/');
+	if (dirSep[0] == 0 || dirSep[1] == 0) {
+	    if (retVal != NULL) {
+		Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
+	    }
+	    break;
+	}
+	if (dirSep[1] == '.') {
+	    if (retVal != NULL) {
+		Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
+		oldDirSep = dirSep;
+	    }
+	again:
+	    if (IsSeparatorOrNull(dirSep[2])) {
+		/*
+		 * Need to skip '.' in the path.
+		 */
+		int curLen;
+
+		if (retVal == NULL) {
+		    const char *path = TclGetString(pathPtr);
+		    retVal = Tcl_NewStringObj(path, dirSep - path);
+		    Tcl_IncrRefCount(retVal);
+		}
+		(void) Tcl_GetStringFromObj(retVal, &curLen);
+		if (curLen == 0) {
+		    Tcl_AppendToObj(retVal, dirSep, 1);
+		}
+		dirSep += 2;
+		oldDirSep = dirSep;
+		if (dirSep[0] != 0 && dirSep[1] == '.') {
+		    goto again;
+		}
+		continue;
+	    }
+	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
+		Tcl_Obj *link;
+		int curLen;
+		char *linkStr;
+
+		/*
+		 * Have '..' so need to skip previous directory.
+		 */
+
+		if (retVal == NULL) {
+		    const char *path = TclGetString(pathPtr);
+
+		    retVal = Tcl_NewStringObj(path, dirSep - path);
+		    Tcl_IncrRefCount(retVal);
+		}
+		(void) Tcl_GetStringFromObj(retVal, &curLen);
+		if (curLen == 0) {
+		    Tcl_AppendToObj(retVal, dirSep, 1);
+		}
+		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
+		    link = Tcl_FSLink(retVal, NULL, 0);
+
+		    /* Safety check in case driver caused sharing */
+		    if (Tcl_IsShared(retVal)) {
+			TclDecrRefCount(retVal);
+			retVal = Tcl_DuplicateObj(retVal);
+			Tcl_IncrRefCount(retVal);
+		    }
+
+		    if (link != NULL) {
+			/*
+			 * Got a link. Need to check if the link is relative
+			 * or absolute, for those platforms where relative
+			 * links exist.
+			 */
+
+			if (tclPlatform != TCL_PLATFORM_WINDOWS &&
+				Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) {
+			    /*
+			     * We need to follow this link which is relative
+			     * to retVal's directory. This means concatenating
+			     * the link onto the directory of the path so far.
+			     */
+
+			    const char *path =
+				    Tcl_GetStringFromObj(retVal, &curLen);
+
+			    while (--curLen >= 0) {
+				if (IsSeparatorOrNull(path[curLen])) {
+				    break;
+				}
+			    }
+
+			    /*
+			     * We want the trailing slash.
+			     */
+
+			    Tcl_SetObjLength(retVal, curLen+1);
+			    Tcl_AppendObjToObj(retVal, link);
+			    TclDecrRefCount(link);
+			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+			} else {
+			    /*
+			     * Absolute link.
+			     */
+
+			    TclDecrRefCount(retVal);
+			    if (Tcl_IsShared(link)) {
+				retVal = Tcl_DuplicateObj(link);
+				TclDecrRefCount(link);
+			    } else {
+				retVal = link;
+			    }
+			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+
+			    /*
+			     * Convert to forward-slashes on windows.
+			     */
+
+			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+				int i;
+
+				for (i = 0; i < curLen; i++) {
+				    if (linkStr[i] == '\\') {
+					linkStr[i] = '/';
+				    }
+				}
+			    }
+			}
+		    } else {
+			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+		    }
+
+		    /*
+		     * Either way, we now remove the last path element.
+		     * (but not the first character of the path)
+		     */
+
+		    while (--curLen >= 0) {
+			if (IsSeparatorOrNull(linkStr[curLen])) {
+			    if (curLen) {
+				Tcl_SetObjLength(retVal, curLen);
+			    } else {
+				Tcl_SetObjLength(retVal, 1);
+			    }
+			    break;
+			}
+		    }
+		}
+		dirSep += 3;
+		oldDirSep = dirSep;
+
+		if ((curLen == 0) && (dirSep[0] != 0)) {
+		    Tcl_SetObjLength(retVal, 0);
+		}
+
+		if (dirSep[0] != 0 && dirSep[1] == '.') {
+		    goto again;
+		}
+		continue;
+	    }
+	}
+	first = 0;
+	if (retVal != NULL) {
+	    Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
+	}
+    }
+
+    /*
+     * If we didn't make any changes, just use the input path.
+     */
+
+    if (retVal == NULL) {
+	retVal = pathPtr;
+	Tcl_IncrRefCount(retVal);
+
+	if (Tcl_IsShared(retVal)) {
+	    /*
+	     * Unfortunately, the platform-specific normalization code which
+	     * will be called below has no way of dealing with the case where
+	     * an object is shared. It is expecting to modify an object in
+	     * place. So, we must duplicate this here to ensure an object with
+	     * a single ref-count.
+	     *
+	     * If that changes in the future (e.g. the normalize proc is given
+	     * one object and is able to return a different one), then we
+	     * could remove this code.
+	     */
+
+	    TclDecrRefCount(retVal);
+	    retVal = Tcl_DuplicateObj(pathPtr);
+	    Tcl_IncrRefCount(retVal);
+	}
+    }
+
+    /*
+     * Ensure a windows drive like C:/ has a trailing separator
+     */
+
+    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+	int len;
+	const char *path = Tcl_GetStringFromObj(retVal, &len);
+
+	if (len == 2 && path[0] != 0 && path[1] == ':') {
+	    if (Tcl_IsShared(retVal)) {
+		TclDecrRefCount(retVal);
+		retVal = Tcl_DuplicateObj(retVal);
+		Tcl_IncrRefCount(retVal);
+	    }
+	    Tcl_AppendToObj(retVal, "/", 1);
+	}
+    }
+
+    /*
+     * Now we have an absolute path, with no '..', '.' sequences, but it still
+     * may not be in 'unique' form, depending on the platform. For instance,
+     * Unix is case-sensitive, so the path is ok. Windows is case-insensitive,
+     * and also has the weird 'longname/shortname' thing (e.g. C:/Program
+     * Files/ and C:/Progra~1/ are equivalent).
+     *
+     * Virtual file systems which may be registered may have other criteria
+     * for normalizing a path.
+     */
+
+    TclFSNormalizeToUniquePath(interp, retVal, 0);
+
+    /*
+     * Since we know it is a normalized path, we can actually convert this
+     * object into an FsPath for greater efficiency
+     */
+
+    MakePathFromNormalized(interp, retVal);
+
+    /*
+     * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
+     */
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSGetPathType --
+ *
+ *	Determines whether a given path is relative to the current directory,
+ *	relative to the current volume, or absolute.
+ *
+ * Results:
+ *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ *	TCL_PATH_VOLUME_RELATIVE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_PathType
+Tcl_FSGetPathType(
+    Tcl_Obj *pathPtr)
+{
+    return TclFSGetPathType(pathPtr, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFSGetPathType --
+ *
+ *	Determines whether a given path is relative to the current directory,
+ *	relative to the current volume, or absolute. If the caller wishes to
+ *	know which filesystem claimed the path (in the case for which the path
+ *	is absolute), then a reference to a filesystem pointer can be passed
+ *	in (but passing NULL is acceptable).
+ *
+ * Results:
+ *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ *	TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
+ *	only if it is non-NULL and the function's return value is
+ *	TCL_PATH_ABSOLUTE.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_PathType
+TclFSGetPathType(
+    Tcl_Obj *pathPtr,
+    Tcl_Filesystem **filesystemPtrPtr,
+    int *driveNameLengthPtr)
+{
+    FsPath *fsPathPtr;
+
+    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
+	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+		NULL);
+    }
+
+    fsPathPtr = PATHOBJ(pathPtr);
+    if (fsPathPtr->cwdPtr == NULL) {
+	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+		NULL);
+    }
+
+    if (PATHFLAGS(pathPtr) == 0) {
+	/* The path is not absolute... */
+#ifdef __WIN32__
+	/* ... on Windows we must make another call to determine whether
+	 * it's relative or volumerelative [Bug 2571597]. */
+	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
+		NULL);
+#else
+	/* On other systems, quickly deduce !absolute -> relative */
+	return TCL_PATH_RELATIVE;
+#endif
+    }
+    return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
+	    driveNameLengthPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclPathPart
+ *
+ *	This function calculates the requested part of the given path, which
+ *	can be:
+ *
+ *	- the directory above ('file dirname')
+ *	- the tail            ('file tail')
+ *	- the extension       ('file extension')
+ *	- the root            ('file root')
+ *
+ *	The 'portion' parameter dictates which of these to calculate. There
+ *	are a number of special cases both to be more efficient, and because
+ *	the behaviour when given a path with only a single element is defined
+ *	to require the expansion of that single element, where possible.
+ *
+ *	Should look into integrating 'FileBasename' in tclFCmd.c into this
+ *	function.
+ *
+ * Results:
+ *	NULL if an error occurred, otherwise a Tcl_Obj owned by the caller
+ *	(i.e. most likely with refCount 1).
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclPathPart(
+    Tcl_Interp *interp,		/* Used for error reporting */
+    Tcl_Obj *pathPtr,		/* Path to take dirname of */
+    Tcl_PathPart portion)	/* Requested portion of name */
+{
+    if (pathPtr->typePtr == &tclFsPathType) {
+	FsPath *fsPathPtr = PATHOBJ(pathPtr);
+
+	if (PATHFLAGS(pathPtr) != 0) {
+	    switch (portion) {
+	    case TCL_PATH_DIRNAME: {
+		/*
+		 * Check if the joined-on bit has any directory delimiters in
+		 * it. If so, the 'dirname' would be a joining of the main
+		 * part with the dirname of the joined-on bit. We could handle
+		 * that special case here, but we don't, and instead just use
+		 * the standardPath code.
+		 */
+
+		int numBytes;
+		const char *rest =
+			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
+
+		if (strchr(rest, '/') != NULL) {
+		    goto standardPath;
+		}
+		/*
+		 * If the joined-on bit is empty, then [file dirname] is
+		 * documented to return all but the last non-empty element
+		 * of the path, so we need to split apart the main part to
+		 * get the right answer.  We could do that here, but it's
+		 * simpler to fall back to the standardPath code.
+		 * [Bug 2710920]
+		 */
+		if (numBytes == 0) {
+		    goto standardPath;
+		}
+		if (tclPlatform == TCL_PLATFORM_WINDOWS
+			&& strchr(rest, '\\') != NULL) {
+		    goto standardPath;
+		}
+
+		/*
+		 * The joined-on path is simple, so we can just return here.
+		 */
+
+		Tcl_IncrRefCount(fsPathPtr->cwdPtr);
+		return fsPathPtr->cwdPtr;
+	    }
+	    case TCL_PATH_TAIL: {
+		/*
+		 * Check if the joined-on bit has any directory delimiters in
+		 * it. If so, the 'tail' would be only the part following the
+		 * last delimiter. We could handle that special case here, but
+		 * we don't, and instead just use the standardPath code.
+		 */
+
+		int numBytes;
+		const char *rest =
+			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
+
+		if (strchr(rest, '/') != NULL) {
+		    goto standardPath;
+		}
+		/*
+		 * If the joined-on bit is empty, then [file tail] is
+		 * documented to return the last non-empty element
+		 * of the path, so we need to split off the last element
+		 * of the main part to get the right answer.  We could do
+		 * that here, but it's simpler to fall back to the
+		 * standardPath code.  [Bug 2710920]
+		 */
+		if (numBytes == 0) {
+		    goto standardPath;
+		}
+		if (tclPlatform == TCL_PLATFORM_WINDOWS
+			&& strchr(rest, '\\') != NULL) {
+		    goto standardPath;
+		}
+		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
+		return fsPathPtr->normPathPtr;
+	    }
+	    case TCL_PATH_EXTENSION:
+		return GetExtension(fsPathPtr->normPathPtr);
+	    case TCL_PATH_ROOT: {
+		const char *fileName, *extension;
+		int length;
+
+		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
+			&length);
+		extension = TclGetExtension(fileName);
+		if (extension == NULL) {
+		    /*
+		     * There is no extension so the root is the same as the
+		     * path we were given.
+		     */
+
+		    Tcl_IncrRefCount(pathPtr);
+		    return pathPtr;
+		} else {
+		    /*
+		     * Need to return the whole path with the extension
+		     * suffix removed.  Do that by joining our "head" to
+		     * our "tail" with the extension suffix removed from
+		     * the tail.
+		     */
+
+		    Tcl_Obj *resultPtr =
+			    TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
+			    (int)(length - strlen(extension)));
+
+		    Tcl_IncrRefCount(resultPtr);
+		    return resultPtr;
+		}
+	    }
+	    default:
+		/* We should never get here */
+		Tcl_Panic("Bad portion to TclPathPart");
+		/* For less clever compilers */
+		return NULL;
+	    }
+	} else if (fsPathPtr->cwdPtr != NULL) {
+	    /* Relative path */
+	    goto standardPath;
+	} else {
+	    /* Absolute path */
+	    goto standardPath;
+	}
+    } else {
+	int splitElements;
+	Tcl_Obj *splitPtr, *resultPtr;
+
+    standardPath:
+	resultPtr = NULL;
+	if (portion == TCL_PATH_EXTENSION) {
+	    return GetExtension(pathPtr);
+	} else if (portion == TCL_PATH_ROOT) {
+	    int length;
+	    const char *fileName, *extension;
+
+	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
+	    extension = TclGetExtension(fileName);
+	    if (extension == NULL) {
+		Tcl_IncrRefCount(pathPtr);
+		return pathPtr;
+	    } else {
+		Tcl_Obj *root = Tcl_NewStringObj(fileName,
+			(int) (length - strlen(extension)));
+
+		Tcl_IncrRefCount(root);
+		return root;
+	    }
+	}
+
+	/*
+	 * The behaviour we want here is slightly different to the standard
+	 * Tcl_FSSplitPath in the handling of home directories;
+	 * Tcl_FSSplitPath preserves the "~" while this code computes the
+	 * actual full path name, if we had just a single component.
+	 */
+
+	splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
+	Tcl_IncrRefCount(splitPtr);
+	if (splitElements == 1  &&  TclGetString(pathPtr)[0] == '~') {
+	    Tcl_Obj *norm;
+
+	    TclDecrRefCount(splitPtr);
+	    norm = Tcl_FSGetNormalizedPath(interp, pathPtr);
+	    if (norm == NULL) {
+		return NULL;
+	    }
+	    splitPtr = Tcl_FSSplitPath(norm, &splitElements);
+	    Tcl_IncrRefCount(splitPtr);
+	}
+	if (portion == TCL_PATH_TAIL) {
+	    /*
+	     * Return the last component, unless it is the only component, and
+	     * it is the root of an absolute path.
+	     */
+
+	    if ((splitElements > 0) && ((splitElements > 1) ||
+		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) {
+		Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr);
+	    } else {
+		resultPtr = Tcl_NewObj();
+	    }
+	} else {
+	    /*
+	     * Return all but the last component. If there is only one
+	     * component, return it if the path was non-relative, otherwise
+	     * return the current directory.
+	     */
+
+	    if (splitElements > 1) {
+		resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
+	    } else if (splitElements == 0 ||
+		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
+		TclNewLiteralStringObj(resultPtr, ".");
+	    } else {
+		Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr);
+	    }
+	}
+	Tcl_IncrRefCount(resultPtr);
+	TclDecrRefCount(splitPtr);
+	return resultPtr;
+    }
+}
+
+/*
+ * Simple helper function
+ */
+
+static Tcl_Obj *
+GetExtension(
+    Tcl_Obj *pathPtr)
+{
+    const char *tail, *extension;
+    Tcl_Obj *ret;
+
+    tail = TclGetString(pathPtr);
+    extension = TclGetExtension(tail);
+    if (extension == NULL) {
+	ret = Tcl_NewObj();
+    } else {
+	ret = Tcl_NewStringObj(extension, -1);
+    }
+    Tcl_IncrRefCount(ret);
+    return ret;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSJoinPath --
+ *
+ *	This function takes the given Tcl_Obj, which should be a valid list,
+ *	and returns the path object given by considering the first 'elements'
+ *	elements as valid path segments (each path segment may be a complete
+ *	path, a partial path or just a single possible directory or file
+ *	name). If any path segment is actually an absolute path, then all
+ *	prior path segments are discarded.
+ *
+ *	If elements < 0, we use the entire list that was given.
+ *
+ *	It is possible that the returned object is actually an element of the
+ *	given list, so the caller should be careful to store a refCount to it
+ *	before freeing the list.
+ *
+ * Results:
+ *	Returns object with refCount of zero, (or if non-zero, it has
+ *	references elsewhere in Tcl). Either way, the caller must increment
+ *	its refCount before use. Note that in the case where the caller has
+ *	asked to join zero elements of the list, the return value will be an
+ *	empty-string Tcl_Obj.
+ *
+ *	If the given listObj was invalid, then the calling routine has a bug,
+ *	and this function will just return NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_FSJoinPath(
+    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
+				 * reference count. */
+    int elements)		/* Number of elements to use (-1 = all) */
+{
+    Tcl_Obj *res;
+    int i;
+    Tcl_Filesystem *fsPtr = NULL;
+
+    if (elements < 0) {
+	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
+	    return NULL;
+	}
+    } else {
+	/*
+	 * Just make sure it is a valid list.
+	 */
+
+	int listTest;
+
+	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
+	    return NULL;
+	}
+
+	/*
+	 * Correct this if it is too large, otherwise we will waste our time
+	 * joining null elements to the path.
+	 */
+
+	if (elements > listTest) {
+	    elements = listTest;
+	}
+    }
+
+    res = NULL;
+
+    for (i = 0; i < elements; i++) {
+	Tcl_Obj *elt, *driveName = NULL;
+	int driveNameLength, strEltLen, length;
+	Tcl_PathType type;
+	char *strElt, *ptr;
+
+	Tcl_ListObjIndex(NULL, listObj, i, &elt);
+
+	/*
+	 * This is a special case where we can be much more efficient, where
+	 * we are joining a single relative path onto an object that is
+	 * already of path type. The 'TclNewFSPathObj' call below creates an
+	 * object which can be normalized more efficiently. Currently we only
+	 * use the special case when we have exactly two elements, but we
+	 * could expand that in the future.
+	 */
+
+	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
+		&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
+	    Tcl_Obj *tail;
+
+	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
+	    type = TclGetPathType(tail, NULL, NULL, NULL);
+	    if (type == TCL_PATH_RELATIVE) {
+		const char *str;
+		int len;
+
+		str = Tcl_GetStringFromObj(tail, &len);
+		if (len == 0) {
+		    /*
+		     * This happens if we try to handle the root volume '/'.
+		     * There's no need to return a special path object, when
+		     * the base itself is just fine!
+		     */
+
+		    if (res != NULL) {
+			TclDecrRefCount(res);
+		    }
+		    return elt;
+		}
+
+		/*
+		 * If it doesn't begin with '.' and is a unix path or it a
+		 * windows path without backslashes, then we can be very
+		 * efficient here. (In fact even a windows path with
+		 * backslashes can be joined efficiently, but the path object
+		 * would not have forward slashes only, and this would
+		 * therefore contradict our 'file join' documentation).
+		 */
+
+		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
+			|| (strchr(str, '\\') == NULL))) {
+		    /*
+		     * Finally, on Windows, 'file join' is defined to convert
+		     * all backslashes to forward slashes, so the base part
+		     * cannot have backslashes either.
+		     */
+
+		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
+			    || (strchr(Tcl_GetString(elt), '\\') == NULL)) {
+			if (res != NULL) {
+			    TclDecrRefCount(res);
+			}
+			return TclNewFSPathObj(elt, str, len);
+		    }
+		}
+
+		/*
+		 * Otherwise we don't have an easy join, and we must let the
+		 * more general code below handle things.
+		 */
+	    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
+		if (res != NULL) {
+		    TclDecrRefCount(res);
+		}
+		return tail;
+	    } else {
+		const char *str = TclGetString(tail);
+
+		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+		    if (strchr(str, '\\') == NULL) {
+			if (res != NULL) {
+			    TclDecrRefCount(res);
+			}
+			return tail;
+		    }
+		}
+	    }
+	}
+	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
+	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
+	if (type != TCL_PATH_RELATIVE) {
+	    /*
+	     * Zero out the current result.
+	     */
+
+	    if (res != NULL) {
+		TclDecrRefCount(res);
+	    }
+
+	    if (driveName != NULL) {
+		/*
+		 * We've been given a separate drive-name object, because the
+		 * prefix in 'elt' is not in a suitable format for us (e.g. it
+		 * may contain irrelevant multiple separators, like
+		 * C://///foo).
+		 */
+
+		res = Tcl_DuplicateObj(driveName);
+		TclDecrRefCount(driveName);
+
+		/*
+		 * Do not set driveName to NULL, because we will check its
+		 * value below (but we won't access the contents, since those
+		 * have been cleaned-up).
+		 */
+	    } else {
+		res = Tcl_NewStringObj(strElt, driveNameLength);
+	    }
+	    strElt += driveNameLength;
+	} else if (driveName != NULL) {
+	    Tcl_DecrRefCount(driveName);
+	}
+
+	/*
+	 * Optimisation block: if this is the last element to be examined, and
+	 * it is absolute or the only element, and the drive-prefix was ok (if
+	 * there is one), it might be that the path is already in a suitable
+	 * form to be returned. Then we can short-cut the rest of this
+	 * function.
+	 */
+
+	if ((driveName == NULL) && (i == (elements - 1))
+		&& (type != TCL_PATH_RELATIVE || res == NULL)) {
+	    /*
+	     * It's the last path segment. Perform a quick check if the path
+	     * is already in a suitable form.
+	     */
+
+	    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+		if (strchr(strElt, '\\') != NULL) {
+		    goto noQuickReturn;
+		}
+	    }
+	    ptr = strElt;
+	    while (*ptr != '\0') {
+		if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
+		    /*
+		     * We have a repeated file separator, which means the path
+		     * is not in normalized form
+		     */
+
+		    goto noQuickReturn;
+		}
+		ptr++;
+	    }
+	    if (res != NULL) {
+		TclDecrRefCount(res);
+	    }
+
+	    /*
+	     * This element is just what we want to return already - no
+	     * further manipulation is requred.
+	     */
+
+	    return elt;
+	}
+
+	/*
+	 * The path element was not of a suitable form to be returned as is.
+	 * We need to perform a more complex operation here.
+	 */
+
+    noQuickReturn:
+	if (res == NULL) {
+	    res = Tcl_NewObj();
+	    ptr = Tcl_GetStringFromObj(res, &length);
+	} else {
+	    ptr = Tcl_GetStringFromObj(res, &length);
+	}
+
+	/*
+	 * Strip off any './' before a tilde, unless this is the beginning of
+	 * the path.
+	 */
+
+	if (length > 0 && strEltLen > 0 && (strElt[0] == '.') &&
+		(strElt[1] == '/') && (strElt[2] == '~')) {
+	    strElt += 2;
+	}
+
+	/*
+	 * A NULL value for fsPtr at this stage basically means we're trying
+	 * to join a relative path onto something which is also relative (or
+	 * empty). There's nothing particularly wrong with that.
+	 */
+
+	if (*strElt == '\0') {
+	    continue;
+	}
+
+	if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
+	    TclpNativeJoinPath(res, strElt);
+	} else {
+	    char separator = '/';
+	    int needsSep = 0;
+
+	    if (fsPtr->filesystemSeparatorProc != NULL) {
+		Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+
+		if (sep != NULL) {
+		    separator = TclGetString(sep)[0];
+		}
+		/* Safety check in case the VFS driver caused sharing */
+		if (Tcl_IsShared(res)) {
+		    TclDecrRefCount(res);
+		    res = Tcl_DuplicateObj(res);
+		    Tcl_IncrRefCount(res);
+		}
+	    }
+
+	    if (length > 0 && ptr[length -1] != '/') {
+		Tcl_AppendToObj(res, &separator, 1);
+		Tcl_GetStringFromObj(res, &length);
+	    }
+	    Tcl_SetObjLength(res, length + (int) strlen(strElt));
+
+	    ptr = TclGetString(res) + length;
+	    for (; *strElt != '\0'; strElt++) {
+		if (*strElt == separator) {
+		    while (strElt[1] == separator) {
+			strElt++;
+		    }
+		    if (strElt[1] != '\0') {
+			if (needsSep) {
+			    *ptr++ = separator;
+			}
+		    }
+		} else {
+		    *ptr++ = *strElt;
+		    needsSep = 1;
+		}
+	    }
+	    length = ptr - TclGetString(res);
+	    Tcl_SetObjLength(res, length);
+	}
+    }
+    if (res == NULL) {
+	res = Tcl_NewObj();
+    }
+    return res;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSConvertToPathType --
+ *
+ *	This function tries to convert the given Tcl_Obj to a valid Tcl path
+ *	type, taking account of the fact that the cwd may have changed even if
+ *	this object is already supposedly of the correct type.
+ *
+ *	The filename may begin with "~" (to indicate current user's home
+ *	directory) or "~<user>" (to indicate any user's home directory).
+ *
+ * Results:
+ *	Standard Tcl error code.
+ *
+ * Side effects:
+ *	The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSConvertToPathType(
+    Tcl_Interp *interp,		/* Interpreter in which to store error message
+				 * (if necessary). */
+    Tcl_Obj *pathPtr)		/* Object to convert to a valid, current path
+				 * type. */
+{
+    /*
+     * While it is bad practice to examine an object's type directly, this is
+     * actually the best thing to do here. The reason is that if we are
+     * converting this object to FsPath type for the first time, we don't need
+     * to worry whether the 'cwd' has changed. On the other hand, if this
+     * object is already of FsPath type, and is a relative path, we do have to
+     * worry about the cwd. If the cwd has changed, we must recompute the
+     * path.
+     */
+
+    if (pathPtr->typePtr == &tclFsPathType) {
+	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
+	    return TCL_OK;
+	}
+
+	if (pathPtr->bytes == NULL) {
+	    UpdateStringOfFsPath(pathPtr);
+	}
+	FreeFsPathInternalRep(pathPtr);
+    }
+
+    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+
+    /*
+     * We used to have more complex code here:
+     *
+     * FsPath *fsPathPtr = PATHOBJ(pathPtr);
+     * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
+     *     return TCL_OK;
+     * } else {
+     *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
+     *         return TCL_OK;
+     *     } else {
+     *         if (pathPtr->bytes == NULL) {
+     *             UpdateStringOfFsPath(pathPtr);
+     *         }
+     *         FreeFsPathInternalRep(pathPtr);
+     *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+     *     }
+     * }
+     *
+     * But we no longer believe this is necessary.
+     */
+}
+
+/*
+ * Helper function for normalization.
+ */
+
+static int
+IsSeparatorOrNull(
+    int ch)
+{
+    if (ch == 0) {
+	return 1;
+    }
+    switch (tclPlatform) {
+    case TCL_PLATFORM_UNIX:
+	return (ch == '/' ? 1 : 0);
+    case TCL_PLATFORM_WINDOWS:
+	return ((ch == '/' || ch == '\\') ? 1 : 0);
+    }
+    return 0;
+}
+
+/*
+ * Helper function for SetFsPathFromAny. Returns position of first directory
+ * delimiter in the path. If no separator is found, then returns the position
+ * of the end of the string.
+ */
+
+static int
+FindSplitPos(
+    const char *path,
+    int separator)
+{
+    int count = 0;
+    switch (tclPlatform) {
+    case TCL_PLATFORM_UNIX:
+	while (path[count] != 0) {
+	    if (path[count] == separator) {
+		return count;
+	    }
+	    count++;
+	}
+	break;
+
+    case TCL_PLATFORM_WINDOWS:
+	while (path[count] != 0) {
+	    if (path[count] == separator || path[count] == '\\') {
+		return count;
+	    }
+	    count++;
+	}
+	break;
+    }
+    return count;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNewFSPathObj --
+ *
+ *	Creates a path object whose string representation is '[file join
+ *	dirPtr addStrRep]', but does so in a way that allows for more
+ *	efficient creation and caching of normalized paths, and more efficient
+ *	'file dirname', 'file tail', etc.
+ *
+ * Assumptions:
+ *	'dirPtr' must be an absolute path. 'len' may not be zero.
+ *
+ * Results:
+ *	The new Tcl object, with refCount zero.
+ *
+ * Side effects:
+ *	Memory is allocated. 'dirPtr' gets an additional refCount.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewFSPathObj(
+    Tcl_Obj *dirPtr,
+    const char *addStrRep,
+    int len)
+{
+    FsPath *fsPathPtr;
+    Tcl_Obj *pathPtr;
+    const char *p;
+    int state = 0, count = 0;
+
+    /* [Bug 2806250] - this is only a partial solution of the problem.
+     * The PATHFLAGS != 0 representation assumes in many places that
+     * the "tail" part stored in the normPathPtr field is itself a
+     * relative path.  Strings that begin with "~" are not relative paths,
+     * so we must prevent their storage in the normPathPtr field.
+     *
+     * More generally we ought to be testing "addStrRep" for any value
+     * that is not a relative path, but in an unconstrained VFS world
+     * that could be just about anything, and testing could be expensive.
+     * Since this routine plays a big role in [glob], anything that slows
+     * it down would be unwelcome.  For now, continue the risk of further
+     * bugs when some Tcl_Filesystem uses otherwise relative path strings
+     * as absolute path strings.  Sensible Tcl_Filesystems will avoid
+     * that by mounting on path prefixes like foo:// which cannot be the
+     * name of a file or directory read from a native [glob] operation.
+     */
+    if (addStrRep[0] == '~') {
+	Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len);
+
+	pathPtr = AppendPath(dirPtr, tail);
+	Tcl_DecrRefCount(tail);
+	return pathPtr;
+    }
+
+    pathPtr = Tcl_NewObj();
+    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+    /*
+     * Set up the path.
+     */
+
+    fsPathPtr->translatedPathPtr = NULL;
+    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
+    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
+    fsPathPtr->cwdPtr = dirPtr;
+    Tcl_IncrRefCount(dirPtr);
+    fsPathPtr->nativePathPtr = NULL;
+    fsPathPtr->fsPtr = NULL;
+    fsPathPtr->filesystemEpoch = 0;
+
+    SETPATHOBJ(pathPtr, fsPathPtr);
+    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
+    pathPtr->typePtr = &tclFsPathType;
+    pathPtr->bytes = NULL;
+    pathPtr->length = 0;
+
+    /*
+     * Look for path components made up of only "."
+     * This is overly conservative analysis to keep simple.  It may
+     * mark some things as needing more aggressive normalization
+     * that don't actually need it.  No harm done.
+     */
+    for (p = addStrRep; len > 0; p++, len--) {
+       switch (state) {
+       case 0: /* So far only "." since last dirsep or start */
+           switch (*p) {
+           case '.':
+               count++;
+               break;
+           case '/':
+           case '\\':
+           case ':':
+               if (count) {
+                   PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+                   len = 0;
+               }
+               break;
+           default:
+               count = 0;
+               state = 1;
+           }
+       case 1: /* Scanning for next dirsep */
+           switch (*p) {
+           case '/':
+           case '\\':
+           case ':':
+               state = 0;
+               break;
+           }
+       }
+    }
+    if (len == 0 && count) {
+       PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
+    }
+
+    return pathPtr;
+}
+
+static Tcl_Obj *
+AppendPath(
+    Tcl_Obj *head,
+    Tcl_Obj *tail)
+{
+    int numBytes;
+    const char *bytes;
+    Tcl_Obj *copy = Tcl_DuplicateObj(head);
+
+    /*
+     * This is likely buggy when dealing with virtual filesystem drivers
+     * that use some character other than "/" as a path separator.  I know
+     * of no evidence that such a foolish thing exists.  This solution was
+     * chosen so that "JoinPath" operations that pass through either path
+     * intrep produce the same results; that is, bugward compatibility.  If
+     * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too.
+     */
+    bytes = Tcl_GetStringFromObj(tail, &numBytes);
+    if (numBytes == 0) {
+	Tcl_AppendToObj(copy, "/", 1);
+    } else {
+	TclpNativeJoinPath(copy, bytes);
+    }
+    return copy;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFSMakePathRelative --
+ *
+ *	Only for internal use.
+ *
+ *	Takes a path and a directory, where we _assume_ both path and
+ *	directory are absolute, normalized and that the path lies inside the
+ *	directory. Returns a Tcl_Obj representing filename of the path
+ *	relative to the directory.
+ *
+ * Results:
+ *	NULL on error, otherwise a valid object, typically with refCount of
+ *	zero, which it is assumed the caller will increment.
+ *
+ * Side effects:
+ *	The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFSMakePathRelative(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *pathPtr,		/* The path we have. */
+    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
+{
+    int cwdLen, len;
+    const char *tempStr;
+
+    if (pathPtr->typePtr == &tclFsPathType) {
+	FsPath *fsPathPtr = PATHOBJ(pathPtr);
+
+	if (PATHFLAGS(pathPtr) != 0
+		&& fsPathPtr->cwdPtr == cwdPtr) {
+	    pathPtr = fsPathPtr->normPathPtr;
+
+	    /* TODO: Determine how much, if any, of this forcing
+	     * the relative path tail into the "path" Tcl_ObjType
+	     * with a recorded cwdPtr context has any actual value.
+	     *
+	     * Nothing is getting cached.  Not normPathPtr, not nativePathPtr,
+	     * nor fsPtr, so storing the cwdPtr context against which such
+	     * cached values might later be validated appears to be of no
+	     * value.  Take that away, and all this code is just a mildly
+	     * optimized equivalent of a call to SetFsPathFromAny().  That
+	     * optimization may have some value, *if* these value in fact
+	     * get used as "path" values before used as something else.
+	     * If not, though, whatever cost we pay below to convert to
+	     * one of the "path" intreps is just a waste, it seems.  The
+	     * usual convention in the core is to delay ObjType conversion
+	     * until it is needed and demanded, and I don't see why this
+	     * section of code should be an exception to that.  Leaving it
+	     * in place for the rest of the 8.5.* releases just for sake
+	     * of stability.
+	     */
+
+	    /*
+	     * Free old representation.
+	     */
+
+	    if (pathPtr->typePtr != NULL) {
+		if (pathPtr->bytes == NULL) {
+		    if (pathPtr->typePtr->updateStringProc == NULL) {
+			if (interp != NULL) {
+			    Tcl_ResetResult(interp);
+			    Tcl_AppendResult(interp, "can't find object"
+				    "string representation", NULL);
+			}
+			return NULL;
+		    }
+		    pathPtr->typePtr->updateStringProc(pathPtr);
+		}
+		TclFreeIntRep(pathPtr);
+	    }
+
+	    /*
+	     * Now pathPtr is a string object.
+	     */
+
+	    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+	    /*
+	     * Circular reference, by design.
+	     */
+
+	    fsPathPtr->translatedPathPtr = pathPtr;
+	    fsPathPtr->normPathPtr = NULL;
+	    fsPathPtr->cwdPtr = cwdPtr;
+	    Tcl_IncrRefCount(cwdPtr);
+	    fsPathPtr->nativePathPtr = NULL;
+	    fsPathPtr->fsPtr = NULL;
+	    fsPathPtr->filesystemEpoch = 0;
+
+	    SETPATHOBJ(pathPtr, fsPathPtr);
+	    PATHFLAGS(pathPtr) = 0;
+	    pathPtr->typePtr = &tclFsPathType;
+
+	    return pathPtr;
+	}
+    }
+
+    /*
+     * We know the cwd is a normalised object which does not end in a
+     * directory delimiter, unless the cwd is the name of a volume, in which
+     * case it will end in a delimiter! We handle this situation here. A
+     * better test than the '!= sep' might be to simply check if 'cwd' is a
+     * root volume.
+     *
+     * Note that if we get this wrong, we will strip off either too much or
+     * too little below, leading to wrong answers returned by glob.
+     */
+
+    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+
+    /*
+     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
+     * Windows special case? Perhaps we should just check if cwd is a root
+     * volume.
+     */
+
+    switch (tclPlatform) {
+    case TCL_PLATFORM_UNIX:
+	if (tempStr[cwdLen-1] != '/') {
+	    cwdLen++;
+	}
+	break;
+    case TCL_PLATFORM_WINDOWS:
+	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
+	    cwdLen++;
+	}
+	break;
+    }
+    tempStr = Tcl_GetStringFromObj(pathPtr, &len);
+
+    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MakePathFromNormalized --
+ *
+ *	Like SetFsPathFromAny, but assumes the given object is an absolute
+ *	normalized path. Only for internal use.
+ *
+ * Results:
+ *	Standard Tcl error code.
+ *
+ * Side effects:
+ *	The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+MakePathFromNormalized(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *pathPtr)		/* The object to convert. */
+{
+    FsPath *fsPathPtr;
+
+    if (pathPtr->typePtr == &tclFsPathType) {
+	return TCL_OK;
+    }
+
+    /*
+     * Free old representation
+     */
+
+    if (pathPtr->typePtr != NULL) {
+	if (pathPtr->bytes == NULL) {
+	    if (pathPtr->typePtr->updateStringProc == NULL) {
+		if (interp != NULL) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendResult(interp, "can't find object"
+			    "string representation", NULL);
+		}
+		return TCL_ERROR;
+	    }
+	    pathPtr->typePtr->updateStringProc(pathPtr);
+	}
+	TclFreeIntRep(pathPtr);
+    }
+
+    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+    /*
+     * It's a pure normalized absolute path.
+     */
+
+    fsPathPtr->translatedPathPtr = NULL;
+
+    /*
+     * Circular reference by design.
+     */
+
+    fsPathPtr->normPathPtr = pathPtr;
+    fsPathPtr->cwdPtr = NULL;
+    fsPathPtr->nativePathPtr = NULL;
+    fsPathPtr->fsPtr = NULL;
+    /* Remember the epoch under which we decided pathPtr was normalized */
+    fsPathPtr->filesystemEpoch = TclFSEpoch();
+
+    SETPATHOBJ(pathPtr, fsPathPtr);
+    PATHFLAGS(pathPtr) = 0;
+    pathPtr->typePtr = &tclFsPathType;
+
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSNewNativePath --
+ *
+ *	This function performs the something like the reverse of the usual
+ *	obj->path->nativerep conversions. If some code retrieves a path in
+ *	native form (from, e.g. readlink or a native dialog), and that path is
+ *	to be used at the Tcl level, then calling this function is an
+ *	efficient way of creating the appropriate path object type.
+ *
+ *	Any memory which is allocated for 'clientData' should be retained
+ *	until clientData is passed to the filesystem's freeInternalRepProc
+ *	when it can be freed. The built in platform-specific filesystems use
+ *	'ckalloc' to allocate clientData, and ckfree to free it.
+ *
+ * Results:
+ *	NULL or a valid path object pointer, with refCount zero.
+ *
+ * Side effects:
+ *	New memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_FSNewNativePath(
+    Tcl_Filesystem *fromFilesystem,
+    ClientData clientData)
+{
+    Tcl_Obj *pathPtr = NULL;
+    FsPath *fsPathPtr;
+
+
+    if (fromFilesystem->internalToNormalizedProc != NULL) {
+	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
+    }
+    if (pathPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Free old representation; shouldn't normally be any, but best to be
+     * safe.
+     */
+
+    if (pathPtr->typePtr != NULL) {
+	if (pathPtr->bytes == NULL) {
+	    if (pathPtr->typePtr->updateStringProc == NULL) {
+		return NULL;
+	    }
+	    pathPtr->typePtr->updateStringProc(pathPtr);
+	}
+	TclFreeIntRep(pathPtr);
+    }
+
+    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+    fsPathPtr->translatedPathPtr = NULL;
+
+    /*
+     * Circular reference, by design.
+     */
+
+    fsPathPtr->normPathPtr = pathPtr;
+    fsPathPtr->cwdPtr = NULL;
+    fsPathPtr->nativePathPtr = clientData;
+    fsPathPtr->fsPtr = fromFilesystem;
+    fsPathPtr->filesystemEpoch = TclFSEpoch();
+
+    SETPATHOBJ(pathPtr, fsPathPtr);
+    PATHFLAGS(pathPtr) = 0;
+    pathPtr->typePtr = &tclFsPathType;
+
+    return pathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetTranslatedPath --
+ *
+ *	This function attempts to extract the translated path from the given
+ *	Tcl_Obj. If the translation succeeds (i.e. the object is a valid
+ *	path), then it is returned. Otherwise NULL will be returned, and an
+ *	error message may be left in the interpreter (if it is non-NULL)
+ *
+ * Results:
+ *	NULL or a valid Tcl_Obj pointer.
+ *
+ * Side effects:
+ *	Only those of 'Tcl_FSConvertToPathType'
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_FSGetTranslatedPath(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathPtr)
+{
+    Tcl_Obj *retObj = NULL;
+    FsPath *srcFsPathPtr;
+
+    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
+	return NULL;
+    }
+    srcFsPathPtr = PATHOBJ(pathPtr);
+    if (srcFsPathPtr->translatedPathPtr == NULL) {
+	if (PATHFLAGS(pathPtr) != 0) {
+	    /*
+	     * We lack a translated path result, but we have a directory
+	     * (cwdPtr) and a tail (normPathPtr), and if we join the
+	     * translated version of cwdPtr to normPathPtr, we'll get the
+	     * translated result we need, and can store it for future use.
+	     */
+
+	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
+		    srcFsPathPtr->cwdPtr);
+	    if (translatedCwdPtr == NULL) {
+		return NULL;
+	    }
+
+	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
+		    &(srcFsPathPtr->normPathPtr));
+	    srcFsPathPtr->translatedPathPtr = retObj;
+	    if (translatedCwdPtr->typePtr == &tclFsPathType) {
+		srcFsPathPtr->filesystemEpoch
+			= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
+	    } else {
+		srcFsPathPtr->filesystemEpoch = 0;
+	    }
+	    Tcl_IncrRefCount(retObj);
+	    Tcl_DecrRefCount(translatedCwdPtr);
+	} else {
+	    /*
+	     * It is a pure absolute, normalized path object. This is
+	     * something like being a 'pure list'. The object's string,
+	     * translatedPath and normalizedPath are all identical.
+	     */
+
+	    retObj = srcFsPathPtr->normPathPtr;
+	}
+    } else {
+	/*
+	 * It is an ordinary path object.
+	 */
+
+	retObj = srcFsPathPtr->translatedPathPtr;
+    }
+
+    if (retObj != NULL) {
+	Tcl_IncrRefCount(retObj);
+    }
+    return retObj;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetTranslatedStringPath --
+ *
+ *	This function attempts to extract the translated path from the given
+ *	Tcl_Obj. If the translation succeeds (i.e. the object is a valid
+ *	path), then the path is returned. Otherwise NULL will be returned, and
+ *	an error message may be left in the interpreter (if it is non-NULL)
+ *
+ * Results:
+ *	NULL or a valid string.
+ *
+ * Side effects:
+ *	Only those of 'Tcl_FSConvertToPathType'
+ *
+ *---------------------------------------------------------------------------
+ */
+
+const char *
+Tcl_FSGetTranslatedStringPath(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathPtr)
+{
+    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+
+    if (transPtr != NULL) {
+	int len;
+	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
+	char *result = (char *) ckalloc((unsigned) len+1);
+
+	memcpy(result, orig, (size_t) len+1);
+	TclDecrRefCount(transPtr);
+	return result;
+    }
+
+    return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetNormalizedPath --
+ *
+ *	This important function attempts to extract from the given Tcl_Obj a
+ *	unique normalised path representation, whose string value can be used
+ *	as a unique identifier for the file.
+ *
+ * Results:
+ *	NULL or a valid path object pointer.
+ *
+ * Side effects:
+ *	New memory may be allocated. The Tcl 'errno' may be modified in the
+ *	process of trying to examine various path possibilities.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_FSGetNormalizedPath(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathPtr)
+{
+    FsPath *fsPathPtr;
+
+    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
+	return NULL;
+    }
+    fsPathPtr = PATHOBJ(pathPtr);
+
+    if (PATHFLAGS(pathPtr) != 0) {
+	/*
+	 * This is a special path object which is the result of something like
+	 * 'file join'
+	 */
+
+	Tcl_Obj *dir, *copy;
+	int tailLen, cwdLen, pathType;
+
+	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
+	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
+	if (dir == NULL) {
+	    return NULL;
+	}
+	/* TODO: Figure out why this is needed. */
+	if (pathPtr->bytes == NULL) {
+	    UpdateStringOfFsPath(pathPtr);
+	}
+
+	Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
+	if (tailLen) {
+	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
+	} else {
+	    copy = Tcl_DuplicateObj(dir);
+	}
+	Tcl_IncrRefCount(dir);
+	Tcl_IncrRefCount(copy);
+
+	/*
+	 * We now own a reference on both 'dir' and 'copy'
+	 */
+
+	(void) Tcl_GetStringFromObj(dir, &cwdLen);
+	cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
+
+	/* Normalize the combined string. */
+
+	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
+	    /*
+	     * If the "tail" part has components (like /../) that cause
+	     * the combined path to need more complete normalizing,
+	     * call on the more powerful routine to accomplish that so
+	     * we avoid [Bug 2385549] ...
+	     */
+
+	    Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
+	    Tcl_DecrRefCount(copy);
+	    copy = newCopy;
+	} else {
+	    /*
+	     * ... but in most cases where we join a trouble free tail
+	     * to a normalized head, we can more efficiently normalize the
+	     * combined path by passing over only the unnormalized tail
+	     * portion.  When this is sufficient, prior developers claim
+	     * this should be much faster.  We use 'cwdLen-1' so that we are
+	     * already pointing at the dir-separator that we know about.
+	     * The normalization code will actually start off directly
+	     * after that separator.
+	     */
+
+	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
+	}
+
+	/* Now we need to construct the new path object. */
+
+	if (pathType == TCL_PATH_RELATIVE) {
+	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;
+
+	    /*
+	     * NOTE: here we are (dangerously?) assuming that origDir points
+	     * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType .  The
+	     *     pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
+	     * above that set the pathType value should have established
+	     * that, but it's far less clear on what basis we know there's
+	     * been no shimmering since then.
+	     */
+
+	    FsPath *origDirFsPathPtr = PATHOBJ(origDir);
+
+	    fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
+	    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
+
+	    TclDecrRefCount(fsPathPtr->normPathPtr);
+	    fsPathPtr->normPathPtr = copy;
+
+	    /*
+	     * That's our reference to copy used.
+	     */
+
+	    TclDecrRefCount(dir);
+	    TclDecrRefCount(origDir);
+	} else {
+	    TclDecrRefCount(fsPathPtr->cwdPtr);
+	    fsPathPtr->cwdPtr = NULL;
+	    TclDecrRefCount(fsPathPtr->normPathPtr);
+	    fsPathPtr->normPathPtr = copy;
+
+	    /*
+	     * That's our reference to copy used.
+	     */
+
+	    TclDecrRefCount(dir);
+	}
+	PATHFLAGS(pathPtr) = 0;
+    }
+
+    /*
+     * Ensure cwd hasn't changed.
+     */
+
+    if (fsPathPtr->cwdPtr != NULL) {
+	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
+	    if (pathPtr->bytes == NULL) {
+		UpdateStringOfFsPath(pathPtr);
+	    }
+	    FreeFsPathInternalRep(pathPtr);
+	    if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
+		return NULL;
+	    }
+	    fsPathPtr = PATHOBJ(pathPtr);
+	} else if (fsPathPtr->normPathPtr == NULL) {
+	    int cwdLen;
+	    Tcl_Obj *copy;
+
+	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
+
+	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
+	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
+
+	    /*
+	     * Normalize the combined string, but only starting after the end
+	     * of the previously normalized 'dir'. This should be much faster!
+	     */
+
+	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
+	    fsPathPtr->normPathPtr = copy;
+	    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
+	}
+    }
+    if (fsPathPtr->normPathPtr == NULL) {
+	Tcl_Obj *useThisCwd = NULL;
+	int pureNormalized = 1;
+
+	/*
+	 * Since normPathPtr is NULL, but this is a valid path object, we know
+	 * that the translatedPathPtr cannot be NULL.
+	 */
+
+	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
+	const char *path = TclGetString(absolutePath);
+
+	Tcl_IncrRefCount(absolutePath);
+
+	/*
+	 * We have to be a little bit careful here to avoid infinite loops
+	 * we're asking Tcl_FSGetPathType to return the path's type, but that
+	 * call can actually result in a lot of other filesystem action, which
+	 * might loop back through here.
+	 */
+
+	if (path[0] == '\0') {
+	    /*
+	     * Special handling for the empty string value.  This one is
+	     * very weird with [file normalize {}] => {}.  (The reasoning
+	     * supporting this is unknown to DGP, but he fears changing it.)
+	     * Attempt here to keep the expectations of other parts of
+	     * Tcl_Filesystem code about state of the FsPath fields satisfied.
+	     *
+	     * In particular, capture the cwd value and save so it can be
+	     * stored in the cwdPtr field below.
+	     */
+
+	    useThisCwd = Tcl_FSGetCwd(interp);
+	} else {
+	    /*
+	     * We don't ask for the type of 'pathPtr' here, because that is
+	     * not correct for our purposes when we have a path like '~'. Tcl
+	     * has a bit of a contradiction in that '~' paths are defined as
+	     * 'absolute', but in reality can be just about anything,
+	     * depending on how env(HOME) is set.
+	     */
+
+	    Tcl_PathType type = Tcl_FSGetPathType(absolutePath);
+
+	    if (type == TCL_PATH_RELATIVE) {
+		useThisCwd = Tcl_FSGetCwd(interp);
+
+		if (useThisCwd == NULL) {
+		    return NULL;
+		}
+
+		pureNormalized = 0;
+		Tcl_DecrRefCount(absolutePath);
+		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
+		Tcl_IncrRefCount(absolutePath);
+
+		/*
+		 * We have a refCount on the cwd.
+		 */
+#ifdef __WIN32__
+	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
+		/*
+		 * Only Windows has volume-relative paths.
+		 */
+
+		Tcl_DecrRefCount(absolutePath);
+		absolutePath = TclWinVolumeRelativeNormalize(interp,
+			path, &useThisCwd);
+		if (absolutePath == NULL) {
+		    return NULL;
+		}
+		pureNormalized = 0;
+#endif /* __WIN32__ */
+	    }
+	}
+
+	/*
+	 * Already has refCount incremented.
+	 */
+
+	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
+		absolutePath);
+
+	/*
+	 * Check if path is pure normalized (this can only be the case if it
+	 * is an absolute path).
+	 */
+
+	if (pureNormalized) {
+	    if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
+		    TclGetString(pathPtr))) {
+		/*
+		 * The path was already normalized. Get rid of the duplicate.
+		 */
+
+		TclDecrRefCount(fsPathPtr->normPathPtr);
+
+		/*
+		 * We do *not* increment the refCount for this circular
+		 * reference.
+		 */
+
+		fsPathPtr->normPathPtr = pathPtr;
+	    }
+	}
+	if (useThisCwd != NULL) {
+	    /*
+	     * We just need to free an object we allocated above for relative
+	     * paths (this was returned by Tcl_FSJoinToPath above), and then
+	     * of course store the cwd.
+	     */
+
+	    fsPathPtr->cwdPtr = useThisCwd;
+	}
+	TclDecrRefCount(absolutePath);
+    }
+
+    return fsPathPtr->normPathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetInternalRep --
+ *
+ *	Extract the internal representation of a given path object, in the
+ *	given filesystem. If the path object belongs to a different
+ *	filesystem, we return NULL.
+ *
+ *	If the internal representation is currently NULL, we attempt to
+ *	generate it, by calling the filesystem's
+ *	'Tcl_FSCreateInternalRepProc'.
+ *
+ * Results:
+ *	NULL or a valid internal representation.
+ *
+ * Side effects:
+ *	An attempt may be made to convert the object.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_FSGetInternalRep(
+    Tcl_Obj *pathPtr,
+    Tcl_Filesystem *fsPtr)
+{
+    FsPath *srcFsPathPtr;
+
+    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
+	return NULL;
+    }
+    srcFsPathPtr = PATHOBJ(pathPtr);
+
+    /*
+     * We will only return the native representation for the caller's
+     * filesystem. Otherwise we will simply return NULL. This means that there
+     * must be a unique bi-directional mapping between paths and filesystems,
+     * and that this mapping will not allow 'remapped' files -- files which
+     * are in one filesystem but mapped into another. Another way of putting
+     * this is that 'stacked' filesystems are not allowed. We recognise that
+     * this is a potentially useful feature for the future.
+     *
+     * Even something simple like a 'pass through' filesystem which logs all
+     * activity and passes the calls onto the native system would be nice, but
+     * not easily achievable with the current implementation.
+     */
+
+    if (srcFsPathPtr->fsPtr == NULL) {
+	/*
+	 * This only usually happens in wrappers like TclpStat which create a
+	 * string object and pass it to TclpObjStat. Code which calls the
+	 * Tcl_FS.. functions should always have a filesystem already set.
+	 * Whether this code path is legal or not depends on whether we decide
+	 * to allow external code to call the native filesystem directly. It
+	 * is at least safer to allow this sub-optimal routing.
+	 */
+
+	Tcl_FSGetFileSystemForPath(pathPtr);
+
+	/*
+	 * If we fail through here, then the path is probably not a valid path
+	 * in the filesystsem, and is most likely to be a use of the empty
+	 * path "" via a direct call to one of the objectified interfaces
+	 * (e.g. from the Tcl testsuite).
+	 */
+
+	srcFsPathPtr = PATHOBJ(pathPtr);
+	if (srcFsPathPtr->fsPtr == NULL) {
+	    return NULL;
+	}
+    }
+
+    /*
+     * There is still one possibility we should consider; if the file belongs
+     * to a different filesystem, perhaps it is actually linked through to a
+     * file in our own filesystem which we do care about. The way we can check
+     * for this is we ask what filesystem this path belongs to.
+     */
+
+    if (fsPtr != srcFsPathPtr->fsPtr) {
+	const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
+
+	if (actualFs == fsPtr) {
+	    return Tcl_FSGetInternalRep(pathPtr, fsPtr);
+	}
+	return NULL;
+    }
+
+    if (srcFsPathPtr->nativePathPtr == NULL) {
+	Tcl_FSCreateInternalRepProc *proc;
+	char *nativePathPtr;
+
+	proc = srcFsPathPtr->fsPtr->createInternalRepProc;
+	if (proc == NULL) {
+	    return NULL;
+	}
+
+	nativePathPtr = (*proc)(pathPtr);
+	srcFsPathPtr = PATHOBJ(pathPtr);
+	srcFsPathPtr->nativePathPtr = nativePathPtr;
+    }
+
+    return srcFsPathPtr->nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFSEnsureEpochOk --
+ *
+ *	This will ensure the pathPtr is up to date and can be converted into a
+ *	"path" type, and that we are able to generate a complete normalized
+ *	path which is used to determine the filesystem match.
+ *
+ * Results:
+ *	Standard Tcl return code.
+ *
+ * Side effects:
+ *	An attempt may be made to convert the object.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclFSEnsureEpochOk(
+    Tcl_Obj *pathPtr,
+    Tcl_Filesystem **fsPtrPtr)
+{
+    FsPath *srcFsPathPtr;
+
+    if (pathPtr->typePtr != &tclFsPathType) {
+	return TCL_OK;
+    }
+
+    srcFsPathPtr = PATHOBJ(pathPtr);
+
+    /*
+     * Check if the filesystem has changed in some way since this object's
+     * internal representation was calculated.
+     */
+
+    if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
+	/*
+	 * We have to discard the stale representation and recalculate it.
+	 */
+
+	if (pathPtr->bytes == NULL) {
+	    UpdateStringOfFsPath(pathPtr);
+	}
+	FreeFsPathInternalRep(pathPtr);
+	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	srcFsPathPtr = PATHOBJ(pathPtr);
+    }
+
+    /*
+     * Check whether the object is already assigned to a fs.
+     */
+
+    if (srcFsPathPtr->fsPtr != NULL) {
+	*fsPtrPtr = srcFsPathPtr->fsPtr;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFSSetPathDetails --
+ *
+ *	???
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	???
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclFSSetPathDetails(
+    Tcl_Obj *pathPtr,
+    Tcl_Filesystem *fsPtr,
+    ClientData clientData)
+{
+    FsPath *srcFsPathPtr;
+
+    /*
+     * Make sure pathPtr is of the correct type.
+     */
+
+    if (pathPtr->typePtr != &tclFsPathType) {
+	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
+	    return;
+	}
+    }
+
+    srcFsPathPtr = PATHOBJ(pathPtr);
+    srcFsPathPtr->fsPtr = fsPtr;
+    srcFsPathPtr->nativePathPtr = clientData;
+    srcFsPathPtr->filesystemEpoch = TclFSEpoch();
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSEqualPaths --
+ *
+ *	This function tests whether the two paths given are equal path
+ *	objects. If either or both is NULL, 0 is always returned.
+ *
+ * Results:
+ *	1 or 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSEqualPaths(
+    Tcl_Obj *firstPtr,
+    Tcl_Obj *secondPtr)
+{
+    char *firstStr, *secondStr;
+    int firstLen, secondLen, tempErrno;
+
+    if (firstPtr == secondPtr) {
+	return 1;
+    }
+
+    if (firstPtr == NULL || secondPtr == NULL) {
+	return 0;
+    }
+    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
+    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
+    if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
+	return 1;
+    }
+
+    /*
+     * Try the most thorough, correct method of comparing fully normalized
+     * paths.
+     */
+
+    tempErrno = Tcl_GetErrno();
+    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
+    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
+    Tcl_SetErrno(tempErrno);
+
+    if (firstPtr == NULL || secondPtr == NULL) {
+	return 0;
+    }
+
+    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
+    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
+    return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetFsPathFromAny --
+ *
+ *	This function tries to convert the given Tcl_Obj to a valid Tcl path
+ *	type.
+ *
+ *	The filename may begin with "~" (to indicate current user's home
+ *	directory) or "~<user>" (to indicate any user's home directory).
+ *
+ * Results:
+ *	Standard Tcl error code.
+ *
+ * Side effects:
+ *	The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetFsPathFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *pathPtr)		/* The object to convert. */
+{
+    int len;
+    FsPath *fsPathPtr;
+    Tcl_Obj *transPtr;
+    char *name;
+
+    if (pathPtr->typePtr == &tclFsPathType) {
+	return TCL_OK;
+    }
+
+    /*
+     * First step is to translate the filename. This is similar to
+     * Tcl_TranslateFilename, but shouldn't convert everything to windows
+     * backslashes on that platform. The current implementation of this piece
+     * is a slightly optimised version of the various Tilde/Split/Join stuff
+     * to avoid multiple split/join operations.
+     *
+     * We remove any trailing directory separator.
+     *
+     * However, the split/join routines are quite complex, and one has to make
+     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
+     * cmdAH.test exercise most of the code).
+     */
+
+    name = Tcl_GetStringFromObj(pathPtr, &len);
+
+    /*
+     * Handle tilde substitutions, if needed.
+     */
+
+    if (name[0] == '~') {
+	char *expandedUser;
+	Tcl_DString temp;
+	int split;
+	char separator = '/';
+
+	split = FindSplitPos(name, separator);
+	if (split != len) {
+	    /*
+	     * We have multiple pieces '~user/foo/bar...'
+	     */
+
+	    name[split] = '\0';
+	}
+
+	/*
+	 * Do some tilde substitution.
+	 */
+
+	if (name[1] == '\0') {
+	    /*
+	     * We have just '~'
+	     */
+
+	    const char *dir;
+	    Tcl_DString dirString;
+
+	    if (split != len) {
+		name[split] = separator;
+	    }
+
+	    dir = TclGetEnv("HOME", &dirString);
+	    if (dir == NULL) {
+		if (interp) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendResult(interp, "couldn't find HOME environment "
+			    "variable to expand path", NULL);
+		}
+		return TCL_ERROR;
+	    }
+	    Tcl_DStringInit(&temp);
+	    Tcl_JoinPath(1, &dir, &temp);
+	    Tcl_DStringFree(&dirString);
+	} else {
+	    /*
+	     * We have a user name '~user'
+	     */
+
+	    Tcl_DStringInit(&temp);
+	    if (TclpGetUserHome(name+1, &temp) == NULL) {
+		if (interp != NULL) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendResult(interp, "user \"", name+1,
+			    "\" doesn't exist", NULL);
+		}
+		Tcl_DStringFree(&temp);
+		if (split != len) {
+		    name[split] = separator;
+		}
+		return TCL_ERROR;
+	    }
+	    if (split != len) {
+		name[split] = separator;
+	    }
+	}
+
+	expandedUser = Tcl_DStringValue(&temp);
+	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
+
+	if (split != len) {
+	    /*
+	     * Join up the tilde substitution with the rest.
+	     */
+
+	    if (name[split+1] == separator) {
+		/*
+		 * Somewhat tricky case like ~//foo/bar. Make use of
+		 * Split/Join machinery to get it right. Assumes all paths
+		 * beginning with ~ are part of the native filesystem.
+		 */
+
+		int objc;
+		Tcl_Obj **objv;
+		Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
+
+		Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
+
+		/*
+		 * Skip '~'. It's replaced by its expansion.
+		 */
+
+		objc--; objv++;
+		while (objc--) {
+		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
+		}
+		TclDecrRefCount(parts);
+	    } else {
+		/*
+		 * Simple case. "rest" is relative path. Just join it. The
+		 * "rest" object will be freed when Tcl_FSJoinToPath returns
+		 * (unless something else claims a refCount on it).
+		 */
+
+		Tcl_Obj *joined;
+		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1);
+
+		Tcl_IncrRefCount(transPtr);
+		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
+		TclDecrRefCount(transPtr);
+		transPtr = joined;
+	    }
+	}
+	Tcl_DStringFree(&temp);
+    } else {
+	/* Bug 3479689: protect 0-refcount pathPth from getting freed */
+	pathPtr->refCount++;
+	transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
+	pathPtr->refCount--;
+    }
+
+    /*
+     * Now we have a translated filename in 'transPtr'. This will have forward
+     * slashes on Windows, and will not contain any ~user sequences.
+     */
+
+    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+    fsPathPtr->translatedPathPtr = transPtr;
+    if (transPtr != pathPtr) {
+	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
+	/* Redo translation when $env(HOME) changes */
+	fsPathPtr->filesystemEpoch = TclFSEpoch();
+    } else {
+	fsPathPtr->filesystemEpoch = 0;
+    }
+    fsPathPtr->normPathPtr = NULL;
+    fsPathPtr->cwdPtr = NULL;
+    fsPathPtr->nativePathPtr = NULL;
+    fsPathPtr->fsPtr = NULL;
+
+    /*
+     * Free old representation before installing our new one.
+     */
+
+    TclFreeIntRep(pathPtr);
+    SETPATHOBJ(pathPtr, fsPathPtr);
+    PATHFLAGS(pathPtr) = 0;
+    pathPtr->typePtr = &tclFsPathType;
+    return TCL_OK;
+}
+
+static void
+FreeFsPathInternalRep(
+    Tcl_Obj *pathPtr)		/* Path object with internal rep to free. */
+{
+    FsPath *fsPathPtr = PATHOBJ(pathPtr);
+
+    if (fsPathPtr->translatedPathPtr != NULL) {
+	if (fsPathPtr->translatedPathPtr != pathPtr) {
+	    TclDecrRefCount(fsPathPtr->translatedPathPtr);
+	}
+    }
+    if (fsPathPtr->normPathPtr != NULL) {
+	if (fsPathPtr->normPathPtr != pathPtr) {
+	    TclDecrRefCount(fsPathPtr->normPathPtr);
+	}
+	fsPathPtr->normPathPtr = NULL;
+    }
+    if (fsPathPtr->cwdPtr != NULL) {
+	TclDecrRefCount(fsPathPtr->cwdPtr);
+    }
+    if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
+	Tcl_FSFreeInternalRepProc *freeProc =
+		fsPathPtr->fsPtr->freeInternalRepProc;
+
+	if (freeProc != NULL) {
+	    (*freeProc)(fsPathPtr->nativePathPtr);
+	    fsPathPtr->nativePathPtr = NULL;
+	}
+    }
+
+    ckfree((char *) fsPathPtr);
+    pathPtr->typePtr = NULL;
+}
+
+static void
+DupFsPathInternalRep(
+    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
+{
+    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
+    FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+
+    SETPATHOBJ(copyPtr, copyFsPathPtr);
+
+    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
+	/* Cycle in src -> make cycle in copy. */
+	copyFsPathPtr->translatedPathPtr = copyPtr;
+    } else {
+	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
+	if (copyFsPathPtr->translatedPathPtr != NULL) {
+	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+	}
+    }
+
+    if (srcFsPathPtr->normPathPtr == srcPtr) {
+	/* Cycle in src -> make cycle in copy. */
+	copyFsPathPtr->normPathPtr = copyPtr;
+    } else {
+	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
+	if (copyFsPathPtr->normPathPtr != NULL) {
+	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
+	}
+    }
+
+    copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
+    if (copyFsPathPtr->cwdPtr != NULL) {
+	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
+    }
+
+    copyFsPathPtr->flags = srcFsPathPtr->flags;
+
+    if (srcFsPathPtr->fsPtr != NULL
+	    && srcFsPathPtr->nativePathPtr != NULL) {
+	Tcl_FSDupInternalRepProc *dupProc =
+		srcFsPathPtr->fsPtr->dupInternalRepProc;
+
+	if (dupProc != NULL) {
+	    copyFsPathPtr->nativePathPtr =
+		    (*dupProc)(srcFsPathPtr->nativePathPtr);
+	} else {
+	    copyFsPathPtr->nativePathPtr = NULL;
+	}
+    } else {
+	copyFsPathPtr->nativePathPtr = NULL;
+    }
+    copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
+    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
+
+    copyPtr->typePtr = &tclFsPathType;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateStringOfFsPath --
+ *
+ *	Gives an object a valid string rep.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfFsPath(
+    register Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
+{
+    FsPath *fsPathPtr = PATHOBJ(pathPtr);
+    int cwdLen;
+    Tcl_Obj *copy;
+
+    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
+	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
+    }
+
+    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
+
+    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
+    pathPtr->length = cwdLen;
+    copy->bytes = tclEmptyStringRep;
+    copy->length = 0;
+    TclDecrRefCount(copy);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativePathInFilesystem --
+ *
+ *	Any path object is acceptable to the native filesystem, by default (we
+ *	will throw errors when illegal paths are actually tried to be used).
+ *
+ *	However, this behavior means the native filesystem must be the last
+ *	filesystem in the lookup list (otherwise it will claim all files
+ *	belong to it, and other filesystems will never get a look in).
+ *
+ * Results:
+ *	TCL_OK, to indicate 'yes', -1 to indicate no.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclNativePathInFilesystem(
+    Tcl_Obj *pathPtr,
+    ClientData *clientDataPtr)
+{
+    /*
+     * A special case is required to handle the empty path "". This is a valid
+     * path (i.e. the user should be able to do 'file exists ""' without
+     * throwing an error), but equally the path doesn't exist. Those are the
+     * semantics of Tcl (at present anyway), so we have to abide by them here.
+     */
+
+    if (pathPtr->typePtr == &tclFsPathType) {
+	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
+	    /*
+	     * We reject the empty path "".
+	     */
+
+	    return -1;
+	}
+
+	/*
+	 * Otherwise there is no way this path can be empty.
+	 */
+    } else {
+	/*
+	 * It is somewhat unusual to reach this code path without the object
+	 * being of tclFsPathType. However, we do our best to deal with the
+	 * situation.
+	 */
+
+	int len;
+
+	(void) Tcl_GetStringFromObj(pathPtr, &len);
+	if (len == 0) {
+	    /*
+	     * We reject the empty path "".
+	     */
+
+	    return -1;
+	}
+    }
+
+    /*
+     * Path is of correct type, or is of non-zero length, so we accept it.
+     */
+
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 6e7029e..698f85d 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -1,60 +1,56 @@
-/* 
+/*
  * tclPipe.c --
  *
- *	This file contains the generic portion of the command channel
- *	driver as well as various utility routines used in managing
- *	subprocesses.
+ *	This file contains the generic portion of the command channel driver
+ *	as well as various utility routines used in managing subprocesses.
  *
  * Copyright (c) 1997 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
- * A linked list of the following structures is used to keep track
- * of child processes that have been detached but haven't exited
- * yet, so we can make sure that they're properly "reaped" (officially
- * waited for) and don't lie around as zombies cluttering the
- * system.
+ * A linked list of the following structures is used to keep track of child
+ * processes that have been detached but haven't exited yet, so we can make
+ * sure that they're properly "reaped" (officially waited for) and don't lie
+ * around as zombies cluttering the system.
  */
 
 typedef struct Detached {
-    Tcl_Pid pid;			/* Id of process that's been detached
-					 * but isn't known to have exited. */
-    struct Detached *nextPtr;		/* Next in list of all detached
-					 * processes. */
+    Tcl_Pid pid;		/* Id of process that's been detached but
+				 * isn't known to have exited. */
+    struct Detached *nextPtr;	/* Next in list of all detached processes. */
 } Detached;
 
-static Detached *detList = NULL;	/* List of all detached proceses. */
-TCL_DECLARE_MUTEX(pipeMutex)		/* Guard access to detList. */
+static Detached *detList = NULL;/* List of all detached proceses. */
+TCL_DECLARE_MUTEX(pipeMutex)	/* Guard access to detList. */
 
 /*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
  */
 
-static TclFile	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
-	            CONST char *spec, int atOk, CONST char *arg, 
-		    CONST char *nextArg, int flags, int *skipPtr,
-		    int *closePtr, int *releasePtr));
+static TclFile		FileForRedirect(Tcl_Interp *interp, CONST char *spec,
+			    int atOk, CONST char *arg, CONST char *nextArg,
+			    int flags, int *skipPtr, int *closePtr,
+			    int *releasePtr);
 
 /*
  *----------------------------------------------------------------------
  *
  * FileForRedirect --
  *
- *	This procedure does much of the work of parsing redirection
- *	operators.  It handles "@" if specified and allowed, and a file
- *	name, and opens the file if necessary.
+ *	This function does much of the work of parsing redirection operators.
+ *	It handles "@" if specified and allowed, and a file name, and opens
+ *	the file if necessary.
  *
  * Results:
- *	The return value is the descriptor number for the file.  If an
- *	error occurs then NULL is returned and an error message is left
- *	in the interp's result.  Several arguments are side-effected; see
- *	the argument list below for details.
+ *	The return value is the descriptor number for the file. If an error
+ *	occurs then NULL is returned and an error message is left in the
+ *	interp's result. Several arguments are side-effected; see the argument
+ *	list below for details.
  *
  * Side effects:
  *	None.
@@ -63,34 +59,33 @@ static TclFile	FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  */
 
 static TclFile
-FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
-	releasePtr)
-    Tcl_Interp *interp;		/* Intepreter to use for error reporting. */
-    CONST char *spec;		/* Points to character just after
-				 * redirection character. */
-    int atOK;			/* Non-zero means that '@' notation can be 
+FileForRedirect(
+    Tcl_Interp *interp,		/* Intepreter to use for error reporting. */
+    CONST char *spec,		/* Points to character just after redirection
+				 * character. */
+    int atOK,			/* Non-zero means that '@' notation can be
 				 * used to specify a channel, zero means that
 				 * it isn't. */
-    CONST char *arg;		/* Pointer to entire argument containing 
-				 * spec:  used for error reporting. */
-    CONST char *nextArg;	/* Next argument in argc/argv array, if needed 
-				 * for file name or channel name.  May be 
+    CONST char *arg,		/* Pointer to entire argument containing spec:
+				 * used for error reporting. */
+    CONST char *nextArg,	/* Next argument in argc/argv array, if needed
+				 * for file name or channel name. May be
 				 * NULL. */
-    int flags;			/* Flags to use for opening file or to 
-				 * specify mode for channel. */
-    int *skipPtr;		/* Filled with 1 if redirection target was
-				 * in spec, 2 if it was in nextArg. */
-    int *closePtr;		/* Filled with one if the caller should 
-				 * close the file when done with it, zero
+    int flags,			/* Flags to use for opening file or to specify
+				 * mode for channel. */
+    int *skipPtr,		/* Filled with 1 if redirection target was in
+				 * spec, 2 if it was in nextArg. */
+    int *closePtr,		/* Filled with one if the caller should close
+				 * the file when done with it, zero
 				 * otherwise. */
-    int *releasePtr;
+    int *releasePtr)
 {
     int writing = (flags & O_WRONLY);
     Tcl_Channel chan;
     TclFile file;
 
     *skipPtr = 1;
-    if ((atOK != 0)  && (*spec == '@')) {
+    if ((atOK != 0) && (*spec == '@')) {
 	spec++;
 	if (*spec == '\0') {
 	    spec = nextArg;
@@ -105,18 +100,22 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
         }
 	file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
         if (file == NULL) {
-	    Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
-		    "\" wasn't opened for ",
-		    ((writing) ? "writing" : "reading"), (char *) NULL);
+	    Tcl_Obj* msg;
+	    Tcl_GetChannelError(chan, &msg);
+	    if (msg) {
+		Tcl_SetObjResult (interp, msg);
+	    } else {
+		Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
+				 "\" wasn't opened for ",
+				 ((writing) ? "writing" : "reading"), NULL);
+	    }
             return NULL;
         }
 	*releasePtr = 1;
 	if (writing) {
-
 	    /*
-	     * Be sure to flush output to the file, so that anything
-	     * written by the child appears after stuff we've already
-	     * written.
+	     * Be sure to flush output to the file, so that anything written
+	     * by the child appears after stuff we've already written.
 	     */
 
             Tcl_Flush(chan);
@@ -141,16 +140,16 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
 	if (file == NULL) {
 	    Tcl_AppendResult(interp, "couldn't ",
 		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+		    Tcl_PosixError(interp), NULL);
 	    return NULL;
 	}
         *closePtr = 1;
     }
     return file;
 
-    badLastArg:
+  badLastArg:
     Tcl_AppendResult(interp, "can't specify \"", arg,
-	    "\" as last word in command", (char *) NULL);
+	    "\" as last word in command", NULL);
     return NULL;
 }
 
@@ -159,10 +158,9 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
  *
  * Tcl_DetachPids --
  *
- *	This procedure is called to indicate that one or more child
- *	processes have been placed in background and will never be
- *	waited for;  they should eventually be reaped by
- *	Tcl_ReapDetachedProcs.
+ *	This function is called to indicate that one or more child processes
+ *	have been placed in background and will never be waited for; they
+ *	should eventually be reaped by Tcl_ReapDetachedProcs.
  *
  * Results:
  *	None.
@@ -174,10 +172,10 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
  */
 
 void
-Tcl_DetachPids(numPids, pidPtr)
-    int numPids;		/* Number of pids to detach:  gives size
-				 * of array pointed to by pidPtr. */
-    Tcl_Pid *pidPtr;		/* Array of pids to detach. */
+Tcl_DetachPids(
+    int numPids,		/* Number of pids to detach: gives size of
+				 * array pointed to by pidPtr. */
+    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
 {
     register Detached *detPtr;
     int i;
@@ -198,23 +196,22 @@ Tcl_DetachPids(numPids, pidPtr)
  *
  * Tcl_ReapDetachedProcs --
  *
- *	This procedure checks to see if any detached processes have
- *	exited and, if so, it "reaps" them by officially waiting on
- *	them.  It should be called "occasionally" to make sure that
- *	all detached processes are eventually reaped.
+ *	This function checks to see if any detached processes have exited and,
+ *	if so, it "reaps" them by officially waiting on them. It should be
+ *	called "occasionally" to make sure that all detached processes are
+ *	eventually reaped.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Processes are waited on, so that they can be reaped by the
- *	system.
+ *	Processes are waited on, so that they can be reaped by the system.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_ReapDetachedProcs()
+Tcl_ReapDetachedProcs(void)
 {
     register Detached *detPtr;
     Detached *nextPtr, *prevPtr;
@@ -246,30 +243,30 @@ Tcl_ReapDetachedProcs()
  *
  * TclCleanupChildren --
  *
- *	This is a utility procedure used to wait for child processes
- *	to exit, record information about abnormal exits, and then
- *	collect any stderr output generated by them.
+ *	This is a utility function used to wait for child processes to exit,
+ *	record information about abnormal exits, and then collect any stderr
+ *	output generated by them.
  *
  * Results:
- *	The return value is a standard Tcl result.  If anything at
- *	weird happened with the child processes, TCL_ERROR is returned
- *	and a message is left in the interp's result.
+ *	The return value is a standard Tcl result. If anything at weird
+ *	happened with the child processes, TCL_ERROR is returned and a message
+ *	is left in the interp's result.
  *
  * Side effects:
- *	If the last character of the interp's result is a newline, then it
- *	is removed unless keepNewline is non-zero.  File errorId gets
- *	closed, and pidPtr is freed back to the storage allocator.
+ *	If the last character of the interp's result is a newline, then it is
+ *	removed unless keepNewline is non-zero. File errorId gets closed, and
+ *	pidPtr is freed back to the storage allocator.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCleanupChildren(interp, numPids, pidPtr, errorChan)
-    Tcl_Interp *interp;		/* Used for error messages. */
-    int numPids;		/* Number of entries in pidPtr array. */
-    Tcl_Pid *pidPtr;		/* Array of process ids of children. */
-    Tcl_Channel errorChan;	/* Channel for file containing stderr output
-				 * from pipeline.  NULL means there isn't any
+TclCleanupChildren(
+    Tcl_Interp *interp,		/* Used for error messages. */
+    int numPids,		/* Number of entries in pidPtr array. */
+    Tcl_Pid *pidPtr,		/* Array of process ids of children. */
+    Tcl_Channel errorChan)	/* Channel for file containing stderr output
+				 * from pipeline. NULL means there isn't any
 				 * stderr output. */
 {
     int result = TCL_OK;
@@ -282,93 +279,83 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
     abnormalExit = 0;
     for (i = 0; i < numPids; i++) {
 	/*
-	 * We need to get the resolved pid before we wait on it as
-	 * the windows implementation of Tcl_WaitPid deletes the
-	 * information such that any following calls to TclpGetPid
-	 * fail.
+	 * We need to get the resolved pid before we wait on it as the windows
+	 * implementation of Tcl_WaitPid deletes the information such that any
+	 * following calls to TclpGetPid fail.
 	 */
+
 	resolvedPid = TclpGetPid(pidPtr[i]);
         pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
 	if (pid == (Tcl_Pid) -1) {
 	    result = TCL_ERROR;
-            if (interp != (Tcl_Interp *) NULL) {
+            if (interp != NULL) {
                 msg = Tcl_PosixError(interp);
                 if (errno == ECHILD) {
 		    /*
-                     * This changeup in message suggested by Mark Diekhans
-                     * to remind people that ECHILD errors can occur on
-                     * some systems if SIGCHLD isn't in its default state.
+                     * This changeup in message suggested by Mark Diekhans to
+                     * remind people that ECHILD errors can occur on some
+                     * systems if SIGCHLD isn't in its default state.
                      */
 
                     msg =
                         "child process lost (is SIGCHLD ignored or trapped?)";
                 }
                 Tcl_AppendResult(interp, "error waiting for process to exit: ",
-                        msg, (char *) NULL);
+                        msg, NULL);
             }
 	    continue;
 	}
 
 	/*
-	 * Create error messages for unusual process exits.  An
-	 * extra newline gets appended to each error message, but
-	 * it gets removed below (in the same fashion that an
-	 * extra newline in the command's output is removed).
+	 * Create error messages for unusual process exits. An extra newline
+	 * gets appended to each error message, but it gets removed below (in
+	 * the same fashion that an extra newline in the command's output is
+	 * removed).
 	 */
 
 	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
 	    char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
 
 	    result = TCL_ERROR;
-	    TclFormatInt(msg1, (long) resolvedPid);
+	    sprintf(msg1, "%lu", resolvedPid);
 	    if (WIFEXITED(waitStatus)) {
                 if (interp != (Tcl_Interp *) NULL) {
-		    TclFormatInt(msg2, WEXITSTATUS(waitStatus));
-                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
-                            (char *) NULL);
+		    sprintf(msg2, "%lu",
+			    (unsigned long) WEXITSTATUS(waitStatus));
+                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
                 }
 		abnormalExit = 1;
-	    } else if (WIFSIGNALED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-                    CONST char *p;
-                    
+	    } else if (interp != NULL) {
+		CONST char *p;
+
+		if (WIFSIGNALED(waitStatus)) {
                     p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
                     Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
                             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
-                            (char *) NULL);
-                    Tcl_AppendResult(interp, "child killed: ", p, "\n",
-                            (char *) NULL);
-                }
-	    } else if (WIFSTOPPED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-                    CONST char *p;
-
+                            NULL);
+                    Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
+		} else if (WIFSTOPPED(waitStatus)) {
                     p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
                     Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
-                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
-                            p, (char *) NULL);
+                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p,
+			    NULL);
                     Tcl_AppendResult(interp, "child suspended: ", p, "\n",
-                            (char *) NULL);
-                }
-	    } else {
-                if (interp != (Tcl_Interp *) NULL) {
+                            NULL);
+		} else {
                     Tcl_AppendResult(interp,
-                            "child wait status didn't make sense\n",
-                            (char *) NULL);
+                            "child wait status didn't make sense\n", NULL);
                 }
 	    }
 	}
     }
 
     /*
-     * Read the standard error file.  If there's anything there,
-     * then return an error and add the file's contents to the result
-     * string.
+     * Read the standard error file. If there's anything there, then return an
+     * error and add the file's contents to the result string.
      */
 
     anyErrorInfo = 0;
     if (errorChan != NULL) {
-
 	/*
 	 * Make sure we start at the beginning of the file.
 	 */
@@ -376,7 +363,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
         if (interp != NULL) {
 	    int count;
 	    Tcl_Obj *objPtr;
-	    
+
 	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
 	    objPtr = Tcl_NewObj();
 	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
@@ -398,13 +385,12 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
     }
 
     /*
-     * If a child exited abnormally but didn't output any error information
-     * at all, generate an error message here.
+     * If a child exited abnormally but didn't output any error information at
+     * all, generate an error message here.
      */
 
     if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
-	Tcl_AppendResult(interp, "child process exited abnormally",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "child process exited abnormally", NULL);
     }
     return result;
 }
@@ -414,25 +400,23 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
  *
  * TclCreatePipeline --
  *
- *	Given an argc/argv array, instantiate a pipeline of processes
- *	as described by the argv.
+ *	Given an argc/argv array, instantiate a pipeline of processes as
+ *	described by the argv.
  *
- *	This procedure is unofficially exported for use by BLT.
+ *	This function is unofficially exported for use by BLT.
  *
  * Results:
- *	The return value is a count of the number of new processes
- *	created, or -1 if an error occurred while creating the pipeline.
- *	*pidArrayPtr is filled in with the address of a dynamically
- *	allocated array giving the ids of all of the processes.  It
- *	is up to the caller to free this array when it isn't needed
- *	anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
- *	with the file id for the input pipe for the pipeline (if any):
- *	the caller must eventually close this file.  If outPipePtr
- *	isn't NULL, then *outPipePtr is filled in with the file id
- *	for the output pipe from the pipeline:  the caller must close
- *	this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
- *	with a file id that may be used to read error output after the
- *	pipeline completes.
+ *	The return value is a count of the number of new processes created, or
+ *	-1 if an error occurred while creating the pipeline. *pidArrayPtr is
+ *	filled in with the address of a dynamically allocated array giving the
+ *	ids of all of the processes. It is up to the caller to free this array
+ *	when it isn't needed anymore. If inPipePtr is non-NULL, *inPipePtr is
+ *	filled in with the file id for the input pipe for the pipeline (if
+ *	any): the caller must eventually close this file. If outPipePtr isn't
+ *	NULL, then *outPipePtr is filled in with the file id for the output
+ *	pipe from the pipeline: the caller must close this file. If errFilePtr
+ *	isn't NULL, then *errFilePtr is filled with a file id that may be used
+ *	to read error output after the pipeline completes.
  *
  * Side effects:
  *	Processes and pipes are created.
@@ -441,67 +425,66 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
  */
 
 int
-TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
-	outPipePtr, errFilePtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    int argc;			/* Number of entries in argv. */
-    CONST char **argv;		/* Array of strings describing commands in
-				 * pipeline plus I/O redirection with <,
-				 * <<,  >, etc.  Argv[argc] must be NULL. */
-    Tcl_Pid **pidArrayPtr;	/* Word at *pidArrayPtr gets filled in with
-				 * address of array of pids for processes
-				 * in pipeline (first pid is first process
-				 * in pipeline). */
-    TclFile *inPipePtr;		/* If non-NULL, input to the pipeline comes
+TclCreatePipeline(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
+    int argc,			/* Number of entries in argv. */
+    CONST char **argv,		/* Array of strings describing commands in
+				 * pipeline plus I/O redirection with <, <<,
+				 * >, etc. Argv[argc] must be NULL. */
+    Tcl_Pid **pidArrayPtr,	/* Word at *pidArrayPtr gets filled in with
+				 * address of array of pids for processes in
+				 * pipeline (first pid is first process in
+				 * pipeline). */
+    TclFile *inPipePtr,		/* If non-NULL, input to the pipeline comes
 				 * from a pipe (unless overridden by
-				 * redirection in the command).  The file
-				 * id with which to write to this pipe is
-				 * stored at *inPipePtr.  NULL means command
-				 * specified its own input source. */
-    TclFile *outPipePtr;	/* If non-NULL, output to the pipeline goes
-				 * to a pipe, unless overriden by redirection
-				 * in the command.  The file id with which to
-				 * read frome this pipe is stored at
-				 * *outPipePtr.  NULL means command specified
-				 * its own output sink. */
-    TclFile *errFilePtr;	/* If non-NULL, all stderr output from the
+				 * redirection in the command). The file id
+				 * with which to write to this pipe is stored
+				 * at *inPipePtr. NULL means command specified
+				 * its own input source. */
+    TclFile *outPipePtr,	/* If non-NULL, output to the pipeline goes to
+				 * a pipe, unless overriden by redirection in
+				 * the command. The file id with which to read
+				 * frome this pipe is stored at *outPipePtr.
+				 * NULL means command specified its own output
+				 * sink. */
+    TclFile *errFilePtr)	/* If non-NULL, all stderr output from the
 				 * pipeline will go to a temporary file
-				 * created here, and a descriptor to read
-				 * the file will be left at *errFilePtr.
-				 * The file will be removed already, so
-				 * closing this descriptor will be the end
-				 * of the file.  If this is NULL, then
-				 * all stderr output goes to our stderr.
-				 * If the pipeline specifies redirection
-				 * then the file will still be created
-				 * but it will never get any data. */
+				 * created here, and a descriptor to read the
+				 * file will be left at *errFilePtr. The file
+				 * will be removed already, so closing this
+				 * descriptor will be the end of the file. If
+				 * this is NULL, then all stderr output goes
+				 * to our stderr. If the pipeline specifies
+				 * redirection then the file will still be
+				 * created but it will never get any data. */
 {
-    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all
-				 * the pids of child processes. */
-    int numPids;		/* Actual number of processes that exist
-				 * at *pidPtr right now. */
-    int cmdCount;		/* Count of number of distinct commands
-				 * found in argc/argv. */
-    CONST char *inputLiteral = NULL;	/* If non-null, then this points to a
-				 * string containing input data (specified
-				 * via <<) to be piped to the first process
-				 * in the pipeline. */
+    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all the
+				 * pids of child processes. */
+    int numPids;		/* Actual number of processes that exist at
+				 * *pidPtr right now. */
+    int cmdCount;		/* Count of number of distinct commands found
+				 * in argc/argv. */
+    CONST char *inputLiteral = NULL;
+				/* If non-null, then this points to a string
+				 * containing input data (specified via <<) to
+				 * be piped to the first process in the
+				 * pipeline. */
     TclFile inputFile = NULL;	/* If != NULL, gives file to use as input for
 				 * first process in pipeline (specified via <
 				 * or <@). */
-    int inputClose = 0;		/* If non-zero, then inputFile should be 
+    int inputClose = 0;		/* If non-zero, then inputFile should be
     				 * closed when cleaning up. */
     int inputRelease = 0;
     TclFile outputFile = NULL;	/* Writable file for output from last command
-				 * in pipeline (could be file or pipe).  NULL
+				 * in pipeline (could be file or pipe). NULL
 				 * means use stdout. */
-    int outputClose = 0;	/* If non-zero, then outputFile should be 
+    int outputClose = 0;	/* If non-zero, then outputFile should be
     				 * closed when cleaning up. */
     int outputRelease = 0;
     TclFile errorFile = NULL;	/* Writable file for error output from all
-				 * commands in pipeline.  NULL means use
+				 * commands in pipeline. NULL means use
 				 * stderr. */
-    int errorClose = 0;		/* If non-zero, then errorFile should be 
+    int errorClose = 0;		/* If non-zero, then errorFile should be
     				 * closed when cleaning up. */
     int errorRelease = 0;
     CONST char *p;
@@ -523,23 +506,23 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
     }
 
     Tcl_DStringInit(&execBuffer);
-    
+
     pipeIn = NULL;
     curInFile = NULL;
     curOutFile = NULL;
     numPids = 0;
 
     /*
-     * First, scan through all the arguments to figure out the structure
-     * of the pipeline.  Process all of the input and output redirection
-     * arguments and remove them from the argument list in the pipeline.
-     * Count the number of distinct processes (it's the number of "|"
-     * arguments plus one) but don't remove the "|" arguments because 
-     * they'll be used in the second pass to seperate the individual 
-     * child processes.  Cannot start the child processes in this pass 
-     * because the redirection symbols may appear anywhere in the 
-     * command line -- e.g., the '<' that specifies the input to the 
-     * entire pipe may appear at the very end of the argument list.
+     * First, scan through all the arguments to figure out the structure of
+     * the pipeline. Process all of the input and output redirection arguments
+     * and remove them from the argument list in the pipeline. Count the
+     * number of distinct processes (it's the number of "|" arguments plus
+     * one) but don't remove the "|" arguments because they'll be used in the
+     * second pass to seperate the individual child processes. Cannot start
+     * the child processes in this pass because the redirection symbols may
+     * appear anywhere in the command line - e.g., the '<' that specifies the
+     * input to the entire pipe may appear at the very end of the argument
+     * list.
      */
 
     lastBar = -1;
@@ -556,8 +539,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    }
 	    if (*p == '\0') {
 		if ((i == (lastBar + 1)) || (i == (argc - 1))) {
-		    Tcl_SetResult(interp,
-			    "illegal use of | or |& in command",
+		    Tcl_SetResult(interp, "illegal use of | or |& in command",
 			    TCL_STATIC);
 		    goto error;
 		}
@@ -584,7 +566,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 		    inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
 		    if (inputLiteral == NULL) {
 			Tcl_AppendResult(interp, "can't specify \"", argv[i],
-				"\" as last word in command", (char *) NULL);
+				"\" as last word in command", NULL);
 			goto error;
 		    }
 		    skip = 2;
@@ -592,8 +574,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    } else {
 		nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
 		inputLiteral = NULL;
-		inputFile = FileForRedirect(interp, p, 1, argv[i], 
-			nextArg, O_RDONLY, &skip, &inputClose, &inputRelease);
+		inputFile = FileForRedirect(interp, p, 1, argv[i], nextArg,
+			O_RDONLY, &skip, &inputClose, &inputRelease);
 		if (inputFile == NULL) {
 		    goto error;
 		}
@@ -624,8 +606,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    }
 
 	    /*
-	     * Close the old output file, but only if the error file is
-	     * not also using it.
+	     * Close the old output file, but only if the error file is not
+	     * also using it.
 	     */
 
 	    if (outputClose != 0) {
@@ -645,8 +627,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 		}
 	    }
 	    nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
-	    outputFile = FileForRedirect(interp, p, atOK, argv[i], 
-		    nextArg, flags, &skip, &outputClose, &outputRelease);
+	    outputFile = FileForRedirect(interp, p, atOK, argv[i], nextArg,
+		    flags, &skip, &outputClose, &outputRelease);
 	    if (outputFile == NULL) {
 		goto error;
 	    }
@@ -686,12 +668,13 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') {
 		/*
 		 * Special case handling of 2>@1 to redirect stderr to the
-		 * exec/open output pipe as well.  This is meant for the end
-		 * of the command string, otherwise use |& between commands.
+		 * exec/open output pipe as well. This is meant for the end of
+		 * the command string, otherwise use |& between commands.
 		 */
-		if (i != argc - 1) {
+
+		if (i != argc-1) {
 		    Tcl_AppendResult(interp, "must specify \"", argv[i],
-			    "\" as last word in command", (char *) NULL);
+			    "\" as last word in command", NULL);
 		    goto error;
 		}
 		errorFile = outputFile;
@@ -699,7 +682,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 		skip = 1;
 	    } else {
 		nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
-		errorFile = FileForRedirect(interp, p, atOK, argv[i], 
+		errorFile = FileForRedirect(interp, p, atOK, argv[i],
 			nextArg, flags, &skip, &errorClose, &errorRelease);
 		if (errorFile == NULL) {
 		    goto error;
@@ -723,7 +706,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
     }
 
     if (needCmd) {
-        /* We had a bar followed only by redirections. */
+	/* We had a bar followed only by redirections. */
 
         Tcl_SetResult(interp,
 		      "illegal use of | or |& in command",
@@ -735,27 +718,28 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	if (inputLiteral != NULL) {
 	    /*
 	     * The input for the first process is immediate data coming from
-	     * Tcl.  Create a temporary file for it and put the data into the
+	     * Tcl. Create a temporary file for it and put the data into the
 	     * file.
 	     */
+
 	    inputFile = TclpCreateTempFile(inputLiteral);
 	    if (inputFile == NULL) {
 		Tcl_AppendResult(interp,
 			"couldn't create input file for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
+			Tcl_PosixError(interp), NULL);
 		goto error;
 	    }
 	    inputClose = 1;
 	} else if (inPipePtr != NULL) {
 	    /*
-	     * The input for the first process in the pipeline is to
-	     * come from a pipe that can be written from by the caller.
+	     * The input for the first process in the pipeline is to come from
+	     * a pipe that can be written from by the caller.
 	     */
 
 	    if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
-		Tcl_AppendResult(interp, 
+		Tcl_AppendResult(interp,
 			"couldn't create input pipe for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
+			Tcl_PosixError(interp), NULL);
 		goto error;
 	    }
 	    inputClose = 1;
@@ -777,14 +761,14 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
     if (outputFile == NULL) {
 	if (outPipePtr != NULL) {
 	    /*
-	     * Output from the last process in the pipeline is to go to a
-	     * pipe that can be read by the caller.
+	     * Output from the last process in the pipeline is to go to a pipe
+	     * that can be read by the caller.
 	     */
 
 	    if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
-		Tcl_AppendResult(interp, 
+		Tcl_AppendResult(interp,
 			"couldn't create output pipe for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
+			Tcl_PosixError(interp), NULL);
 		goto error;
 	    }
 	    outputClose = 1;
@@ -806,16 +790,17 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
     if (errorFile == NULL) {
 	if (errorToOutput == 2) {
 	    /*
-	     * Handle 2>@1 special case at end of cmd line
+	     * Handle 2>@1 special case at end of cmd line.
 	     */
+
 	    errorFile = outputFile;
 	} else if (errFilePtr != NULL) {
 	    /*
 	     * Set up the standard error output sink for the pipeline, if
-	     * requested.  Use a temporary file which is opened, then deleted.
+	     * requested. Use a temporary file which is opened, then deleted.
 	     * Could potentially just use pipe, but if it filled up it could
-	     * cause the pipeline to deadlock:  we'd be waiting for processes
-	     * to complete before reading stderr, and processes couldn't 
+	     * cause the pipeline to deadlock: we'd be waiting for processes
+	     * to complete before reading stderr, and processes couldn't
 	     * complete because stderr was backed up.
 	     */
 
@@ -823,7 +808,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    if (errorFile == NULL) {
 		Tcl_AppendResult(interp,
 			"couldn't create error file for command: ",
-			Tcl_PosixError(interp), (char *) NULL);
+			Tcl_PosixError(interp), NULL);
 		goto error;
 	    }
 	    *errFilePtr = errorFile;
@@ -841,10 +826,10 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    }
 	}
     }
-	
+
     /*
-     * Scan through the argc array, creating a process for each
-     * group of arguments between the "|" characters.
+     * Scan through the argc array, creating a process for each group of
+     * arguments between the "|" characters.
      */
 
     Tcl_ReapDetachedProcs();
@@ -852,13 +837,13 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 
     curInFile = inputFile;
 
-    for (i = 0; i < argc; i = lastArg + 1) { 
+    for (i = 0; i < argc; i = lastArg + 1) {
 	int result, joinThisError;
 	Tcl_Pid pid;
 	CONST char *oldName;
 
 	/*
-	 * Convert the program name into native form. 
+	 * Convert the program name into native form.
 	 */
 
 	if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
@@ -871,20 +856,21 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 
 	joinThisError = 0;
 	for (lastArg = i; lastArg < argc; lastArg++) {
-	    if (argv[lastArg][0] == '|') { 
-		if (argv[lastArg][1] == '\0') { 
-		    break;
-		}
-		if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
-		    joinThisError = 1;
-		    break;
-		}
+	    if (argv[lastArg][0] != '|') {
+		continue;
+	    }
+	    if (argv[lastArg][1] == '\0') {
+		break;
+	    }
+	    if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
+		joinThisError = 1;
+		break;
 	    }
 	}
 
 	/*
 	 * If this is the last segment, use the specified outputFile.
-	 * Otherwise create an intermediate pipe.  pipeIn will become the
+	 * Otherwise create an intermediate pipe. pipeIn will become the
 	 * curInFile for the next segment of the pipe.
 	 */
 
@@ -894,7 +880,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	    argv[lastArg] = NULL;
 	    if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
 		Tcl_AppendResult(interp, "couldn't create pipe: ",
-			Tcl_PosixError(interp), (char *) NULL);
+			Tcl_PosixError(interp), NULL);
 		goto error;
 	    }
 	}
@@ -909,7 +895,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	 * Restore argv[i], since a caller wouldn't expect the contents of
 	 * argv to be modified.
 	 */
-	 
+
 	oldName = argv[i];
 	argv[i] = Tcl_DStringValue(&execBuffer);
 	result = TclpCreateProcess(interp, lastArg - i, argv + i,
@@ -924,8 +910,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
 	numPids++;
 
 	/*
-	 * Close off our copies of file descriptors that were set up for
-	 * this child, then set up the input for the next child.
+	 * Close off our copies of file descriptors that were set up for this
+	 * child, then set up the input for the next child.
 	 */
 
 	if ((curInFile != NULL) && (curInFile != inputFile)) {
@@ -943,10 +929,10 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
     *pidArrayPtr = pidPtr;
 
     /*
-     * All done.  Cleanup open files lying around and then return.
+     * All done. Cleanup open files lying around and then return.
      */
 
-cleanup:
+  cleanup:
     Tcl_DStringFree(&execBuffer);
 
     if (inputClose) {
@@ -967,12 +953,12 @@ cleanup:
     return numPids;
 
     /*
-     * An error occurred.  There could have been extra files open, such
-     * as pipes between children.  Clean them all up.  Detach any child
-     * processes that have been created.
+     * An error occurred. There could have been extra files open, such as
+     * pipes between children. Clean them all up. Detach any child processes
+     * that have been created.
      */
 
-error:
+  error:
     if (pipeIn != NULL) {
 	TclpCloseFile(pipeIn);
     }
@@ -1011,28 +997,26 @@ error:
  *
  * Tcl_OpenCommandChannel --
  *
- *	Opens an I/O channel to one or more subprocesses specified
- *	by argc and argv.  The flags argument determines the
- *	disposition of the stdio handles.  If the TCL_STDIN flag is
- *	set then the standard input for the first subprocess will
- *	be tied to the channel:  writing to the channel will provide
- *	input to the subprocess.  If TCL_STDIN is not set, then
- *	standard input for the first subprocess will be the same as
- *	this application's standard input.  If TCL_STDOUT is set then
- *	standard output from the last subprocess can be read from the
- *	channel;  otherwise it goes to this application's standard
- *	output.  If TCL_STDERR is set, standard error output for all
- *	subprocesses is returned to the channel and results in an error
- *	when the channel is closed;  otherwise it goes to this
- *	application's standard error.  If TCL_ENFORCE_MODE is not set,
- *	then argc and argv can redirect the stdio handles to override
- *	TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it 
- *	is an error for argc and argv to override stdio channels for
- *	which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
+ *	Opens an I/O channel to one or more subprocesses specified by argc and
+ *	argv. The flags argument determines the disposition of the stdio
+ *	handles. If the TCL_STDIN flag is set then the standard input for the
+ *	first subprocess will be tied to the channel: writing to the channel
+ *	will provide input to the subprocess. If TCL_STDIN is not set, then
+ *	standard input for the first subprocess will be the same as this
+ *	application's standard input. If TCL_STDOUT is set then standard
+ *	output from the last subprocess can be read from the channel;
+ *	otherwise it goes to this application's standard output. If TCL_STDERR
+ *	is set, standard error output for all subprocesses is returned to the
+ *	channel and results in an error when the channel is closed; otherwise
+ *	it goes to this application's standard error. If TCL_ENFORCE_MODE is
+ *	not set, then argc and argv can redirect the stdio handles to override
+ *	TCL_STDIN, TCL_STDOUT, and TCL_STDERR; if it is set, then it is an
+ *	error for argc and argv to override stdio channels for which
+ *	TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
  *
  * Results:
- *	A new command channel, or NULL on failure with an error
- *	message left in interp.
+ *	A new command channel, or NULL on failure with an error message left
+ *	in interp.
  *
  * Side effects:
  *	Creates processes, opens pipes.
@@ -1041,12 +1025,12 @@ error:
  */
 
 Tcl_Channel
-Tcl_OpenCommandChannel(interp, argc, argv, flags)
-    Tcl_Interp *interp;		/* Interpreter for error reporting. Can
-                                 * NOT be NULL. */
-    int argc;			/* How many arguments. */
-    CONST char **argv;		/* Array of arguments for command pipe. */
-    int flags;			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
+Tcl_OpenCommandChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. Can NOT be
+                                 * NULL. */
+    int argc,			/* How many arguments. */
+    CONST char **argv,		/* Array of arguments for command pipe. */
+    int flags)			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
 				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
 {
     TclFile *inPipePtr, *outPipePtr, *errFilePtr;
@@ -1060,7 +1044,7 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
     inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
     outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
-    
+
     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
             outPipePtr, errFilePtr);
 
@@ -1069,34 +1053,34 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
     }
 
     /*
-     * Verify that the pipes that were created satisfy the
-     * readable/writable constraints. 
+     * Verify that the pipes that were created satisfy the readable/writable
+     * constraints.
      */
 
     if (flags & TCL_ENFORCE_MODE) {
 	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't read output from command:",
-		    " standard output was redirected", (char *) NULL);
+	    Tcl_AppendResult(interp, "can't read output from command:"
+		    " standard output was redirected", NULL);
 	    goto error;
 	}
 	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't write input to command:",
-		    " standard input was redirected", (char *) NULL);
+	    Tcl_AppendResult(interp, "can't write input to command:"
+		    " standard input was redirected", NULL);
 	    goto error;
 	}
     }
-    
+
     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
 	    numPids, pidPtr);
 
     if (channel == (Tcl_Channel) NULL) {
         Tcl_AppendResult(interp, "pipe for command could not be created",
-                (char *) NULL);
+                NULL);
 	goto error;
     }
     return channel;
 
-error:
+  error:
     if (numPids > 0) {
 	Tcl_DetachPids(numPids, pidPtr);
 	ckfree((char *) pidPtr);
@@ -1112,3 +1096,11 @@ error:
     }
     return NULL;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 940d011..b3396e6 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1,14 +1,14 @@
-/* 
+/*
  * tclPkg.c --
  *
- *	This file implements package and version control for Tcl via
- *	the "package" command and a few C APIs.
+ *	This file implements package and version control for Tcl via the
+ *	"package" command and a few C APIs.
  *
  * Copyright (c) 1996 Sun Microsystems, Inc.
  * Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * TIP #268.
  * Heavily rewritten to handle the extend version numbers, and extended
@@ -18,70 +18,60 @@
 #include "tclInt.h"
 
 /*
- * Each invocation of the "package ifneeded" command creates a structure
- * of the following type, which is used to load the package into the
- * interpreter if it is requested with a "package require" command.
+ * Each invocation of the "package ifneeded" command creates a structure of
+ * the following type, which is used to load the package into the interpreter
+ * if it is requested with a "package require" command.
  */
 
 typedef struct PkgAvail {
     char *version;		/* Version string; malloc'ed. */
-    char *script;		/* Script to invoke to provide this version
-				 * of the package.  Malloc'ed and protected
-				 * by Tcl_Preserve and Tcl_Release. */
-    struct PkgAvail *nextPtr;	/* Next in list of available versions of
-				 * the same package. */
+    char *script;		/* Script to invoke to provide this version of
+				 * the package. Malloc'ed and protected by
+				 * Tcl_Preserve and Tcl_Release. */
+    struct PkgAvail *nextPtr;	/* Next in list of available versions of the
+				 * same package. */
 } PkgAvail;
 
 /*
- * For each package that is known in any way to an interpreter, there
- * is one record of the following type.  These records are stored in
- * the "packageTable" hash table in the interpreter, keyed by
- * package name such as "Tk" (no version number).
+ * For each package that is known in any way to an interpreter, there is one
+ * record of the following type. These records are stored in the
+ * "packageTable" hash table in the interpreter, keyed by package name such as
+ * "Tk" (no version number).
  */
 
 typedef struct Package {
     char *version;		/* Version that has been supplied in this
 				 * interpreter via "package provide"
-				 * (malloc'ed).  NULL means the package doesn't
+				 * (malloc'ed). NULL means the package doesn't
 				 * exist in this interpreter yet. */
-    PkgAvail *availPtr;		/* First in list of all available versions
-				 * of this package. */
+    PkgAvail *availPtr;		/* First in list of all available versions of
+				 * this package. */
     ClientData clientData;	/* Client data. */
 } Package;
 
 /*
- * Prototypes for procedures defined in this file:
+ * Prototypes for functions defined in this file:
  */
 
-#ifndef TCL_TIP268
-static int		CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *string));
-static int		ComparePkgVersions _ANSI_ARGS_((CONST char *v1, 
-                            CONST char *v2,
-			    int *satPtr));
-static Package *	FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *name));
-#else
 static int		CheckVersionAndConvert(Tcl_Interp *interp,
-			    CONST char *string, char** internal, int* stable);
-static int		CompareVersions(CONST char *v1i, CONST char *v2i,
+			    const char *string, char **internal, int *stable);
+static int		CompareVersions(char *v1i, char *v2i,
 			    int *isMajorPtr);
 static int		CheckRequirement(Tcl_Interp *interp,
-			    CONST char *string);
-static int		CheckAllRequirements(Tcl_Interp* interp, int reqc,
-			    Tcl_Obj *CONST reqv[]);
-static int		RequirementSatisfied(char *havei, CONST char *req);
+			    const char *string);
+static int		CheckAllRequirements(Tcl_Interp *interp, int reqc,
+			    Tcl_Obj *const reqv[]);
+static int		RequirementSatisfied(char *havei, const char *req);
 static int		SomeRequirementSatisfied(char *havei, int reqc,
-			    Tcl_Obj *CONST reqv[]);
-static void		AddRequirementsToResult(Tcl_Interp* interp, int reqc,
-			    Tcl_Obj *CONST reqv[]);
-static void		AddRequirementsToDString(Tcl_DString* dstring,
-			    int reqc, Tcl_Obj *CONST reqv[]);
-static Package *	FindPackage(Tcl_Interp *interp, CONST char *name);
-static CONST char *	PkgRequireCore(Tcl_Interp *interp, CONST char *name,
-			    int reqx, Tcl_Obj *CONST reqv[],
+			    Tcl_Obj *const reqv[]);
+static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
+			    Tcl_Obj *const reqv[]);
+static void		AddRequirementsToDString(Tcl_DString *dstring,
+			    int reqc, Tcl_Obj *const reqv[]);
+static Package *	FindPackage(Tcl_Interp *interp, const char *name);
+static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
+			    int reqc, Tcl_Obj *const reqv[],
 			    ClientData *clientDataPtr);
-#endif
 
 /*
  * Helper macros.
@@ -94,56 +84,50 @@ static CONST char *	PkgRequireCore(Tcl_Interp *interp, CONST char *name,
 	unsigned local__len = (unsigned) (strlen(s) + 1); \
 	DupBlock((v),(s),local__len); \
     } while (0)
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_PkgProvide / Tcl_PkgProvideEx --
  *
- *	This procedure is invoked to declare that a particular version
- *	of a particular package is now present in an interpreter.  There
- *	must not be any other version of this package already
- *	provided in the interpreter.
+ *	This function is invoked to declare that a particular version of a
+ *	particular package is now present in an interpreter. There must not be
+ *	any other version of this package already provided in the interpreter.
  *
  * Results:
- *	Normally returns TCL_OK;  if there is already another version
- *	of the package loaded then TCL_ERROR is returned and an error
- *	message is left in the interp's result.
+ *	Normally returns TCL_OK; if there is already another version of the
+ *	package loaded then TCL_ERROR is returned and an error message is left
+ *	in the interp's result.
  *
  * Side effects:
- *	The interpreter remembers that this package is available,
- *	so that no other version of the package may be provided for
- *	the interpreter.
+ *	The interpreter remembers that this package is available, so that no
+ *	other version of the package may be provided for the interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_PkgProvide(interp, name, version)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
+Tcl_PkgProvide(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     CONST char *name;		/* Name of package. */
-     CONST char *version;	/* Version string for package. */
+    const char *name,		/* Name of package. */
+    const char *version)	/* Version string for package. */
 {
-    return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
+    return Tcl_PkgProvideEx(interp, name, version, NULL);
 }
 
 int
-Tcl_PkgProvideEx(interp, name, version, clientData)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
+Tcl_PkgProvideEx(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     CONST char *name;		/* Name of package. */
-     CONST char *version;	/* Version string for package. */
-     ClientData clientData;     /* clientdata for this package (normally
-				 * used for C callback function table) */
+    const char *name,		/* Name of package. */
+    const char *version,	/* Version string for package. */
+    ClientData clientData)	/* clientdata for this package (normally used
+				 * for C callback function table) */
 {
     Package *pkgPtr;
-#ifdef TCL_TIP268
-    char* pvi;
-    char* vi;
+    char *pvi, *vi;
     int res;
-#endif
 
     pkgPtr = FindPackage(interp, name);
     if (pkgPtr->version == NULL) {
@@ -151,12 +135,11 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
 	pkgPtr->clientData = clientData;
 	return TCL_OK;
     }
-#ifndef TCL_TIP268
-    if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
-#else
-    if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {
+
+    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
+	    NULL) != TCL_OK) {
 	return TCL_ERROR;
-    } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) {
+    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
 	ckfree(pvi);
 	return TCL_ERROR;
     }
@@ -166,14 +149,13 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
     ckfree(vi);
 
     if (res == 0) {
-#endif
 	if (clientData != NULL) {
 	    pkgPtr->clientData = clientData;
 	}
 	return TCL_OK;
     }
     Tcl_AppendResult(interp, "conflicting versions provided for package \"",
-		     name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
+	    name, "\": ", pkgPtr->version, ", then ", version, NULL);
     return TCL_ERROR;
 }
 
@@ -182,166 +164,134 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
  *
  * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
  *
- *	This procedure is called by code that depends on a particular
- *	version of a particular package.  If the package is not already
- *	provided in the interpreter, this procedure invokes a Tcl script
- *	to provide it.  If the package is already provided, this
- *	procedure makes sure that the caller's needs don't conflict with
- *	the version that is present.
+ *	This function is called by code that depends on a particular version
+ *	of a particular package. If the package is not already provided in the
+ *	interpreter, this function invokes a Tcl script to provide it. If the
+ *	package is already provided, this function makes sure that the
+ *	caller's needs don't conflict with the version that is present.
  *
  * Results:
- *	If successful, returns the version string for the currently
- *	provided version of the package, which may be different from
- *	the "version" argument.  If the caller's requirements
- *	cannot be met (e.g. the version requested conflicts with
- *	a currently provided version, or the required version cannot
- *	be found, or the script to provide the required version
- *	generates an error), NULL is returned and an error
- *	message is left in the interp's result.
+ *	If successful, returns the version string for the currently provided
+ *	version of the package, which may be different from the "version"
+ *	argument. If the caller's requirements cannot be met (e.g. the version
+ *	requested conflicts with a currently provided version, or the required
+ *	version cannot be found, or the script to provide the required version
+ *	generates an error), NULL is returned and an error message is left in
+ *	the interp's result.
  *
  * Side effects:
- *	The script from some previous "package ifneeded" command may
- *	be invoked to provide the package.
+ *	The script from some previous "package ifneeded" command may be
+ *	invoked to provide the package.
  *
  *----------------------------------------------------------------------
  */
 
-#ifndef TCL_TIP268
-/*
- * Empty definition for Stubs when TIP 268 is not activated.
- */
-int
-Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
-				 * available. */
-     CONST char *name;		/* Name of desired package. */
-     int reqc;                  /* Requirements constraining the desired version. */
-     Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
-     ClientData *clientDataPtr;
-{
-    return TCL_ERROR;
-}
-#endif
-
-CONST char *
-Tcl_PkgRequire(interp, name, version, exact)
-    Tcl_Interp *interp;	        /* Interpreter in which package is now
+const char *
+Tcl_PkgRequire(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     CONST char *name;		/* Name of desired package. */
-     CONST char *version;	/* Version string for desired version; NULL
+    const char *name,		/* Name of desired package. */
+    const char *version,	/* Version string for desired version; NULL
 				 * means use the latest version available. */
-     int exact;			/* Non-zero means that only the particular
+    int exact)			/* Non-zero means that only the particular
 				 * version given is acceptable. Zero means use
 				 * the latest compatible version. */
 {
-    return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
+    return Tcl_PkgRequireEx(interp, name, version, exact, NULL);
 }
 
-CONST char *
-Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
-				 * available. */
-     CONST char *name;		/* Name of desired package. */
-     CONST char *version;	/* Version string for desired version;
-				 * NULL means use the latest version
+const char *
+Tcl_PkgRequireEx(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     int exact;			/* Non-zero means that only the particular
-				 * version given is acceptable. Zero means
-				 * use the latest compatible version. */
-     ClientData *clientDataPtr;	/* Used to return the client data for this
-				 * package. If it is NULL then the client
-				 * data is not returned. This is unchanged
-				 * if this call fails for any reason. */
+    const char *name,		/* Name of desired package. */
+    const char *version,	/* Version string for desired version; NULL
+				 * means use the latest version available. */
+    int exact,			/* Non-zero means that only the particular
+				 * version given is acceptable. Zero means use
+				 * the latest compatible version. */
+    ClientData *clientDataPtr)	/* Used to return the client data for this
+				 * package. If it is NULL then the client data
+				 * is not returned. This is unchanged if this
+				 * call fails for any reason. */
 {
-#ifndef TCL_TIP268
-    Package *pkgPtr;
-    PkgAvail *availPtr, *bestPtr;
-    char *script;
-    int code, satisfies, result, pass;
-    Tcl_DString command;
-#else
     Tcl_Obj *ov;
-    CONST char *result = NULL;
-#endif
+    const char *result = NULL;
 
     /*
      * If an attempt is being made to load this into a standalone executable
-     * on a platform where backlinking is not supported then this must be
-     * a shared version of Tcl (Otherwise the load would have failed).
-     * Detect this situation by checking that this library has been correctly
+     * on a platform where backlinking is not supported then this must be a
+     * shared version of Tcl (Otherwise the load would have failed). Detect
+     * this situation by checking that this library has been correctly
      * initialised. If it has not been then return immediately as nothing will
      * work.
      */
-    
-    if (tclEmptyStringRep == NULL) {
 
+    if (tclEmptyStringRep == NULL) {
 	/*
 	 * OK, so what's going on here?
 	 *
-	 * First, what are we doing?  We are performing a check on behalf of
-	 * one particular caller, Tcl_InitStubs().  When a package is
-	 * stub-enabled, it is statically linked to libtclstub.a, which
-	 * contains a copy of Tcl_InitStubs().  When a stub-enabled package
-	 * is loaded, its *_Init() function is supposed to call
-	 * Tcl_InitStubs() before calling any other functions in the Tcl
-	 * library.  The first Tcl function called by Tcl_InitStubs() through
-	 * the stub table is Tcl_PkgRequireEx(), so this code right here is
-	 * the first code that is part of the original Tcl library in the
-	 * executable that gets executed on behalf of a newly loaded
-	 * stub-enabled package.
+	 * First, what are we doing? We are performing a check on behalf of
+	 * one particular caller, Tcl_InitStubs(). When a package is stub-
+	 * enabled, it is statically linked to libtclstub.a, which contains a
+	 * copy of Tcl_InitStubs(). When a stub-enabled package is loaded, its
+	 * *_Init() function is supposed to call Tcl_InitStubs() before
+	 * calling any other functions in the Tcl library. The first Tcl
+	 * function called by Tcl_InitStubs() through the stub table is
+	 * Tcl_PkgRequireEx(), so this code right here is the first code that
+	 * is part of the original Tcl library in the executable that gets
+	 * executed on behalf of a newly loaded stub-enabled package.
 	 *
 	 * One easy error for the developer/builder of a stub-enabled package
 	 * to make is to forget to define USE_TCL_STUBS when compiling the
-	 * package.  When that happens, the package will contain symbols
-	 * that are references to the Tcl library, rather than function
-	 * pointers referencing the stub table.  On platforms that lack
-	 * backlinking, those unresolved references may cause the loading
-	 * of the package to also load a second copy of the Tcl library,
-	 * leading to all kinds of trouble.  We would like to catch that
-	 * error and report a useful message back to the user.  That's
-	 * what we're doing.
+	 * package. When that happens, the package will contain symbols that
+	 * are references to the Tcl library, rather than function pointers
+	 * referencing the stub table. On platforms that lack backlinking,
+	 * those unresolved references may cause the loading of the package to
+	 * also load a second copy of the Tcl library, leading to all kinds of
+	 * trouble. We would like to catch that error and report a useful
+	 * message back to the user. That's what we're doing.
 	 *
-	 * Second, how does this work?  If we reach this point, then the
-	 * global variable tclEmptyStringRep has the value NULL.  Compare
-	 * that with the definition of tclEmptyStringRep near the top of
-	 * the file generic/tclObj.c.  It clearly should not have the value
-	 * NULL; it should point to the char tclEmptyString.  If we see it
-	 * having the value NULL, then somehow we are seeing a Tcl library
-	 * that isn't completely initialized, and that's an indicator for the
-	 * error condition described above.  (Further explanation is welcome.)
+	 * Second, how does this work? If we reach this point, then the global
+	 * variable tclEmptyStringRep has the value NULL. Compare that with
+	 * the definition of tclEmptyStringRep near the top of the file
+	 * generic/tclObj.c. It clearly should not have the value NULL; it
+	 * should point to the char tclEmptyString. If we see it having the
+	 * value NULL, then somehow we are seeing a Tcl library that isn't
+	 * completely initialized, and that's an indicator for the error
+	 * condition described above. (Further explanation is welcome.)
 	 *
-	 * Third, so what do we do about it?  This situation indicates
-	 * the package we just loaded wasn't properly compiled to be
-	 * stub-enabled, yet it thinks it is stub-enabled (it called
-	 * Tcl_InitStubs()).  We want to report that the package just
-	 * loaded is broken, so we want to place an error message in
-	 * the interpreter result and return NULL to indicate failure
-	 * to Tcl_InitStubs() so that it will also fail.  (Further
-	 * explanation why we don't want to Tcl_Panic() is welcome.
+	 * Third, so what do we do about it? This situation indicates the
+	 * package we just loaded wasn't properly compiled to be stub-enabled,
+	 * yet it thinks it is stub-enabled (it called Tcl_InitStubs()). We
+	 * want to report that the package just loaded is broken, so we want
+	 * to place an error message in the interpreter result and return NULL
+	 * to indicate failure to Tcl_InitStubs() so that it will also fail.
+	 * (Further explanation why we don't want to Tcl_Panic() is welcome.
 	 * After all, two Tcl libraries can't be a good thing!)
 	 *
-	 * Trouble is that's going to be tricky.  We're now using a Tcl
-	 * library that's not fully initialized.  In particular, it 
-	 * doesn't have a proper value for tclEmptyStringRep.  The
-	 * Tcl_Obj system heavily depends on the value of tclEmptyStringRep
-	 * and all of Tcl depends (increasingly) on the Tcl_Obj system, we
-	 * need to correct that flaw before making the calls to set the 
-	 * interpreter result to the error message.  That's the only flaw
-	 * corrected; other problems with initialization of the Tcl library
-	 * are not remedied, so be very careful about adding any other calls
-	 * here without checking how they behave when initialization is
-	 * incomplete.
+	 * Trouble is that's going to be tricky. We're now using a Tcl library
+	 * that's not fully initialized. In particular, it doesn't have a
+	 * proper value for tclEmptyStringRep. The Tcl_Obj system heavily
+	 * depends on the value of tclEmptyStringRep and all of Tcl depends
+	 * (increasingly) on the Tcl_Obj system, we need to correct that flaw
+	 * before making the calls to set the interpreter result to the error
+	 * message. That's the only flaw corrected; other problems with
+	 * initialization of the Tcl library are not remedied, so be very
+	 * careful about adding any other calls here without checking how they
+	 * behave when initialization is incomplete.
 	 */
 
 	tclEmptyStringRep = &tclEmptyString;
-        Tcl_AppendResult(interp, "Cannot load package \"", name, 
-			 "\" in standalone executable: This package is not ",
-			 "compiled with stub support", NULL);
-        return NULL;
+	Tcl_AppendResult(interp, "Cannot load package \"", name,
+		"\" in standalone executable: This package is not "
+		"compiled with stub support", NULL);
+	return NULL;
     }
 
-#ifdef TCL_TIP268
-    /* Translate between old and new API, and defer to the new function. */
+    /*
+     * Translate between old and new API, and defer to the new function.
+     */
 
     if (version == NULL) {
 	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
@@ -354,9 +304,9 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
 	if (exact) {
 	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
 	}
-	Tcl_IncrRefCount (ov);
+	Tcl_IncrRefCount(ov);
 	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
-	Tcl_DecrRefCount (ov);
+	TclDecrRefCount(ov);
     }
 
     return result;
@@ -364,16 +314,16 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
 
 int
 Tcl_PkgRequireProc(
-     Tcl_Interp *interp,	/* Interpreter in which package is now
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     CONST char *name,		/* Name of desired package. */
-     int reqc,                  /* Requirements constraining the desired
+    const char *name,		/* Name of desired package. */
+    int reqc,			/* Requirements constraining the desired
 				 * version. */
-     Tcl_Obj *CONST reqv[],     /* 0 means to use the latest version
+    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
 				 * available. */
-     ClientData *clientDataPtr)
+    ClientData *clientDataPtr)
 {
-    CONST char *result =
+    const char *result =
 	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
 
     if (result == NULL) {
@@ -383,28 +333,30 @@ Tcl_PkgRequireProc(
     return TCL_OK;
 }
 
-static CONST char *
+static const char *
 PkgRequireCore(
-     Tcl_Interp *interp,	/* Interpreter in which package is now
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     CONST char *name,		/* Name of desired package. */
-     int reqc,                  /* Requirements constraining the desired
+    const char *name,		/* Name of desired package. */
+    int reqc,			/* Requirements constraining the desired
 				 * version. */
-     Tcl_Obj *CONST reqv[],     /* 0 means to use the latest version
+    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
 				 * available. */
-     ClientData *clientDataPtr)
+    ClientData *clientDataPtr)
 {
     Interp *iPtr = (Interp *) interp;
     Package *pkgPtr;
     PkgAvail *availPtr, *bestPtr, *bestStablePtr;
-    char *availVersion, *bestVersion;	/* Internal rep. of versions */
-    int availStable;
-    char *script;
-    int code, satisfies, pass;
+    char *availVersion, *bestVersion;
+				/* Internal rep. of versions */
+    int availStable, code, satisfies, pass;
+    char *script, *pkgVersionI;
     Tcl_DString command;
-    char* pkgVersionI;
 
-#endif
+    if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
+	return NULL;
+    }
+
     /*
      * It can take up to three passes to find the package: one pass to run the
      * "package unknown" script, one to run the "package ifneeded" script for
@@ -412,45 +364,32 @@ PkgRequireCore(
      * the "package ifneeded" script.
      */
 
-    for (pass = 1; ; pass++) {
+    for (pass=1 ;; pass++) {
 	pkgPtr = FindPackage(interp, name);
 	if (pkgPtr->version != NULL) {
 	    break;
 	}
 
-	/* 
-	 * Check whether we're already attempting to load some version
-	 * of this package (circular dependency detection).
+	/*
+	 * Check whether we're already attempting to load some version of this
+	 * package (circular dependency detection).
 	 */
 
 	if (pkgPtr->clientData != NULL) {
-	    Tcl_AppendResult(interp, "circular package dependency: ",
+	    Tcl_AppendResult(interp, "circular package dependency: "
 		    "attempt to provide ", name, " ",
-		    (char *)(pkgPtr->clientData), " requires ", name, NULL);
-#ifndef TCL_TIP268
-	    if (version != NULL) {
-		Tcl_AppendResult(interp, " ", version, NULL);
-	    }
-#else
-	    AddRequirementsToResult (interp, reqc, reqv);
-#endif
+		    (char *) pkgPtr->clientData, " requires ", name, NULL);
+	    AddRequirementsToResult(interp, reqc, reqv);
 	    return NULL;
 	}
 
 	/*
 	 * The package isn't yet present. Search the list of available
-	 * versions and invoke the script for the best available version.
-	 *
-	 * For TIP 268 we are actually locating the best, and the best stable
-	 * version.  One of them is then chosen based on the selection mode.
+	 * versions and invoke the script for the best available version. We
+	 * are actually locating the best, and the best stable version. One of
+	 * them is then chosen based on the selection mode.
 	 */
-#ifndef TCL_TIP268    
-	bestPtr = NULL;
-	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
-		availPtr = availPtr->nextPtr) {
-	    if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
-		    bestPtr->version, (int *) NULL) <= 0)) {
-#else
+
 	bestPtr = NULL;
 	bestStablePtr = NULL;
 	bestVersion = NULL;
@@ -459,34 +398,32 @@ PkgRequireCore(
 		availPtr = availPtr->nextPtr) {
 	    if (CheckVersionAndConvert(interp, availPtr->version,
 		    &availVersion, &availStable) != TCL_OK) {
-		/* The provided version number has invalid syntax. This
+		/*
+		 * The provided version number has invalid syntax. This
 		 * should not happen. This should have been caught by the
 		 * 'package ifneeded' registering the package.
 		 */
-#endif
+
 		continue;
 	    }
-#ifndef TCL_TIP268
-	    if (version != NULL) {
-		result = ComparePkgVersions(availPtr->version, version,
-			&satisfies);
-		if ((result != 0) && exact) {
-#else
+
 	    if (bestPtr != NULL) {
-		int res = CompareVersions (availVersion, bestVersion, NULL);
+		int res = CompareVersions(availVersion, bestVersion, NULL);
+
+		/*
+		 * Note: Use internal reps!
+		 */
 
-		/* Note: Use internal reps! */
 		if (res <= 0) {
 		    /*
 		     * The version of the package sought is not as good as the
 		     * currently selected version. Ignore it.
 		     */
+
 		    ckfree(availVersion);
 		    availVersion = NULL;
-#endif
 		    continue;
 		}
-#ifdef TCL_TIP268
 	    }
 
 	    /* We have found a version which is better than our max. */
@@ -495,24 +432,19 @@ PkgRequireCore(
 		/* Check satisfaction of requirements. */
 
 		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
-#endif
 		if (!satisfies) {
-#ifdef TCL_TIP268
 		    ckfree(availVersion);
 		    availVersion = NULL;
-#endif
 		    continue;
 		}
 	    }
 
 	    bestPtr = availPtr;
 
-#ifdef TCL_TIP268
 	    if (bestVersion != NULL) {
 		ckfree(bestVersion);
 	    }
 	    bestVersion = availVersion;
-	    availVersion = NULL;
 
 	    /*
 	     * If this new best version is stable then it also has to be
@@ -525,10 +457,11 @@ PkgRequireCore(
 	}
 
 	if (bestVersion != NULL) {
-	   ckfree(bestVersion);
+	    ckfree(bestVersion);
 	}
 
-	/* Now choose a version among the two best. For 'latest' we simply
+	/*
+	 * Now choose a version among the two best. For 'latest' we simply
 	 * take (actually keep) the best. For 'stable' we take the best
 	 * stable, if there is any, or the best if there is nothing stable.
 	 */
@@ -536,8 +469,8 @@ PkgRequireCore(
 	if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
 		&& (bestStablePtr != NULL)) {
 	    bestPtr = bestStablePtr;
-#endif
 	}
+
 	if (bestPtr != NULL) {
 	    /*
 	     * We found an ifneeded script for the package. Be careful while
@@ -546,7 +479,7 @@ PkgRequireCore(
 	     * will still exist when the script completes.
 	     */
 
-	    CONST char *versionToProvide = bestPtr->version;
+	    const char *versionToProvide = bestPtr->version;
 	    script = bestPtr->script;
 
 	    pkgPtr->clientData = (ClientData) versionToProvide;
@@ -557,60 +490,15 @@ PkgRequireCore(
 
 	    pkgPtr = FindPackage(interp, name);
 	    if (code == TCL_OK) {
-#ifdef TCL_TIP268
 		Tcl_ResetResult(interp);
-#endif
 		if (pkgPtr->version == NULL) {
-#ifndef TCL_TIP268
-		    Tcl_ResetResult(interp);
-#endif
 		    code = TCL_ERROR;
 		    Tcl_AppendResult(interp, "attempt to provide package ",
 			    name, " ", versionToProvide,
 			    " failed: no version of package ", name,
 			    " provided", NULL);
-#ifndef TCL_TIP268
-		} else if (0 != ComparePkgVersions(
-			pkgPtr->version, versionToProvide, NULL)) {
-		    /* At this point, it is clear that a prior
-		     * [package ifneeded] command lied to us.  It said
-		     * that to get a particular version of a particular
-		     * package, we needed to evaluate a particular script.
-		     * However, we evaluated that script and got a different
-		     * version than we were told.  This is an error, and we
-		     * ought to report it.
-		     *
-		     * However, we've been letting this type of error slide
-		     * for a long time, and as a result, a lot of packages
-		     * suffer from them.
-		     *
-		     * It's a bit too harsh to make a large number of
-		     * existing packages start failing by releasing a
-		     * new patch release, so we forgive this type of error
-		     * for the rest of the Tcl 8.4 series.
-		     *
-		     * We considered reporting a warning, but in practice
-		     * even that appears too harsh a change for a patch release.
-		     *
-		     * We limit the error reporting to only
-		     * the situation where a broken ifneeded script leads
-		     * to a failure to satisfy the requirement.
-		     */
-		    if (version) {
-			result = ComparePkgVersions(
-				pkgPtr->version, version, &satisfies);
-			if (result && (exact || !satisfies)) {
-			    Tcl_ResetResult(interp);
-			    code = TCL_ERROR;
-			    Tcl_AppendResult(interp,
-				    "attempt to provide package ", name, " ",
-				    versionToProvide, " failed: package ",
-				    name, " ", pkgPtr->version,
-				    " provided instead", NULL);
-#else
 		} else {
 		    char *pvi, *vi;
-		    int res;
 
 		    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
 			    NULL) != TCL_OK) {
@@ -620,66 +508,36 @@ PkgRequireCore(
 			ckfree(pvi);
 			code = TCL_ERROR;
 		    } else {
-			res = CompareVersions(pvi, vi, NULL);
-			ckfree(vi);
+			int res = CompareVersions(pvi, vi, NULL);
 
+			ckfree(pvi);
+			ckfree(vi);
 			if (res != 0) {
-			    /* At this point, it is clear that a prior
-			     * [package ifneeded] command lied to us.  It said
-			     * that to get a particular version of a particular
-			     * package, we needed to evaluate a particular
-			     * script.  However, we evaluated that script and
-			     * got a different version than we were told.
-			     * This is an error, and we ought to report it.
-			     *
-			     * However, we've been letting this type of error
-			     * slide for a long time, and as a result, a lot
-			     * of packages suffer from them.
-			     *
-			     * It's a bit too harsh to make a large number of
-			     * existing packages start failing by releasing a
-			     * new patch release, so we forgive this type of
-			     * error for the rest of the Tcl 8.4 series.
-			     *
-			     * We considered reporting a warning, but in
-			     * practice even that appears too harsh a change
-			     * for a patch release.
-			     *
-			     * We limit the error reporting to only the
-			     * situation where a broken ifneeded script leads
-			     * to a failure to satisfy the requirement.
-			     */
-
-			    if (reqc > 0) {
-			        satisfies = SomeRequirementSatisfied(pvi,
-					reqc, reqv);
-				if (!satisfies) {
-				    code = TCL_ERROR;
-				    Tcl_AppendResult(interp,
-					    "attempt to provide package ",
-					    name, " ", versionToProvide,
-					    " failed: package ", name, " ",
-					    pkgPtr->version,
-					    " provided instead", NULL);
-				}
-			    }
-#endif
+			    code = TCL_ERROR;
+			    Tcl_AppendResult(interp,
+				    "attempt to provide package ", name, " ",
+				    versionToProvide, " failed: package ",
+				    name, " ", pkgPtr->version,
+				    " provided instead", NULL);
 			}
-#ifdef TCL_TIP268
-			ckfree(pvi);
-#endif
 		    }
 		}
 	    } else if (code != TCL_ERROR) {
 		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
+
 		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "attempt to provide package ",
-			name, " ", versionToProvide, " failed: ",
-			"bad return code: ", Tcl_GetString(codePtr), NULL);
-		Tcl_DecrRefCount(codePtr);
+		Tcl_AppendResult(interp, "attempt to provide package ", name,
+			" ", versionToProvide, " failed: bad return code: ",
+			TclGetString(codePtr), NULL);
+		TclDecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
 
+	    if (code == TCL_ERROR) {
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (\"package ifneeded %s %s\" script)",
+			name, versionToProvide));
+	    }
 	    Tcl_Release((ClientData) versionToProvide);
 
 	    if (code != TCL_OK) {
@@ -688,12 +546,12 @@ PkgRequireCore(
 		 * package wasn't loaded properly, so the package system
 		 * should not remember an improper load.
 		 *
-		 * This is consistent with our returning NULL.  If we're not
+		 * This is consistent with our returning NULL. If we're not
 		 * willing to tell our caller we got a particular version, we
 		 * shouldn't store that version for telling future callers
 		 * either.
 		 */
-		Tcl_AddErrorInfo(interp, "\n    (\"package ifneeded\" script)");
+
 		if (pkgPtr->version != NULL) {
 		    ckfree(pkgPtr->version);
 		    pkgPtr->version = NULL;
@@ -720,30 +578,23 @@ PkgRequireCore(
 	    Tcl_DStringInit(&command);
 	    Tcl_DStringAppend(&command, script, -1);
 	    Tcl_DStringAppendElement(&command, name);
-#ifndef TCL_TIP268
-	    Tcl_DStringAppend(&command, " ", 1);
-	    Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
-		    -1);
-	    if (exact) {
-		Tcl_DStringAppend(&command, " -exact", 7);
-	    }
-#else
 	    AddRequirementsToDString(&command, reqc, reqv);
-#endif
+
 	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
-			      Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
+		    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
 	    Tcl_DStringFree(&command);
 
 	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
 		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
 		Tcl_ResetResult(interp);
 		Tcl_AppendResult(interp, "bad return code: ",
-			Tcl_GetString(codePtr), NULL);
+			TclGetString(codePtr), NULL);
 		Tcl_DecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
 	    if (code == TCL_ERROR) {
-		Tcl_AddErrorInfo(interp, "\n    (\"package unknown\" script)");
+		Tcl_AddErrorInfo(interp,
+			"\n    (\"package unknown\" script)");
 		return NULL;
 	    }
 	    Tcl_ResetResult(interp);
@@ -751,14 +602,8 @@ PkgRequireCore(
     }
 
     if (pkgPtr->version == NULL) {
-	Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL);
-#ifndef TCL_TIP268
-	if (version != NULL) {
-	    Tcl_AppendResult(interp, " ", version, (char *) NULL);
-	}
-#else
+	Tcl_AppendResult(interp, "can't find package ", name, NULL);
 	AddRequirementsToResult(interp, reqc, reqv);
-#endif
 	return NULL;
     }
 
@@ -767,13 +612,6 @@ PkgRequireCore(
      * provided version meets the current requirements.
      */
 
-#ifndef TCL_TIP268
-    if (version == NULL) {
-        if (clientDataPtr) {
-	    *clientDataPtr = pkgPtr->clientData;
-	}
-	return pkgPtr->version;
-#else
     if (reqc == 0) {
 	satisfies = 1;
     } else {
@@ -781,27 +619,18 @@ PkgRequireCore(
 	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
 
 	ckfree(pkgVersionI);
-#endif
     }
-#ifndef TCL_TIP268
-    result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
-    if ((satisfies && !exact) || (result == 0)) {
-#else
+
     if (satisfies) {
-#endif
 	if (clientDataPtr) {
 	    *clientDataPtr = pkgPtr->clientData;
 	}
 	return pkgPtr->version;
     }
+
     Tcl_AppendResult(interp, "version conflict for package \"", name,
-	    "\": have ", pkgPtr->version,
-#ifndef TCL_TIP268
-	    ", need ", version, (char *) NULL);
-#else
-	    ", need", (char*) NULL);
-    AddRequirementsToResult (interp, reqc, reqv);
-#endif
+	    "\": have ", pkgPtr->version, ", need", NULL);
+    AddRequirementsToResult(interp, reqc, reqv);
     return NULL;
 }
 
@@ -810,16 +639,15 @@ PkgRequireCore(
  *
  * Tcl_PkgPresent / Tcl_PkgPresentEx --
  *
- *	Checks to see whether the specified package is present. If it
- *	is not then no additional action is taken.
+ *	Checks to see whether the specified package is present. If it is not
+ *	then no additional action is taken.
  *
  * Results:
- *	If successful, returns the version string for the currently
- *	provided version of the package, which may be different from
- *	the "version" argument.  If the caller's requirements
- *	cannot be met (e.g. the version requested conflicts with
- *	a currently provided version), NULL is returned and an error
- *	message is left in interp->result.
+ *	If successful, returns the version string for the currently provided
+ *	version of the package, which may be different from the "version"
+ *	argument. If the caller's requirements cannot be met (e.g. the version
+ *	requested conflicts with a currently provided version), NULL is
+ *	returned and an error message is left in interp->result.
  *
  * Side effects:
  *	None.
@@ -827,36 +655,34 @@ PkgRequireCore(
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_PkgPresent(interp, name, version, exact)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
-				 * available. */
-     CONST char *name;		/* Name of desired package. */
-     CONST char *version;	/* Version string for desired version;
-				 * NULL means use the latest version
+const char *
+Tcl_PkgPresent(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     int exact;			/* Non-zero means that only the particular
-				 * version given is acceptable. Zero means
-				 * use the latest compatible version. */
+    const char *name,		/* Name of desired package. */
+    const char *version,	/* Version string for desired version; NULL
+				 * means use the latest version available. */
+    int exact)			/* Non-zero means that only the particular
+				 * version given is acceptable. Zero means use
+				 * the latest compatible version. */
 {
-    return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
+    return Tcl_PkgPresentEx(interp, name, version, exact, NULL);
 }
 
-CONST char *
-Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
-     Tcl_Interp *interp;	/* Interpreter in which package is now
-				 * available. */
-     CONST char *name;		/* Name of desired package. */
-     CONST char *version;	/* Version string for desired version;
-				 * NULL means use the latest version
+const char *
+Tcl_PkgPresentEx(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
-     int exact;			/* Non-zero means that only the particular
-				 * version given is acceptable. Zero means
-				 * use the latest compatible version. */
-     ClientData *clientDataPtr;	/* Used to return the client data for this
-				 * package. If it is NULL then the client
-				 * data is not returned. This is unchanged
-				 * if this call fails for any reason. */
+    const char *name,		/* Name of desired package. */
+    const char *version,	/* Version string for desired version; NULL
+				 * means use the latest version available. */
+    int exact,			/* Non-zero means that only the particular
+				 * version given is acceptable. Zero means use
+				 * the latest compatible version. */
+    ClientData *clientDataPtr)	/* Used to return the client data for this
+				 * package. If it is NULL then the client data
+				 * is not returned. This is unchanged if this
+				 * call fails for any reason. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hPtr;
@@ -864,17 +690,22 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
 
     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
     if (hPtr) {
-	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	pkgPtr = Tcl_GetHashValue(hPtr);
 	if (pkgPtr->version != NULL) {
-	    
 	    /*
-	     * At this point we know that the package is present.  Make sure
+	     * At this point we know that the package is present. Make sure
 	     * that the provided version meets the current requirement by
 	     * calling Tcl_PkgRequireEx() to check for us.
 	     */
 
-	    return Tcl_PkgRequireEx(interp, name, version, exact,
-		    clientDataPtr);
+	    const char *foundVersion = Tcl_PkgRequireEx(interp, name, version,
+		    exact, clientDataPtr);
+
+	    if (foundVersion == NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
+			NULL);
+	    }
+	    return foundVersion;
 	}
     }
 
@@ -884,6 +715,7 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
     } else {
 	Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
     }
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
     return NULL;
 }
 
@@ -892,8 +724,8 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
  *
  * Tcl_PackageObjCmd --
  *
- *	This procedure is invoked to process the "package" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "package" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -904,29 +736,23 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
  *----------------------------------------------------------------------
  */
 
-/* ARGSUSED */
+	/* ARGSUSED */
 int
-Tcl_PackageObjCmd(dummy, interp, objc, objv)
-     ClientData dummy;		/* Not used. */
-     Tcl_Interp *interp;	/* Current interpreter. */
-     int objc;			/* Number of arguments. */
-     Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_PackageObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static CONST char *pkgOptions[] = {
-	"forget", "ifneeded", "names",
-#ifdef TCL_TIP268
-	"prefer",
-#endif
-	"present", "provide", "require", "unknown", "vcompare",
-	"versions", "vsatisfies", (char *) NULL
+    static const char *pkgOptions[] = {
+	"forget",  "ifneeded", "names",   "prefer",   "present",
+	"provide", "require",  "unknown", "vcompare", "versions",
+	"vsatisfies", NULL
     };
     enum pkgOptions {
-	PKG_FORGET, PKG_IFNEEDED, PKG_NAMES,
-#ifdef TCL_TIP268
-	PKG_PREFER,
-#endif
-	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
-	PKG_VERSIONS, PKG_VSATISFIES
+	PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,   PKG_PRESENT,
+	PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
+	PKG_VSATISFIES
     };
     Interp *iPtr = (Interp *) interp;
     int optionIndex, exact, i, satisfies;
@@ -935,32 +761,29 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
     Tcl_HashTable *tablePtr;
-    CONST char *version;
-    char *argv2, *argv3, *argv4;
-#ifdef TCL_TIP268
-    char* iva = NULL;
-    char* ivb = NULL;
-#endif
+    const char *version;
+    char *argv2, *argv3, *argv4, *iva = NULL, *ivb = NULL;
 
     if (objc < 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 	return TCL_ERROR;
     }
 
     if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
-			    &optionIndex) != TCL_OK) {
+	    &optionIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
     switch ((enum pkgOptions) optionIndex) {
     case PKG_FORGET: {
 	char *keyString;
+
 	for (i = 2; i < objc; i++) {
-	    keyString = Tcl_GetString(objv[i]);
+	    keyString = TclGetString(objv[i]);
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
 	    if (hPtr == NULL) {
-		continue;	
+		continue;
 	    }
-	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    pkgPtr = Tcl_GetHashValue(hPtr);
 	    Tcl_DeleteHashEntry(hPtr);
 	    if (pkgPtr->version != NULL) {
 		ckfree(pkgPtr->version);
@@ -977,43 +800,32 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	break;
     }
     case PKG_IFNEEDED: {
-	int length;
-#ifdef TCL_TIP268
-	int res;
+	int length, res;
 	char *argv3i, *avi;
-#endif
 
 	if ((objc != 4) && (objc != 5)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
 	    return TCL_ERROR;
 	}
-	argv3 = Tcl_GetString(objv[3]);
-#ifdef TCL_TIP268
+	argv3 = TclGetString(objv[3]);
 	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
-#else
-	if (CheckVersion(interp, argv3) != TCL_OK) {
-#endif
 	    return TCL_ERROR;
 	}
-	argv2 = Tcl_GetString(objv[2]);
+	argv2 = TclGetString(objv[2]);
 	if (objc == 4) {
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
 	    if (hPtr == NULL) {
-#ifdef TCL_TIP268
 		ckfree(argv3i);
-#endif
 		return TCL_OK;
 	    }
-	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    pkgPtr = Tcl_GetHashValue(hPtr);
 	} else {
 	    pkgPtr = FindPackage(interp, argv2);
 	}
 	argv3 = Tcl_GetStringFromObj(objv[3], &length);
 
 	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
-	     prevPtr = availPtr, availPtr = availPtr->nextPtr) {
-
-#ifdef TCL_TIP268
+		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
 	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
 		    NULL) != TCL_OK) {
 		ckfree(argv3i);
@@ -1024,14 +836,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	    ckfree(avi);
 
 	    if (res == 0){
-#else
-	    if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)
-		    == 0) {
-#endif
 		if (objc == 4) {
-#ifdef TCL_TIP268
 		    ckfree(argv3i);
-#endif
 		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
 		    return TCL_OK;
 		}
@@ -1039,9 +845,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 		break;
 	    }
 	}
-#ifdef TCL_TIP268
 	ckfree(argv3i);
-#endif
+
 	if (objc == 4) {
 	    return TCL_OK;
 	}
@@ -1061,27 +866,26 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	DupBlock(availPtr->script, argv4, (unsigned) length + 1);
 	break;
     }
-    case PKG_NAMES: {
+    case PKG_NAMES:
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
 	tablePtr = &iPtr->packageTable;
 	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
-	     hPtr = Tcl_NextHashEntry(&search)) {
-	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+		hPtr = Tcl_NextHashEntry(&search)) {
+	    pkgPtr = Tcl_GetHashValue(hPtr);
 	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
 		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
 	    }
 	}
 	break;
-    }
     case PKG_PRESENT: {
-	CONST char *name;
+	const char *name;
 	if (objc < 3) {
 	    goto require;
 	}
-	argv2 = Tcl_GetString(objv[2]);
+	argv2 = TclGetString(objv[2]);
 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
 	    if (objc != 5) {
 		goto requireSyntax;
@@ -1100,138 +904,98 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 		goto require;
 	    }
 	}
-#ifndef TCL_TIP268
-	version = NULL;
-	if (objc == (4 + exact)) {
-	    version =  Tcl_GetString(objv[3 + exact]);
-	    if (CheckVersion(interp, version) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	} else if ((objc != 3) || exact) {
-	    goto requireSyntax;
-	}
-#else
+
 	version = NULL;
 	if (exact) {
-	    version = Tcl_GetString(objv[4]);
-	    if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {
+	    version = TclGetString(objv[4]);
+	    if (CheckVersionAndConvert(interp, version, NULL,
+		    NULL) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	} else {
 	    if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
 		return TCL_ERROR;
-	    } 
+	    }
 	    if ((objc > 3) && (CheckVersionAndConvert(interp,
 		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
 		version = TclGetString(objv[3]);
 	    }
 	}
-#endif
 	Tcl_PkgPresent(interp, name, version, exact);
 	return TCL_ERROR;
 	break;
     }
-    case PKG_PROVIDE: {
+    case PKG_PROVIDE:
 	if ((objc != 3) && (objc != 4)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
 	    return TCL_ERROR;
 	}
-	argv2 = Tcl_GetString(objv[2]);
+	argv2 = TclGetString(objv[2]);
 	if (objc == 3) {
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
 	    if (hPtr != NULL) {
-		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+		pkgPtr = Tcl_GetHashValue(hPtr);
 		if (pkgPtr->version != NULL) {
 		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
 		}
 	    }
 	    return TCL_OK;
 	}
-	argv3 = Tcl_GetString(objv[3]);
-#ifndef TCL_TIP268
-	if (CheckVersion(interp, argv3) != TCL_OK) {
-#else
+	argv3 = TclGetString(objv[3]);
 	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
-#endif
 	    return TCL_ERROR;
 	}
 	return Tcl_PkgProvide(interp, argv2, argv3);
-    }
-    case PKG_REQUIRE: {
+    case PKG_REQUIRE:
     require:
 	if (objc < 3) {
 	requireSyntax:
-#ifndef TCL_TIP268
-	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
-#else
 	    Tcl_WrongNumArgs(interp, 2, objv,
 		    "?-exact? package ?requirement...?");
-#endif
-	    return TCL_ERROR;
-	}
-#ifndef TCL_TIP268
-	argv2 = Tcl_GetString(objv[2]);
-	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
-	    exact = 1;
-	} else {
-	    exact = 0;
-	}
-	version = NULL;
-	if (objc == (4 + exact)) {
-	    version =  Tcl_GetString(objv[3 + exact]);
-	    if (CheckVersion(interp, version) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	} else if ((objc != 3) || exact) {
-	    goto requireSyntax;
-	}
-	if (exact) {
-	    argv3 =  Tcl_GetString(objv[3]);
-	    version = Tcl_PkgRequire(interp, argv3, version, exact);
-	} else {
-	    version = Tcl_PkgRequire(interp, argv2, version, exact);
-	}
-	if (version == NULL) {
 	    return TCL_ERROR;
 	}
-	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
-#else
+
 	version = NULL;
-	argv2 = Tcl_GetString(objv[2]);
+
+	argv2 = TclGetString(objv[2]);
 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
-	    Tcl_Obj* ov;
+	    Tcl_Obj *ov;
 	    int res;
 
 	    if (objc != 5) {
 		goto requireSyntax;
 	    }
-	    version = Tcl_GetString(objv[4]);
-	    if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {
+
+	    version = TclGetString(objv[4]);
+	    if (CheckVersionAndConvert(interp, version, NULL,
+		    NULL) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 
-	    /* Create a new-style requirement for the exact version. */
+	    /*
+	     * Create a new-style requirement for the exact version.
+	     */
 
 	    ov = Tcl_NewStringObj(version, -1);
 	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
 	    version = NULL;
-	    argv3   = Tcl_GetString(objv[3]);
+	    argv3 = TclGetString(objv[3]);
 
-	    Tcl_IncrRefCount (ov);
+	    Tcl_IncrRefCount(ov);
 	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
-	    Tcl_DecrRefCount (ov);
+	    TclDecrRefCount(ov);
 	    return res;
 	} else {
-	    if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) {
+	    if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+
 	    return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
 	}
-#endif
 	break;
-    }
     case PKG_UNKNOWN: {
 	int length;
+
 	if (objc == 2) {
 	    if (iPtr->packageUnknown != NULL) {
 		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
@@ -1244,7 +1008,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	    if (argv2[0] == 0) {
 		iPtr->packageUnknown = NULL;
 	    } else {
-		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length + 1);
+		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
 	    }
 	} else {
 	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");
@@ -1252,85 +1016,89 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	}
 	break;
     }
-#ifdef TCL_TIP268
     case PKG_PREFER: {
-	/* See tclInt.h for the enum, just before Interp */
-	static CONST char *pkgPreferOptions[] = {
+	static const char *pkgPreferOptions[] = {
 	    "latest", "stable", NULL
 	};
 
+	/*
+	 * See tclInt.h for the enum, just before Interp.
+	 */
+
 	if (objc > 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?");
 	    return TCL_ERROR;
 	} else if (objc == 3) {
-	    /* Set value. */
-	    int new;
+	    /*
+	     * Seting the value.
+	     */
+
+	    int newPref;
+
 	    if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions,
-		    "preference", 0, &new) != TCL_OK) {
+		    "preference", 0, &newPref) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (new < iPtr->packagePrefer) {
-		iPtr->packagePrefer = new;
+
+	    if (newPref < iPtr->packagePrefer) {
+		iPtr->packagePrefer = newPref;
 	    }
 	}
-	/* Always return current value. */
+
+	/*
+	 * Always return current value.
+	 */
+
 	Tcl_SetObjResult(interp,
 		Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1));
 	break;
     }
-#endif
-    case PKG_VCOMPARE: {
+    case PKG_VCOMPARE:
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
 	    return TCL_ERROR;
 	}
-	argv3 = Tcl_GetString(objv[3]);
-	argv2 = Tcl_GetString(objv[2]);
-#ifndef TCL_TIP268
-	if ((CheckVersion(interp, argv2) != TCL_OK)
-		|| (CheckVersion(interp, argv3) != TCL_OK)) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(
-		ComparePkgVersions(argv2, argv3, (int *) NULL)));
-#else
-	if ((CheckVersionAndConvert (interp, argv2, &iva, NULL) != TCL_OK)
-		|| (CheckVersionAndConvert (interp, argv3, &ivb, NULL)
-		!= TCL_OK)) {
+	argv3 = TclGetString(objv[3]);
+	argv2 = TclGetString(objv[2]);
+	if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
+		CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
 	    if (iva != NULL) {
 		ckfree(iva);
 	    }
-	    /* ivb cannot be set in this branch */
+
+	    /*
+	     * ivb cannot be set in this branch.
+	     */
+
 	    return TCL_ERROR;
 	}
 
-	/* Comparison is done on the internal representation */
+	/*
+	 * Comparison is done on the internal representation.
+	 */
+
 	Tcl_SetObjResult(interp,
 		Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
 	ckfree(iva);
 	ckfree(ivb);
-#endif
 	break;
-    }
-    case PKG_VERSIONS: {
+    case PKG_VERSIONS:
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "package");
 	    return TCL_ERROR;
 	}
-	argv2 = Tcl_GetString(objv[2]);
+	argv2 = TclGetString(objv[2]);
 	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
 	if (hPtr != NULL) {
-	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    pkgPtr = Tcl_GetHashValue(hPtr);
 	    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
-		 availPtr = availPtr->nextPtr) {
+		    availPtr = availPtr->nextPtr) {
 		Tcl_AppendElement(interp, availPtr->version);
 	    }
 	}
 	break;
-    }
     case PKG_VSATISFIES: {
-#ifdef TCL_TIP268
-	char* argv2i = NULL;
+	char *argv2i = NULL;
 
 	if (objc < 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv,
@@ -1338,8 +1106,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	    return TCL_ERROR;
 	}
 
-	argv2 = Tcl_GetString(objv[2]);
-	if ((CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK)) {
+	argv2 = TclGetString(objv[2]);
+	if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
 	    return TCL_ERROR;
 	} else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
 	    ckfree(argv2i);
@@ -1347,27 +1115,13 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
 	}
 
 	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
-	ckfree (argv2i);
-#else
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
-	    return TCL_ERROR;
-	}
-	argv3 = Tcl_GetString(objv[3]);
-	argv2 = Tcl_GetString(objv[2]);
-	if ((CheckVersion(interp, argv2) != TCL_OK)
-		|| (CheckVersion(interp, argv3) != TCL_OK)) {
-	    return TCL_ERROR;
-	}
-	ComparePkgVersions(argv2, argv3, &satisfies);
-#endif
+	ckfree(argv2i);
 
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(satisfies));
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
 	break;
     }
-    default: {
-	panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
-    }
+    default:
+	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
     }
     return TCL_OK;
 }
@@ -1377,13 +1131,12 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
  *
  * FindPackage --
  *
- *	This procedure finds the Package record for a particular package
- *	in a particular interpreter, creating a record if one doesn't
- *	already exist.
+ *	This function finds the Package record for a particular package in a
+ *	particular interpreter, creating a record if one doesn't already
+ *	exist.
  *
  * Results:
- *	The return value is a pointer to the Package record for the
- *	package.
+ *	The return value is a pointer to the Package record for the package.
  *
  * Side effects:
  *	A new Package record may be created.
@@ -1392,24 +1145,24 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
  */
 
 static Package *
-FindPackage(interp, name)
-     Tcl_Interp *interp;	/* Interpreter to use for package lookup. */
-     CONST char *name;		/* Name of package to fine. */
+FindPackage(
+    Tcl_Interp *interp,		/* Interpreter to use for package lookup. */
+    const char *name)		/* Name of package to fine. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
     Package *pkgPtr;
 
-    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
-    if (new) {
+    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
+    if (isNew) {
 	pkgPtr = (Package *) ckalloc(sizeof(Package));
 	pkgPtr->version = NULL;
 	pkgPtr->availPtr = NULL;
 	pkgPtr->clientData = NULL;
 	Tcl_SetHashValue(hPtr, pkgPtr);
     } else {
-	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	pkgPtr = Tcl_GetHashValue(hPtr);
     }
     return pkgPtr;
 }
@@ -1419,9 +1172,8 @@ FindPackage(interp, name)
  *
  * TclFreePackageInfo --
  *
- *	This procedure is called during interpreter deletion to
- *	free all of the package-related information for the
- *	interpreter.
+ *	This function is called during interpreter deletion to free all of the
+ *	package-related information for the interpreter.
  *
  * Results:
  *	None.
@@ -1433,8 +1185,8 @@ FindPackage(interp, name)
  */
 
 void
-TclFreePackageInfo(iPtr)
-     Interp *iPtr;	/* Interpreter that is being deleted. */
+TclFreePackageInfo(
+    Interp *iPtr)		/* Interpereter that is being deleted. */
 {
     Package *pkgPtr;
     Tcl_HashSearch search;
@@ -1442,8 +1194,8 @@ TclFreePackageInfo(iPtr)
     PkgAvail *availPtr;
 
     for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
-	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
-	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	pkgPtr = Tcl_GetHashValue(hPtr);
 	if (pkgPtr->version != NULL) {
 	    ckfree(pkgPtr->version);
 	}
@@ -1465,15 +1217,16 @@ TclFreePackageInfo(iPtr)
 /*
  *----------------------------------------------------------------------
  *
- * CheckVersion / CheckVersionAndConvert --
+ * CheckVersionAndConvert --
  *
- *	This procedure checks to see whether a version number has
- *	valid syntax.
+ *	This function checks to see whether a version number has valid syntax.
+ *	It also generates a semi-internal representation (string rep of a list
+ *	of numbers).
  *
  * Results:
- *	If string is a properly formed version number the TCL_OK
- *	is returned.  Otherwise TCL_ERROR is returned and an error
- *	message is left in the interp's result.
+ *	If string is a properly formed version number the TCL_OK is returned.
+ *	Otherwise TCL_ERROR is returned and an error message is left in the
+ *	interp's result.
  *
  * Side effects:
  *	None.
@@ -1481,60 +1234,31 @@ TclFreePackageInfo(iPtr)
  *----------------------------------------------------------------------
  */
 
-#ifndef TCL_TIP268
 static int
-CheckVersion(interp, string)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    CONST char *string;		/* Supposedly a version number, which is
-				 * groups of decimal digits separated
-				 * by dots. */
-{
-    CONST char *p = string;
-    char prevChar;
-    if (!isdigit(UCHAR(*p))) {	/* INTL: digit */
-	goto error;
-    }
-    for (prevChar = *p, p++; *p != 0; p++) {
-	if (!isdigit(UCHAR(*p)) &&
-		((*p != '.') || (prevChar == '.'))) { /* INTL: digit */
-	    goto error;
-	}
-	prevChar = *p;
-    }
-    if (prevChar != '.') {
-	return TCL_OK;
-    }
-
- error:
-    Tcl_AppendResult(interp, "expected version number but got \"",
-	    string, "\"", (char *) NULL);
-    return TCL_ERROR;
-}
-#else
-static int
-CheckVersionAndConvert(interp, string, internal, stable)
-     Tcl_Interp *interp;	/* Used for error reporting. */
-     CONST char *string;	/* Supposedly a version number, which is
+CheckVersionAndConvert(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    const char *string,		/* Supposedly a version number, which is
 				 * groups of decimal digits separated by
 				 * dots. */
-     char** internal;    /* Internal normalized representation */
-     int* stable;      /* Flag: Version is (un)stable. */
+    char **internal,		/* Internal normalized representation */
+    int *stable)		/* Flag: Version is (un)stable. */
 {
-    CONST char *p = string;
+    const char *p = string;
     char prevChar;
     int hasunstable = 0;
     /*
      * 4* assuming that each char is a separator (a,b become ' -x ').
      * 4+ to have spce for an additional -2 at the end
      */
-    char* ibuf = ckalloc(4+4*strlen(string));
-    char* ip = ibuf;
+    char *ibuf = ckalloc(4 + 4*strlen(string));
+    char *ip = ibuf;
 
-    /* Basic rules
+    /*
+     * Basic rules
      * (1) First character has to be a digit.
      * (2) All other characters have to be a digit or '.'
      * (3) Two '.'s may not follow each other.
-
+     *
      * TIP 268, Modified rules
      * (1) s.a.
      * (2) All other characters have to be a digit, 'a', 'b', or '.'
@@ -1543,20 +1267,23 @@ CheckVersionAndConvert(interp, string, internal, stable)
      * (5) Neither 'a', nor 'b' may occur before or after a '.'
      */
 
-    if (!isdigit(UCHAR(*p))) {	/* INTL: digit */
+    if (!isdigit(UCHAR(*p))) {				/* INTL: digit */
 	goto error;
     }
+
     *ip++ = *p;
+
     for (prevChar = *p, p++; *p != 0; p++) {
-	if ((!isdigit(UCHAR(*p))) && (((*p != '.') && (*p != 'a')
-		&& (*p != 'b')) || ((hasunstable && ((*p == 'a')
-		|| (*p == 'b'))) || (((prevChar == 'a') || (prevChar == 'b')
-		|| (prevChar == '.')) && (*p == '.')) || (((*p == 'a')
-		|| (*p == 'b') || (*p == '.')) && (prevChar == '.'))))) {
-	    /* INTL: digit */
+	if (!isdigit(UCHAR(*p)) &&			/* INTL: digit */
+		((*p!='.' && *p!='a' && *p!='b') ||
+		((hasunstable && (*p=='a' || *p=='b')) ||
+		((prevChar=='a' || prevChar=='b' || prevChar=='.')
+			&& (*p=='.')) ||
+		((*p=='a' || *p=='b' || *p=='.') && prevChar=='.')))) {
 	    goto error;
 	}
-	if ((*p == 'a') || (*p == 'b')) {
+
+	if (*p == 'a' || *p == 'b') {
 	    hasunstable = 1;
 	}
 
@@ -1583,9 +1310,10 @@ CheckVersionAndConvert(interp, string, internal, stable)
 	} else {
 	    *ip++ = *p;
 	}
+
 	prevChar = *p;
     }
-    if ((prevChar != '.') && (prevChar != 'a') && (prevChar != 'b')) {
+    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
 	*ip = '\0';
 	if (internal != NULL) {
 	    *internal = ibuf;
@@ -1598,27 +1326,25 @@ CheckVersionAndConvert(interp, string, internal, stable)
 	return TCL_OK;
     }
 
- error:
+  error:
     ckfree(ibuf);
-    Tcl_AppendResult(interp, "expected version number but got \"",
-	    string, "\"", (char *) NULL);
+    Tcl_AppendResult(interp, "expected version number but got \"", string,
+	    "\"", NULL);
     return TCL_ERROR;
 }
-#endif
 
 /*
  *----------------------------------------------------------------------
  *
- * ComparePkgVersions / CompareVersions --
+ * CompareVersions --
  *
- *	This procedure compares two version numbers. (268: in internal rep).
+ *	This function compares two version numbers (in internal rep).
  *
  * Results:
- *	The return value is -1 if v1 is less than v2, 0 if the two
- *	version numbers are the same, and 1 if v1 is greater than v2.
- *	If *satPtr is non-NULL, the word it points to is filled in
- *	with 1 if v2 >= v1 and both numbers have the same major number
- *	or 0 otherwise.
+ *	The return value is -1 if v1 is less than v2, 0 if the two version
+ *	numbers are the same, and 1 if v1 is greater than v2. If *satPtr is
+ *	non-NULL, the word it points to is filled in with 1 if v2 >= v1 and
+ *	both numbers have the same major number or 0 otherwise.
  *
  * Side effects:
  *	None.
@@ -1626,142 +1352,157 @@ CheckVersionAndConvert(interp, string, internal, stable)
  *----------------------------------------------------------------------
  */
 
-#ifndef TCL_TIP268
 static int
-ComparePkgVersions(v1, v2, satPtr)
-    CONST char *v1;
-    CONST char *v2;		/* Versions strings, of form 2.1.3 (any
-				 * number of version numbers). */
-    int *satPtr;		/* If non-null, the word pointed to is
-				 * filled in with a 0/1 value.  1 means
-				 * v1 "satisfies" v2:  v1 is greater than
-				 * or equal to v2 and both version numbers
-				 * have the same major number. */
+CompareVersions(
+    char *v1, char *v2,		/* Versions strings, of form 2.1.3 (any number
+				 * of version numbers). */
+    int *isMajorPtr)		/* If non-null, the word pointed to is filled
+				 * in with a 0/1 value. 1 means that the
+				 * difference occured in the first element. */
 {
-    int thisIsMajor, n1, n2;
+    int thisIsMajor, res, flip;
+    char *s1, *e1, *s2, *e2, o1, o2;
 
     /*
      * Each iteration of the following loop processes one number from each
      * string, terminated by a " " (space). If those numbers don't match then
      * the comparison is over; otherwise, we loop back for the next number.
+     *
+     * TIP 268.
+     * This is identical the function 'ComparePkgVersion', but using the new
+     * space separator as used by the internal rep of version numbers. The
+     * special separators 'a' and 'b' have already been dealt with in
+     * 'CheckVersionAndConvert', they were translated into numbers as well.
+     * This keeps the comparison sane. Otherwise we would have to compare
+     * numerics, the separators, and also deal with the special case of
+     * end-of-string compared to separators. The semi-list rep we get here is
+     * much easier to handle, as it is still regular.
+     *
+     * Rewritten to not compute a numeric value for the extracted version
+     * number, but do string comparison. Skip any leading zeros for that to
+     * work. This change breaks through the 32bit-limit on version numbers.
      */
 
     thisIsMajor = 1;
+    s1 = v1;
+    s2 = v2;
+
     while (1) {
-	/* Parse one decimal number from the front of each string. */
+	/*
+	 * Parse one decimal number from the front of each string. Skip
+	 * leading zeros. Terminate found number for upcoming string-wise
+	 * comparison, if needed.
+	 */
 
-	n1 = n2 = 0;
-	while ((*v1 != 0) && (*v1 != '.')) {
-	    n1 = 10*n1 + (*v1 - '0');
-	    v1++;
+	while ((*s1 != 0) && (*s1 == '0')) {
+	    s1++;
 	}
-	while ((*v2 != 0) && (*v2 != '.')) {
-	    n2 = 10*n2 + (*v2 - '0');
-	    v2++;
+	while ((*s2 != 0) && (*s2 == '0')) {
+	    s2++;
 	}
 
 	/*
-	 * Compare and go on to the next version number if the current numbers
-	 * match.
+	 * s1, s2 now point to the beginnings of the numbers to compare. Test
+	 * for their signs first, as shortcut to the result (different signs),
+	 * or determines if result has to be flipped (both negative). If there
+	 * is no shortcut we have to insert terminators later to limit the
+	 * strcmp.
 	 */
 
-	if (n1 != n2) {
+	if ((*s1 == '-') && (*s2 != '-')) {
+	    /* s1 < 0, s2 >= 0 => s1 < s2 */
+	    res = -1;
 	    break;
 	}
-	if (*v1 != 0) {
-	    v1++;
-	} else if (*v2 == 0) {
+	if ((*s1 != '-') && (*s2 == '-')) {
+	    /* s1 >= 0, s2 < 0 => s1 > s2 */
+	    res = 1;
 	    break;
 	}
-	if (*v2 != 0) {
-	    v2++;
+
+	if ((*s1 == '-') && (*s2 == '-')) {
+	    /* a < b => -a > -b, etc. */
+	    s1++;
+	    s2++;
+	    flip = 1;
+	} else {
+	    flip = 0;
 	}
-	thisIsMajor = 0;
-    }
-    if (satPtr != NULL) {
-	*satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);
-    }
-    if (n1 > n2) {
-	return 1;
-    } else if (n1 == n2) {
-	return 0;
-    } else {
-	return -1;
-    }
-}
-#else
-static int
-CompareVersions(v1, v2, isMajorPtr)
-     CONST char *v1;	/* Versions strings, of form 2.1.3 (any number */
-     CONST char *v2;	/* of version numbers). */
-     int *isMajorPtr;   /* If non-null, the word pointed to is filled
-			 * in with a 0/1 value. 1 means that the difference
-			 * occured in the first element. */
-{
-    int thisIsMajor, n1, n2;
-    int res, flip;
 
-    /*
-     * Each iteration of the following loop processes one number from each
-     * string, terminated by a " " (space). If those numbers don't match then
-     * the comparison is over; otherwise, we loop back for the next number.
-     *
-     * TIP 268.
-     * This is identical the function 'ComparePkgVersion', but using the new
-     * space separator as used by the internal rep of version numbers. The
-     * special separators 'a' and 'b' have already been dealt with in
-     * 'CheckVersionAndConvert', they were translated into numbers as
-     * well. This keeps the comparison sane. Otherwise we would have to
-     * compare numerics, the separators, and also deal with the special case
-     * of end-of-string compared to separators. The semi-list rep we get here
-     * is much easier to handle, as it is still regular.
-     */
+	/*
+	 * The string comparison is needed, so now we determine where the
+	 * numbers end.
+	 */
 
-    thisIsMajor = 1;
-    while (1) {
-	/* Parse one decimal number from the front of each string. */
-
-	n1 = n2 = 0;
-	flip = 0;
-	while ((*v1 != 0) && (*v1 != ' ')) {
-	    if (*v1 == '-') {flip = 1 ; v1++ ; continue;}
-	    n1 = 10*n1 + (*v1 - '0');
-	    v1++;
+	e1 = s1;
+	while ((*e1 != 0) && (*e1 != ' ')) {
+	    e1++;
+	}
+	e2 = s2;
+	while ((*e2 != 0) && (*e2 != ' ')) {
+	    e2++;
 	}
-	if (flip) n1 = -n1;
-	flip = 0;
-	while ((*v2 != 0) && (*v2 != ' ')) {
-	    if (*v2 == '-') {flip = 1; v2++ ; continue;}
-	    n2 = 10*n2 + (*v2 - '0');
-	    v2++;
+
+	/*
+	 * s1 .. e1 and s2 .. e2 now bracket the numbers to compare. Insert
+	 * terminators, compare, and restore actual contents. First however
+	 * another shortcut. Compare lengths. Shorter string is smaller
+	 * number! Thus we strcmp only strings of identical length.
+	 */
+
+	if ((e1-s1) < (e2-s2)) {
+	    res = -1;
+	} else if ((e2-s2) < (e1-s1)) {
+	    res = 1;
+	} else {
+	    o1 = *e1;
+	    *e1 = '\0';
+	    o2 = *e2;
+	    *e2 = '\0';
+
+	    res = strcmp(s1, s2);
+	    res = (res < 0) ? -1 : (res ? 1 : 0);
+
+	    *e1 = o1;
+	    *e2 = o2;
 	}
-	if (flip) n2 = -n2;
 
 	/*
-	 * Compare and go on to the next version number if the current numbers
-	 * match.
+	 * Stop comparing segments when a difference has been found. Here we
+	 * may have to flip the result to account for signs.
 	 */
 
-	if (n1 != n2) {
+	if (res != 0) {
+	    if (flip) {
+		res = -res;
+	    }
 	    break;
 	}
-	if (*v1 != 0) {
-	    v1++;
-	} else if (*v2 == 0) {
+
+	/*
+	 * Go on to the next version number if the current numbers match.
+	 * However stop processing if the end of both numbers has been
+	 * reached.
+	 */
+
+	s1 = e1;
+	s2 = e2;
+
+	if (*s1 != 0) {
+	    s1++;
+	} else if (*s2 == 0) {
+	    /*
+	     * s1, s2 both at the end => identical
+	     */
+
+	    res = 0;
 	    break;
 	}
-	if (*v2 != 0) {
-	    v2++;
+	if (*s2 != 0) {
+	    s2++;
 	}
 	thisIsMajor = 0;
     }
-    if (n1 > n2) {
-	res = 1;
-    } else if (n1 == n2) {
-	res = 0;
-    } else {
-	res = -1;
-    }
 
     if (isMajorPtr != NULL) {
 	*isMajorPtr = thisIsMajor;
@@ -1775,13 +1516,12 @@ CompareVersions(v1, v2, isMajorPtr)
  *
  * CheckAllRequirements --
  *
- *	This function checks to see whether all requirements in a set
- *	have valid syntax.
+ *	This function checks to see whether all requirements in a set have
+ *	valid syntax.
  *
  * Results:
- *	TCL_OK is returned if all requirements are valid.
- *	Otherwise TCL_ERROR is returned and an error message
- *	is left in the interp's result.
+ *	TCL_OK is returned if all requirements are valid. Otherwise TCL_ERROR
+ *	is returned and an error message is left in the interp's result.
  *
  * Side effects:
  *	May modify the interpreter result.
@@ -1790,14 +1530,15 @@ CompareVersions(v1, v2, isMajorPtr)
  */
 
 static int
-CheckAllRequirements(interp, reqc, reqv)
-     Tcl_Interp* interp;
-     int reqc;                   /* Requirements to check. */
-     Tcl_Obj *CONST reqv[];
+CheckAllRequirements(
+    Tcl_Interp *interp,
+    int reqc,			/* Requirements to check. */
+    Tcl_Obj *const reqv[])
 {
     int i;
+
     for (i = 0; i < reqc; i++) {
-	if ((CheckRequirement(interp, Tcl_GetString(reqv[i])) != TCL_OK)) {
+	if ((CheckRequirement(interp, TclGetString(reqv[i])) != TCL_OK)) {
 	    return TCL_ERROR;
 	}
     }
@@ -1823,43 +1564,52 @@ CheckAllRequirements(interp, reqc, reqv)
  */
 
 static int
-CheckRequirement(interp, string)
-     Tcl_Interp *interp;	/* Used for error reporting. */
-     CONST char *string;	/* Supposedly a requirement. */
+CheckRequirement(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    const char *string)		/* Supposedly a requirement. */
 {
-    /* Syntax of requirement = version
-     *                       = version-version
-     *                       = version-
+    /*
+     * Syntax of requirement = version
+     *			     = version-version
+     *			     = version-
      */
 
-    char* dash = NULL;
-    char* buf;
+    char *dash = NULL, *buf;
 
-    dash = strchr (string, '-');
+    dash = strchr(string, '-');
     if (dash == NULL) {
-	/* no dash found, has to be a simple version */
-	return CheckVersionAndConvert (interp, string, NULL, NULL);
+	/*
+	 * No dash found, has to be a simple version.
+	 */
+
+	return CheckVersionAndConvert(interp, string, NULL, NULL);
     }
-    if (strchr (dash+1, '-') != NULL) {
-	/* More dashes found after the first. This is wrong. */
+
+    if (strchr(dash+1, '-') != NULL) {
+	/*
+	 * More dashes found after the first. This is wrong.
+	 */
+
 	Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
 		string, "\"", NULL);
 	return TCL_ERROR;
     }
 
-    /* Exactly one dash is present. Copy the string, split at the location of
+    /*
+     * Exactly one dash is present. Copy the string, split at the location of
      * dash and check that both parts are versions. Note that the max part can
-     * be empty.
+     * be empty. Also note that the string allocated with strdup() must be
+     * freed with free() and not ckfree().
      */
 
     DupString(buf, string);
-    dash = buf + (dash - string);  
-    *dash = '\0';     /* buf  now <=> min part */
-    dash ++;          /* dash now <=> max part */
+    dash = buf + (dash - string);
+    *dash = '\0';		/* buf now <=> min part */
+    dash++;			/* dash now <=> max part */
 
-    if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK)
-	    || ((*dash != '\0')
-	    && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
+    if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
+	    ((*dash != '\0') &&
+	    (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
 	ckfree(buf);
 	return TCL_ERROR;
     }
@@ -1885,20 +1635,23 @@ CheckRequirement(interp, string)
  */
 
 static void
-AddRequirementsToResult(interp, reqc, reqv)
-     Tcl_Interp* interp;
-     int reqc;		/* Requirements constraining the desired version. */
-     Tcl_Obj *CONST reqv[];	/* 0 means use the latest version available. */
+AddRequirementsToResult(
+    Tcl_Interp *interp,
+    int reqc,			/* Requirements constraining the desired
+				 * version. */
+    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
+				 * available. */
 {
     if (reqc > 0) {
 	int i;
+
 	for (i = 0; i < reqc; i++) {
 	    int length;
 	    char *v = Tcl_GetStringFromObj(reqv[i], &length);
 
 	    if ((length & 0x1) && (v[length/2] == '-')
 		    && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
-		Tcl_AppendResult(interp, " ", v+((length+1)/2), NULL);
+		Tcl_AppendResult(interp, " exactly ", v+((length+1)/2), NULL);
 	    } else {
 		Tcl_AppendResult(interp, " ", v, NULL);
 	    }
@@ -1923,19 +1676,22 @@ AddRequirementsToResult(interp, reqc, reqv)
  */
 
 static void
-AddRequirementsToDString(dstring, reqc, reqv)
-     Tcl_DString* dstring;
-     int reqc;		/* Requirements constraining the desired version. */
-     Tcl_Obj *CONST reqv[];	/* 0 means use the latest version available. */
+AddRequirementsToDString(
+    Tcl_DString *dsPtr,
+    int reqc,			/* Requirements constraining the desired
+				 * version. */
+    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
+				 * available. */
 {
     if (reqc > 0) {
 	int i;
+
 	for (i = 0; i < reqc; i++) {
-	    Tcl_DStringAppend(dstring, " ", 1);
-	    Tcl_DStringAppend(dstring, TclGetString(reqv[i]), -1);
+	    Tcl_DStringAppend(dsPtr, " ", 1);
+	    Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
 	}
     } else {
-	Tcl_DStringAppend(dstring, " 0-", -1);
+	Tcl_DStringAppend(dsPtr, " 0-", -1);
     }
 }
 
@@ -1944,14 +1700,13 @@ AddRequirementsToDString(dstring, reqc, reqv)
  *
  * SomeRequirementSatisfied --
  *
- *	This function checks to see whether a version satisfies at
- *	least one of a set of requirements.
+ *	This function checks to see whether a version satisfies at least one
+ *	of a set of requirements.
  *
  * Results:
- *	If the requirements are satisfied 1 is returned.
- *	Otherwise 0 is returned. The function assumes
- *	that all pieces have valid syntax. And is allowed
- *	to make that assumption.
+ *	If the requirements are satisfied 1 is returned. Otherwise 0 is
+ *	returned. The function assumes that all pieces have valid syntax. And
+ *	is allowed to make that assumption.
  *
  * Side effects:
  *	None.
@@ -1960,17 +1715,18 @@ AddRequirementsToDString(dstring, reqc, reqv)
  */
 
 static int
-SomeRequirementSatisfied(availVersionI, reqc, reqv)
-     char *availVersionI;	/* Candidate version to check against the
+SomeRequirementSatisfied(
+    char *availVersionI,	/* Candidate version to check against the
 				 * requirements. */
-     int reqc;			/* Requirements constraining the desired
+    int reqc,			/* Requirements constraining the desired
 				 * version. */
-     Tcl_Obj *CONST reqv[];	/* 0 means use the latest version available. */
+    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
+				 * available. */
 {
     int i;
 
     for (i = 0; i < reqc; i++) {
-	if (RequirementSatisfied(availVersionI, Tcl_GetString(reqv[i]))) {
+	if (RequirementSatisfied(availVersionI, TclGetString(reqv[i]))) {
 	    return 1;
 	}
     }
@@ -1985,10 +1741,9 @@ SomeRequirementSatisfied(availVersionI, reqc, reqv)
  *	This function checks to see whether a version satisfies a requirement.
  *
  * Results:
- *	If the requirement is satisfied 1 is returned.
- *	Otherwise 0 is returned. The function assumes
- *	that all pieces have valid syntax. And is allowed
- *	to make that assumption.
+ *	If the requirement is satisfied 1 is returned. Otherwise 0 is
+ *	returned. The function assumes that all pieces have valid syntax, and
+ *	is allowed to make that assumption.
  *
  * Side effects:
  *	None.
@@ -1997,75 +1752,80 @@ SomeRequirementSatisfied(availVersionI, reqc, reqv)
  */
 
 static int
-RequirementSatisfied(havei, req)
-     char *havei; /* Version string, of candidate package we have */
-     CONST char *req;   /* Requirement string the candidate has to satisfy */
+RequirementSatisfied(
+    char *havei,		/* Version string, of candidate package we
+				 * have. */
+    const char *req)		/* Requirement string the candidate has to
+				 * satisfy. */
 {
-    /* The have candidate is already in internal rep. */
+    /*
+     * The have candidate is already in internal rep.
+     */
 
     int satisfied, res;
-    char* dash = NULL;
-    char* buf, *min, *max;
+    char *dash = NULL, *buf, *min, *max;
 
-    dash = strchr (req, '-');
+    dash = strchr(req, '-');
     if (dash == NULL) {
-	/* No dash found, is a simple version, fallback to regular check.
-	 * The 'CheckVersionAndConvert' cannot fail. We pad the requirement with
+	/*
+	 * No dash found, is a simple version, fallback to regular check. The
+	 * 'CheckVersionAndConvert' cannot fail. We pad the requirement with
 	 * 'a0', i.e '-2' before doing the comparison to properly accept
 	 * unstables as well.
 	 */
 
-	char* reqi = NULL;
+	char *reqi = NULL;
 	int thisIsMajor;
 
-	CheckVersionAndConvert (NULL, req, &reqi, NULL);
-	strcat (reqi, " -2");
+	CheckVersionAndConvert(NULL, req, &reqi, NULL);
+	strcat(reqi, " -2");
 	res = CompareVersions(havei, reqi, &thisIsMajor);
 	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
 	ckfree(reqi);
 	return satisfied;
     }
 
-    /* Exactly one dash is present (Assumption of valid syntax). Copy the req,
-     * split at the location of dash and check that both parts are
-     * versions. Note that the max part can be empty.
+    /*
+     * Exactly one dash is present (Assumption of valid syntax). Copy the req,
+     * split at the location of dash and check that both parts are versions.
+     * Note that the max part can be empty.
      */
 
     DupString(buf, req);
-    dash  = buf + (dash - req);  
-    *dash = '\0';     /* buf  now <=> min part */
-    dash ++;          /* dash now <=> max part */
+    dash = buf + (dash - req);
+    *dash = '\0';		/* buf now <=> min part */
+    dash++;			/* dash now <=> max part */
 
     if (*dash == '\0') {
-	/* We have a min, but no max. For the comparison we generate the
+	/*
+	 * We have a min, but no max. For the comparison we generate the
 	 * internal rep, padded with 'a0' i.e. '-2'.
 	 */
 
-	/* No max part, unbound */
-
-	CheckVersionAndConvert (NULL, buf, &min, NULL);
-	strcat (min, " -2");
+	CheckVersionAndConvert(NULL, buf, &min, NULL);
+	strcat(min, " -2");
 	satisfied = (CompareVersions(havei, min, NULL) >= 0);
 	ckfree(min);
 	ckfree(buf);
 	return satisfied;
     }
 
-    /* We have both min and max, and generate their internal reps.
-     * When identical we compare as is, otherwise we pad with 'a0'
-     * to ove the range a bit.
+    /*
+     * We have both min and max, and generate their internal reps. When
+     * identical we compare as is, otherwise we pad with 'a0' to ove the range
+     * a bit.
      */
 
-    CheckVersionAndConvert (NULL, buf,  &min, NULL);
-    CheckVersionAndConvert (NULL, dash, &max, NULL);
+    CheckVersionAndConvert(NULL, buf, &min, NULL);
+    CheckVersionAndConvert(NULL, dash, &max, NULL);
 
     if (CompareVersions(min, max, NULL) == 0) {
 	satisfied = (CompareVersions(min, havei, NULL) == 0);
     } else {
-	strcat (min, " -2");
-	strcat (max, " -2");
+	strcat(min, " -2");
+	strcat(max, " -2");
 	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
-		     (CompareVersions(havei, max, NULL) < 0));
+		(CompareVersions(havei, max, NULL) < 0));
     }
 
     ckfree(min);
@@ -2075,10 +1835,55 @@ RequirementSatisfied(havei, req)
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PkgInitStubsCheck --
+ *
+ *	This is a replacement routine for Tcl_InitStubs() that is called
+ *	from code where -DUSE_TCL_STUBS has not been enabled.
+ *
+ * Results:
+ *	Returns the version of a conforming stubs table, or NULL, if
+ *	the table version doesn't satisfy the requested requirements,
+ *	according to historical practice.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char *
+Tcl_PkgInitStubsCheck(
+    Tcl_Interp *interp,
+    const char * version,
+    int exact)
+{
+    const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
+
+    if (exact && actualVersion) {
+	const char *p = version;
+	int count = 0;
+
+	while (*p) {
+	    count += !isdigit(UCHAR(*p++));
+	}
+	if (count == 1) {
+	    if (0 != strncmp(version, actualVersion, strlen(version))) {
+		/* Construct error message */
+		Tcl_PkgPresent(interp, "Tcl", version, 1);
+		return NULL;
+	    }
+	} else {
+	    return Tcl_PkgPresent(interp, "Tcl", version, 1);
+	}
+    }
+    return actualVersion;
+}
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
  * End:
  */
-#endif
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
new file mode 100644
index 0000000..840ebed
--- /dev/null
+++ b/generic/tclPkgConfig.c
@@ -0,0 +1,135 @@
+/*
+ * tclPkgConfig.c --
+ *
+ *	This file contains the configuration information to embed into the tcl
+ *	binary library.
+ *
+ * Copyright (c) 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/* Note, the definitions in this module are influenced by the following C
+ * preprocessor macros:
+ *
+ * OSCMa  = shortcut for "old style configuration macro activates"
+ * NSCMdt = shortcut for "new style configuration macro declares that"
+ *
+ * - TCL_THREADS		OSCMa compilation as threaded core.
+ * - TCL_MEM_DEBUG		OSCMa memory debugging.
+ * - TCL_COMPILE_DEBUG		OSCMa debugging of bytecode compiler.
+ * - TCL_COMPILE_STATS		OSCMa bytecode compiler statistics.
+ *
+ * - TCL_CFG_DO64BIT		NSCMdt tcl is compiled for a 64bit system.
+ * - NDEBUG		NSCMdt tcl is compiled with symbol info off.
+ * - TCL_CFG_OPTIMIZED		NSCMdt tcl is compiled with cc optimizations on
+ * - TCL_CFG_PROFILED		NSCMdt tcl is compiled with profiling info.
+ *
+ * - CFG_RUNTIME_*		Paths to various stuff at runtime.
+ * - CFG_INSTALL_*		Paths to various stuff at installation time.
+ *
+ * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
+ *				configuration values.
+ */
+
+#include "tclInt.h"
+
+/*
+ * Use C preprocessor statements to define the various values for the embedded
+ * configuration information.
+ */
+
+#ifdef TCL_THREADS
+#  define  CFG_THREADED		"1"
+#else
+#  define  CFG_THREADED		"0"
+#endif
+
+#ifdef TCL_MEM_DEBUG
+#  define CFG_MEMDEBUG		"1"
+#else
+#  define CFG_MEMDEBUG		"0"
+#endif
+
+#ifdef TCL_COMPILE_DEBUG
+#  define CFG_COMPILE_DEBUG	"1"
+#else
+#  define CFG_COMPILE_DEBUG	"0"
+#endif
+
+#ifdef TCL_COMPILE_STATS
+#  define CFG_COMPILE_STATS	"1"
+#else
+#  define CFG_COMPILE_STATS	"0"
+#endif
+
+#ifdef TCL_CFG_DO64BIT
+#  define CFG_64		"1"
+#else
+#  define CFG_64		"0"
+#endif
+
+#ifndef NDEBUG
+#  define CFG_DEBUG		"1"
+#else
+#  define CFG_DEBUG		"0"
+#endif
+
+#ifdef TCL_CFG_OPTIMIZED
+#  define CFG_OPTIMIZED		"1"
+#else
+#  define CFG_OPTIMIZED		"0"
+#endif
+
+#ifdef TCL_CFG_PROFILED
+#  define CFG_PROFILED		"1"
+#else
+#  define CFG_PROFILED		"0"
+#endif
+
+static Tcl_Config cfg[] = {
+    {"debug",			CFG_DEBUG},
+    {"threaded",		CFG_THREADED},
+    {"profiled",		CFG_PROFILED},
+    {"64bit",			CFG_64},
+    {"optimized",		CFG_OPTIMIZED},
+    {"mem_debug",		CFG_MEMDEBUG},
+    {"compile_debug",		CFG_COMPILE_DEBUG},
+    {"compile_stats",		CFG_COMPILE_STATS},
+
+    /* Runtime paths to various stuff */
+
+    {"libdir,runtime",		CFG_RUNTIME_LIBDIR},
+    {"bindir,runtime",		CFG_RUNTIME_BINDIR},
+    {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
+    {"includedir,runtime",	CFG_RUNTIME_INCDIR},
+    {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
+
+    /* Installation paths to various stuff */
+
+    {"libdir,install",		CFG_INSTALL_LIBDIR},
+    {"bindir,install",		CFG_INSTALL_BINDIR},
+    {"scriptdir,install",	CFG_INSTALL_SCRDIR},
+    {"includedir,install",	CFG_INSTALL_INCDIR},
+    {"docdir,install",		CFG_INSTALL_DOCDIR},
+
+    /* Last entry, closes the array */
+    {NULL, NULL}
+};
+
+void
+TclInitEmbeddedConfigurationInformation(
+    Tcl_Interp* interp)		/* Interpreter the configuration command is
+				 * registered in. */
+{
+    Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index b339795..8652e8d 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -10,6 +10,17 @@
 #ifndef _TCLPLATDECLS
 #define _TCLPLATDECLS
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
 /*
  * TCHAR is needed here for win32, so if it is not defined yet do it here.
  * This way, we don't need to include <tchar.h> just for one define.
@@ -30,25 +41,36 @@
  */
 
 #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#ifndef Tcl_WinUtfToTChar_TCL_DECLARED
+#define Tcl_WinUtfToTChar_TCL_DECLARED
 /* 0 */
-EXTERN TCHAR *		Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char *str,
-				int len, Tcl_DString *dsPtr));
+EXTERN TCHAR *		Tcl_WinUtfToTChar(CONST char *str, int len,
+				Tcl_DString *dsPtr);
+#endif
+#ifndef Tcl_WinTCharToUtf_TCL_DECLARED
+#define Tcl_WinTCharToUtf_TCL_DECLARED
 /* 1 */
-EXTERN char *		Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR *str,
-				int len, Tcl_DString *dsPtr));
+EXTERN char *		Tcl_WinTCharToUtf(CONST TCHAR *str, int len,
+				Tcl_DString *dsPtr);
+#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
+#ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED
+#define Tcl_MacOSXOpenBundleResources_TCL_DECLARED
 /* 0 */
-EXTERN int		Tcl_MacOSXOpenBundleResources _ANSI_ARGS_((
-				Tcl_Interp *interp, CONST char *bundleName,
-				int hasResourceFile, int maxPathLen,
-				char *libraryPath));
+EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
+				CONST char *bundleName, int hasResourceFile,
+				int maxPathLen, char *libraryPath);
+#endif
+#ifndef Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
+#define Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
 /* 1 */
-EXTERN int		Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_((
+EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
 				Tcl_Interp *interp, CONST char *bundleName,
 				CONST char *bundleVersion,
 				int hasResourceFile, int maxPathLen,
-				char *libraryPath));
+				char *libraryPath);
+#endif
 #endif /* MACOSX */
 
 typedef struct TclPlatStubs {
@@ -56,12 +78,12 @@ typedef struct TclPlatStubs {
     struct TclPlatStubHooks *hooks;
 
 #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-    TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char *str, int len, Tcl_DString *dsPtr)); /* 0 */
-    char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR *str, int len, Tcl_DString *dsPtr)); /* 1 */
+    TCHAR * (*tcl_WinUtfToTChar) (CONST char *str, int len, Tcl_DString *dsPtr); /* 0 */
+    char * (*tcl_WinTCharToUtf) (CONST TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-    int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 0 */
-    int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 1 */
+    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
+    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
 #endif /* MACOSX */
 } TclPlatStubs;
 
@@ -104,6 +126,9 @@ extern TclPlatStubs *tclPlatStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
 #endif /* _TCLPLATDECLS */
 
 
diff --git a/generic/tclPort.h b/generic/tclPort.h
index c5d8b71..12a60db 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -14,13 +14,15 @@
 #ifndef _TCLPORT
 #define _TCLPORT
 
-#include "tcl.h"
-
-#if defined(__WIN32__)
+#ifdef HAVE_TCL_CONFIG_H
+#include "tclConfig.h"
+#endif
+#if defined(_WIN32)
 #   include "tclWinPort.h"
 #else
 #   include "tclUnixPort.h"
 #endif
+#include "tcl.h"
 
 #if !defined(LLONG_MIN)
 #   ifdef TCL_WIDE_INT_IS_LONG
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index 258996f..a11b532 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -1,9 +1,8 @@
-/* 
+/*
  * tclPosixStr.c --
  *
- *	This file contains procedures that generate strings
- *	corresponding to various POSIX-related codes, such
- *	as errno and signals.
+ *	This file contains procedures that generate strings corresponding to
+ *	various POSIX-related codes, such as errno and signals.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -13,7 +12,6 @@
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
  *----------------------------------------------------------------------
@@ -23,9 +21,9 @@
  *	Return a textual identifier for the current errno value.
  *
  * Results:
- *	This procedure returns a machine-readable textual identifier
- *	that corresponds to the current errno value (e.g. "EPERM").
- *	The identifier is the same as the #define name in errno.h.
+ *	This procedure returns a machine-readable textual identifier that
+ *	corresponds to the current errno value (e.g. "EPERM"). The identifier
+ *	is the same as the #define name in errno.h.
  *
  * Side effects:
  *	None.
@@ -34,425 +32,425 @@
  */
 
 CONST char *
-Tcl_ErrnoId()
+Tcl_ErrnoId(void)
 {
     switch (errno) {
 #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
-	case E2BIG: return "E2BIG";
+    case E2BIG: return "E2BIG";
 #endif
 #ifdef EACCES
-	case EACCES: return "EACCES";
+    case EACCES: return "EACCES";
 #endif
 #ifdef EADDRINUSE
-	case EADDRINUSE: return "EADDRINUSE";
+    case EADDRINUSE: return "EADDRINUSE";
 #endif
 #ifdef EADDRNOTAVAIL
-	case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
+    case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
 #endif
 #ifdef EADV
-	case EADV: return "EADV";
+    case EADV: return "EADV";
 #endif
 #ifdef EAFNOSUPPORT
-	case EAFNOSUPPORT: return "EAFNOSUPPORT";
+    case EAFNOSUPPORT: return "EAFNOSUPPORT";
 #endif
 #ifdef EAGAIN
-	case EAGAIN: return "EAGAIN";
+    case EAGAIN: return "EAGAIN";
 #endif
 #ifdef EALIGN
-	case EALIGN: return "EALIGN";
+    case EALIGN: return "EALIGN";
 #endif
 #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
-	case EALREADY: return "EALREADY";
+    case EALREADY: return "EALREADY";
 #endif
 #ifdef EBADE
-	case EBADE: return "EBADE";
+    case EBADE: return "EBADE";
 #endif
 #ifdef EBADF
-	case EBADF: return "EBADF";
+    case EBADF: return "EBADF";
 #endif
 #ifdef EBADFD
-	case EBADFD: return "EBADFD";
+    case EBADFD: return "EBADFD";
 #endif
 #ifdef EBADMSG
-	case EBADMSG: return "EBADMSG";
+    case EBADMSG: return "EBADMSG";
 #endif
 #ifdef EBADR
-	case EBADR: return "EBADR";
+    case EBADR: return "EBADR";
 #endif
 #ifdef EBADRPC
-	case EBADRPC: return "EBADRPC";
+    case EBADRPC: return "EBADRPC";
 #endif
 #ifdef EBADRQC
-	case EBADRQC: return "EBADRQC";
+    case EBADRQC: return "EBADRQC";
 #endif
 #ifdef EBADSLT
-	case EBADSLT: return "EBADSLT";
+    case EBADSLT: return "EBADSLT";
 #endif
 #ifdef EBFONT
-	case EBFONT: return "EBFONT";
+    case EBFONT: return "EBFONT";
 #endif
 #ifdef EBUSY
-	case EBUSY: return "EBUSY";
+    case EBUSY: return "EBUSY";
 #endif
 #ifdef ECHILD
-	case ECHILD: return "ECHILD";
+    case ECHILD: return "ECHILD";
 #endif
 #ifdef ECHRNG
-	case ECHRNG: return "ECHRNG";
+    case ECHRNG: return "ECHRNG";
 #endif
 #ifdef ECOMM
-	case ECOMM: return "ECOMM";
+    case ECOMM: return "ECOMM";
 #endif
 #ifdef ECONNABORTED
-	case ECONNABORTED: return "ECONNABORTED";
+    case ECONNABORTED: return "ECONNABORTED";
 #endif
 #ifdef ECONNREFUSED
-	case ECONNREFUSED: return "ECONNREFUSED";
+    case ECONNREFUSED: return "ECONNREFUSED";
 #endif
 #ifdef ECONNRESET
-	case ECONNRESET: return "ECONNRESET";
+    case ECONNRESET: return "ECONNRESET";
 #endif
 #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
-	case EDEADLK: return "EDEADLK";
+    case EDEADLK: return "EDEADLK";
 #endif
 #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
-	case EDEADLOCK: return "EDEADLOCK";
+    case EDEADLOCK: return "EDEADLOCK";
 #endif
 #ifdef EDESTADDRREQ
-	case EDESTADDRREQ: return "EDESTADDRREQ";
+    case EDESTADDRREQ: return "EDESTADDRREQ";
 #endif
 #ifdef EDIRTY
-	case EDIRTY: return "EDIRTY";
+    case EDIRTY: return "EDIRTY";
 #endif
 #ifdef EDOM
-	case EDOM: return "EDOM";
+    case EDOM: return "EDOM";
 #endif
 #ifdef EDOTDOT
-	case EDOTDOT: return "EDOTDOT";
+    case EDOTDOT: return "EDOTDOT";
 #endif
 #ifdef EDQUOT
-	case EDQUOT: return "EDQUOT";
+    case EDQUOT: return "EDQUOT";
 #endif
 #ifdef EDUPPKG
-	case EDUPPKG: return "EDUPPKG";
+    case EDUPPKG: return "EDUPPKG";
 #endif
 #ifdef EEXIST
-	case EEXIST: return "EEXIST";
+    case EEXIST: return "EEXIST";
 #endif
 #ifdef EFAULT
-	case EFAULT: return "EFAULT";
+    case EFAULT: return "EFAULT";
 #endif
 #ifdef EFBIG
-	case EFBIG: return "EFBIG";
+    case EFBIG: return "EFBIG";
 #endif
 #ifdef EHOSTDOWN
-	case EHOSTDOWN: return "EHOSTDOWN";
+    case EHOSTDOWN: return "EHOSTDOWN";
 #endif
 #ifdef EHOSTUNREACH
-	case EHOSTUNREACH: return "EHOSTUNREACH";
+    case EHOSTUNREACH: return "EHOSTUNREACH";
 #endif
 #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
-	case EIDRM: return "EIDRM";
+    case EIDRM: return "EIDRM";
 #endif
 #ifdef EINIT
-	case EINIT: return "EINIT";
+    case EINIT: return "EINIT";
 #endif
 #ifdef EINPROGRESS
-	case EINPROGRESS: return "EINPROGRESS";
+    case EINPROGRESS: return "EINPROGRESS";
 #endif
 #ifdef EINTR
-	case EINTR: return "EINTR";
+    case EINTR: return "EINTR";
 #endif
 #ifdef EINVAL
-	case EINVAL: return "EINVAL";
+    case EINVAL: return "EINVAL";
 #endif
 #ifdef EIO
-	case EIO: return "EIO";
+    case EIO: return "EIO";
 #endif
 #ifdef EISCONN
-	case EISCONN: return "EISCONN";
+    case EISCONN: return "EISCONN";
 #endif
 #ifdef EISDIR
-	case EISDIR: return "EISDIR";
+    case EISDIR: return "EISDIR";
 #endif
 #ifdef EISNAME
-	case EISNAM: return "EISNAM";
+    case EISNAM: return "EISNAM";
 #endif
 #ifdef ELBIN
-	case ELBIN: return "ELBIN";
+    case ELBIN: return "ELBIN";
 #endif
 #ifdef EL2HLT
-	case EL2HLT: return "EL2HLT";
+    case EL2HLT: return "EL2HLT";
 #endif
 #ifdef EL2NSYNC
-	case EL2NSYNC: return "EL2NSYNC";
+    case EL2NSYNC: return "EL2NSYNC";
 #endif
 #ifdef EL3HLT
-	case EL3HLT: return "EL3HLT";
+    case EL3HLT: return "EL3HLT";
 #endif
 #ifdef EL3RST
-	case EL3RST: return "EL3RST";
+    case EL3RST: return "EL3RST";
 #endif
 #ifdef ELIBACC
-	case ELIBACC: return "ELIBACC";
+    case ELIBACC: return "ELIBACC";
 #endif
 #ifdef ELIBBAD
-	case ELIBBAD: return "ELIBBAD";
+    case ELIBBAD: return "ELIBBAD";
 #endif
 #ifdef ELIBEXEC
-	case ELIBEXEC: return "ELIBEXEC";
+    case ELIBEXEC: return "ELIBEXEC";
 #endif
 #ifdef ELIBMAX
-	case ELIBMAX: return "ELIBMAX";
+    case ELIBMAX: return "ELIBMAX";
 #endif
 #ifdef ELIBSCN
-	case ELIBSCN: return "ELIBSCN";
+    case ELIBSCN: return "ELIBSCN";
 #endif
 #ifdef ELNRNG
-	case ELNRNG: return "ELNRNG";
+    case ELNRNG: return "ELNRNG";
 #endif
 #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
-	case ELOOP: return "ELOOP";
+    case ELOOP: return "ELOOP";
 #endif
 #ifdef EMFILE
-	case EMFILE: return "EMFILE";
+    case EMFILE: return "EMFILE";
 #endif
 #ifdef EMLINK
-	case EMLINK: return "EMLINK";
+    case EMLINK: return "EMLINK";
 #endif
 #ifdef EMSGSIZE
-	case EMSGSIZE: return "EMSGSIZE";
+    case EMSGSIZE: return "EMSGSIZE";
 #endif
 #ifdef EMULTIHOP
-	case EMULTIHOP: return "EMULTIHOP";
+    case EMULTIHOP: return "EMULTIHOP";
 #endif
 #ifdef ENAMETOOLONG
-	case ENAMETOOLONG: return "ENAMETOOLONG";
+    case ENAMETOOLONG: return "ENAMETOOLONG";
 #endif
 #ifdef ENAVAIL
-	case ENAVAIL: return "ENAVAIL";
+    case ENAVAIL: return "ENAVAIL";
 #endif
 #ifdef ENET
-	case ENET: return "ENET";
+    case ENET: return "ENET";
 #endif
 #ifdef ENETDOWN
-	case ENETDOWN: return "ENETDOWN";
+    case ENETDOWN: return "ENETDOWN";
 #endif
 #ifdef ENETRESET
-	case ENETRESET: return "ENETRESET";
+    case ENETRESET: return "ENETRESET";
 #endif
 #ifdef ENETUNREACH
-	case ENETUNREACH: return "ENETUNREACH";
+    case ENETUNREACH: return "ENETUNREACH";
 #endif
 #ifdef ENFILE
-	case ENFILE: return "ENFILE";
+    case ENFILE: return "ENFILE";
 #endif
 #ifdef ENOANO
-	case ENOANO: return "ENOANO";
+    case ENOANO: return "ENOANO";
 #endif
 #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
-	case ENOBUFS: return "ENOBUFS";
+    case ENOBUFS: return "ENOBUFS";
 #endif
 #ifdef ENOCSI
-	case ENOCSI: return "ENOCSI";
+    case ENOCSI: return "ENOCSI";
 #endif
 #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
-	case ENODATA: return "ENODATA";
+    case ENODATA: return "ENODATA";
 #endif
 #ifdef ENODEV
-	case ENODEV: return "ENODEV";
+    case ENODEV: return "ENODEV";
 #endif
 #ifdef ENOENT
-	case ENOENT: return "ENOENT";
+    case ENOENT: return "ENOENT";
 #endif
 #ifdef ENOEXEC
-	case ENOEXEC: return "ENOEXEC";
+    case ENOEXEC: return "ENOEXEC";
 #endif
 #ifdef ENOLCK
-	case ENOLCK: return "ENOLCK";
+    case ENOLCK: return "ENOLCK";
 #endif
 #if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
-	case ENOLINK: return "ENOLINK";
+    case ENOLINK: return "ENOLINK";
 #endif
 #ifdef ENOMEM
-	case ENOMEM: return "ENOMEM";
+    case ENOMEM: return "ENOMEM";
 #endif
 #ifdef ENOMSG
-	case ENOMSG: return "ENOMSG";
+    case ENOMSG: return "ENOMSG";
 #endif
 #ifdef ENONET
-	case ENONET: return "ENONET";
+    case ENONET: return "ENONET";
 #endif
 #ifdef ENOPKG
-	case ENOPKG: return "ENOPKG";
+    case ENOPKG: return "ENOPKG";
 #endif
 #if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
-	case ENOPROTOOPT: return "ENOPROTOOPT";
+    case ENOPROTOOPT: return "ENOPROTOOPT";
 #endif
 #ifdef ENOSPC
-	case ENOSPC: return "ENOSPC";
+    case ENOSPC: return "ENOSPC";
 #endif
 #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
-	case ENOSR: return "ENOSR";
+    case ENOSR: return "ENOSR";
 #endif
 #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
-	case ENOSTR: return "ENOSTR";
+    case ENOSTR: return "ENOSTR";
 #endif
 #ifdef ENOSYM
-	case ENOSYM: return "ENOSYM";
+    case ENOSYM: return "ENOSYM";
 #endif
 #ifdef ENOSYS
-	case ENOSYS: return "ENOSYS";
+    case ENOSYS: return "ENOSYS";
 #endif
 #ifdef ENOTBLK
-	case ENOTBLK: return "ENOTBLK";
+    case ENOTBLK: return "ENOTBLK";
 #endif
 #ifdef ENOTCONN
-	case ENOTCONN: return "ENOTCONN";
+    case ENOTCONN: return "ENOTCONN";
 #endif
 #ifdef ENOTDIR
-	case ENOTDIR: return "ENOTDIR";
+    case ENOTDIR: return "ENOTDIR";
 #endif
 #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
-	case ENOTEMPTY: return "ENOTEMPTY";
+    case ENOTEMPTY: return "ENOTEMPTY";
 #endif
 #ifdef ENOTNAM
-	case ENOTNAM: return "ENOTNAM";
+    case ENOTNAM: return "ENOTNAM";
 #endif
 #ifdef ENOTSOCK
-	case ENOTSOCK: return "ENOTSOCK";
+    case ENOTSOCK: return "ENOTSOCK";
 #endif
 #ifdef ENOTSUP
-	case ENOTSUP: return "ENOTSUP";
+    case ENOTSUP: return "ENOTSUP";
 #endif
 #ifdef ENOTTY
-	case ENOTTY: return "ENOTTY";
+    case ENOTTY: return "ENOTTY";
 #endif
 #ifdef ENOTUNIQ
-	case ENOTUNIQ: return "ENOTUNIQ";
+    case ENOTUNIQ: return "ENOTUNIQ";
 #endif
 #ifdef ENXIO
-	case ENXIO: return "ENXIO";
+    case ENXIO: return "ENXIO";
 #endif
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
-	case EOPNOTSUPP: return "EOPNOTSUPP";
+    case EOPNOTSUPP: return "EOPNOTSUPP";
 #endif
 #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
-        case EOVERFLOW: return "EOVERFLOW";
+    case EOVERFLOW: return "EOVERFLOW";
 #endif
 #ifdef EPERM
-	case EPERM: return "EPERM";
+    case EPERM: return "EPERM";
 #endif
 #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
-	case EPFNOSUPPORT: return "EPFNOSUPPORT";
+    case EPFNOSUPPORT: return "EPFNOSUPPORT";
 #endif
 #ifdef EPIPE
-	case EPIPE: return "EPIPE";
+    case EPIPE: return "EPIPE";
 #endif
 #ifdef EPROCLIM
-	case EPROCLIM: return "EPROCLIM";
+    case EPROCLIM: return "EPROCLIM";
 #endif
 #ifdef EPROCUNAVAIL
-	case EPROCUNAVAIL: return "EPROCUNAVAIL";
+    case EPROCUNAVAIL: return "EPROCUNAVAIL";
 #endif
 #ifdef EPROGMISMATCH
-	case EPROGMISMATCH: return "EPROGMISMATCH";
+    case EPROGMISMATCH: return "EPROGMISMATCH";
 #endif
 #ifdef EPROGUNAVAIL
-	case EPROGUNAVAIL: return "EPROGUNAVAIL";
+    case EPROGUNAVAIL: return "EPROGUNAVAIL";
 #endif
 #ifdef EPROTO
-	case EPROTO: return "EPROTO";
+    case EPROTO: return "EPROTO";
 #endif
 #ifdef EPROTONOSUPPORT
-	case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
+    case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
 #endif
 #ifdef EPROTOTYPE
-	case EPROTOTYPE: return "EPROTOTYPE";
+    case EPROTOTYPE: return "EPROTOTYPE";
 #endif
 #ifdef ERANGE
-	case ERANGE: return "ERANGE";
+    case ERANGE: return "ERANGE";
 #endif
 #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
-	case EREFUSED: return "EREFUSED";
+    case EREFUSED: return "EREFUSED";
 #endif
 #ifdef EREMCHG
-	case EREMCHG: return "EREMCHG";
+    case EREMCHG: return "EREMCHG";
 #endif
 #ifdef EREMDEV
-	case EREMDEV: return "EREMDEV";
+    case EREMDEV: return "EREMDEV";
 #endif
 #ifdef EREMOTE
-	case EREMOTE: return "EREMOTE";
+    case EREMOTE: return "EREMOTE";
 #endif
 #ifdef EREMOTEIO
-	case EREMOTEIO: return "EREMOTEIO";
+    case EREMOTEIO: return "EREMOTEIO";
 #endif
 #ifdef EREMOTERELEASE
-	case EREMOTERELEASE: return "EREMOTERELEASE";
+    case EREMOTERELEASE: return "EREMOTERELEASE";
 #endif
 #ifdef EROFS
-	case EROFS: return "EROFS";
+    case EROFS: return "EROFS";
 #endif
 #ifdef ERPCMISMATCH
-	case ERPCMISMATCH: return "ERPCMISMATCH";
+    case ERPCMISMATCH: return "ERPCMISMATCH";
 #endif
 #ifdef ERREMOTE
-	case ERREMOTE: return "ERREMOTE";
+    case ERREMOTE: return "ERREMOTE";
 #endif
 #ifdef ESHUTDOWN
-	case ESHUTDOWN: return "ESHUTDOWN";
+    case ESHUTDOWN: return "ESHUTDOWN";
 #endif
 #ifdef ESOCKTNOSUPPORT
-	case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
+    case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
 #endif
 #ifdef ESPIPE
-	case ESPIPE: return "ESPIPE";
+    case ESPIPE: return "ESPIPE";
 #endif
 #ifdef ESRCH
-	case ESRCH: return "ESRCH";
+    case ESRCH: return "ESRCH";
 #endif
 #ifdef ESRMNT
-	case ESRMNT: return "ESRMNT";
+    case ESRMNT: return "ESRMNT";
 #endif
 #ifdef ESTALE
-	case ESTALE: return "ESTALE";
+    case ESTALE: return "ESTALE";
 #endif
 #ifdef ESUCCESS
-	case ESUCCESS: return "ESUCCESS";
+    case ESUCCESS: return "ESUCCESS";
 #endif
 #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
-	case ETIME: return "ETIME";
+    case ETIME: return "ETIME";
 #endif
 #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
-	case ETIMEDOUT: return "ETIMEDOUT";
+    case ETIMEDOUT: return "ETIMEDOUT";
 #endif
 #ifdef ETOOMANYREFS
-	case ETOOMANYREFS: return "ETOOMANYREFS";
+    case ETOOMANYREFS: return "ETOOMANYREFS";
 #endif
 #ifdef ETXTBSY
-	case ETXTBSY: return "ETXTBSY";
+    case ETXTBSY: return "ETXTBSY";
 #endif
 #ifdef EUCLEAN
-	case EUCLEAN: return "EUCLEAN";
+    case EUCLEAN: return "EUCLEAN";
 #endif
 #ifdef EUNATCH
-	case EUNATCH: return "EUNATCH";
+    case EUNATCH: return "EUNATCH";
 #endif
 #ifdef EUSERS
-	case EUSERS: return "EUSERS";
+    case EUSERS: return "EUSERS";
 #endif
 #ifdef EVERSION
-	case EVERSION: return "EVERSION";
+    case EVERSION: return "EVERSION";
 #endif
 #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
-	case EWOULDBLOCK: return "EWOULDBLOCK";
+    case EWOULDBLOCK: return "EWOULDBLOCK";
 #endif
 #ifdef EXDEV
-	case EXDEV: return "EXDEV";
+    case EXDEV: return "EXDEV";
 #endif
 #ifdef EXFULL
-	case EXFULL: return "EXFULL";
+    case EXFULL: return "EXFULL";
 #endif
     }
     return "unknown error";
@@ -463,17 +461,15 @@ Tcl_ErrnoId()
  *
  * Tcl_ErrnoMsg --
  *
- *	Return a human-readable message corresponding to a given
- *	errno value.
+ *	Return a human-readable message corresponding to a given errno value.
  *
  * Results:
- *	The return value is the standard POSIX error message for
- *	errno.  This procedure is used instead of strerror because
- *	strerror returns slightly different values on different
- *	machines (e.g. different capitalizations), which cause
- *	problems for things such as regression tests.  This procedure
- *	provides messages for most standard errors, then it calls
- *	strerror for things it doesn't understand.
+ *	The return value is the standard POSIX error message for errno.  This
+ *	procedure is used instead of strerror because strerror returns
+ *	slightly different values on different machines (e.g. different
+ *	capitalizations), which cause problems for things such as regression
+ *	tests. This procedure provides messages for most standard errors, then
+ *	it calls strerror for things it doesn't understand.
  *
  * Side effects:
  *	None.
@@ -482,433 +478,433 @@ Tcl_ErrnoId()
  */
 
 CONST char *
-Tcl_ErrnoMsg(err)
-    int err;			/* Error number (such as in errno variable). */
+Tcl_ErrnoMsg(
+     int err)			/* Error number (such as in errno variable). */
 {
     switch (err) {
 #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
-	case E2BIG: return "argument list too long";
+    case E2BIG: return "argument list too long";
 #endif
 #ifdef EACCES
-	case EACCES: return "permission denied";
+    case EACCES: return "permission denied";
 #endif
 #ifdef EADDRINUSE
-	case EADDRINUSE: return "address already in use";
+    case EADDRINUSE: return "address already in use";
 #endif
 #ifdef EADDRNOTAVAIL
-	case EADDRNOTAVAIL: return "can't assign requested address";
+    case EADDRNOTAVAIL: return "can't assign requested address";
 #endif
 #ifdef EADV
-	case EADV: return "advertise error";
+    case EADV: return "advertise error";
 #endif
 #ifdef EAFNOSUPPORT
-	case EAFNOSUPPORT: return "address family not supported by protocol family";
+    case EAFNOSUPPORT: return "address family not supported by protocol family";
 #endif
 #ifdef EAGAIN
-	case EAGAIN: return "resource temporarily unavailable";
+    case EAGAIN: return "resource temporarily unavailable";
 #endif
 #ifdef EALIGN
-	case EALIGN: return "EALIGN";
+    case EALIGN: return "EALIGN";
 #endif
 #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
-	case EALREADY: return "operation already in progress";
+    case EALREADY: return "operation already in progress";
 #endif
 #ifdef EBADE
-	case EBADE: return "bad exchange descriptor";
+    case EBADE: return "bad exchange descriptor";
 #endif
 #ifdef EBADF
-	case EBADF: return "bad file number";
+    case EBADF: return "bad file number";
 #endif
 #ifdef EBADFD
-	case EBADFD: return "file descriptor in bad state";
+    case EBADFD: return "file descriptor in bad state";
 #endif
 #ifdef EBADMSG
-	case EBADMSG: return "not a data message";
+    case EBADMSG: return "not a data message";
 #endif
 #ifdef EBADR
-	case EBADR: return "bad request descriptor";
+    case EBADR: return "bad request descriptor";
 #endif
 #ifdef EBADRPC
-	case EBADRPC: return "RPC structure is bad";
+    case EBADRPC: return "RPC structure is bad";
 #endif
 #ifdef EBADRQC
-	case EBADRQC: return "bad request code";
+    case EBADRQC: return "bad request code";
 #endif
 #ifdef EBADSLT
-	case EBADSLT: return "invalid slot";
+    case EBADSLT: return "invalid slot";
 #endif
 #ifdef EBFONT
-	case EBFONT: return "bad font file format";
+    case EBFONT: return "bad font file format";
 #endif
 #ifdef EBUSY
-	case EBUSY: return "file busy";
+    case EBUSY: return "file busy";
 #endif
 #ifdef ECHILD
-	case ECHILD: return "no children";
+    case ECHILD: return "no children";
 #endif
 #ifdef ECHRNG
-	case ECHRNG: return "channel number out of range";
+    case ECHRNG: return "channel number out of range";
 #endif
 #ifdef ECOMM
-	case ECOMM: return "communication error on send";
+    case ECOMM: return "communication error on send";
 #endif
 #ifdef ECONNABORTED
-	case ECONNABORTED: return "software caused connection abort";
+    case ECONNABORTED: return "software caused connection abort";
 #endif
 #ifdef ECONNREFUSED
-	case ECONNREFUSED: return "connection refused";
+    case ECONNREFUSED: return "connection refused";
 #endif
 #ifdef ECONNRESET
-	case ECONNRESET: return "connection reset by peer";
+    case ECONNRESET: return "connection reset by peer";
 #endif
 #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
-	case EDEADLK: return "resource deadlock avoided";
+    case EDEADLK: return "resource deadlock avoided";
 #endif
 #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
-	case EDEADLOCK: return "resource deadlock avoided";
+    case EDEADLOCK: return "resource deadlock avoided";
 #endif
 #ifdef EDESTADDRREQ
-	case EDESTADDRREQ: return "destination address required";
+    case EDESTADDRREQ: return "destination address required";
 #endif
 #ifdef EDIRTY
-	case EDIRTY: return "mounting a dirty fs w/o force";
+    case EDIRTY: return "mounting a dirty fs w/o force";
 #endif
 #ifdef EDOM
-	case EDOM: return "math argument out of range";
+    case EDOM: return "math argument out of range";
 #endif
 #ifdef EDOTDOT
-	case EDOTDOT: return "cross mount point";
+    case EDOTDOT: return "cross mount point";
 #endif
 #ifdef EDQUOT
-	case EDQUOT: return "disk quota exceeded";
+    case EDQUOT: return "disk quota exceeded";
 #endif
 #ifdef EDUPPKG
-	case EDUPPKG: return "duplicate package name";
+    case EDUPPKG: return "duplicate package name";
 #endif
 #ifdef EEXIST
-	case EEXIST: return "file already exists";
+    case EEXIST: return "file already exists";
 #endif
 #ifdef EFAULT
-	case EFAULT: return "bad address in system call argument";
+    case EFAULT: return "bad address in system call argument";
 #endif
 #ifdef EFBIG
-	case EFBIG: return "file too large";
+    case EFBIG: return "file too large";
 #endif
 #ifdef EHOSTDOWN
-	case EHOSTDOWN: return "host is down";
+    case EHOSTDOWN: return "host is down";
 #endif
 #ifdef EHOSTUNREACH
-	case EHOSTUNREACH: return "host is unreachable";
+    case EHOSTUNREACH: return "host is unreachable";
 #endif
 #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
-	case EIDRM: return "identifier removed";
+    case EIDRM: return "identifier removed";
 #endif
 #ifdef EINIT
-	case EINIT: return "initialization error";
+    case EINIT: return "initialization error";
 #endif
 #ifdef EINPROGRESS
-	case EINPROGRESS: return "operation now in progress";
+    case EINPROGRESS: return "operation now in progress";
 #endif
 #ifdef EINTR
-	case EINTR: return "interrupted system call";
+    case EINTR: return "interrupted system call";
 #endif
 #ifdef EINVAL
-	case EINVAL: return "invalid argument";
+    case EINVAL: return "invalid argument";
 #endif
 #ifdef EIO
-	case EIO: return "I/O error";
+    case EIO: return "I/O error";
 #endif
 #ifdef EISCONN
-	case EISCONN: return "socket is already connected";
+    case EISCONN: return "socket is already connected";
 #endif
 #ifdef EISDIR
-	case EISDIR: return "illegal operation on a directory";
+    case EISDIR: return "illegal operation on a directory";
 #endif
 #ifdef EISNAME
-	case EISNAM: return "is a name file";
+    case EISNAM: return "is a name file";
 #endif
 #ifdef ELBIN
-	case ELBIN: return "ELBIN";
+    case ELBIN: return "ELBIN";
 #endif
 #ifdef EL2HLT
-	case EL2HLT: return "level 2 halted";
+    case EL2HLT: return "level 2 halted";
 #endif
 #ifdef EL2NSYNC
-	case EL2NSYNC: return "level 2 not synchronized";
+    case EL2NSYNC: return "level 2 not synchronized";
 #endif
 #ifdef EL3HLT
-	case EL3HLT: return "level 3 halted";
+    case EL3HLT: return "level 3 halted";
 #endif
 #ifdef EL3RST
-	case EL3RST: return "level 3 reset";
+    case EL3RST: return "level 3 reset";
 #endif
 #ifdef ELIBACC
-	case ELIBACC: return "can not access a needed shared library";
+    case ELIBACC: return "can not access a needed shared library";
 #endif
 #ifdef ELIBBAD
-	case ELIBBAD: return "accessing a corrupted shared library";
+    case ELIBBAD: return "accessing a corrupted shared library";
 #endif
 #ifdef ELIBEXEC
-	case ELIBEXEC: return "can not exec a shared library directly";
+    case ELIBEXEC: return "can not exec a shared library directly";
 #endif
 #ifdef ELIBMAX
-	case ELIBMAX: return
-		"attempting to link in more shared libraries than system limit";
+    case ELIBMAX: return
+	    "attempting to link in more shared libraries than system limit";
 #endif
 #ifdef ELIBSCN
-	case ELIBSCN: return ".lib section in a.out corrupted";
+    case ELIBSCN: return ".lib section in a.out corrupted";
 #endif
 #ifdef ELNRNG
-	case ELNRNG: return "link number out of range";
+    case ELNRNG: return "link number out of range";
 #endif
 #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
-	case ELOOP: return "too many levels of symbolic links";
+    case ELOOP: return "too many levels of symbolic links";
 #endif
 #ifdef EMFILE
-	case EMFILE: return "too many open files";
+    case EMFILE: return "too many open files";
 #endif
 #ifdef EMLINK
-	case EMLINK: return "too many links";
+    case EMLINK: return "too many links";
 #endif
 #ifdef EMSGSIZE
-	case EMSGSIZE: return "message too long";
+    case EMSGSIZE: return "message too long";
 #endif
 #ifdef EMULTIHOP
-	case EMULTIHOP: return "multihop attempted";
+    case EMULTIHOP: return "multihop attempted";
 #endif
 #ifdef ENAMETOOLONG
-	case ENAMETOOLONG: return "file name too long";
+    case ENAMETOOLONG: return "file name too long";
 #endif
 #ifdef ENAVAIL
-	case ENAVAIL: return "not available";
+    case ENAVAIL: return "not available";
 #endif
 #ifdef ENET
-	case ENET: return "ENET";
+    case ENET: return "ENET";
 #endif
 #ifdef ENETDOWN
-	case ENETDOWN: return "network is down";
+    case ENETDOWN: return "network is down";
 #endif
 #ifdef ENETRESET
-	case ENETRESET: return "network dropped connection on reset";
+    case ENETRESET: return "network dropped connection on reset";
 #endif
 #ifdef ENETUNREACH
-	case ENETUNREACH: return "network is unreachable";
+    case ENETUNREACH: return "network is unreachable";
 #endif
 #ifdef ENFILE
-	case ENFILE: return "file table overflow";
+    case ENFILE: return "file table overflow";
 #endif
 #ifdef ENOANO
-	case ENOANO: return "anode table overflow";
+    case ENOANO: return "anode table overflow";
 #endif
 #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
-	case ENOBUFS: return "no buffer space available";
+    case ENOBUFS: return "no buffer space available";
 #endif
 #ifdef ENOCSI
-	case ENOCSI: return "no CSI structure available";
+    case ENOCSI: return "no CSI structure available";
 #endif
 #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
-	case ENODATA: return "no data available";
+    case ENODATA: return "no data available";
 #endif
 #ifdef ENODEV
-	case ENODEV: return "no such device";
+    case ENODEV: return "no such device";
 #endif
 #ifdef ENOENT
-	case ENOENT: return "no such file or directory";
+    case ENOENT: return "no such file or directory";
 #endif
 #ifdef ENOEXEC
-	case ENOEXEC: return "exec format error";
+    case ENOEXEC: return "exec format error";
 #endif
 #ifdef ENOLCK
-	case ENOLCK: return "no locks available";
+    case ENOLCK: return "no locks available";
 #endif
 #if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
-	case ENOLINK: return "link has been severed";
+    case ENOLINK: return "link has been severed";
 #endif
 #ifdef ENOMEM
-	case ENOMEM: return "not enough memory";
+    case ENOMEM: return "not enough memory";
 #endif
 #ifdef ENOMSG
-	case ENOMSG: return "no message of desired type";
+    case ENOMSG: return "no message of desired type";
 #endif
 #ifdef ENONET
-	case ENONET: return "machine is not on the network";
+    case ENONET: return "machine is not on the network";
 #endif
 #ifdef ENOPKG
-	case ENOPKG: return "package not installed";
+    case ENOPKG: return "package not installed";
 #endif
 #if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
-	case ENOPROTOOPT: return "bad protocol option";
+    case ENOPROTOOPT: return "bad protocol option";
 #endif
 #ifdef ENOSPC
-	case ENOSPC: return "no space left on device";
+    case ENOSPC: return "no space left on device";
 #endif
 #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
-	case ENOSR: return "out of stream resources";
+    case ENOSR: return "out of stream resources";
 #endif
 #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
-	case ENOSTR: return "not a stream device";
+    case ENOSTR: return "not a stream device";
 #endif
 #ifdef ENOSYM
-	case ENOSYM: return "unresolved symbol name";
+    case ENOSYM: return "unresolved symbol name";
 #endif
 #ifdef ENOSYS
-	case ENOSYS: return "function not implemented";
+    case ENOSYS: return "function not implemented";
 #endif
 #ifdef ENOTBLK
-	case ENOTBLK: return "block device required";
+    case ENOTBLK: return "block device required";
 #endif
 #ifdef ENOTCONN
-	case ENOTCONN: return "socket is not connected";
+    case ENOTCONN: return "socket is not connected";
 #endif
 #ifdef ENOTDIR
-	case ENOTDIR: return "not a directory";
+    case ENOTDIR: return "not a directory";
 #endif
 #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
-	case ENOTEMPTY: return "directory not empty";
+    case ENOTEMPTY: return "directory not empty";
 #endif
 #ifdef ENOTNAM
-	case ENOTNAM: return "not a name file";
+    case ENOTNAM: return "not a name file";
 #endif
 #ifdef ENOTSOCK
-	case ENOTSOCK: return "socket operation on non-socket";
+    case ENOTSOCK: return "socket operation on non-socket";
 #endif
 #ifdef ENOTSUP
-	case ENOTSUP: return "operation not supported";
+    case ENOTSUP: return "operation not supported";
 #endif
 #ifdef ENOTTY
-	case ENOTTY: return "inappropriate device for ioctl";
+    case ENOTTY: return "inappropriate device for ioctl";
 #endif
 #ifdef ENOTUNIQ
-	case ENOTUNIQ: return "name not unique on network";
+    case ENOTUNIQ: return "name not unique on network";
 #endif
 #ifdef ENXIO
-	case ENXIO: return "no such device or address";
+    case ENXIO: return "no such device or address";
 #endif
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
-	case EOPNOTSUPP: return "operation not supported on socket";
+    case EOPNOTSUPP: return "operation not supported on socket";
 #endif
 #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
-        case EOVERFLOW: return "file too big";
+    case EOVERFLOW: return "file too big";
 #endif
 #ifdef EPERM
-	case EPERM: return "not owner";
+    case EPERM: return "not owner";
 #endif
 #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
-	case EPFNOSUPPORT: return "protocol family not supported";
+    case EPFNOSUPPORT: return "protocol family not supported";
 #endif
 #ifdef EPIPE
-	case EPIPE: return "broken pipe";
+    case EPIPE: return "broken pipe";
 #endif
 #ifdef EPROCLIM
-	case EPROCLIM: return "too many processes";
+    case EPROCLIM: return "too many processes";
 #endif
 #ifdef EPROCUNAVAIL
-	case EPROCUNAVAIL: return "bad procedure for program";
+    case EPROCUNAVAIL: return "bad procedure for program";
 #endif
 #ifdef EPROGMISMATCH
-	case EPROGMISMATCH: return "program version wrong";
+    case EPROGMISMATCH: return "program version wrong";
 #endif
 #ifdef EPROGUNAVAIL
-	case EPROGUNAVAIL: return "RPC program not available";
+    case EPROGUNAVAIL: return "RPC program not available";
 #endif
 #ifdef EPROTO
-	case EPROTO: return "protocol error";
+    case EPROTO: return "protocol error";
 #endif
 #ifdef EPROTONOSUPPORT
-	case EPROTONOSUPPORT: return "protocol not supported";
+    case EPROTONOSUPPORT: return "protocol not supported";
 #endif
 #ifdef EPROTOTYPE
-	case EPROTOTYPE: return "protocol wrong type for socket";
+    case EPROTOTYPE: return "protocol wrong type for socket";
 #endif
 #ifdef ERANGE
-	case ERANGE: return "math result unrepresentable";
+    case ERANGE: return "math result unrepresentable";
 #endif
 #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
-	case EREFUSED: return "EREFUSED";
+    case EREFUSED: return "EREFUSED";
 #endif
 #ifdef EREMCHG
-	case EREMCHG: return "remote address changed";
+    case EREMCHG: return "remote address changed";
 #endif
 #ifdef EREMDEV
-	case EREMDEV: return "remote device";
+    case EREMDEV: return "remote device";
 #endif
 #ifdef EREMOTE
-	case EREMOTE: return "pathname hit remote file system";
+    case EREMOTE: return "pathname hit remote file system";
 #endif
 #ifdef EREMOTEIO
-	case EREMOTEIO: return "remote i/o error";
+    case EREMOTEIO: return "remote i/o error";
 #endif
 #ifdef EREMOTERELEASE
-	case EREMOTERELEASE: return "EREMOTERELEASE";
+    case EREMOTERELEASE: return "EREMOTERELEASE";
 #endif
 #ifdef EROFS
-	case EROFS: return "read-only file system";
+    case EROFS: return "read-only file system";
 #endif
 #ifdef ERPCMISMATCH
-	case ERPCMISMATCH: return "RPC version is wrong";
+    case ERPCMISMATCH: return "RPC version is wrong";
 #endif
 #ifdef ERREMOTE
-	case ERREMOTE: return "object is remote";
+    case ERREMOTE: return "object is remote";
 #endif
 #ifdef ESHUTDOWN
-	case ESHUTDOWN: return "can't send after socket shutdown";
+    case ESHUTDOWN: return "can't send after socket shutdown";
 #endif
 #ifdef ESOCKTNOSUPPORT
-	case ESOCKTNOSUPPORT: return "socket type not supported";
+    case ESOCKTNOSUPPORT: return "socket type not supported";
 #endif
 #ifdef ESPIPE
-	case ESPIPE: return "invalid seek";
+    case ESPIPE: return "invalid seek";
 #endif
 #ifdef ESRCH
-	case ESRCH: return "no such process";
+    case ESRCH: return "no such process";
 #endif
 #ifdef ESRMNT
-	case ESRMNT: return "srmount error";
+    case ESRMNT: return "srmount error";
 #endif
 #ifdef ESTALE
-	case ESTALE: return "stale remote file handle";
+    case ESTALE: return "stale remote file handle";
 #endif
 #ifdef ESUCCESS
-	case ESUCCESS: return "Error 0";
+    case ESUCCESS: return "Error 0";
 #endif
 #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
-	case ETIME: return "timer expired";
+    case ETIME: return "timer expired";
 #endif
 #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
-	case ETIMEDOUT: return "connection timed out";
+    case ETIMEDOUT: return "connection timed out";
 #endif
 #ifdef ETOOMANYREFS
-	case ETOOMANYREFS: return "too many references: can't splice";
+    case ETOOMANYREFS: return "too many references: can't splice";
 #endif
 #ifdef ETXTBSY
-	case ETXTBSY: return "text file or pseudo-device busy";
+    case ETXTBSY: return "text file or pseudo-device busy";
 #endif
 #ifdef EUCLEAN
-	case EUCLEAN: return "structure needs cleaning";
+    case EUCLEAN: return "structure needs cleaning";
 #endif
 #ifdef EUNATCH
-	case EUNATCH: return "protocol driver not attached";
+    case EUNATCH: return "protocol driver not attached";
 #endif
 #ifdef EUSERS
-	case EUSERS: return "too many users";
+    case EUSERS: return "too many users";
 #endif
 #ifdef EVERSION
-	case EVERSION: return "version mismatch";
+    case EVERSION: return "version mismatch";
 #endif
 #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
-	case EWOULDBLOCK: return "operation would block";
+    case EWOULDBLOCK: return "operation would block";
 #endif
 #ifdef EXDEV
-	case EXDEV: return "cross-domain link";
+    case EXDEV: return "cross-domain link";
 #endif
 #ifdef EXFULL
-	case EXFULL: return "message tables full";
+    case EXFULL: return "message tables full";
 #endif
-	default:
+    default:
 #ifdef NO_STRERROR
-	    return "unknown POSIX error";
+	return "unknown POSIX error";
 #else
-	    return strerror(err);
+	return strerror(err);
 #endif
     }
 }
@@ -921,9 +917,9 @@ Tcl_ErrnoMsg(err)
  *	Return a textual identifier for a signal number.
  *
  * Results:
- *	This procedure returns a machine-readable textual identifier
- *	that corresponds to sig.  The identifier is the same as the
- *	#define name in signal.h.
+ *	This procedure returns a machine-readable textual identifier that
+ *	corresponds to sig.  The identifier is the same as the #define name in
+ *	signal.h.
  *
  * Side effects:
  *	None.
@@ -932,114 +928,117 @@ Tcl_ErrnoMsg(err)
  */
 
 CONST char *
-Tcl_SignalId(sig)
-    int sig;			/* Number of signal. */
+Tcl_SignalId(
+     int sig)			/* Number of signal. */
 {
     switch (sig) {
 #ifdef SIGABRT
-	case SIGABRT: return "SIGABRT";
+    case SIGABRT: return "SIGABRT";
 #endif
 #ifdef SIGALRM
-	case SIGALRM: return "SIGALRM";
+    case SIGALRM: return "SIGALRM";
 #endif
 #ifdef SIGBUS
-	case SIGBUS: return "SIGBUS";
+    case SIGBUS: return "SIGBUS";
 #endif
 #ifdef SIGCHLD
-	case SIGCHLD: return "SIGCHLD";
+    case SIGCHLD: return "SIGCHLD";
 #endif
 #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
-	case SIGCLD: return "SIGCLD";
+    case SIGCLD: return "SIGCLD";
 #endif
 #ifdef SIGCONT
-	case SIGCONT: return "SIGCONT";
+    case SIGCONT: return "SIGCONT";
 #endif
 #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
-	case SIGEMT: return "SIGEMT";
+    case SIGEMT: return "SIGEMT";
 #endif
 #ifdef SIGFPE
-	case SIGFPE: return "SIGFPE";
+    case SIGFPE: return "SIGFPE";
 #endif
 #ifdef SIGHUP
-	case SIGHUP: return "SIGHUP";
+    case SIGHUP: return "SIGHUP";
 #endif
 #ifdef SIGILL
-	case SIGILL: return "SIGILL";
+    case SIGILL: return "SIGILL";
 #endif
 #ifdef SIGINT
-	case SIGINT: return "SIGINT";
+    case SIGINT: return "SIGINT";
 #endif
 #ifdef SIGIO
-	case SIGIO: return "SIGIO";
+    case SIGIO: return "SIGIO";
 #endif
 #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT))
-	case SIGIOT: return "SIGIOT";
+    case SIGIOT: return "SIGIOT";
 #endif
 #ifdef SIGKILL
-	case SIGKILL: return "SIGKILL";
+    case SIGKILL: return "SIGKILL";
 #endif
 #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
-	case SIGLOST: return "SIGLOST";
+    case SIGLOST: return "SIGLOST";
 #endif
 #ifdef SIGPIPE
-	case SIGPIPE: return "SIGPIPE";
+    case SIGPIPE: return "SIGPIPE";
 #endif
 #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
-	case SIGPOLL: return "SIGPOLL";
+    case SIGPOLL: return "SIGPOLL";
 #endif
 #ifdef SIGPROF
-	case SIGPROF: return "SIGPROF";
+    case SIGPROF: return "SIGPROF";
 #endif
 #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
-	case SIGPWR: return "SIGPWR";
+    case SIGPWR: return "SIGPWR";
 #endif
 #ifdef SIGQUIT
-	case SIGQUIT: return "SIGQUIT";
+    case SIGQUIT: return "SIGQUIT";
 #endif
 #if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS))
-	case SIGSEGV: return "SIGSEGV";
+    case SIGSEGV: return "SIGSEGV";
 #endif
 #ifdef SIGSTOP
-	case SIGSTOP: return "SIGSTOP";
+    case SIGSTOP: return "SIGSTOP";
 #endif
 #ifdef SIGSYS
-	case SIGSYS: return "SIGSYS";
+    case SIGSYS: return "SIGSYS";
 #endif
 #ifdef SIGTERM
-	case SIGTERM: return "SIGTERM";
+    case SIGTERM: return "SIGTERM";
 #endif
 #ifdef SIGTRAP
-	case SIGTRAP: return "SIGTRAP";
+    case SIGTRAP: return "SIGTRAP";
 #endif
 #ifdef SIGTSTP
-	case SIGTSTP: return "SIGTSTP";
+    case SIGTSTP: return "SIGTSTP";
 #endif
 #ifdef SIGTTIN
-	case SIGTTIN: return "SIGTTIN";
+    case SIGTTIN: return "SIGTTIN";
 #endif
 #ifdef SIGTTOU
-	case SIGTTOU: return "SIGTTOU";
+    case SIGTTOU: return "SIGTTOU";
 #endif
 #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
-	case SIGURG: return "SIGURG";
+    case SIGURG: return "SIGURG";
 #endif
 #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
-	case SIGUSR1: return "SIGUSR1";
+    case SIGUSR1: return "SIGUSR1";
 #endif
 #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
-	case SIGUSR2: return "SIGUSR2";
+    case SIGUSR2: return "SIGUSR2";
 #endif
 #ifdef SIGVTALRM
-	case SIGVTALRM: return "SIGVTALRM";
+    case SIGVTALRM: return "SIGVTALRM";
 #endif
 #ifdef SIGWINCH
-	case SIGWINCH: return "SIGWINCH";
+    case SIGWINCH: return "SIGWINCH";
 #endif
 #ifdef SIGXCPU
-	case SIGXCPU: return "SIGXCPU";
+    case SIGXCPU: return "SIGXCPU";
 #endif
 #ifdef SIGXFSZ
-	case SIGXFSZ: return "SIGXFSZ";
+    case SIGXFSZ: return "SIGXFSZ";
+#endif
+#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
+    case SIGINFO: return "SIGINFO";
 #endif
     }
     return "unknown signal";
@@ -1053,9 +1052,8 @@ Tcl_SignalId(sig)
  *	Return a human-readable message describing a signal.
  *
  * Results:
- *	This procedure returns a string describing sig that should
- *	make sense to a human.  It may not be easy for a machine
- *	to parse.
+ *	This procedure returns a string describing sig that should make sense
+ *	to a human.  It may not be easy for a machine to parse.
  *
  * Side effects:
  *	None.
@@ -1064,115 +1062,126 @@ Tcl_SignalId(sig)
  */
 
 CONST char *
-Tcl_SignalMsg(sig)
-    int sig;			/* Number of signal. */
+Tcl_SignalMsg(
+     int sig)			/* Number of signal. */
 {
     switch (sig) {
 #ifdef SIGABRT
-	case SIGABRT: return "SIGABRT";
+    case SIGABRT: return "SIGABRT";
 #endif
 #ifdef SIGALRM
-	case SIGALRM: return "alarm clock";
+    case SIGALRM: return "alarm clock";
 #endif
 #ifdef SIGBUS
-	case SIGBUS: return "bus error";
+    case SIGBUS: return "bus error";
 #endif
 #ifdef SIGCHLD
-	case SIGCHLD: return "child status changed";
+    case SIGCHLD: return "child status changed";
 #endif
 #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
-	case SIGCLD: return "child status changed";
+    case SIGCLD: return "child status changed";
 #endif
 #ifdef SIGCONT
-	case SIGCONT: return "continue after stop";
+    case SIGCONT: return "continue after stop";
 #endif
 #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
-	case SIGEMT: return "EMT instruction";
+    case SIGEMT: return "EMT instruction";
 #endif
 #ifdef SIGFPE
-	case SIGFPE: return "floating-point exception";
+    case SIGFPE: return "floating-point exception";
 #endif
 #ifdef SIGHUP
-	case SIGHUP: return "hangup";
+    case SIGHUP: return "hangup";
 #endif
 #ifdef SIGILL
-	case SIGILL: return "illegal instruction";
+    case SIGILL: return "illegal instruction";
 #endif
 #ifdef SIGINT
-	case SIGINT: return "interrupt";
+    case SIGINT: return "interrupt";
 #endif
 #ifdef SIGIO
-	case SIGIO: return "input/output possible on file";
+    case SIGIO: return "input/output possible on file";
 #endif
 #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT))
-	case SIGIOT: return "IOT instruction";
+    case SIGIOT: return "IOT instruction";
 #endif
 #ifdef SIGKILL
-	case SIGKILL: return "kill signal";
+    case SIGKILL: return "kill signal";
 #endif
 #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
-	case SIGLOST: return "resource lost";
+    case SIGLOST: return "resource lost";
 #endif
 #ifdef SIGPIPE
-	case SIGPIPE: return "write on pipe with no readers";
+    case SIGPIPE: return "write on pipe with no readers";
 #endif
 #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
-	case SIGPOLL: return "input/output possible on file";
+    case SIGPOLL: return "input/output possible on file";
 #endif
 #ifdef SIGPROF
-	case SIGPROF: return "profiling alarm";
+    case SIGPROF: return "profiling alarm";
 #endif
 #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
-	case SIGPWR: return "power-fail restart";
+    case SIGPWR: return "power-fail restart";
 #endif
 #ifdef SIGQUIT
-	case SIGQUIT: return "quit signal";
+    case SIGQUIT: return "quit signal";
 #endif
 #if defined(SIGSEGV) && (!defined(SIGBUS) || (SIGSEGV != SIGBUS))
-	case SIGSEGV: return "segmentation violation";
+    case SIGSEGV: return "segmentation violation";
 #endif
 #ifdef SIGSTOP
-	case SIGSTOP: return "stop";
+    case SIGSTOP: return "stop";
 #endif
 #ifdef SIGSYS
-	case SIGSYS: return "bad argument to system call";
+    case SIGSYS: return "bad argument to system call";
 #endif
 #ifdef SIGTERM
-	case SIGTERM: return "software termination signal";
+    case SIGTERM: return "software termination signal";
 #endif
 #ifdef SIGTRAP
-	case SIGTRAP: return "trace trap";
+    case SIGTRAP: return "trace trap";
 #endif
 #ifdef SIGTSTP
-	case SIGTSTP: return "stop signal from tty";
+    case SIGTSTP: return "stop signal from tty";
 #endif
 #ifdef SIGTTIN
-	case SIGTTIN: return "background tty read";
+    case SIGTTIN: return "background tty read";
 #endif
 #ifdef SIGTTOU
-	case SIGTTOU: return "background tty write";
+    case SIGTTOU: return "background tty write";
 #endif
 #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
-	case SIGURG: return "urgent I/O condition";
+    case SIGURG: return "urgent I/O condition";
 #endif
 #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
-	case SIGUSR1: return "user-defined signal 1";
+    case SIGUSR1: return "user-defined signal 1";
 #endif
 #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
-	case SIGUSR2: return "user-defined signal 2";
+    case SIGUSR2: return "user-defined signal 2";
 #endif
 #ifdef SIGVTALRM
-	case SIGVTALRM: return "virtual time alarm";
+    case SIGVTALRM: return "virtual time alarm";
 #endif
 #ifdef SIGWINCH
-	case SIGWINCH: return "window changed";
+    case SIGWINCH: return "window changed";
 #endif
 #ifdef SIGXCPU
-	case SIGXCPU: return "exceeded CPU time limit";
+    case SIGXCPU: return "exceeded CPU time limit";
 #endif
 #ifdef SIGXFSZ
-	case SIGXFSZ: return "exceeded file size limit";
+    case SIGXFSZ: return "exceeded file size limit";
+#endif
+#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
+    case SIGINFO: return "information request";
 #endif
     }
     return "unknown signal";
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 006c92b..0dc669c 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -1,69 +1,71 @@
-/* 
+/*
  * tclPreserve.c --
  *
- *	This file contains a collection of procedures that are used
- *	to make sure that widget records and other data structures
- *	aren't reallocated when there are nested procedures that
- *	depend on their existence.
+ *	This file contains a collection of functions that are used to make
+ *	sure that widget records and other data structures aren't reallocated
+ *	when there are nested functions that depend on their existence.
  *
  * Copyright (c) 1991-1994 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * The following data structure is used to keep track of all the
- * Tcl_Preserve calls that are still in effect.  It grows as needed
- * to accommodate any number of calls in effect.
+ * The following data structure is used to keep track of all the Tcl_Preserve
+ * calls that are still in effect. It grows as needed to accommodate any
+ * number of calls in effect.
  */
 
 typedef struct {
     ClientData clientData;	/* Address of preserved block. */
-    int refCount;		/* Number of Tcl_Preserve calls in effect
-				 * for block. */
+    int refCount;		/* Number of Tcl_Preserve calls in effect for
+				 * block. */
     int mustFree;		/* Non-zero means Tcl_EventuallyFree was
 				 * called while a Tcl_Preserve call was in
-				 * effect, so the structure must be freed
-				 * when refCount becomes zero. */
-    Tcl_FreeProc *freeProc;	/* Procedure to call to free. */
+				 * effect, so the structure must be freed when
+				 * refCount becomes zero. */
+    Tcl_FreeProc *freeProc;	/* Function to call to free. */
 } Reference;
 
-static Reference *refArray;	/* First in array of references. */
-static int spaceAvl = 0;	/* Total number of structures available
-				 * at *firstRefPtr. */
-static int inUse = 0;		/* Count of structures currently in use
-				 * in refArray. */
-#define INITIAL_SIZE 2
+/*
+ * Global data structures used to hold the list of preserved data references.
+ * These variables are protected by "preserveMutex".
+ */
+
+static Reference *refArray = NULL;	/* First in array of references. */
+static int spaceAvl = 0;	/* Total number of structures available at
+				 * *firstRefPtr. */
+static int inUse = 0;		/* Count of structures currently in use in
+				 * refArray. */
 TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
 
+#define INITIAL_SIZE	2	/* Initial number of reference slots to make */
+
 /*
- * The following data structure is used to keep track of whether an
- * arbitrary block of memory has been deleted.  This is used by the
- * TclHandle code to avoid the more time-expensive algorithm of
- * Tcl_Preserve().  This mechanism is mainly used when we have lots of
- * references to a few big, expensive objects that we don't want to live
- * any longer than necessary.
+ * The following data structure is used to keep track of whether an arbitrary
+ * block of memory has been deleted. This is used by the TclHandle code to
+ * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism
+ * is mainly used when we have lots of references to a few big, expensive
+ * objects that we don't want to live any longer than necessary.
  */
 
 typedef struct HandleStruct {
-    VOID *ptr;			/* Pointer to the memory block being
-				 * tracked.  This field will become NULL when
-				 * the memory block is deleted.  This field
-				 * must be the first in the structure. */
+    void *ptr;			/* Pointer to the memory block being tracked.
+				 * This field will become NULL when the memory
+				 * block is deleted. This field must be the
+				 * first in the structure. */
 #ifdef TCL_MEM_DEBUG
-    VOID *ptr2;			/* Backup copy of the abpve pointer used to
+    void *ptr2;			/* Backup copy of the above pointer used to
 				 * ensure that the contents of the handle are
 				 * not changed by anyone else. */
 #endif
     int refCount;		/* Number of TclHandlePreserve() calls in
 				 * effect on this handle. */
 } HandleStruct;
-
-
 
 /*
  *----------------------------------------------------------------------
@@ -83,12 +85,12 @@ typedef struct HandleStruct {
 
 	/* ARGSUSED */
 void
-TclFinalizePreserve()
+TclFinalizePreserve(void)
 {
     Tcl_MutexLock(&preserveMutex);
     if (spaceAvl != 0) {
         ckfree((char *) refArray);
-        refArray = (Reference *) NULL;
+        refArray = NULL;
         inUse = 0;
         spaceAvl = 0;
     }
@@ -100,34 +102,34 @@ TclFinalizePreserve()
  *
  * Tcl_Preserve --
  *
- *	This procedure is used by a procedure to declare its interest
- *	in a particular block of memory, so that the block will not be
- *	reallocated until a matching call to Tcl_Release has been made.
+ *	This function is used by a function to declare its interest in a
+ *	particular block of memory, so that the block will not be reallocated
+ *	until a matching call to Tcl_Release has been made.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Information is retained so that the block of memory will
- *	not be freed until at least the matching call to Tcl_Release.
+ *	Information is retained so that the block of memory will not be freed
+ *	until at least the matching call to Tcl_Release.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_Preserve(clientData)
-    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+Tcl_Preserve(
+    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
 {
     Reference *refPtr;
     int i;
 
     /*
-     * See if there is already a reference for this pointer.  If so,
-     * just increment its reference count.
+     * See if there is already a reference for this pointer. If so, just
+     * increment its reference count.
      */
 
     Tcl_MutexLock(&preserveMutex);
-    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
 	if (refPtr->clientData == clientData) {
 	    refPtr->refCount++;
 	    Tcl_MutexUnlock(&preserveMutex);
@@ -136,26 +138,14 @@ Tcl_Preserve(clientData)
     }
 
     /*
-     * Make a reference array if it doesn't already exist, or make it
-     * bigger if it is full.
+     * Make a reference array if it doesn't already exist, or make it bigger
+     * if it is full.
      */
 
     if (inUse == spaceAvl) {
-	if (spaceAvl == 0) {
-	    refArray = (Reference *) ckalloc((unsigned)
-		    (INITIAL_SIZE*sizeof(Reference)));
-	    spaceAvl = INITIAL_SIZE;
-	} else {
-	    Reference *new;
-
-	    new = (Reference *) ckalloc((unsigned)
-		    (2*spaceAvl*sizeof(Reference)));
-	    memcpy((VOID *) new, (VOID *) refArray,
-                    spaceAvl*sizeof(Reference));
-	    ckfree((char *) refArray);
-	    refArray = new;
-	    spaceAvl *= 2;
-	}
+	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
+	refArray = (Reference *) ckrealloc((char *) refArray,
+		spaceAvl * sizeof(Reference));
     }
 
     /*
@@ -176,71 +166,79 @@ Tcl_Preserve(clientData)
  *
  * Tcl_Release --
  *
- *	This procedure is called to cancel a previous call to
- *	Tcl_Preserve, thereby allowing a block of memory to be
- *	freed (if no one else cares about it).
+ *	This function is called to cancel a previous call to Tcl_Preserve,
+ *	thereby allowing a block of memory to be freed (if no one else cares
+ *	about it).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If Tcl_EventuallyFree has been called for clientData, and if
- *	no other call to Tcl_Preserve is still in effect, the block of
- *	memory is freed.
+ *	If Tcl_EventuallyFree has been called for clientData, and if no other
+ *	call to Tcl_Preserve is still in effect, the block of memory is freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_Release(clientData)
-    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+Tcl_Release(
+    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
 {
     Reference *refPtr;
-    int mustFree;
-    Tcl_FreeProc *freeProc;
     int i;
 
     Tcl_MutexLock(&preserveMutex);
-    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
+    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
+	int mustFree;
+	Tcl_FreeProc *freeProc;
+
 	if (refPtr->clientData != clientData) {
 	    continue;
 	}
-	refPtr->refCount--;
-	if (refPtr->refCount == 0) {
-
-            /*
-             * Must remove information from the slot before calling freeProc
-             * to avoid reentrancy problems if the freeProc calls Tcl_Preserve
-             * on the same clientData. Copy down the last reference in the
-             * array to overwrite the current slot.
-             */
-
-            freeProc = refPtr->freeProc;
-            mustFree = refPtr->mustFree;
-	    inUse--;
-	    if (i < inUse) {
-		refArray[i] = refArray[inUse];
-	    }
-	    if (mustFree) {
-		if (freeProc == TCL_DYNAMIC) {
-		    ckfree((char *) clientData);
-		} else {
-		    Tcl_MutexUnlock(&preserveMutex);
-		    (*freeProc)((char *) clientData);
-		    return;
-		}
-	    }
+
+	if (--refPtr->refCount != 0) {
+	    Tcl_MutexUnlock(&preserveMutex);
+	    return;
 	}
+
+	/*
+	 * Must remove information from the slot before calling freeProc to
+	 * avoid reentrancy problems if the freeProc calls Tcl_Preserve on the
+	 * same clientData. Copy down the last reference in the array to
+	 * overwrite the current slot.
+	 */
+
+	freeProc = refPtr->freeProc;
+	mustFree = refPtr->mustFree;
+	inUse--;
+	if (i < inUse) {
+	    refArray[i] = refArray[inUse];
+	}
+
+	/*
+	 * Now committed to disposing the data. But first, we've patched up
+	 * all the global data structures so we should release the mutex now.
+	 * Only then should we dabble around with potentially-slow memory
+	 * managers...
+	 */
+
 	Tcl_MutexUnlock(&preserveMutex);
+	if (mustFree) {
+	    if (freeProc == TCL_DYNAMIC) {
+		ckfree((char *) clientData);
+	    } else {
+		(*freeProc)((char *) clientData);
+	    }
+	}
 	return;
     }
     Tcl_MutexUnlock(&preserveMutex);
 
     /*
-     * Reference not found.  This is a bug in the caller.
+     * Reference not found. This is a bug in the caller.
      */
 
-    panic("Tcl_Release couldn't find reference for 0x%x", clientData);
+    Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", PTR2UINT(clientData));
 }
 
 /*
@@ -248,10 +246,9 @@ Tcl_Release(clientData)
  *
  * Tcl_EventuallyFree --
  *
- *	Free up a block of memory, unless a call to Tcl_Preserve is in
- *	effect for that block.  In this case, defer the free until all
- *	calls to Tcl_Preserve have been undone by matching calls to
- *	Tcl_Release.
+ *	Free up a block of memory, unless a call to Tcl_Preserve is in effect
+ *	for that block. In this case, defer the free until all calls to
+ *	Tcl_Preserve have been undone by matching calls to Tcl_Release.
  *
  * Results:
  *	None.
@@ -263,16 +260,16 @@ Tcl_Release(clientData)
  */
 
 void
-Tcl_EventuallyFree(clientData, freeProc)
-    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
-    Tcl_FreeProc *freeProc;	/* Procedure to actually do free. */
+Tcl_EventuallyFree(
+    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
+    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
 {
     Reference *refPtr;
     int i;
 
     /*
-     * See if there is a reference for this pointer.  If so, set its
-     * "mustFree" flag (the flag had better not be set already!).
+     * See if there is a reference for this pointer. If so, set its "mustFree"
+     * flag (the flag had better not be set already!).
      */
 
     Tcl_MutexLock(&preserveMutex);
@@ -281,7 +278,8 @@ Tcl_EventuallyFree(clientData, freeProc)
 	    continue;
 	}
 	if (refPtr->mustFree) {
-	    panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
+	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x",
+		    PTR2UINT(clientData));
         }
         refPtr->mustFree = 1;
 	refPtr->freeProc = freeProc;
@@ -306,31 +304,29 @@ Tcl_EventuallyFree(clientData, freeProc)
  *
  * TclHandleCreate --
  *
- *	Allocate a handle that contains enough information to determine
- *	if an arbitrary malloc'd block has been deleted.  This is 
- *	used to avoid the more time-expensive algorithm of Tcl_Preserve().
+ *	Allocate a handle that contains enough information to determine if an
+ *	arbitrary malloc'd block has been deleted. This is used to avoid the
+ *	more time-expensive algorithm of Tcl_Preserve().
  *
  * Results:
  *	The return value is a TclHandle that refers to the given malloc'd
- *	block.  Doubly dereferencing the returned handle will give
- *	back the pointer to the block, or will give NULL if the block has
- *	been deleted.
+ *	block. Doubly dereferencing the returned handle will give back the
+ *	pointer to the block, or will give NULL if the block has been deleted.
  *
  * Side effects:
- *	The caller must keep track of this handle (generally by storing
- *	it in a field in the malloc'd block) and call TclHandleFree()
- *	on this handle when the block is deleted.  Everything else that
- *	wishes to keep track of whether the malloc'd block has been deleted
- *	should use calls to TclHandlePreserve() and TclHandleRelease()
- *	on the associated handle.
+ *	The caller must keep track of this handle (generally by storing it in
+ *	a field in the malloc'd block) and call TclHandleFree() on this handle
+ *	when the block is deleted. Everything else that wishes to keep track
+ *	of whether the malloc'd block has been deleted should use calls to
+ *	TclHandlePreserve() and TclHandleRelease() on the associated handle.
  *
  *---------------------------------------------------------------------------
  */
 
 TclHandle
-TclHandleCreate(ptr)
-    VOID *ptr;			/* Pointer to an arbitrary block of memory
-				 * to be tracked for deletion.  Must not be
+TclHandleCreate(
+    void *ptr)			/* Pointer to an arbitrary block of memory to
+				 * be tracked for deletion. Must not be
 				 * NULL. */
 {
     HandleStruct *handlePtr;
@@ -349,11 +345,10 @@ TclHandleCreate(ptr)
  *
  * TclHandleFree --
  *
- *	Called when the arbitrary malloc'd block associated with the
- *	handle is being deleted.  Modifies the handle so that doubly
- *	dereferencing it will give NULL.  This informs any user of the
- *	handle that the block of memory formerly referenced by the
- *	handle has been freed.
+ *	Called when the arbitrary malloc'd block associated with the handle is
+ *	being deleted. Modifies the handle so that doubly dereferencing it
+ *	will give NULL. This informs any user of the handle that the block of
+ *	memory formerly referenced by the handle has been freed.
  *
  * Results:
  *	None.
@@ -365,21 +360,21 @@ TclHandleCreate(ptr)
  */
 
 void
-TclHandleFree(handle)
-    TclHandle handle;		/* Previously created handle associated
-				 * with a malloc'd block that is being
-				 * deleted.  The handle is modified so that
-				 * doubly dereferencing it will give NULL. */
+TclHandleFree(
+    TclHandle handle)		/* Previously created handle associated with a
+				 * malloc'd block that is being deleted. The
+				 * handle is modified so that doubly
+				 * dereferencing it will give NULL. */
 {
     HandleStruct *handlePtr;
 
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
     }
     if (handlePtr->ptr2 != handlePtr->ptr) {
-	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
@@ -394,36 +389,35 @@ TclHandleFree(handle)
  *
  * TclHandlePreserve --
  *
- *	Declare an interest in the arbitrary malloc'd block associated
- *	with the handle.  
+ *	Declare an interest in the arbitrary malloc'd block associated with
+ *	the handle.
  *
  * Results:
  *	The return value is the handle argument, with its ref count
  *	incremented.
  *
  * Side effects:
- *	For each call to TclHandlePreserve(), there should be a matching
- *	call to TclHandleRelease() when the caller is no longer interested
- *	in the malloc'd block associated with the handle.
+ *	For each call to TclHandlePreserve(), there should be a matching call
+ *	to TclHandleRelease() when the caller is no longer interested in the
+ *	malloc'd block associated with the handle.
  *
  *---------------------------------------------------------------------------
  */
 
 TclHandle
-TclHandlePreserve(handle)
-    TclHandle handle;		/* Declare an interest in the block of
-				 * memory referenced by this handle. */
+TclHandlePreserve(
+    TclHandle handle)		/* Declare an interest in the block of memory
+				 * referenced by this handle. */
 {
     HandleStruct *handlePtr;
 
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
     }
-    if ((handlePtr->ptr != NULL)
-	    && (handlePtr->ptr != handlePtr->ptr2)) {
-	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
+	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
@@ -437,35 +431,34 @@ TclHandlePreserve(handle)
  *
  * TclHandleRelease --
  *
- *	This procedure is called to release an interest in the malloc'd
- *	block associated with the handle.
+ *	This function is called to release an interest in the malloc'd block
+ *	associated with the handle.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The ref count of the handle is decremented.  If the malloc'd block
- *	has been freed and if no one is using the handle any more, the
- *	handle will be reclaimed.
+ *	The ref count of the handle is decremented. If the malloc'd block has
+ *	been freed and if no one is using the handle any more, the handle will
+ *	be reclaimed.
  *
  *---------------------------------------------------------------------------
  */
- 
+
 void
-TclHandleRelease(handle)
-    TclHandle handle;		/* Unregister interest in the block of
-				 * memory referenced by this handle. */
+TclHandleRelease(
+    TclHandle handle)		/* Unregister interest in the block of memory
+				 * referenced by this handle. */
 {
     HandleStruct *handlePtr;
 
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
     }
-    if ((handlePtr->ptr != NULL)
-	    && (handlePtr->ptr != handlePtr->ptr2)) {
-	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
+	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
@@ -474,4 +467,11 @@ TclHandleRelease(handle)
 	ckfree((char *) handlePtr);
     }
 }
-    
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index abfd152..d58e8da 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1,15 +1,16 @@
 /*
  * tclProc.c --
  *
- *	This file contains routines that implement Tcl procedures,
- *	including the "proc" and "uplevel" commands.
+ *	This file contains routines that implement Tcl procedures, including
+ *	the "proc" and "uplevel" commands.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004-2006 Miguel Sofer
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -19,19 +20,30 @@
  * Prototypes for static functions in this file
  */
 
-static void	ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
-static void	ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int	ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-		Tcl_Obj *objPtr));
-static void	ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int	ProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
-		    Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
-		    CONST char *description, CONST char *procName,
-		    Proc **procPtrPtr));
-static  int	ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
-		    char *procName, int nameLen, int returnCode));
-static int	TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+static void		DupLambdaInternalRep(Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr);
+static void		FreeLambdaInternalRep(Tcl_Obj *objPtr);
+static int		InitArgsAndLocals(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj, int skip);
+static void		InitResolvedLocals(Tcl_Interp *interp,
+			    ByteCode *codePtr, Var *defPtr,
+	                    Namespace *nsPtr);
+static void             InitLocalCache(Proc *procPtr);
+static int		PushProcCallFrame(ClientData clientData,
+			    register Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[], int isLambda);
+static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void		ProcBodyFree(Tcl_Obj *objPtr);
+static int              ProcWrongNumArgs(Tcl_Interp *interp, int skip);
+static void		MakeProcError(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj);
+static void		MakeLambdaError(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj);
+static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int		ProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
+			    Tcl_Obj *bodyPtr, Namespace *nsPtr,
+			    CONST char *description, CONST char *procName,
+			    Proc **procPtrPtr);
 
 /*
  * The ProcBodyObjType type
@@ -39,10 +51,44 @@ static int	TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
 
 Tcl_ObjType tclProcBodyType = {
     "procbody",			/* name for this type */
-    ProcBodyFree,		/* FreeInternalRep procedure */
-    ProcBodyDup,		/* DupInternalRep procedure */
-    ProcBodyUpdateString,	/* UpdateString procedure */
-    ProcBodySetFromAny		/* SetFromAny procedure */
+    ProcBodyFree,		/* FreeInternalRep function */
+    ProcBodyDup,		/* DupInternalRep function */
+    NULL,			/* UpdateString function; Tcl_GetString and
+				 * Tcl_GetStringFromObj should panic
+				 * instead. */
+    NULL			/* SetFromAny function; Tcl_ConvertToType
+				 * should panic instead. */
+};
+
+/*
+ * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
+ * encoding the type of level reference in ptr1 and the actual parsed out
+ * offset in ptr2.
+ *
+ * Uses the default behaviour throughout, and never disposes of the string
+ * rep; it's just a cache type.
+ */
+
+static Tcl_ObjType levelReferenceType = {
+    "levelReference",
+    NULL, NULL, NULL, NULL
+};
+
+/*
+ * The type of lambdas. Note that every lambda will *always* have a string
+ * representation.
+ *
+ * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
+ * command name, and ptr2 is a pointer to the namespace that the Proc instance
+ * will execute within.
+ */
+
+static Tcl_ObjType lambdaType = {
+    "lambdaExpr",		/* name */
+    FreeLambdaInternalRep,	/* freeIntRepProc */
+    DupLambdaInternalRep,	/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    SetLambdaFromAny		/* setFromAnyProc */
 };
 
 /*
@@ -50,7 +96,7 @@ Tcl_ObjType tclProcBodyType = {
  *
  * Tcl_ProcObjCmd --
  *
- *	This object-based procedure is invoked to process the "proc" Tcl
+ *	This object-based function is invoked to process the "proc" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -64,11 +110,11 @@ Tcl_ObjType tclProcBodyType = {
 
 	/* ARGSUSED */
 int
-Tcl_ProcObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ProcObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
@@ -84,47 +130,48 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Determine the namespace where the procedure should reside. Unless
-     * the command name includes namespace qualifiers, this will be the
-     * current namespace.
+     * Determine the namespace where the procedure should reside. Unless the
+     * command name includes namespace qualifiers, this will be the current
+     * namespace.
      */
 
     fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
-	    0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
 
     if (nsPtr == NULL) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"can't create procedure \"", fullName,
-		"\": unknown namespace", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
+		"\": unknown namespace", NULL);
+	return TCL_ERROR;
     }
     if (procName == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"can't create procedure \"", fullName,
-		"\": bad procedure name", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
+		"\": bad procedure name", NULL);
+	return TCL_ERROR;
     }
     if ((nsPtr != iPtr->globalNsPtr)
 	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"can't create procedure \"", procName,
+	Tcl_AppendResult(interp, "can't create procedure \"", procName,
 		"\" in non-global namespace with name starting with \":\"",
-	        (char *) NULL);
-        return TCL_ERROR;
+		NULL);
+	return TCL_ERROR;
     }
 
     /*
-     *  Create the data structure to represent the procedure.
+     * Create the data structure to represent the procedure.
      */
+
     if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
-        &procPtr) != TCL_OK) {
-        return TCL_ERROR;
+	    &procPtr) != TCL_OK) {
+	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
+	Tcl_AddErrorInfo(interp, procName);
+	Tcl_AddErrorInfo(interp, "\")");
+	return TCL_ERROR;
     }
 
     /*
-     * Now create a command for the procedure. This will initially be in
-     * the current namespace unless the procedure's name included namespace
+     * Now create a command for the procedure. This will initially be in the
+     * current namespace unless the procedure's name included namespace
      * qualifiers. To create the new command in the right namespace, we
      * generate a fully qualified name for it.
      */
@@ -136,12 +183,11 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
     }
     Tcl_DStringAppend(&ds, procName, -1);
 
-    Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
-	    (ClientData) procPtr, TclProcDeleteProc);
     cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
 	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
 
     Tcl_DStringFree(&ds);
+
     /*
      * Now initialize the new procedure's cmdPtr field. This will be used
      * later when the procedure is called to determine what namespace the
@@ -151,113 +197,133 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
 
     procPtr->cmdPtr = (Command *) cmd;
 
-#ifdef TCL_TIP280
-    /* TIP #280 Remember the line the procedure body is starting on. In a
-     * Byte code context we ask the engine to provide us with the necessary
+    /*
+     * TIP #280: Remember the line the procedure body is starting on. In a
+     * bytecode context we ask the engine to provide us with the necessary
      * information. This is for the initialization of the byte code compiler
      * when the body is used for the first time.
+     *
+     * This code is nearly identical to the #280 code in SetLambdaFromAny, see
+     * this file. The differences are the different index of the body in the
+     * line array of the context, and the lamdba code requires some special
+     * processing. Find a way to factor the common elements into a single
+     * function.
      */
 
     if (iPtr->cmdFramePtr) {
-        CmdFrame context = *iPtr->cmdFramePtr;
-
-	if (context.type == TCL_LOCATION_BC) {
-	    TclGetSrcInfoForPc (&context);
-	    /* May get path in context */
-	} else if (context.type == TCL_LOCATION_SOURCE) {
-	    /* context now holds another reference */
-	    Tcl_IncrRefCount (context.data.eval.path);
-	}
+	CmdFrame *contextPtr;
 
-	/* type == TCL_LOCATION_PREBC implies that 'line' is NULL here!  We
-	 * cannot assume that 'line' is valid here, we have to check. If the
-	 * outer context is an eval (bc, prebc, eval) we do not save any
-	 * information. Counting relative to the beginning of the proc body is
-	 * more sensible than counting relative to the outer eval block.
-	 */
+	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+	*contextPtr = *iPtr->cmdFramePtr;
 
-	if ((context.type == TCL_LOCATION_SOURCE) &&
-	    context.line &&
-	    (context.nline >= 4) &&
-	    (context.line [3] >= 0)) {
-	    int       isNew;
-	    Tcl_HashEntry* hePtr;
-	    CmdFrame* cfPtr = (CmdFrame*) ckalloc (sizeof (CmdFrame));
-
-	    cfPtr->level    = -1;
-	    cfPtr->type     = context.type;
-	    cfPtr->line     = (int*) ckalloc (sizeof (int));
-	    cfPtr->line [0] = context.line [3];
-	    cfPtr->nline    = 1;
-	    cfPtr->framePtr = NULL;
-	    cfPtr->nextPtr  = NULL;
-
-	    if (context.type == TCL_LOCATION_SOURCE) {
-	        cfPtr->data.eval.path = context.data.eval.path;
-		/* Transfer of reference. The reference going away (release of
-		 * the context) is replaced by the reference in the
-		 * constructed cmdframe */
-	    } else {
-	        cfPtr->type = TCL_LOCATION_EVAL;
-		cfPtr->data.eval.path = NULL;
-	    }
+	if (contextPtr->type == TCL_LOCATION_BC) {
+	    /*
+	     * Retrieve source information from the bytecode, if possible. If
+	     * the information is retrieved successfully, context.type will be
+	     * TCL_LOCATION_SOURCE and the reference held by
+	     * context.data.eval.path will be counted.
+	     */
 
-	    cfPtr->cmd.str.cmd = NULL;
-	    cfPtr->cmd.str.len = 0;
+	    TclGetSrcInfoForPc(contextPtr);
+	} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * The copy into 'context' up above has created another reference
+	     * to 'context.data.eval.path'; account for it.
+	     */
 
-	    hePtr = Tcl_CreateHashEntry (iPtr->linePBodyPtr, (char*) procPtr,
-					 &isNew);
-	    if (!isNew) {
-		/*
-		 * Get the old command frame and release it.  See also
-		 * TclProcCleanupProc in this file. Currently it seems as if
-		 * only the procbodytest::proc command of the testsuite is
-		 * able to trigger this situation.
-		 */
+	    Tcl_IncrRefCount(contextPtr->data.eval.path);
+	}
+
+	if (contextPtr->type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * We can account for source location within a proc only if the
+	     * proc body was not created by substitution.
+	     */
+
+	    if (contextPtr->line
+		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
+		int isNew;
+		Tcl_HashEntry* hePtr;
+		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+
+		cfPtr->level = -1;
+		cfPtr->type = contextPtr->type;
+		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line[0] = contextPtr->line[3];
+		cfPtr->nline = 1;
+		cfPtr->framePtr = NULL;
+		cfPtr->nextPtr = NULL;
+
+		cfPtr->data.eval.path = contextPtr->data.eval.path;
+		Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+		cfPtr->cmd.str.cmd = NULL;
+		cfPtr->cmd.str.len = 0;
+
+		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew);
+		if (!isNew) {
+		    /*
+		     * Get the old command frame and release it.  See also
+		     * TclProcCleanupProc in this file. Currently it seems as
+		     * if only the procbodytest::proc command of the testsuite
+		     * is able to trigger this situation.
+		     */
 
-		CmdFrame* cfOldPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
+		    CmdFrame* cfOldPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
 
-		if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
-		    Tcl_DecrRefCount(cfOldPtr->data.eval.path);
-		    cfOldPtr->data.eval.path = NULL;
+		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
+			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
+			cfOldPtr->data.eval.path = NULL;
+		    }
+		    ckfree((char *) cfOldPtr->line);
+		    cfOldPtr->line = NULL;
+		    ckfree((char *) cfOldPtr);
 		}
-		ckfree((char *) cfOldPtr->line);
-		cfOldPtr->line = NULL;
-		ckfree((char *) cfOldPtr);
+		Tcl_SetHashValue(hePtr, cfPtr);
 	    }
-	    Tcl_SetHashValue (hePtr, cfPtr);
+
+	    /*
+	     * 'contextPtr' is going out of scope; account for the reference that
+	     * it's holding to the path name.
+	     */
+
+	    Tcl_DecrRefCount(contextPtr->data.eval.path);
+	    contextPtr->data.eval.path = NULL;
 	}
+	TclStackFree(interp, contextPtr);
     }
-#endif
 
     /*
-     * Optimize for noop procs: if the body is not precompiled (like a TclPro
+     * Optimize for no-op procs: if the body is not precompiled (like a TclPro
      * procbody), and the argument list is just "args" and the body is empty,
-     * define a compileProc to compile a noop.
+     * define a compileProc to compile a no-op.
      *
      * Notes:
-     *   - cannot be done for any argument list without having different
-     *     compiled/not-compiled behaviour in the "wrong argument #" case,
-     *     or making this code much more complicated. In any case, it doesn't
-     *     seem to make a lot of sense to verify the number of arguments we
-     *     are about to ignore ...
-     *   - could be enhanced to handle also non-empty bodies that contain
-     *     only comments; however, parsing the body will slow down the
-     *     compilation of all procs whose argument list is just _args_ */
+     *	 - cannot be done for any argument list without having different
+     *	   compiled/not-compiled behaviour in the "wrong argument #" case, or
+     *	   making this code much more complicated. In any case, it doesn't
+     *	   seem to make a lot of sense to verify the number of arguments we
+     *	   are about to ignore ...
+     *	 - could be enhanced to handle also non-empty bodies that contain only
+     *	   comments; however, parsing the body will slow down the compilation
+     *	   of all procs whose argument list is just _args_
+     */
 
     if (objv[3]->typePtr == &tclProcBodyType) {
 	goto done;
     }
 
-    procArgs = Tcl_GetString(objv[2]);
+    procArgs = TclGetString(objv[2]);
 
     while (*procArgs == ' ') {
 	procArgs++;
     }
 
     if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
+	int numBytes;
+
 	procArgs +=4;
-	while(*procArgs != '\0') {
+	while (*procArgs != '\0') {
 	    if (*procArgs != ' ') {
 		goto done;
 	    }
@@ -268,12 +334,9 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
 	 * The argument list is just "args"; check the body
 	 */
 
-	procBody = Tcl_GetString(objv[3]);
-	while (*procBody != '\0') {
-	    if (!isspace(UCHAR(*procBody))) {
-		goto done;
-	    }
-	    procBody++;
+	procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
+	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
+	    goto done;
 	}
 
 	/*
@@ -283,7 +346,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
 	((Command *) cmd)->compileProc = TclCompileNoOp;
     }
 
- done:
+  done:
     return TCL_OK;
 }
 
@@ -292,34 +355,35 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
  *
  * TclCreateProc --
  *
- *	Creates the data associated with a Tcl procedure definition.
- *	This procedure knows how to handle two types of body objects:
- *	strings and procbody. Strings are the traditional (and common) value
- *	for bodies, procbody are values created by extensions that have
- *	loaded a previously compiled script.
+ *	Creates the data associated with a Tcl procedure definition. This
+ *	function knows how to handle two types of body objects: strings and
+ *	procbody. Strings are the traditional (and common) value for bodies,
+ *	procbody are values created by extensions that have loaded a
+ *	previously compiled script.
  *
  * Results:
- *	Returns TCL_OK on success, along with a pointer to a Tcl
- *	procedure definition in procPtrPtr.  This definition should
- *	be freed by calling TclCleanupProc() when it is no longer
- *	needed.  Returns TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK on success, along with a pointer to a Tcl procedure
+ *	definition in procPtrPtr where the cmdPtr field is not initialised.
+ *	This definition should be freed by calling TclProcCleanupProc() when
+ *	it is no longer needed. Returns TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	If anything goes wrong, this procedure returns an error
- *	message in the interpreter.
+ *	If anything goes wrong, this function returns an error message in the
+ *	interpreter.
  *
  *----------------------------------------------------------------------
  */
+
 int
-TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
-    Tcl_Interp *interp;         /* interpreter containing proc */
-    Namespace *nsPtr;           /* namespace containing this proc */
-    CONST char *procName;       /* unqualified name of this proc */
-    Tcl_Obj *argsPtr;           /* description of arguments */
-    Tcl_Obj *bodyPtr;           /* command body */
-    Proc **procPtrPtr;          /* returns:  pointer to proc data */
+TclCreateProc(
+    Tcl_Interp *interp,		/* Interpreter containing proc. */
+    Namespace *nsPtr,		/* Namespace containing this proc. */
+    CONST char *procName,	/* Unqualified name of this proc. */
+    Tcl_Obj *argsPtr,		/* Description of arguments. */
+    Tcl_Obj *bodyPtr,		/* Command body. */
+    Proc **procPtrPtr)		/* Returns: pointer to proc data. */
 {
-    Interp *iPtr = (Interp*)interp;
+    Interp *iPtr = (Interp *) interp;
     CONST char **argArray = NULL;
 
     register Proc *procPtr;
@@ -330,46 +394,44 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
     int precompiled = 0;
 
     if (bodyPtr->typePtr == &tclProcBodyType) {
-        /*
-         * Because the body is a TclProProcBody, the actual body is already
-         * compiled, and it is not shared with anyone else, so it's OK not to
-         * unshare it (as a matter of fact, it is bad to unshare it, because
-         * there may be no source code).
-         *
-         * We don't create and initialize a Proc structure for the procedure;
-         * rather, we use what is in the body object. Note that
-         * we initialize its cmdPtr field below after we've created the command
-         * for the procedure. We increment the ref count of the Proc struct
-         * since the command (soon to be created) will be holding a reference
-         * to it.
-         */
-
-        procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
-        procPtr->iPtr = iPtr;
-        procPtr->refCount++;
-        precompiled = 1;
+	/*
+	 * Because the body is a TclProProcBody, the actual body is already
+	 * compiled, and it is not shared with anyone else, so it's OK not to
+	 * unshare it (as a matter of fact, it is bad to unshare it, because
+	 * there may be no source code).
+	 *
+	 * We don't create and initialize a Proc structure for the procedure;
+	 * rather, we use what is in the body object. We increment the ref
+	 * count of the Proc struct since the command (soon to be created)
+	 * will be holding a reference to it.
+	 */
+
+	procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
+	procPtr->iPtr = iPtr;
+	procPtr->refCount++;
+	precompiled = 1;
     } else {
-        /*
-         * If the procedure's body object is shared because its string value is
-         * identical to, e.g., the body of another procedure, we must create a
-         * private copy for this procedure to use. Such sharing of procedure
-         * bodies is rare but can cause problems. A procedure body is compiled
-         * in a context that includes the number of compiler-allocated "slots"
-         * for local variables. Each formal parameter is given a local variable
-         * slot (the "procPtr->numCompiledLocals = numArgs" assignment
-         * below). This means that the same code can not be shared by two
-         * procedures that have a different number of arguments, even if their
-         * bodies are identical. Note that we don't use Tcl_DuplicateObj since
-         * we would not want any bytecode internal representation.
-         */
-
-        if (Tcl_IsShared(bodyPtr)) {
-#ifdef TCL_TIP280
+	/*
+	 * If the procedure's body object is shared because its string value
+	 * is identical to, e.g., the body of another procedure, we must
+	 * create a private copy for this procedure to use. Such sharing of
+	 * procedure bodies is rare but can cause problems. A procedure body
+	 * is compiled in a context that includes the number of "slots"
+	 * allocated by the compiler for local variables. There is a local
+	 * variable slot for each formal parameter (the
+	 * "procPtr->numCompiledLocals = numArgs" assignment below). This
+	 * means that the same code can not be shared by two procedures that
+	 * have a different number of arguments, even if their bodies are
+	 * identical. Note that we don't use Tcl_DuplicateObj since we would
+	 * not want any bytecode internal representation.
+	 */
+
+	if (Tcl_IsShared(bodyPtr)) {
 	    Tcl_Obj* sharedBodyPtr = bodyPtr;
-#endif
-            bytes = Tcl_GetStringFromObj(bodyPtr, &length);
-            bodyPtr = Tcl_NewStringObj(bytes, length);
-#ifdef TCL_TIP280
+
+	    bytes = TclGetStringFromObj(bodyPtr, &length);
+	    bodyPtr = Tcl_NewStringObj(bytes, length);
+
 	    /*
 	     * TIP #280.
 	     * Ensure that the continuation line data for the original body is
@@ -377,121 +439,111 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 	     */
 
 	    TclContinuationsCopy (bodyPtr, sharedBodyPtr);
-#endif
-        }
+	}
 
-        /*
-         * Create and initialize a Proc structure for the procedure. Note that
-         * we initialize its cmdPtr field below after we've created the command
-         * for the procedure. We increment the ref count of the procedure's
-         * body object since there will be a reference to it in the Proc
-         * structure.
-         */
+	/*
+	 * Create and initialize a Proc structure for the procedure. We
+	 * increment the ref count of the procedure's body object since there
+	 * will be a reference to it in the Proc structure.
+	 */
 
-        Tcl_IncrRefCount(bodyPtr);
+	Tcl_IncrRefCount(bodyPtr);
 
-        procPtr = (Proc *) ckalloc(sizeof(Proc));
-        procPtr->iPtr = iPtr;
-        procPtr->refCount = 1;
-        procPtr->bodyPtr = bodyPtr;
-        procPtr->numArgs  = 0;	/* actual argument count is set below. */
-        procPtr->numCompiledLocals = 0;
-        procPtr->firstLocalPtr = NULL;
-        procPtr->lastLocalPtr = NULL;
+	procPtr = (Proc *) ckalloc(sizeof(Proc));
+	procPtr->iPtr = iPtr;
+	procPtr->refCount = 1;
+	procPtr->bodyPtr = bodyPtr;
+	procPtr->numArgs = 0;	/* Actual argument count is set below. */
+	procPtr->numCompiledLocals = 0;
+	procPtr->firstLocalPtr = NULL;
+	procPtr->lastLocalPtr = NULL;
     }
 
     /*
-     * Break up the argument list into argument specifiers, then process
-     * each argument specifier.
-     * If the body is precompiled, processing is limited to checking that
-     * the the parsed argument is consistent with the one stored in the
-     * Proc.
-     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
+     * Break up the argument list into argument specifiers, then process each
+     * argument specifier. If the body is precompiled, processing is limited
+     * to checking that the parsed argument is consistent with the one stored
+     * in the Proc.
+     *
+     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
      */
 
-    args = Tcl_GetStringFromObj(argsPtr, &length);
+    args = TclGetStringFromObj(argsPtr, &length);
     result = Tcl_SplitList(interp, args, &numArgs, &argArray);
     if (result != TCL_OK) {
-        goto procError;
+	goto procError;
     }
 
     if (precompiled) {
-        if (numArgs > procPtr->numArgs) {
-            char buf[64 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
-            sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
-                    numArgs, procPtr->numArgs);
-            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "procedure \"", procName,
-                    buf, (char *) NULL);
-            goto procError;
-        }
-        localPtr = procPtr->firstLocalPtr;
+	if (numArgs > procPtr->numArgs) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "procedure \"%s\": arg list contains %d entries, "
+		    "precompiled header expects %d", procName, numArgs,
+		    procPtr->numArgs));
+	    goto procError;
+	}
+	localPtr = procPtr->firstLocalPtr;
     } else {
-        procPtr->numArgs = numArgs;
-        procPtr->numCompiledLocals = numArgs;
-    }
-    for (i = 0;  i < numArgs;  i++) {
-        int fieldCount, nameLength, valueLength;
-        CONST char **fieldValues;
-
-        /*
-         * Now divide the specifier up into name and default.
-         */
-
-        result = Tcl_SplitList(interp, argArray[i], &fieldCount,
-                &fieldValues);
-        if (result != TCL_OK) {
-            goto procError;
-        }
-        if (fieldCount > 2) {
-            ckfree((char *) fieldValues);
-            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "too many fields in argument specifier \"",
-                    argArray[i], "\"", (char *) NULL);
-            goto procError;
-        }
-        if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
-            ckfree((char *) fieldValues);
-            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                    "procedure \"", procName,
-                    "\" has argument with no name", (char *) NULL);
-            goto procError;
-        }
-
-        nameLength = strlen(fieldValues[0]);
-        if (fieldCount == 2) {
-            valueLength = strlen(fieldValues[1]);
-        } else {
-            valueLength = 0;
-        }
-
-        /*
-         * Check that the formal parameter name is a scalar.
-         */
-
-        p = fieldValues[0];
-        while (*p != '\0') {
-            if (*p == '(') {
-                CONST char *q = p;
-                do {
+	procPtr->numArgs = numArgs;
+	procPtr->numCompiledLocals = numArgs;
+    }
+
+    for (i = 0; i < numArgs; i++) {
+	int fieldCount, nameLength, valueLength;
+	CONST char **fieldValues;
+
+	/*
+	 * Now divide the specifier up into name and default.
+	 */
+
+	result = Tcl_SplitList(interp, argArray[i], &fieldCount,
+		&fieldValues);
+	if (result != TCL_OK) {
+	    goto procError;
+	}
+	if (fieldCount > 2) {
+	    ckfree((char *) fieldValues);
+	    Tcl_AppendResult(interp,
+		    "too many fields in argument specifier \"",
+		    argArray[i], "\"", NULL);
+	    goto procError;
+	}
+	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
+	    ckfree((char *) fieldValues);
+	    Tcl_AppendResult(interp, "argument with no name", NULL);
+	    goto procError;
+	}
+
+	nameLength = strlen(fieldValues[0]);
+	if (fieldCount == 2) {
+	    valueLength = strlen(fieldValues[1]);
+	} else {
+	    valueLength = 0;
+	}
+
+	/*
+	 * Check that the formal parameter name is a scalar.
+	 */
+
+	p = fieldValues[0];
+	while (*p != '\0') {
+	    if (*p == '(') {
+		CONST char *q = p;
+		do {
 		    q++;
 		} while (*q != '\0');
 		q--;
-		if (*q == ')') { /* we have an array element */
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		            "procedure \"", procName,
-		            "\" has formal parameter \"", fieldValues[0],
-			    "\" that is an array element",
-			    (char *) NULL);
+		if (*q == ')') {	/* We have an array element. */
+		    Tcl_AppendResult(interp, "formal parameter \"",
+			    fieldValues[0],
+			    "\" is an array element", NULL);
 		    ckfree((char *) fieldValues);
 		    goto procError;
 		}
 	    } else if ((*p == ':') && (*(p+1) == ':')) {
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		        "procedure \"", procName,
-		        "\" has formal parameter \"", fieldValues[0],
-			"\" that is not a simple name",
-			(char *) NULL);
+		Tcl_AppendResult(interp, "formal parameter \"",
+			fieldValues[0],
+			"\" is not a simple name", NULL);
 		ckfree((char *) fieldValues);
 		goto procError;
 	    }
@@ -500,116 +552,117 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 
 	if (precompiled) {
 	    /*
-	     * Compare the parsed argument with the stored one.
-	     * For the flags, we and out VAR_UNDEFINED to support bridging
-	     * precompiled <= 8.3 code in 8.4 where this is now used as an
-	     * optimization indicator.	Yes, this is a hack. -- hobbs
+	     * Compare the parsed argument with the stored one. Note that the
+	     * only flag value that makes sense at this point is VAR_ARGUMENT
+	     * (its value was kept the same as pre VarReform to simplify
+	     * tbcload's processing of older byetcodes).
+	     *
+	     * The only other flag vlaue that is important to retrieve from
+	     * precompiled procs is VAR_TEMPORARY (also unchanged). It is
+	     * needed later when retrieving the variable names.
 	     */
 
 	    if ((localPtr->nameLength != nameLength)
 		    || (strcmp(localPtr->name, fieldValues[0]))
 		    || (localPtr->frameIndex != i)
-		    || ((localPtr->flags & ~VAR_UNDEFINED)
-			    != (VAR_SCALAR | VAR_ARGUMENT))
-		    || ((localPtr->defValuePtr == NULL)
-			    && (fieldCount == 2))
-		    || ((localPtr->defValuePtr != NULL)
-			    && (fieldCount != 2))) {
-		char buf[80 + TCL_INTEGER_SPACE];
-		sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
-			i);
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"procedure \"", procName,
-			buf, (char *) NULL);
+		    || !(localPtr->flags & VAR_ARGUMENT)
+		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
+		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"procedure \"%s\": formal parameter %d is "
+			"inconsistent with precompiled body", procName, i));
 		ckfree((char *) fieldValues);
 		goto procError;
 	    }
 
-            /*
-             * compare the default value if any
-             */
-
-            if (localPtr->defValuePtr != NULL) {
-                int tmpLength;
-                char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
-                        &tmpLength);
-                if ((valueLength != tmpLength)
-                        || (strncmp(fieldValues[1], tmpPtr,
-                                (size_t) tmpLength))) {
-                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                            "procedure \"", procName,
-                            "\": formal parameter \"",
-                            fieldValues[0],
-                            "\" has default value inconsistent with precompiled body",
-                            (char *) NULL);
-                    ckfree((char *) fieldValues);
-                    goto procError;
-                }
-            }
-
-            localPtr = localPtr->nextPtr;
-        } else {
-            /*
-             * Allocate an entry in the runtime procedure frame's array of
-             * local variables for the argument.
-             */
-
-            localPtr = (CompiledLocal *) ckalloc((unsigned)
-                    (sizeof(CompiledLocal) - sizeof(localPtr->name)
-                            + nameLength+1));
-            if (procPtr->firstLocalPtr == NULL) {
-                procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
-            } else {
-                procPtr->lastLocalPtr->nextPtr = localPtr;
-                procPtr->lastLocalPtr = localPtr;
-            }
-            localPtr->nextPtr = NULL;
-            localPtr->nameLength = nameLength;
-            localPtr->frameIndex = i;
-            localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
-            localPtr->resolveInfo = NULL;
-
-            if (fieldCount == 2) {
-                localPtr->defValuePtr =
-		    Tcl_NewStringObj(fieldValues[1], valueLength);
-                Tcl_IncrRefCount(localPtr->defValuePtr);
-            } else {
-                localPtr->defValuePtr = NULL;
-            }
-            memcpy(localPtr->name, fieldValues[0], nameLength + 1);
+	    /*
+	     * Compare the default value if any.
+	     */
+
+	    if (localPtr->defValuePtr != NULL) {
+		int tmpLength;
+		char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
+			&tmpLength);
+
+		if ((valueLength != tmpLength) ||
+			strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "procedure \"%s\": formal parameter \"%s\" has "
+			    "default value inconsistent with precompiled body",
+			    procName, fieldValues[0]));
+		    ckfree((char *) fieldValues);
+		    goto procError;
+		}
+	    }
+	    if ((i == numArgs - 1)
+		    && (localPtr->nameLength == 4)
+		    && (localPtr->name[0] == 'a')
+		    && (strcmp(localPtr->name, "args") == 0)) {
+		localPtr->flags |= VAR_IS_ARGS;
+	    }
+
+	    localPtr = localPtr->nextPtr;
+	} else {
+	    /*
+	     * Allocate an entry in the runtime procedure frame's array of
+	     * local variables for the argument.
+	     */
+
+	    localPtr = (CompiledLocal *) ckalloc((unsigned)
+		    (sizeof(CompiledLocal) - sizeof(localPtr->name)
+			    + nameLength + 1));
+	    if (procPtr->firstLocalPtr == NULL) {
+		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
+	    } else {
+		procPtr->lastLocalPtr->nextPtr = localPtr;
+		procPtr->lastLocalPtr = localPtr;
+	    }
+	    localPtr->nextPtr = NULL;
+	    localPtr->nameLength = nameLength;
+	    localPtr->frameIndex = i;
+	    localPtr->flags = VAR_ARGUMENT;
+	    localPtr->resolveInfo = NULL;
+
+	    if (fieldCount == 2) {
+		localPtr->defValuePtr =
+			Tcl_NewStringObj(fieldValues[1], valueLength);
+		Tcl_IncrRefCount(localPtr->defValuePtr);
+	    } else {
+		localPtr->defValuePtr = NULL;
+	    }
+	    memcpy(localPtr->name, fieldValues[0], nameLength + 1);
+	    if ((i == numArgs - 1)
+		    && (localPtr->nameLength == 4)
+		    && (localPtr->name[0] == 'a')
+		    && (strcmp(localPtr->name, "args") == 0)) {
+		localPtr->flags |= VAR_IS_ARGS;
+	    }
 	}
 
-        ckfree((char *) fieldValues);
+	ckfree((char *) fieldValues);
     }
 
-    /*
-     * Now initialize the new procedure's cmdPtr field. This will be used
-     * later when the procedure is called to determine what namespace the
-     * procedure will run in. This will be different than the current
-     * namespace if the proc was renamed into a different namespace.
-     */
-
     *procPtrPtr = procPtr;
     ckfree((char *) argArray);
     return TCL_OK;
 
-procError:
+  procError:
     if (precompiled) {
-        procPtr->refCount--;
+	procPtr->refCount--;
     } else {
-        Tcl_DecrRefCount(bodyPtr);
-        while (procPtr->firstLocalPtr != NULL) {
-            localPtr = procPtr->firstLocalPtr;
-            procPtr->firstLocalPtr = localPtr->nextPtr;
+	Tcl_DecrRefCount(bodyPtr);
+	while (procPtr->firstLocalPtr != NULL) {
+	    localPtr = procPtr->firstLocalPtr;
+	    procPtr->firstLocalPtr = localPtr->nextPtr;
 
-            defPtr = localPtr->defValuePtr;
-            if (defPtr != NULL) {
-                Tcl_DecrRefCount(defPtr);
-            }
+	    defPtr = localPtr->defValuePtr;
+	    if (defPtr != NULL) {
+		Tcl_DecrRefCount(defPtr);
+	    }
 
-            ckfree((char *) localPtr);
-        }
-        ckfree((char *) procPtr);
+	    ckfree((char *) localPtr);
+	}
+	ckfree((char *) procPtr);
     }
     if (argArray != NULL) {
 	ckfree((char *) argArray);
@@ -622,19 +675,19 @@ procError:
  *
  * TclGetFrame --
  *
- *	Given a description of a procedure frame, such as the first
- *	argument to an "uplevel" or "upvar" command, locate the
- *	call frame for the appropriate level of procedure.
+ *	Given a description of a procedure frame, such as the first argument
+ *	to an "uplevel" or "upvar" command, locate the call frame for the
+ *	appropriate level of procedure.
  *
  * Results:
- *	The return value is -1 if an error occurred in finding the frame
- *	(in this case an error message is left in the interp's result).
- *	1 is returned if string was either a number or a number preceded
- *	by "#" and it specified a valid frame.  0 is returned if string
- *	isn't one of the two things above (in this case, the lookup
- *	acts as if string were "1").  The variable pointed to by
- *	framePtrPtr is filled in with the address of the desired frame
- *	(unless an error occurs, in which case it isn't modified).
+ *	The return value is -1 if an error occurred in finding the frame (in
+ *	this case an error message is left in the interp's result). 1 is
+ *	returned if string was either a number or a number preceded by "#" and
+ *	it specified a valid frame. 0 is returned if string isn't one of the
+ *	two things above (in this case, the lookup acts as if string were
+ *	"1"). The variable pointed to by framePtrPtr is filled in with the
+ *	address of the desired frame (unless an error occurs, in which case it
+ *	isn't modified).
  *
  * Side effects:
  *	None.
@@ -643,11 +696,11 @@ procError:
  */
 
 int
-TclGetFrame(interp, string, framePtrPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to find frame. */
-    CONST char *string;		/* String describing frame. */
-    CallFrame **framePtrPtr;	/* Store pointer to frame here (or NULL
-				 * if global frame indicated). */
+TclGetFrame(
+    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
+    CONST char *name,		/* String describing frame. */
+    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
+				 * global frame indicated). */
 {
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
@@ -658,47 +711,166 @@ TclGetFrame(interp, string, framePtrPtr)
      */
 
     result = 1;
-    curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
-    if (*string == '#') {
-	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
-	    return -1;
+    curLevel = iPtr->varFramePtr->level;
+    if (*name== '#') {
+	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
+	    goto levelError;
+	}
+    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
+	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
+	    goto levelError;
+	}
+	level = curLevel - level;
+    } else {
+	level = curLevel - 1;
+	result = 0;
+    }
+
+    /*
+     * Figure out which frame to use, and return it to the caller.
+     */
+
+    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+	    framePtr = framePtr->callerVarPtr) {
+	if (framePtr->level == level) {
+	    break;
+	}
+    }
+    if (framePtr == NULL) {
+	goto levelError;
+    }
+
+    *framePtrPtr = framePtr;
+    return result;
+
+  levelError:
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjGetFrame --
+ *
+ *	Given a description of a procedure frame, such as the first argument
+ *	to an "uplevel" or "upvar" command, locate the call frame for the
+ *	appropriate level of procedure.
+ *
+ * Results:
+ *	The return value is -1 if an error occurred in finding the frame (in
+ *	this case an error message is left in the interp's result). 1 is
+ *	returned if objPtr was either a number or a number preceded by "#" and
+ *	it specified a valid frame. 0 is returned if objPtr isn't one of the
+ *	two things above (in this case, the lookup acts as if objPtr were
+ *	"1"). The variable pointed to by framePtrPtr is filled in with the
+ *	address of the desired frame (unless an error occurs, in which case it
+ *	isn't modified).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjGetFrame(
+    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
+    Tcl_Obj *objPtr,		/* Object describing frame. */
+    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
+				 * global frame indicated). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int curLevel, level, result;
+    CallFrame *framePtr;
+    CONST char *name = TclGetString(objPtr);
+
+    /*
+     * Parse object to figure out which level number to go to.
+     */
+
+    result = 1;
+    curLevel = iPtr->varFramePtr->level;
+    if (objPtr->typePtr == &levelReferenceType) {
+	if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr1)) {
+	    level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
+	} else {
+	    level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
 	}
 	if (level < 0) {
-	    levelError:
-	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
-		    (char *) NULL);
-	    return -1;
+	    goto levelError;
+	}
+	/* TODO: Consider skipping the typePtr checks */
+    } else if (objPtr->typePtr == &tclIntType
+#ifndef NO_WIDE_TYPE
+	    || objPtr->typePtr == &tclWideIntType
+#endif
+	    ) {
+	if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
+	    goto levelError;
+	}
+	level = curLevel - level;
+    } else if (*name == '#') {
+	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
+	    goto levelError;
 	}
-    } else if (isdigit(UCHAR(*string))) { /* INTL: digit */
-	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
+
+	/*
+	 * Cache for future reference.
+	 *
+	 * TODO: Use the new ptrAndLongRep intrep
+	 */
+
+	TclFreeIntRep(objPtr);
+	objPtr->typePtr = &levelReferenceType;
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
+	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
+    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
+	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
 	    return -1;
 	}
+
+	/*
+	 * Cache for future reference.
+	 *
+	 * TODO: Use the new ptrAndLongRep intrep
+	 */
+
+	TclFreeIntRep(objPtr);
+	objPtr->typePtr = &levelReferenceType;
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
+	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
 	level = curLevel - level;
     } else {
+	/*
+	 * Don't cache as the object *isn't* a level reference.
+	 */
+
 	level = curLevel - 1;
 	result = 0;
     }
 
     /*
-     * Figure out which frame to use, and modify the interpreter so
-     * its variables come from that frame.
+     * Figure out which frame to use, and return it to the caller.
      */
 
-    if (level == 0) {
-	framePtr = NULL;
-    } else {
-	for (framePtr = iPtr->varFramePtr; framePtr != NULL;
-		framePtr = framePtr->callerVarPtr) {
-	    if (framePtr->level == level) {
-		break;
-	    }
-	}
-	if (framePtr == NULL) {
-	    goto levelError;
+    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+	    framePtr = framePtr->callerVarPtr) {
+	if (framePtr->level == level) {
+	    break;
 	}
     }
+    if (framePtr == NULL) {
+	goto levelError;
+    }
     *framePtrPtr = framePtr;
     return result;
+
+  levelError:
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+    return -1;
 }
 
 /*
@@ -706,8 +878,8 @@ TclGetFrame(interp, string, framePtrPtr)
  *
  * Tcl_UplevelObjCmd --
  *
- *	This object procedure is invoked to process the "uplevel" Tcl
- *	command. See the user documentation for details on what it does.
+ *	This object function is invoked to process the "uplevel" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -720,19 +892,18 @@ TclGetFrame(interp, string, framePtrPtr)
 
 	/* ARGSUSED */
 int
-Tcl_UplevelObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_UplevelObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    char *optLevel;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
 
     if (objc < 2) {
-	uplevelSyntax:
+    uplevelSyntax:
 	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
 	return TCL_ERROR;
     }
@@ -741,8 +912,7 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
      * Find the level to use for executing the command.
      */
 
-    optLevel = TclGetString(objv[1]);
-    result = TclGetFrame(interp, optLevel, &framePtr);
+    result = TclObjGetFrame(interp, objv[1], &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
@@ -764,30 +934,30 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
      */
 
     if (objc == 1) {
-#ifdef TCL_TIP280
-	/* TIP #280. Make argument location available to eval'd script */
+	/*
+	 * TIP #280. Make argument location available to eval'd script
+	 */
+
 	CmdFrame* invoker = NULL;
 	int word          = 0;
+
 	TclArgumentGet (interp, objv[0], &invoker, &word);
-	result = TclEvalObjEx(interp, objv[0], TCL_EVAL_DIRECT, invoker, word);
-#else
-	result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
-#endif
+	result = TclEvalObjEx(interp, objv[0], 0, invoker, word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
-	 * between, then evaluate the result.  Tcl_EvalObjEx will delete
-	 * the object when it decrements its refcount after eval'ing it.
+	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
+	 * object when it decrements its refcount after eval'ing it.
 	 */
+
 	Tcl_Obj *objPtr;
 
 	objPtr = Tcl_ConcatObj(objc, objv);
 	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
     }
     if (result == TCL_ERROR) {
-	char msg[32 + TCL_INTEGER_SPACE];
-	sprintf(msg, "\n    (\"uplevel\" body line %d)", interp->errorLine);
-	Tcl_AddObjErrorInfo(interp, msg, -1);
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"uplevel\" body line %d)", interp->errorLine));
     }
 
     /*
@@ -803,18 +973,17 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
  *
  * TclFindProc --
  *
- *	Given the name of a procedure, return a pointer to the
- *	record describing the procedure. The procedure will be
- *	looked up using the usual rules: first in the current
- *	namespace and then in the global namespace.
+ *	Given the name of a procedure, return a pointer to the record
+ *	describing the procedure. The procedure will be looked up using the
+ *	usual rules: first in the current namespace and then in the global
+ *	namespace.
  *
  * Results:
- *	NULL is returned if the name doesn't correspond to any
- *	procedure. Otherwise, the return value is a pointer to
- *	the procedure's record. If the name is found but refers
- *	to an imported command that points to a "real" procedure
- *	defined in another namespace, a pointer to that "real"
- *	procedure's structure is returned.
+ *	NULL is returned if the name doesn't correspond to any procedure.
+ *	Otherwise, the return value is a pointer to the procedure's record. If
+ *	the name is found but refers to an imported command that points to a
+ *	"real" procedure defined in another namespace, a pointer to that
+ *	"real" procedure's structure is returned.
  *
  * Side effects:
  *	None.
@@ -823,18 +992,17 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
  */
 
 Proc *
-TclFindProc(iPtr, procName)
-    Interp *iPtr;		/* Interpreter in which to look. */
-    CONST char *procName;		/* Name of desired procedure. */
+TclFindProc(
+    Interp *iPtr,		/* Interpreter in which to look. */
+    CONST char *procName)	/* Name of desired procedure. */
 {
     Tcl_Command cmd;
     Tcl_Command origCmd;
     Command *cmdPtr;
 
-    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
-            (Tcl_Namespace *) NULL, /*flags*/ 0);
+    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0);
     if (cmd == (Tcl_Command) NULL) {
-        return NULL;
+	return NULL;
     }
     cmdPtr = (Command *) cmd;
 
@@ -842,10 +1010,10 @@ TclFindProc(iPtr, procName)
     if (origCmd != NULL) {
 	cmdPtr = (Command *) origCmd;
     }
-    if (cmdPtr->proc != TclProcInterpProc) {
+    if (cmdPtr->objProc != TclObjInterpProc) {
 	return NULL;
     }
-    return (Proc *) cmdPtr->clientData;
+    return (Proc *) cmdPtr->objClientData;
 }
 
 /*
@@ -856,9 +1024,9 @@ TclFindProc(iPtr, procName)
  *	Tells whether a command is a Tcl procedure or not.
  *
  * Results:
- *	If the given command is actually a Tcl procedure, the
- *	return value is the address of the record describing
- *	the procedure.  Otherwise the return value is 0.
+ *	If the given command is actually a Tcl procedure, the return value is
+ *	the address of the record describing the procedure. Otherwise the
+ *	return value is 0.
  *
  * Side effects:
  *	None.
@@ -867,8 +1035,8 @@ TclFindProc(iPtr, procName)
  */
 
 Proc *
-TclIsProc(cmdPtr)
-    Command *cmdPtr;		/* Command to test. */
+TclIsProc(
+    Command *cmdPtr)		/* Command to test. */
 {
     Tcl_Command origCmd;
 
@@ -876,8 +1044,8 @@ TclIsProc(cmdPtr)
     if (origCmd != NULL) {
 	cmdPtr = (Command *) origCmd;
     }
-    if (cmdPtr->proc == TclProcInterpProc) {
-	return (Proc *) cmdPtr->clientData;
+    if (cmdPtr->objProc == TclObjInterpProc) {
+	return (Proc *) cmdPtr->objClientData;
     }
     return (Proc *) 0;
 }
@@ -885,310 +1053,659 @@ TclIsProc(cmdPtr)
 /*
  *----------------------------------------------------------------------
  *
- * TclProcInterpProc --
+ * InitArgsAndLocals --
  *
- *	When a Tcl procedure gets invoked with an argc/argv array of
- *	strings, this routine gets invoked to interpret the procedure.
+ *	This routine is invoked in order to initialize the arguments and other
+ *	compiled locals table for a new call frame.
  *
  * Results:
- *	A standard Tcl result value, usually TCL_OK.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Depends on the commands in the procedure.
+ *	Allocates memory on the stack for the compiled local variables, the
+ *	caller is responsible for freeing them. Initialises all variables. May
+ *	invoke various name resolvers in order to determine which variables
+ *	are being referenced at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclProcInterpProc(clientData, interp, argc, argv)
-    ClientData clientData;	/* Record describing procedure to be
-				 * interpreted. */
-    Tcl_Interp *interp;		/* Interpreter in which procedure was
-				 * invoked. */
-    int argc;			/* Count of number of arguments to this
-				 * procedure. */
-    register CONST char **argv;	/* Argument values. */
+static int
+ProcWrongNumArgs(
+    Tcl_Interp *interp, int skip)
 {
-    register Tcl_Obj *objPtr;
-    register int i;
-    int result;
+    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+    register Proc *procPtr = framePtr->procPtr;
+    register Var *defPtr;
+    int localCt = procPtr->numCompiledLocals, numArgs, i;
+    Tcl_Obj **desiredObjs;
+    const char *final = NULL;
 
     /*
-     * This procedure generates an objv array for object arguments that hold
-     * the argv strings. It starts out with stack-allocated space but uses
-     * dynamically-allocated storage if needed.
+     * Build up desired argument list for Tcl_WrongNumArgs
      */
 
-#define NUM_ARGS 20
-    Tcl_Obj *(objStorage[NUM_ARGS]);
-    register Tcl_Obj **objv = objStorage;
+    numArgs = framePtr->procPtr->numArgs;
+    desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,
+	    (int) sizeof(Tcl_Obj *) * (numArgs+1));
 
-    /*
-     * Create the object argument array "objv". Make sure objv is large
-     * enough to hold the objc arguments plus 1 extra for the zero
-     * end-of-objv word.
-     */
+    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
+	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
+    } else {
+	((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
 
-    if ((argc + 1) > NUM_ARGS) {
-	objv = (Tcl_Obj **)
-	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
+#ifdef AVOID_HACKS_FOR_ITCL
+	desiredObjs[0] = framePtr->objv[skip-1];
+#else
+	desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
+#endif /* AVOID_HACKS_FOR_ITCL */
     }
-
-    for (i = 0;  i < argc;  i++) {
-	objv[i] = Tcl_NewStringObj(argv[i], -1);
-	Tcl_IncrRefCount(objv[i]);
+    Tcl_IncrRefCount(desiredObjs[0]);
+
+    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+    for (i=1 ; i<=numArgs ; i++, defPtr++) {
+	Tcl_Obj *argObj;
+	Tcl_Obj *namePtr = localName(framePtr, i-1);
+
+	if (defPtr->value.objPtr != NULL) {
+	    TclNewObj(argObj);
+	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+	} else if (defPtr->flags & VAR_IS_ARGS) {
+	    numArgs--;
+	    final = "...";
+	    break;
+	} else {
+	    argObj = namePtr;
+	    Tcl_IncrRefCount(namePtr);
+	}
+	desiredObjs[i] = argObj;
     }
-    objv[argc] = 0;
-
-    /*
-     * Use TclObjInterpProc to actually interpret the procedure.
-     */
-
-    result = TclObjInterpProc(clientData, interp, argc, objv);
 
-    /*
-     * Move the interpreter's object result to the string result,
-     * then reset the object result.
-     */
+    Tcl_ResetResult(interp);
+    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);
 
-    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	    TCL_VOLATILE);
+    for (i=0 ; i<=numArgs ; i++) {
+	Tcl_DecrRefCount(desiredObjs[i]);
+    }
+    TclStackFree(interp, desiredObjs);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled locals
+ *	table for a new call frame.
+ *
+ *	DEPRECATED: functionality has been inlined elsewhere; this function
+ *	remains to insure binary compatibility with Itcl.
+ *
 
-    /*
-     * Decrement the ref counts on the objv elements since we are done
-     * with them.
-     */
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclInitCompiledLocals(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    CallFrame *framePtr,	/* Call frame to initialize. */
+    Namespace *nsPtr)		/* Pointer to current namespace. */
+{
+    Var *varPtr = framePtr->compiledLocals;
+    Tcl_Obj *bodyPtr;
+    ByteCode *codePtr;
 
-    for (i = 0;  i < argc;  i++) {
-	objPtr = objv[i];
-	TclDecrRefCount(objPtr);
+    bodyPtr = framePtr->procPtr->bodyPtr;
+    if (bodyPtr->typePtr != &tclByteCodeType) {
+	Tcl_Panic("body object for proc attached to frame is not a byte code type");
     }
+    codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
 
-    /*
-     * Free the objv array if malloc'ed storage was used.
-     */
-
-    if (objv != objStorage) {
-	ckfree((char *) objv);
+    if (framePtr->numCompiledLocals) {
+	if (!codePtr->localCachePtr) {
+	    InitLocalCache(framePtr->procPtr) ;
+	}
+	framePtr->localCachePtr = codePtr->localCachePtr;
+	framePtr->localCachePtr->refCount++;
     }
-    return result;
-#undef NUM_ARGS
+
+    InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjInterpProc --
+ * InitResolvedLocals --
  *
- *	When a Tcl procedure gets invoked during bytecode evaluation, this
- *	object-based routine gets invoked to interpret the procedure.
+ *	This routine is invoked in order to initialize the compiled locals
+ *	table for a new call frame.
  *
  * Results:
- *	A standard Tcl object result value.
+ *	None.
  *
  * Side effects:
- *	Depends on the commands in the procedure.
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclObjInterpProc(clientData, interp, objc, objv)
-    ClientData clientData; 	 /* Record describing procedure to be
-				  * interpreted. */
-    register Tcl_Interp *interp; /* Interpreter in which procedure was
-				  * invoked. */
-    int objc;			 /* Count of number of arguments to this
-				  * procedure. */
-    Tcl_Obj *CONST objv[];	 /* Argument value objects. */
+static void
+InitResolvedLocals(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    ByteCode *codePtr,
+    Var *varPtr,
+    Namespace *nsPtr)		/* Pointer to current namespace. */
 {
     Interp *iPtr = (Interp *) interp;
-    Proc *procPtr = (Proc *) clientData;
-    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
-    CallFrame frame;
-    register CallFrame *framePtr = &frame;
-    register Var *varPtr;
-    register CompiledLocal *localPtr;
-    char *procName;
-    int nameLen, localCt, numArgs, argCt, i, result;
+    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
+    CompiledLocal *firstLocalPtr, *localPtr;
+    int varNum;
+    Tcl_ResolvedVarInfo *resVarInfo;
 
     /*
-     * This procedure generates an array "compiledLocals" that holds the
-     * storage for local variables. It starts out with stack-allocated space
-     * but uses dynamically-allocated storage if needed.
+     * Find the localPtr corresponding to varPtr
      */
 
-#define NUM_LOCALS 20
-    Var localStorage[NUM_LOCALS];
-    Var *compiledLocals = localStorage;
+    varNum = varPtr - iPtr->framePtr->compiledLocals;
+    localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
+    while (varNum--) {
+	localPtr = localPtr->nextPtr;
+    }
 
-    /*
-     * Get the procedure's name.
-     */
+    if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
+	/*
+	 * Initialize the array of local variables stored in the call frame.
+	 * Some variables may have special resolution rules. In that case, we
+	 * call their "resolver" procs to get our hands on the variable, and
+	 * we make the compiled local a link to the real variable.
+	 */
 
-    procName = Tcl_GetStringFromObj(objv[0], &nameLen);
+    doInitResolvedLocals:
+	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
+	    varPtr->flags = 0;
+	    varPtr->value.objPtr = NULL;
+
+	    /*
+	     * Now invoke the resolvers to determine the exact variables
+	     * that should be used.
+	     */
+
+	    resVarInfo = localPtr->resolveInfo;
+	    if (resVarInfo && resVarInfo->fetchProc) {
+		Var *resolvedVarPtr = (Var *)
+		    (*resVarInfo->fetchProc)(interp, resVarInfo);
+		if (resolvedVarPtr) {
+		    if (TclIsVarInHash(resolvedVarPtr)) {
+			VarHashRefCount(resolvedVarPtr)++;
+		    }
+		    varPtr->flags = VAR_LINK;
+		    varPtr->value.linkPtr = resolvedVarPtr;
+		}
+	    }
+	}
+	return;
+    }
 
     /*
-     * If necessary, compile the procedure's body. The compiler will
-     * allocate frame slots for the procedure's non-argument local
-     * variables.  Note that compiling the body might increase
-     * procPtr->numCompiledLocals if new local variables are found
-     * while compiling.
+     * This is the first run after a recompile, or else the resolver epoch
+     * has changed: update the resolver cache.
      */
 
-    result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
-	    "body of proc", procName, &procPtr);
+    firstLocalPtr = localPtr;
+    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
+	if (localPtr->resolveInfo) {
+	    if (localPtr->resolveInfo->deleteProc) {
+		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+	    } else {
+		ckfree((char *) localPtr->resolveInfo);
+	    }
+	    localPtr->resolveInfo = NULL;
+	}
+	localPtr->flags &= ~VAR_RESOLVED;
+
+	if (haveResolvers &&
+		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
+	    ResolverScheme *resPtr = iPtr->resolverPtr;
+	    Tcl_ResolvedVarInfo *vinfo;
+	    int result;
+
+	    if (nsPtr->compiledVarResProc) {
+		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
+			localPtr->name, localPtr->nameLength,
+			(Tcl_Namespace *) nsPtr, &vinfo);
+	    } else {
+		result = TCL_CONTINUE;
+	    }
 
-    if (result != TCL_OK) {
-        return result;
+	    while ((result == TCL_CONTINUE) && resPtr) {
+		if (resPtr->compiledVarResProc) {
+		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+			    localPtr->name, localPtr->nameLength,
+			    (Tcl_Namespace *) nsPtr, &vinfo);
+		}
+		resPtr = resPtr->nextPtr;
+	    }
+	    if (result == TCL_OK) {
+		localPtr->resolveInfo = vinfo;
+		localPtr->flags |= VAR_RESOLVED;
+	    }
+	}
     }
+    localPtr = firstLocalPtr;
+    codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+    goto doInitResolvedLocals;
+}
 
-    /*
-     * Create the "compiledLocals" array. Make sure it is large enough to
-     * hold all the procedure's compiled local variables, including its
-     * formal parameters.
-     */
+void
+TclFreeLocalCache(
+    Tcl_Interp *interp,
+    LocalCache *localCachePtr)
+{
+    int i;
+    Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
 
-    localCt = procPtr->numCompiledLocals;
-    if (localCt > NUM_LOCALS) {
-	compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
+    for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
+	Tcl_Obj *objPtr = *namePtrPtr;
+	/*
+	 * Note that this can be called with interp==NULL, on interp
+	 * deletion. In that case, the literal table and objects go away
+	 * on their own.
+	 */
+	if (objPtr) {
+	    if (interp) {
+		TclReleaseLiteral(interp, objPtr);
+	    } else {
+		Tcl_DecrRefCount(objPtr);
+	    }
+	}
     }
+    ckfree((char *) localCachePtr);
+}
+
+static void
+InitLocalCache(Proc *procPtr)
+{
+    Interp *iPtr = procPtr->iPtr;
+    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    int localCt = procPtr->numCompiledLocals;
+    int numArgs = procPtr->numArgs, i = 0;
+
+    Tcl_Obj **namePtr;
+    Var *varPtr;
+    LocalCache *localCachePtr;
+    CompiledLocal *localPtr;
+    int new;
 
     /*
-     * Set up and push a new call frame for the new procedure invocation.
-     * This call frame will execute in the proc's namespace, which might
-     * be different than the current namespace. The proc's namespace is
-     * that of its command, which can change if the command is renamed
-     * from one namespace to another.
+     * Cache the names and initial values of local variables; store the
+     * cache in both the framePtr for this execution and in the codePtr
+     * for future calls.
      */
 
-    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
-            (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
+    localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache)
+	    + (localCt-1)*sizeof(Tcl_Obj *)
+	    + numArgs*sizeof(Var));
 
-    if (result != TCL_OK) {
-        return result;
+    namePtr = &localCachePtr->varName0;
+    varPtr = (Var *) (namePtr + localCt);
+    localPtr = procPtr->firstLocalPtr;
+    while (localPtr) {
+	if (TclIsVarTemporary(localPtr)) {
+	    *namePtr = NULL;
+	} else {
+	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
+		    localPtr->nameLength, /* hash */ (unsigned int) -1,
+		    &new, /* nsPtr */ NULL, 0, NULL);
+	    Tcl_IncrRefCount(*namePtr);
+	}
+
+	if (i < numArgs) {
+	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
+	    varPtr->value.objPtr = localPtr->defValuePtr;
+	    varPtr++;
+	    i++;
+	}
+	namePtr++;
+	localPtr=localPtr->nextPtr;
     }
+    codePtr->localCachePtr = localCachePtr;
+    localCachePtr->refCount = 1;
+    localCachePtr->numVars  = localCt;
+}
 
-    framePtr->objc = objc;
-    framePtr->objv = objv;  /* ref counts for args are incremented below */
+static int
+InitArgsAndLocals(
+    register Tcl_Interp *interp,/* Interpreter in which procedure was
+				 * invoked. */
+    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
+    int skip)			/* Number of initial arguments to be skipped,
+				 * i.e., words in the "command name". */
+{
+    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+    register Proc *procPtr = framePtr->procPtr;
+    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    register Var *varPtr, *defPtr;
+    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
+    Tcl_Obj *const *argObjs;
 
     /*
-     * Initialize and resolve compiled variable references.
+     * Make sure that the local cache of variable names and initial values has
+     * been initialised properly .
      */
 
-    framePtr->procPtr = procPtr;
-    framePtr->numCompiledLocals = localCt;
-    framePtr->compiledLocals = compiledLocals;
+    if (localCt) {
+	if (!codePtr->localCachePtr) {
+	    InitLocalCache(procPtr) ;
+	}
+	framePtr->localCachePtr = codePtr->localCachePtr;
+	framePtr->localCachePtr->refCount++;
+	defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+    } else {
+	defPtr = NULL;
+    }
+
+    /*
+     * Create the "compiledLocals" array. Make sure it is large enough to hold
+     * all the procedure's compiled local variables, including its formal
+     * parameters.
+     */
 
-    TclInitCompiledLocals(interp, framePtr, nsPtr);
+    varPtr = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var)));
+    framePtr->compiledLocals = varPtr;
+    framePtr->numCompiledLocals = localCt;
 
     /*
-     * Match and assign the call's actual parameters to the procedure's
-     * formal arguments. The formal arguments are described by the first
-     * numArgs entries in both the Proc structure's local variable list and
-     * the call frame's local variable array.
+     * Match and assign the call's actual parameters to the procedure's formal
+     * arguments. The formal arguments are described by the first numArgs
+     * entries in both the Proc structure's local variable list and the call
+     * frame's local variable array.
      */
 
     numArgs = procPtr->numArgs;
-    varPtr = framePtr->compiledLocals;
-    localPtr = procPtr->firstLocalPtr;
-    argCt = objc;
-    for (i = 1, argCt -= 1;  i <= numArgs;  i++, argCt--) {
-	if (!TclIsVarArgument(localPtr)) {
-	    panic("TclObjInterpProc: local variable %s is not argument but should be",
-		  localPtr->name);
-	    return TCL_ERROR;
-	}
-	if (TclIsVarTemporary(localPtr)) {
-	    panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
-	    return TCL_ERROR;
+    argCt = framePtr->objc - skip;	/* Set it to the number of args to the
+					 * procedure. */
+    argObjs = framePtr->objv + skip;
+    if (numArgs == 0) {
+	if (argCt) {
+	    goto incorrectArgs;
+	} else {
+	    goto correctArgs;
 	}
+    }
+    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
+    for (i = 0; i < imax; i++, varPtr++, defPtr++) {
+	/*
+	 * "Normal" arguments; last formal is special, depends on it being
+	 * 'args'.
+	 */
+
+	Tcl_Obj *objPtr = argObjs[i];
 
+	varPtr->flags = 0;
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    }
+    for (; i < numArgs-1; i++, varPtr++, defPtr++) {
 	/*
-	 * Handle the special case of the last formal being "args".  When
-	 * it occurs, assign it a list consisting of all the remaining
-	 * actual arguments.
+	 * This loop is entered if argCt < (numArgs-1). Set default values;
+	 * last formal is special.
 	 */
 
-	if ((i == numArgs) && ((localPtr->name[0] == 'a')
-	        && (strcmp(localPtr->name, "args") == 0))) {
-	    Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
-	    varPtr->value.objPtr = listPtr;
-	    Tcl_IncrRefCount(listPtr); /* local var is a reference */
-	    TclClearVarUndefined(varPtr);
-	    argCt = 0;
-	    break;		/* done processing args */
-	} else if (argCt > 0) {
-	    Tcl_Obj *objPtr = objv[i];
-	    varPtr->value.objPtr = objPtr;
-	    TclClearVarUndefined(varPtr);
-	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
-					* another reference to object. */
-	} else if (localPtr->defValuePtr != NULL) {
-	    Tcl_Obj *objPtr = localPtr->defValuePtr;
+	Tcl_Obj *objPtr = defPtr->value.objPtr;
+
+	if (objPtr) {
+	    varPtr->flags = 0;
 	    varPtr->value.objPtr = objPtr;
-	    TclClearVarUndefined(varPtr);
-	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
-					* another reference to object. */
+	    Tcl_IncrRefCount(objPtr);	/* Local var reference. */
 	} else {
 	    goto incorrectArgs;
 	}
-	varPtr++;
-	localPtr = localPtr->nextPtr;
     }
-    if (argCt > 0) {
-	Tcl_Obj *objResult;
-	int len, flags;
 
-	incorrectArgs:
-	/*
-	 * Build up equivalent to Tcl_WrongNumArgs message for proc
-	 */
+    /*
+     * When we get here, the last formal argument remains to be defined:
+     * defPtr and varPtr point to the last argument to be initialized.
+     */
 
-	Tcl_ResetResult(interp);
-	objResult = Tcl_GetObjResult(interp);
-	Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);
 
-	/*
-	 * Quote the proc name if it contains spaces (Bug 942757).
-	 */
+    varPtr->flags = 0;
+    if (defPtr->flags & VAR_IS_ARGS) {
+	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
+
+	varPtr->value.objPtr = listPtr;
+	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
+    } else if (argCt == numArgs) {
+	Tcl_Obj *objPtr = argObjs[i];
 
-	len = Tcl_ScanCountedElement(procName, nameLen, &flags);
-	if (len != nameLen) {
-	    char *procName1 = ckalloc((unsigned) len + 1);
-	    len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags);
-	    Tcl_AppendToObj(objResult, procName1, len);
-	    ckfree(procName1);
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    } else if ((argCt < numArgs) && (defPtr->value.objPtr != NULL)) {
+	Tcl_Obj *objPtr = defPtr->value.objPtr;
+
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    } else {
+	goto incorrectArgs;
+    }
+    varPtr++;
+
+    /*
+     * Initialise and resolve the remaining compiledLocals. In the absence of
+     * resolvers, they are undefined local vars: (flags=0, value=NULL).
+     */
+
+  correctArgs:
+    if (numArgs < localCt) {
+	if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
+	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
 	} else {
-	    Tcl_AppendToObj(objResult, procName, len);
+	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
 	}
+    }
 
-	localPtr = procPtr->firstLocalPtr;
-	for (i = 1;  i <= numArgs;  i++) {
-	    if (localPtr->defValuePtr != NULL) {
-		Tcl_AppendStringsToObj(objResult,
-			" ?", localPtr->name, "?", (char *) NULL);
-	    } else {
-		Tcl_AppendStringsToObj(objResult,
-			" ", localPtr->name, (char *) NULL);
-	    }
-	    localPtr = localPtr->nextPtr;
-	}
-	Tcl_AppendStringsToObj(objResult, "\"", (char *) NULL);
+    return TCL_OK;
 
-	result = TCL_ERROR;
-	goto procDone;
+
+    incorrectArgs:
+    /*
+     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
+     */
+
+    memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var));
+    return ProcWrongNumArgs(interp, skip);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PushProcCallFrame --
+ *
+ *	Compiles a proc body if necessary, then pushes a CallFrame suitable
+ *	for executing it.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	The proc's body may be recompiled. A CallFrame is pushed, it will have
+ *	to be popped by the caller.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PushProcCallFrame(
+    ClientData clientData, 	/* Record describing procedure to be
+				 * interpreted. */
+    register Tcl_Interp *interp,/* Interpreter in which procedure was
+				 * invoked. */
+    int objc,			/* Count of number of arguments to this
+				 * procedure. */
+    Tcl_Obj *CONST objv[],	/* Argument value objects. */
+    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
+				 * needs special rules for error msg */
+{
+    Proc *procPtr = (Proc *) clientData;
+    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
+    CallFrame *framePtr, **framePtrPtr;
+    int result;
+    ByteCode *codePtr;
+
+    /*
+     * If necessary (i.e. if we haven't got a suitable compilation already
+     * cached) compile the procedure's body. The compiler will allocate frame
+     * slots for the procedure's non-argument local variables. Note that
+     * compiling the body might increase procPtr->numCompiledLocals if new
+     * local variables are found while compiling.
+     */
+
+    if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+	Interp *iPtr = (Interp *) interp;
+
+	/*
+	 * When we've got bytecode, this is the check for validity. That is,
+	 * the bytecode must be for the right interpreter (no cross-leaks!),
+	 * the code must be from the current epoch (so subcommand compilation
+	 * is up-to-date), the namespace must match (so variable handling
+	 * is right) and the resolverEpoch must match (so that new shadowed
+	 * commands and/or resolver changes are considered).
+	 */
+
+	codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ 	if (((Interp *) *codePtr->interpHandle != iPtr)
+		|| (codePtr->compileEpoch != iPtr->compileEpoch)
+		|| (codePtr->nsPtr != nsPtr)
+		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
+	    goto doCompilation;
+	}
+    } else {
+    doCompilation:
+	result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+		(isLambda ? "body of lambda term" : "body of proc"),
+		TclGetString(objv[isLambda]), &procPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
 
     /*
-     * Invoke the commands in the procedure's body.
+     * Set up and push a new call frame for the new procedure invocation.
+     * This call frame will execute in the proc's namespace, which might be
+     * different than the current namespace. The proc's namespace is that of
+     * its command, which can change if the command is renamed from one
+     * namespace to another.
      */
 
-#ifdef TCL_COMPILE_DEBUG
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    (Tcl_Namespace *) nsPtr,
+	    (isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC));
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    framePtr->objc = objc;
+    framePtr->objv = objv;
+    framePtr->procPtr = procPtr;
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInterpProc --
+ *
+ *	When a Tcl procedure gets invoked during bytecode evaluation, this
+ *	object-based routine gets invoked to interpret the procedure.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Depends on the commands in the procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInterpProc(
+    ClientData clientData, 	/* Record describing procedure to be
+				 * interpreted. */
+    register Tcl_Interp *interp,/* Interpreter in which procedure was
+				 * invoked. */
+    int objc,			/* Count of number of arguments to this
+				 * procedure. */
+    Tcl_Obj *CONST objv[])	/* Argument value objects. */
+{
+    int result;
+
+    result = PushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0);
+    if (result == TCL_OK) {
+	return TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError);
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjInterpProcCore --
+ *
+ *	When a Tcl procedure, lambda term or anything else that works like a
+ *	procedure gets invoked during bytecode evaluation, this object-based
+ *	routine gets invoked to interpret the body.
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	Nearly anything; depends on the commands in the procedure body.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjInterpProcCore(
+    register Tcl_Interp *interp,/* Interpreter in which procedure was
+				 * invoked. */
+    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
+    int skip,			/* Number of initial arguments to be skipped,
+				 * i.e., words in the "command name". */
+    ProcErrorProc errorProc)	/* How to convert results from the script into
+				 * results of the overall procedure. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Proc *procPtr = iPtr->varFramePtr->procPtr;
+    int result;
+    CallFrame *freePtr;
+
+    result = InitArgsAndLocals(interp, procNameObj, skip);
+    if (result != TCL_OK) {
+	goto procDone;
+    }
+
+#if defined(TCL_COMPILE_DEBUG)
     if (tclTraceExec >= 1) {
-	fprintf(stdout, "Calling proc ");
-	for (i = 0;  i < objc;  i++) {
-	    TclPrintObject(stdout, objv[i], 15);
+	register CallFrame *framePtr = iPtr->varFramePtr;
+	register int i;
+
+	if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
+	    fprintf(stdout, "Calling lambda ");
+	} else {
+	    fprintf(stdout, "Calling proc ");
+	}
+	for (i = 0; i < framePtr->objc; i++) {
+	    TclPrintObject(stdout, framePtr->objv[i], 15);
 	    fprintf(stdout, " ");
 	}
 	fprintf(stdout, "\n");
@@ -1200,40 +1717,117 @@ TclObjInterpProc(clientData, interp, objc, objv)
     if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
 	char *a[10];
 	int i = 0;
+	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
 
 	while (i < 10) {
-	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
+	    a[i] = (l < iPtr->varFramePtr->objc ?
+		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
 	}
 	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
 		a[8], a[9]);
     }
-#endif /* USE_DTRACE */
+    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
+	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+	char *a[4]; int i[2];
 
-    iPtr->returnCode = TCL_OK;
-    procPtr->refCount++;
-    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
-	TCL_DTRACE_PROC_ENTRY(TclGetString(objv[0]), objc - 1,
-		(Tcl_Obj **)(objv + 1));
+	TclDTraceInfo(info, a, i);
+	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+	TclDecrRefCount(info);
     }
-#ifndef TCL_TIP280
-    result = TclCompEvalObj(interp, procPtr->bodyPtr);
-#else
-    /* TIP #280: No need to set the invoking context here. The body has
-     * already been compiled, so the part of CompEvalObj using it is bypassed.
+#endif /* USE_DTRACE */
+
+    /*
+     * Invoke the commands in the procedure's body.
      */
 
-    result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0);
-#endif
-    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
-	TCL_DTRACE_PROC_RETURN(TclGetString(objv[0]), result);
+    procPtr->refCount++;
+    iPtr->numLevels++;
+
+    if (TclInterpReady(interp) == TCL_ERROR) {
+	result = TCL_ERROR;
+    } else {
+	register ByteCode *codePtr =
+		procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+
+	codePtr->refCount++;
+#ifdef USE_DTRACE
+	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+	    int l;
+
+	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
+	    TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
+		    iPtr->varFramePtr->objc - l,
+		    (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
+	}
+#endif /* USE_DTRACE */
+	result = TclExecuteByteCode(interp, codePtr);
+	if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+	    TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
+	}
+	codePtr->refCount--;
+	if (codePtr->refCount <= 0) {
+	    TclCleanupByteCode(codePtr);
+	}
     }
+
+    iPtr->numLevels--;
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
     }
 
-    if (result != TCL_OK) {
-	result = ProcessProcResultCode(interp, procName, nameLen, result);
+    /*
+     * Process the result code.
+     */
+
+    switch (result) {
+    case TCL_RETURN:
+	/*
+	 * If it is a 'return', do the TIP#90 processing now.
+	 */
+
+	result = TclUpdateReturnInfo((Interp *) interp);
+	break;
+
+    case TCL_CONTINUE:
+    case TCL_BREAK:
+	/*
+	 * It's an error to get to this point from a 'break' or 'continue', so
+	 * transform to an error now.
+	 */
+
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "invoked \"",
+		((result == TCL_BREAK) ? "break" : "continue"),
+		"\" outside of a loop", NULL);
+	result = TCL_ERROR;
+
+	/*
+	 * Fall through to the TCL_ERROR handling code.
+	 */
+
+    case TCL_ERROR:
+	/*
+	 * Now it _must_ be an error, so we need to log it as such. This means
+	 * filling out the error trace. Luckily, we just hand this off to the
+	 * function handed to us as an argument.
+	 */
+
+	(*errorProc)(interp, procNameObj);
+
+    default:
+	/*
+	 * Process other results (OK and non-standard) by doing nothing
+	 * special, skipping directly to the code afterwards that cleans up
+	 * associated memory.
+	 *
+	 * Non-standard results are processed by passing them through quickly.
+	 * This means they all work as exceptions, unwinding the stack quickly
+	 * and neatly. Who knows how well they are handled by third-party code
+	 * though...
+	 */
+
+	(void) 0;		/* do nothing */
     }
 
 #ifdef USE_DTRACE
@@ -1241,23 +1835,26 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	Tcl_Obj *r;
 
 	r = Tcl_GetObjResult(interp);
-	TCL_DTRACE_PROC_RESULT(TclGetString(objv[0]), result,
+	TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
 		TclGetString(r), r);
     }
 #endif /* USE_DTRACE */
 
+  procDone:
     /*
-     * Pop and free the call frame for this procedure invocation, then
-     * free the compiledLocals array if malloc'ed storage was used.
+     * Free the stack-allocated compiled locals and CallFrame. It is important
+     * to pop the call frame without freeing it first: the compiledLocals
+     * cannot be freed before the frame is popped, as the local variables must
+     * be deleted. But the compiledLocals must be freed first, as they were
+     * allocated later on the stack.
      */
 
-    procDone:
-    Tcl_PopCallFrame(interp);
-    if (compiledLocals != localStorage) {
-	ckfree((char *) compiledLocals);
-    }
+    freePtr = iPtr->framePtr;
+    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
+    TclStackFree(interp, freePtr->compiledLocals);
+					/* Free compiledLocals. */
+    TclStackFree(interp, freePtr);	/* Free CallFrame. */
     return result;
-#undef NUM_LOCALS
 }
 
 /*
@@ -1265,150 +1862,149 @@ TclObjInterpProc(clientData, interp, objc, objv)
  *
  * TclProcCompileProc --
  *
- *	Called just before a procedure is executed to compile the
- *	body to byte codes.  If the type of the body is not
- *	"byte code" or if the compile conditions have changed
- *	(namespace context, epoch counters, etc.) then the body
- *	is recompiled.  Otherwise, this procedure does nothing.
+ *	Called just before a procedure is executed to compile the body to byte
+ *	codes. If the type of the body is not "byte code" or if the compile
+ *	conditions have changed (namespace context, epoch counters, etc.) then
+ *	the body is recompiled. Otherwise, this function does nothing.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	May change the internal representation of the body object
- *	to compiled code.
+ *	May change the internal representation of the body object to compiled
+ *	code.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
-    Tcl_Interp *interp;		/* Interpreter containing procedure. */
-    Proc *procPtr;		/* Data associated with procedure. */
-    Tcl_Obj *bodyPtr;		/* Body of proc. (Usually procPtr->bodyPtr,
- 				 * but could be any code fragment compiled
- 				 * in the context of this procedure.) */
-    Namespace *nsPtr;		/* Namespace containing procedure. */
-    CONST char *description;	/* string describing this body of code. */
-    CONST char *procName;	/* Name of this procedure. */
+TclProcCompileProc(
+    Tcl_Interp *interp,		/* Interpreter containing procedure. */
+    Proc *procPtr,		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled in
+ 				 * the context of this procedure.) */
+    Namespace *nsPtr,		/* Namespace containing procedure. */
+    CONST char *description,	/* string describing this body of code. */
+    CONST char *procName)	/* Name of this procedure. */
 {
-    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr,
-	    description, procName, NULL);
+    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
+	    procName, NULL);
 }
 
 static int
-ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
-		procName, procPtrPtr)
-    Tcl_Interp *interp;		/* Interpreter containing procedure. */
-    Proc *procPtr;		/* Data associated with procedure. */
-    Tcl_Obj *bodyPtr;		/* Body of proc. (Usually procPtr->bodyPtr,
- 				 * but could be any code fragment compiled
- 				 * in the context of this procedure.) */
-    Namespace *nsPtr;		/* Namespace containing procedure. */
-    CONST char *description;	/* string describing this body of code. */
-    CONST char *procName;	/* Name of this procedure. */
-    Proc **procPtrPtr;		/* points to storage where a replacement
-				 * (Proc *) value may be written, when
-				 * appropriate */
+ProcCompileProc(
+    Tcl_Interp *interp,		/* Interpreter containing procedure. */
+    Proc *procPtr,		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled in
+ 				 * the context of this procedure.) */
+    Namespace *nsPtr,		/* Namespace containing procedure. */
+    CONST char *description,	/* string describing this body of code. */
+    CONST char *procName,	/* Name of this procedure. */
+    Proc **procPtrPtr)		/* Points to storage where a replacement
+				 * (Proc *) value may be written. */
 {
-    Interp *iPtr = (Interp*)interp;
-    int i, result;
-    Tcl_CallFrame frame;
-    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+    Interp *iPtr = (Interp *) interp;
+    int i;
+    Tcl_CallFrame *framePtr;
+    ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
     CompiledLocal *localPtr;
 
     /*
-     * If necessary, compile the procedure's body. The compiler will
-     * allocate frame slots for the procedure's non-argument local
-     * variables. If the ByteCode already exists, make sure it hasn't been
-     * invalidated by someone redefining a core command (this might make the
-     * compiled code wrong). Also, if the code was compiled in/for a
-     * different interpreter, we recompile it. Note that compiling the body
-     * might increase procPtr->numCompiledLocals if new local variables are
-     * found while compiling.
+     * If necessary, compile the procedure's body. The compiler will allocate
+     * frame slots for the procedure's non-argument local variables. If the
+     * ByteCode already exists, make sure it hasn't been invalidated by
+     * someone redefining a core command (this might make the compiled code
+     * wrong). Also, if the code was compiled in/for a different interpreter,
+     * we recompile it. Note that compiling the body might increase
+     * procPtr->numCompiledLocals if new local variables are found while
+     * compiling.
      *
-     * Precompiled procedure bodies, however, are immutable and therefore
-     * they are not recompiled, even if things have changed.
+     * Precompiled procedure bodies, however, are immutable and therefore they
+     * are not recompiled, even if things have changed.
      */
 
     if (bodyPtr->typePtr == &tclByteCodeType) {
- 	if (((Interp *) *codePtr->interpHandle != iPtr)
- 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
- 	        || (codePtr->nsPtr != nsPtr)) {
-            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-                if ((Interp *) *codePtr->interpHandle != iPtr) {
-                    Tcl_AppendResult(interp,
-                            "a precompiled script jumped interps", NULL);
-                    return TCL_ERROR;
-                }
-	        codePtr->compileEpoch = iPtr->compileEpoch;
-                codePtr->nsPtr = nsPtr;
-            } else {
-                (*tclByteCodeType.freeIntRepProc)(bodyPtr);
-                bodyPtr->typePtr = (Tcl_ObjType *) NULL;
-            }
+ 	if (((Interp *) *codePtr->interpHandle == iPtr)
+		&& (codePtr->compileEpoch == iPtr->compileEpoch)
+		&& (codePtr->nsPtr == nsPtr)
+		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
+	    return TCL_OK;
+	} else {
+	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+		if ((Interp *) *codePtr->interpHandle != iPtr) {
+		    Tcl_AppendResult(interp,
+			    "a precompiled script jumped interps", NULL);
+		    return TCL_ERROR;
+		}
+		codePtr->compileEpoch = iPtr->compileEpoch;
+		codePtr->nsPtr = nsPtr;
+	    } else {
+		bodyPtr->typePtr->freeIntRepProc(bodyPtr);
+		bodyPtr->typePtr = NULL;
+	    }
  	}
     }
     if (bodyPtr->typePtr != &tclByteCodeType) {
- 	int numChars;
- 	char *ellipsis;
+	Tcl_HashEntry *hePtr;
 
 #ifdef TCL_COMPILE_DEBUG
  	if (tclTraceCompile >= 1) {
  	    /*
- 	     * Display a line summarizing the top level command we
- 	     * are about to compile.
+ 	     * Display a line summarizing the top level command we are about
+ 	     * to compile.
  	     */
 
- 	    numChars = strlen(procName);
- 	    ellipsis = "";
- 	    if (numChars > 50) {
- 		numChars = 50;
- 		ellipsis = "...";
- 	    }
- 	    fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
- 		    description, numChars, procName, ellipsis);
+	    Tcl_Obj *message;
+
+	    TclNewLiteralStringObj(message, "Compiling ");
+	    Tcl_IncrRefCount(message);
+	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
+	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
+ 	    fprintf(stdout, "%s\"\n", TclGetString(message));
+	    Tcl_DecrRefCount(message);
  	}
 #endif
 
  	/*
- 	 * Plug the current procPtr into the interpreter and coerce
- 	 * the code body to byte codes.  The interpreter needs to
- 	 * know which proc it's compiling so that it can access its
- 	 * list of compiled locals.
+ 	 * Plug the current procPtr into the interpreter and coerce the code
+ 	 * body to byte codes. The interpreter needs to know which proc it's
+ 	 * compiling so that it can access its list of compiled locals.
  	 *
- 	 * TRICKY NOTE:  Be careful to push a call frame with the
- 	 *   proper namespace context, so that the byte codes are
- 	 *   compiled in the appropriate class context.
+ 	 * TRICKY NOTE: Be careful to push a call frame with the proper
+ 	 *   namespace context, so that the byte codes are compiled in the
+ 	 *   appropriate class context.
  	 */
 
 	if (procPtrPtr != NULL && procPtr->refCount > 1) {
 	    Tcl_Command token;
 	    Tcl_CmdInfo info;
-	    Proc *new = (Proc *) ckalloc(sizeof(Proc));
-
-	    new->iPtr = procPtr->iPtr;
-	    new->refCount = 1;
-	    new->cmdPtr = procPtr->cmdPtr;
-	    token = (Tcl_Command) new->cmdPtr;
-	    new->bodyPtr = Tcl_DuplicateObj(bodyPtr);
-	    bodyPtr = new->bodyPtr;
+	    Proc *newProc = (Proc *) ckalloc(sizeof(Proc));
+
+	    newProc->iPtr = procPtr->iPtr;
+	    newProc->refCount = 1;
+	    newProc->cmdPtr = procPtr->cmdPtr;
+	    token = (Tcl_Command) newProc->cmdPtr;
+	    newProc->bodyPtr = Tcl_DuplicateObj(bodyPtr);
+	    bodyPtr = newProc->bodyPtr;
 	    Tcl_IncrRefCount(bodyPtr);
-	    new->numArgs = procPtr->numArgs;
+	    newProc->numArgs = procPtr->numArgs;
 
-	    new->numCompiledLocals = new->numArgs;
-	    new->firstLocalPtr = NULL;
-	    new->lastLocalPtr = NULL;
+	    newProc->numCompiledLocals = newProc->numArgs;
+	    newProc->firstLocalPtr = NULL;
+	    newProc->lastLocalPtr = NULL;
 	    localPtr = procPtr->firstLocalPtr;
-	    for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) {
+	    for (i=0; i<newProc->numArgs; i++, localPtr=localPtr->nextPtr) {
 		CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
-			(sizeof(CompiledLocal) -sizeof(localPtr->name)
-			 + localPtr->nameLength + 1));
-		if (new->firstLocalPtr == NULL) {
-		    new->firstLocalPtr = new->lastLocalPtr = copy;
+			(sizeof(CompiledLocal) - sizeof(localPtr->name)
+			+ localPtr->nameLength + 1));
+
+		if (newProc->firstLocalPtr == NULL) {
+		    newProc->firstLocalPtr = newProc->lastLocalPtr = copy;
 		} else {
-		    new->lastLocalPtr->nextPtr = copy;
-		    new->lastLocalPtr = copy;
+		    newProc->lastLocalPtr->nextPtr = copy;
+		    newProc->lastLocalPtr = copy;
 		}
 		copy->nextPtr = NULL;
 		copy->nameLength = localPtr->nameLength;
@@ -1419,97 +2015,58 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
 		    Tcl_IncrRefCount(copy->defValuePtr);
 		}
 		copy->resolveInfo = localPtr->resolveInfo;
-		memcpy(copy->name, localPtr->name,  localPtr->nameLength + 1);
+		memcpy(copy->name, localPtr->name, localPtr->nameLength + 1);
 	    }
 
+	    /*
+	     * Reset the ClientData
+	     */
 
-	    /* Reset the ClientData */
 	    Tcl_GetCommandInfoFromToken(token, &info);
 	    if (info.objClientData == (ClientData) procPtr) {
-	        info.objClientData = (ClientData) new;
+		info.objClientData = (ClientData) newProc;
 	    }
 	    if (info.clientData == (ClientData) procPtr) {
-	        info.clientData = (ClientData) new;
+		info.clientData = (ClientData) newProc;
 	    }
 	    if (info.deleteData == (ClientData) procPtr) {
-	        info.deleteData = (ClientData) new;
+		info.deleteData = (ClientData) newProc;
 	    }
 	    Tcl_SetCommandInfoFromToken(token, &info);
 
 	    procPtr->refCount--;
-	    *procPtrPtr = procPtr = new;
+	    *procPtrPtr = procPtr = newProc;
 	}
  	iPtr->compiledProcPtr = procPtr;
 
- 	result = Tcl_PushCallFrame(interp, &frame,
-		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
+ 	(void) TclPushStackFrame(interp, &framePtr,
+		(Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0);
 
- 	if (result == TCL_OK) {
-#ifdef TCL_TIP280
-	    /* TIP #280. We get the invoking context from the cmdFrame
-	     * which was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
-	     */
+	/*
+	 * TIP #280: We get the invoking context from the cmdFrame which
+	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
+	 */
 
-	    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
+	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
 
-	    /* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
-	     */
-	    iPtr->invokeWord        = 0;
-	    iPtr->invokeCmdFramePtr = (hePtr
-				       ? (CmdFrame*) Tcl_GetHashValue (hePtr)
-				       : NULL);
-#endif
-	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
-#ifdef TCL_TIP280
-	    iPtr->invokeCmdFramePtr = NULL;
-#endif
-	    Tcl_PopCallFrame(interp);
-	}
+	/*
+	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
+	 */
 
- 	if (result != TCL_OK) {
- 	    if (result == TCL_ERROR) {
-		char buf[100 + TCL_INTEGER_SPACE];
-
-		numChars = strlen(procName);
- 		ellipsis = "";
- 		if (numChars > 50) {
- 		    numChars = 50;
- 		    ellipsis = "...";
- 		}
-		while ( (procName[numChars] & 0xC0) == 0x80 ) {
-	            /*
-		     * Back up truncation point so that we don't truncate
-		     * in the middle of a multi-byte character (in UTF-8)
-		     */
-		    numChars--;
-		    ellipsis = "...";
-		}
- 		sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
- 			description, numChars, procName, ellipsis,
- 			interp->errorLine);
- 		Tcl_AddObjErrorInfo(interp, buf, -1);
- 	    }
- 	    return result;
- 	}
+	iPtr->invokeWord = 0;
+	iPtr->invokeCmdFramePtr =
+		(hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL);
+	(void) tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	iPtr->invokeCmdFramePtr = NULL;
+	TclPopStackFrame(interp);
     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
-
 	/*
-	 * The resolver epoch has changed, but we only need to invalidate
-	 * the resolver cache.
+	 * The resolver epoch has changed, but we only need to invalidate the
+	 * resolver cache.
 	 */
 
-	for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
-	    localPtr = localPtr->nextPtr) {
-	    localPtr->flags &= ~(VAR_RESOLVED);
-	    if (localPtr->resolveInfo) {
-		if (localPtr->resolveInfo->deleteProc) {
-		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
-		} else {
-		    ckfree((char*)localPtr->resolveInfo);
-		}
-		localPtr->resolveInfo = NULL;
-	    }
-	}
+	codePtr->nsEpoch = nsPtr->resolverEpoch;
+	codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS;
     }
     return TCL_OK;
 }
@@ -1517,68 +2074,36 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
 /*
  *----------------------------------------------------------------------
  *
- * ProcessProcResultCode --
+ * MakeProcError --
  *
- *	Procedure called by TclObjInterpProc to process a return code other
- *	than TCL_OK returned by a Tcl procedure.
+ *	Function called by TclObjInterpProc to create the stack information
+ *	upon an error from a procedure.
  *
  * Results:
- *	Depending on the argument return code, the result returned is
- *	another return code and the interpreter's result is set to a value
- *	to supplement that return code.
+ *	The interpreter's error info trace is set to a value that supplements
+ *	the error code.
  *
  * Side effects:
- *	If the result returned is TCL_ERROR, traceback information about
- *	the procedure just executed is appended to the interpreter's
- *	"errorInfo" variable.
+ *	none.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-ProcessProcResultCode(interp, procName, nameLen, returnCode)
-    Tcl_Interp *interp;		/* The interpreter in which the procedure
-				 * was called and returned returnCode. */
-    char *procName;		/* Name of the procedure. Used for error
+static void
+MakeProcError(
+    Tcl_Interp *interp,		/* The interpreter in which the procedure was
+				 * called. */
+    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
 				 * messages and trace information. */
-    int nameLen;		/* Number of bytes in procedure's name. */
-    int returnCode;		/* The unexpected result code. */
 {
-    Interp *iPtr = (Interp *) interp;
-    char msg[100 + TCL_INTEGER_SPACE];
-    char *ellipsis = "";
-
-    if (returnCode == TCL_OK) {
-	return TCL_OK;
-    }
-    if ((returnCode > TCL_CONTINUE) || (returnCode < TCL_OK)) {
-	return returnCode;
-    }
-    if (returnCode == TCL_RETURN) {
-	return TclUpdateReturnInfo(iPtr);
-    }
-    if (returnCode != TCL_ERROR) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK)
-		? "invoked \"break\" outside of a loop"
-		: "invoked \"continue\" outside of a loop"), -1);
-    }
-    if (nameLen > 60) {
-	nameLen = 60;
-	ellipsis = "...";
-    }
-    while ( (procName[nameLen] & 0xC0) == 0x80 ) {
-        /*
-	 * Back up truncation point so that we don't truncate in the
-	 * middle of a multi-byte character (in UTF-8)
-	 */
-	nameLen--;
-	ellipsis = "...";
-    }
-    sprintf(msg, "\n    (procedure \"%.*s%s\" line %d)", nameLen, procName,
-	    ellipsis, iPtr->errorLine);
-    Tcl_AddObjErrorInfo(interp, msg, -1);
-    return TCL_ERROR;
+    int overflow, limit = 60, nameLen;
+    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
+
+    overflow = (nameLen > limit);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (procedure \"%.*s%s\" line %d)",
+	    (overflow ? limit : nameLen), procName,
+	    (overflow ? "..." : ""), interp->errorLine));
 }
 
 /*
@@ -1586,24 +2111,24 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
  *
  * TclProcDeleteProc --
  *
- *	This procedure is invoked just before a command procedure is
- *	removed from an interpreter.  Its job is to release all the
- *	resources allocated to the procedure.
+ *	This function is invoked just before a command procedure is removed
+ *	from an interpreter. Its job is to release all the resources allocated
+ *	to the procedure.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Memory gets freed, unless the procedure is actively being
- *	executed.  In this case the cleanup is delayed until the
- *	last call to the current procedure completes.
+ *	Memory gets freed, unless the procedure is actively being executed.
+ *	In this case the cleanup is delayed until the last call to the current
+ *	procedure completes.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclProcDeleteProc(clientData)
-    ClientData clientData;		/* Procedure to be deleted. */
+TclProcDeleteProc(
+    ClientData clientData)	/* Procedure to be deleted. */
 {
     Proc *procPtr = (Proc *) clientData;
 
@@ -1618,9 +2143,8 @@ TclProcDeleteProc(clientData)
  *
  * TclProcCleanupProc --
  *
- *	This procedure does all the real work of freeing up a Proc
- *	structure.  It's called only when the structure's reference
- *	count becomes zero.
+ *	This function does all the real work of freeing up a Proc structure.
+ *	It's called only when the structure's reference count becomes zero.
  *
  * Results:
  *	None.
@@ -1632,33 +2156,31 @@ TclProcDeleteProc(clientData)
  */
 
 void
-TclProcCleanupProc(procPtr)
-    register Proc *procPtr;		/* Procedure to be deleted. */
+TclProcCleanupProc(
+    register Proc *procPtr)	/* Procedure to be deleted. */
 {
     register CompiledLocal *localPtr;
     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Tcl_Obj *defPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
-#ifdef TCL_TIP280
-    Tcl_HashEntry* hePtr = NULL;
-    CmdFrame*      cfPtr = NULL;
-    Interp*        iPtr  = procPtr->iPtr;
-#endif
+    Tcl_HashEntry *hePtr = NULL;
+    CmdFrame *cfPtr = NULL;
+    Interp *iPtr = procPtr->iPtr;
 
     if (bodyPtr != NULL) {
 	Tcl_DecrRefCount(bodyPtr);
     }
-    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
+    for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) {
 	CompiledLocal *nextPtr = localPtr->nextPtr;
 
-        resVarInfo = localPtr->resolveInfo;
+	resVarInfo = localPtr->resolveInfo;
 	if (resVarInfo) {
 	    if (resVarInfo->deleteProc) {
 		(*resVarInfo->deleteProc)(resVarInfo);
 	    } else {
 		ckfree((char *) resVarInfo);
 	    }
-        }
+	}
 
 	if (localPtr->defValuePtr != NULL) {
 	    defPtr = localPtr->defValuePtr;
@@ -1669,27 +2191,34 @@ TclProcCleanupProc(procPtr)
     }
     ckfree((char *) procPtr);
 
-#ifdef TCL_TIP280
-    /* TIP #280. Release the location data associated with this Proc
+    /*
+     * TIP #280: Release the location data associated with this Proc
      * structure, if any. The interpreter may not exist (For example for
-     * procbody structurues created by tbcload.
+     * procbody structures created by tbcload. See also Tcl_ProcObjCmd(), when
+     * the same ProcPtr is overwritten with a new CmdFrame.
      */
 
-    if (!iPtr) return;
+    if (iPtr == NULL) {
+	return;
+    }
 
-    hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
-    if (!hePtr) return;
+    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
+    if (!hePtr) {
+	return;
+    }
 
-    cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr);
+    cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
 
-    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-        Tcl_DecrRefCount (cfPtr->data.eval.path);
-	cfPtr->data.eval.path = NULL;
+    if (cfPtr) {
+	if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	    Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    cfPtr->data.eval.path = NULL;
+	}
+	ckfree((char *) cfPtr->line);
+	cfPtr->line = NULL;
+	ckfree((char *) cfPtr);
     }
-    ckfree ((char*) cfPtr->line); cfPtr->line = NULL;
-    ckfree ((char*) cfPtr);
-    Tcl_DeleteHashEntry (hePtr);
-#endif
+    Tcl_DeleteHashEntry(hePtr);
 }
 
 /*
@@ -1697,47 +2226,44 @@ TclProcCleanupProc(procPtr)
  *
  * TclUpdateReturnInfo --
  *
- *	This procedure is called when procedures return, and at other
- *	points where the TCL_RETURN code is used.  It examines fields
- *	such as iPtr->returnCode and iPtr->errorCode and modifies
- *	the real return status accordingly.
+ *	This function is called when procedures return, and at other points
+ *	where the TCL_RETURN code is used. It examines the returnLevel and
+ *	returnCode to determine the real return status.
  *
  * Results:
- *	The return value is the true completion code to use for
- *	the procedure, instead of TCL_RETURN.
+ *	The return value is the true completion code to use for the procedure
+ *	or script, instead of TCL_RETURN.
  *
  * Side effects:
- *	The errorInfo and errorCode variables may get modified.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclUpdateReturnInfo(iPtr)
-    Interp *iPtr;		/* Interpreter for which TCL_RETURN
-				 * exception is being processed. */
+TclUpdateReturnInfo(
+    Interp *iPtr)		/* Interpreter for which TCL_RETURN exception
+				 * is being processed. */
 {
-    int code;
-    char *errorCode;
-    Tcl_Obj *objPtr;
+    int code = TCL_RETURN;
+
+    iPtr->returnLevel--;
+    if (iPtr->returnLevel < 0) {
+	Tcl_Panic("TclUpdateReturnInfo: negative return level");
+    }
+    if (iPtr->returnLevel == 0) {
+	/*
+	 * Now we've reached the level to return the requested -code.
+	 * Since iPtr->returnLevel and iPtr->returnCode have completed
+	 * their task, we now reset them to default values so that any
+	 * bare "return TCL_RETURN" that may follow will work [Bug 2152286].
+	 */
 
-    code = iPtr->returnCode;
-    iPtr->returnCode = TCL_OK;
-    if (code == TCL_ERROR) {
-	errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE");
-	objPtr = Tcl_NewStringObj(errorCode, -1);
-	Tcl_IncrRefCount(objPtr);
-	Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
-	        NULL, objPtr, TCL_GLOBAL_ONLY);
-	Tcl_DecrRefCount(objPtr);
-	iPtr->flags |= ERROR_CODE_SET;
-	if (iPtr->errorInfo != NULL) {
-	    objPtr = Tcl_NewStringObj(iPtr->errorInfo, -1);
-	    Tcl_IncrRefCount(objPtr);
-	    Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo,
-		    NULL, objPtr, TCL_GLOBAL_ONLY);
-	    Tcl_DecrRefCount(objPtr);
-	    iPtr->flags |= ERR_IN_PROGRESS;
+	code = iPtr->returnCode;
+	iPtr->returnLevel = 1;
+	iPtr->returnCode = TCL_OK;
+	if (code == TCL_ERROR) {
+	    iPtr->flags |= ERR_LEGACY_COPY;
 	}
     }
     return code;
@@ -1746,49 +2272,24 @@ TclUpdateReturnInfo(iPtr)
 /*
  *----------------------------------------------------------------------
  *
- * TclGetInterpProc --
- *
- *  Returns a pointer to the TclProcInterpProc procedure; this is different
- *  from the value obtained from the TclProcInterpProc reference on systems
- *  like Windows where import and export versions of a procedure exported
- *  by a DLL exist.
- *
- * Results:
- *  Returns the internal address of the TclProcInterpProc procedure.
- *
- * Side effects:
- *  None.
- *
- *----------------------------------------------------------------------
- */
-
-TclCmdProcType
-TclGetInterpProc()
-{
-    return (TclCmdProcType) TclProcInterpProc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclGetObjInterpProc --
  *
- *  Returns a pointer to the TclObjInterpProc procedure; this is different
- *  from the value obtained from the TclObjInterpProc reference on systems
- *  like Windows where import and export versions of a procedure exported
- *  by a DLL exist.
+ *	Returns a pointer to the TclObjInterpProc function; this is different
+ *	from the value obtained from the TclObjInterpProc reference on systems
+ *	like Windows where import and export versions of a function exported
+ *	by a DLL exist.
  *
  * Results:
- *  Returns the internal address of the TclObjInterpProc procedure.
+ *	Returns the internal address of the TclObjInterpProc function.
  *
  * Side effects:
- *  None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 TclObjCmdProcType
-TclGetObjInterpProc()
+TclGetObjInterpProc(void)
 {
     return (TclObjCmdProcType) TclObjInterpProc;
 }
@@ -1798,38 +2299,37 @@ TclGetObjInterpProc()
  *
  * TclNewProcBodyObj --
  *
- *  Creates a new object, of type "procbody", whose internal
- *  representation is the given Proc struct.
- *  The newly created object's reference count is 0.
+ *	Creates a new object, of type "procbody", whose internal
+ *	representation is the given Proc struct. The newly created object's
+ *	reference count is 0.
  *
  * Results:
- *  Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
+ *	Returns a pointer to a newly allocated Tcl_Obj, NULL on error.
  *
  * Side effects:
- *  The reference count in the ByteCode attached to the Proc is bumped up
- *  by one, since the internal rep stores a pointer to it.
+ *	The reference count in the ByteCode attached to the Proc is bumped up
+ *	by one, since the internal rep stores a pointer to it.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-TclNewProcBodyObj(procPtr)
-    Proc *procPtr;	/* the Proc struct to store as the internal
-                         * representation. */
+TclNewProcBodyObj(
+    Proc *procPtr)		/* the Proc struct to store as the internal
+				 * representation. */
 {
     Tcl_Obj *objPtr;
 
     if (!procPtr) {
-        return (Tcl_Obj *) NULL;
+	return NULL;
     }
 
-    objPtr = Tcl_NewStringObj("", 0);
-
+    TclNewObj(objPtr);
     if (objPtr) {
-        objPtr->typePtr = &tclProcBodyType;
-        objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+	objPtr->typePtr = &tclProcBodyType;
+	objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
 
-        procPtr->refCount++;
+	procPtr->refCount++;
     }
 
     return objPtr;
@@ -1840,27 +2340,27 @@ TclNewProcBodyObj(procPtr)
  *
  * ProcBodyDup --
  *
- *  Tcl_ObjType's Dup function for the proc body object.
- *  Bumps the reference count on the Proc stored in the internal
- *  representation.
+ *	Tcl_ObjType's Dup function for the proc body object. Bumps the
+ *	reference count on the Proc stored in the internal representation.
  *
  * Results:
- *  None.
+ *	None.
  *
  * Side effects:
- *  Sets up the object in dupPtr to be a duplicate of the one in srcPtr.
+ *	Sets up the object in dupPtr to be a duplicate of the one in srcPtr.
  *
  *----------------------------------------------------------------------
  */
 
-static void ProcBodyDup(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr;		/* object to copy */
-    Tcl_Obj *dupPtr;		/* target object for the duplication */
+static void
+ProcBodyDup(
+    Tcl_Obj *srcPtr,		/* Object to copy. */
+    Tcl_Obj *dupPtr)		/* Target object for the duplication. */
 {
-    Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
+    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     dupPtr->typePtr = &tclProcBodyType;
-    dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
     procPtr->refCount++;
 }
 
@@ -1869,130 +2369,539 @@ static void ProcBodyDup(srcPtr, dupPtr)
  *
  * ProcBodyFree --
  *
- *  Tcl_ObjType's Free function for the proc body object.
- *  The reference count on its Proc struct is decreased by 1; if the count
- *  reaches 0, the proc is freed.
+ *	Tcl_ObjType's Free function for the proc body object. The reference
+ *	count on its Proc struct is decreased by 1; if the count reaches 0,
+ *	the proc is freed.
  *
  * Results:
- *  None.
+ *	None.
  *
  * Side effects:
- *  If the reference count on the Proc struct reaches 0, the struct is freed.
+ *	If the reference count on the Proc struct reaches 0, the struct is
+ *	freed.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-ProcBodyFree(objPtr)
-    Tcl_Obj *objPtr;		/* the object to clean up */
+ProcBodyFree(
+    Tcl_Obj *objPtr)		/* The object to clean up. */
 {
-    Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
-    procPtr->refCount--;
-    if (procPtr->refCount <= 0) {
-        TclProcCleanupProc(procPtr);
+    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+    if (procPtr->refCount-- < 2) {
+	TclProcCleanupProc(procPtr);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ProcBodySetFromAny --
- *
- *  Tcl_ObjType's SetFromAny function for the proc body object.
- *  Calls panic.
- *
- * Results:
- *  Theoretically returns a TCL result code.
+ * DupLambdaInternalRep, FreeLambdaInternalRep, SetLambdaFromAny --
  *
- * Side effects:
- *  Calls panic, since we can't set the value of the object from a string
- *  representation (or any other internal ones).
+ *	How to manage the internal representations of lambda term objects.
+ *	Syntactically they look like a two- or three-element list, where the
+ *	first element is the formal arguments, the second is the the body, and
+ *	the (optional) third is the namespace to execute the lambda term
+ *	within (the global namespace is assumed if it is absent).
  *
  *----------------------------------------------------------------------
  */
 
+static void
+DupLambdaInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
+{
+    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
+
+    copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+    copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+
+    procPtr->refCount++;
+    Tcl_IncrRefCount(nsObjPtr);
+    copyPtr->typePtr = &lambdaType;
+}
+
+static void
+FreeLambdaInternalRep(
+    register Tcl_Obj *objPtr)	/* CmdName object with internal representation
+				 * to free. */
+{
+    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
+
+    procPtr->refCount--;
+    if (procPtr->refCount == 0) {
+	TclProcCleanupProc(procPtr);
+    }
+    TclDecrRefCount(nsObjPtr);
+    objPtr->typePtr = NULL;
+}
+
 static int
-ProcBodySetFromAny(interp, objPtr)
-    Tcl_Interp *interp;			/* current interpreter */
-    Tcl_Obj *objPtr;			/* object pointer */
+SetLambdaFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
-    panic("called ProcBodySetFromAny");
+    Interp *iPtr = (Interp *) interp;
+    char *name;
+    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
+    int isNew, objc, result;
+    CmdFrame *cfPtr = NULL;
+    Proc *procPtr;
+
+    if (interp == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Convert objPtr to list type first; if it cannot be converted, or if its
+     * length is not 2, then it cannot be converted to lambdaType.
+     */
+
+    result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
+    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
+	TclNewLiteralStringObj(errPtr, "can't interpret \"");
+	Tcl_AppendObjToObj(errPtr, objPtr);
+	Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
+	Tcl_SetObjResult(interp, errPtr);
+	return TCL_ERROR;
+    }
+
+    argsPtr = objv[0];
+    bodyPtr = objv[1];
+
+    /*
+     * Create and initialize the Proc struct. The cmdPtr field is set to NULL
+     * to signal that this is an anonymous function.
+     */
+
+    name = TclGetString(objPtr);
+
+    if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr,
+	    &procPtr) != TCL_OK) {
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (parsing lambda expression \"%s\")", name));
+	return TCL_ERROR;
+    }
+
+    /*
+     * CAREFUL: TclCreateProc returns refCount==1! [Bug 1578454]
+     * procPtr->refCount = 1;
+     */
+
+    procPtr->cmdPtr = NULL;
+
+    /*
+     * TIP #280: Remember the line the apply body is starting on. In a Byte
+     * code context we ask the engine to provide us with the necessary
+     * information. This is for the initialization of the byte code compiler
+     * when the body is used for the first time.
+     *
+     * NOTE: The body is the second word in the 'objPtr'. Its location,
+     * accessible through 'context.line[1]' (see below) is therefore only the
+     * first approximation of the actual line the body is on. We have to use
+     * the string rep of the 'objPtr' to determine the exact line. This is
+     * available already through 'name'. Use 'TclListLines', see 'switch'
+     * (tclCmdMZ.c).
+     *
+     * This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see
+     * this file. The differences are the different index of the body in the
+     * line array of the context, and the special processing mentioned in the
+     * previous paragraph to track into the list. Find a way to factor the
+     * common elements into a single function.
+     */
+
+    if (iPtr->cmdFramePtr) {
+	CmdFrame *contextPtr;
+
+	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+	*contextPtr = *iPtr->cmdFramePtr;
+
+	if (contextPtr->type == TCL_LOCATION_BC) {
+	    /*
+	     * Retrieve the source context from the bytecode. This call
+	     * accounts for the reference to the source file, if any, held in
+	     * 'context.data.eval.path'.
+	     */
+
+	    TclGetSrcInfoForPc(contextPtr);
+	} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * We created a new reference to the source file path name when we
+	     * created 'context' above. Account for the reference.
+	     */
+
+	    Tcl_IncrRefCount(contextPtr->data.eval.path);
+
+	}
+
+	if (contextPtr->type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * We can record source location within a lambda only if the body
+	     * was not created by substitution.
+	     */
+
+	    if (contextPtr->line
+		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
+		int buf[2];
+
+		/*
+		 * Move from approximation (line of list cmd word) to actual
+		 * location (line of 2nd list element).
+		 */
+
+		cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
+
+		cfPtr->level = -1;
+		cfPtr->type = contextPtr->type;
+		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line[0] = buf[1];
+		cfPtr->nline = 1;
+		cfPtr->framePtr = NULL;
+		cfPtr->nextPtr = NULL;
+
+		cfPtr->data.eval.path = contextPtr->data.eval.path;
+		Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+		cfPtr->cmd.str.cmd = NULL;
+		cfPtr->cmd.str.len = 0;
+	    }
+
+	    /*
+	     * 'contextPtr' is going out of scope. Release the reference that
+	     * it's holding to the source file path
+	     */
+
+	    Tcl_DecrRefCount(contextPtr->data.eval.path);
+	}
+	TclStackFree(interp, contextPtr);
+    }
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr,
+	    &isNew), cfPtr);
+
+    /*
+     * Set the namespace for this lambda: given by objv[2] understood as a
+     * global reference, or else global per default.
+     */
+
+    if (objc == 2) {
+	TclNewLiteralStringObj(nsObjPtr, "::");
+    } else {
+	char *nsName = TclGetString(objv[2]);
+
+	if ((*nsName != ':') || (*(nsName+1) != ':')) {
+	    TclNewLiteralStringObj(nsObjPtr, "::");
+	    Tcl_AppendObjToObj(nsObjPtr, objv[2]);
+	} else {
+	    nsObjPtr = objv[2];
+	}
+    }
+
+    Tcl_IncrRefCount(nsObjPtr);
 
     /*
-     * this to keep compilers happy.
+     * Free the list internalrep of objPtr - this will free argsPtr, but
+     * bodyPtr retains a reference from the Proc structure. Then finish the
+     * conversion to lambdaType.
      */
 
+    objPtr->typePtr->freeIntRepProc(objPtr);
+
+    objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+    objPtr->typePtr = &lambdaType;
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ProcBodyUpdateString --
+ * Tcl_ApplyObjCmd --
  *
- *  Tcl_ObjType's UpdateString function for the proc body object.
- *  Calls panic.
+ *	This object-based function is invoked to process the "apply" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *  None.
+ *	A standard Tcl object result value.
  *
  * Side effects:
- *  Calls panic, since we this type has no string representation.
+ *	Depends on the content of the lambda term (i.e., objv[1]).
  *
  *----------------------------------------------------------------------
  */
 
-static void
-ProcBodyUpdateString(objPtr)
-    Tcl_Obj *objPtr;		/* the object to update */
+int
+Tcl_ApplyObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    panic("called ProcBodyUpdateString");
-}
+    Interp *iPtr = (Interp *) interp;
+    Proc *procPtr = NULL;
+    Tcl_Obj *lambdaPtr, *nsObjPtr;
+    int result, isRootEnsemble;
+    Command cmd;
+    Tcl_Namespace *nsPtr;
+    ExtraFrameInfo efi;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set lambdaPtr, convert it to lambdaType in the current interp if
+     * necessary.
+     */
+
+    lambdaPtr = objv[1];
+    if (lambdaPtr->typePtr == &lambdaType) {
+	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+    }
+
+#define JOE_EXTENSION 0
+#if JOE_EXTENSION
+    else {
+	/*
+	 * Joe English's suggestion to allow cmdNames to function as lambdas.
+	 * Also requires making tclCmdNameType non-static in tclObj.c
+	 */
+
+	Tcl_Obj *elemPtr;
+	int numElem;
+
+	if ((lambdaPtr->typePtr == &tclCmdNameType) ||
+		(TclListObjGetElements(interp, lambdaPtr, &numElem,
+		&elemPtr) == TCL_OK && numElem == 1)) {
+	    return Tcl_EvalObjv(interp, objc-1, objv+1, 0);
+	}
+    }
+#endif
+
+    if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
+	result = SetLambdaFromAny(interp, lambdaPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+    }
 
+    memset(&cmd, 0, sizeof(Command));
+    procPtr->cmdPtr = &cmd;
 
+    /*
+     * TIP#280 (semi-)HACK!
+     *
+     * Using cmd.clientData to tell [info frame] how to render the
+     * 'lambdaPtr'. The InfoFrameCmd will detect this case by testing cmd.hPtr
+     * for NULL. This condition holds here because of the 'memset' above, and
+     * nowhere else (in the core). Regular commands always have a valid
+     * 'hPtr', and lambda's never.
+     */
+
+    efi.length = 1;
+    efi.fields[0].name = "lambda";
+    efi.fields[0].proc = NULL;
+    efi.fields[0].clientData = lambdaPtr;
+    cmd.clientData = &efi;
+
+    /*
+     * Find the namespace where this lambda should run, and push a call frame
+     * for that namespace. Note that TclObjInterpProc() will pop it.
+     */
+
+    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
+    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    cmd.nsPtr = (Namespace *) nsPtr;
+
+    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = 1;
+	iPtr->ensembleRewrite.numInsertedObjs = 0;
+    } else {
+	iPtr->ensembleRewrite.numInsertedObjs -= 1;
+    }
+
+    result = PushProcCallFrame((ClientData) procPtr, interp, objc, objv, 1);
+    if (result == TCL_OK) {
+	result = TclObjInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
+    }
+
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = NULL;
+	iPtr->ensembleRewrite.numRemovedObjs = 0;
+	iPtr->ensembleRewrite.numInsertedObjs = 0;
+    }
+
+    return result;
+}
+
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileNoOp --
+ * MakeLambdaError --
  *
- *	Procedure called to compile noOp's
+ *	Function called by TclObjInterpProc to create the stack information
+ *	upon an error from a lambda term.
  *
  * Results:
- *	The return value is TCL_OK, indicating successful compilation.
+ *	The interpreter's error info trace is set to a value that supplements
+ *	the error code.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute a noOp at runtime.
+ *	none.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TclCompileNoOp(interp, parsePtr, envPtr)
-    Tcl_Interp *interp;         /* Used for error reporting. */
-    Tcl_Parse *parsePtr;        /* Points to a parse structure for the
-                                 * command created by Tcl_ParseCommand. */
-    CompileEnv *envPtr;         /* Holds resulting instructions. */
+static void
+MakeLambdaError(
+    Tcl_Interp *interp,		/* The interpreter in which the procedure was
+				 * called. */
+    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
+				 * messages and trace information. */
+{
+    int overflow, limit = 60, nameLen;
+    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
+
+    overflow = (nameLen > limit);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (lambda term \"%.*s%s\" line %d)",
+	    (overflow ? limit : nameLen), procName,
+	    (overflow ? "..." : ""), interp->errorLine));
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DisassembleObjCmd --
+ *
+ *	Implementation of the "::tcl::unsupported::disassemble" command. This
+ *	command is not documented, but will disassemble procedures, lambda
+ *	terms and general scripts. Note that will compile terms if necessary
+ *	in order to disassemble them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DisassembleObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    Tcl_Token *tokenPtr;
-    int i, code;
-    int savedStackDepth = envPtr->currStackDepth;
-
-    tokenPtr = parsePtr->tokenPtr;
-    for(i = 1; i < parsePtr->numWords; i++) {
-	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
-	envPtr->currStackDepth = savedStackDepth;
-
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    code = TclCompileTokens(interp, tokenPtr+1,
-	            tokenPtr->numComponents, envPtr);
-	    if (code != TCL_OK) {
-		return code;
+    static const char *types[] = {
+	"lambda", "proc", "script", NULL
+    };
+    enum Types {
+	DISAS_LAMBDA, DISAS_PROC, DISAS_SCRIPT
+    };
+    int idx, result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "type procName|lambdaTerm|script");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+	return TCL_ERROR;
+    }
+
+    switch ((enum Types) idx) {
+    case DISAS_LAMBDA: {
+	Proc *procPtr = NULL;
+	Command cmd;
+	Tcl_Obj *nsObjPtr;
+	Tcl_Namespace *nsPtr;
+
+	/*
+	 * Compile (if uncompiled) and disassemble a lambda term.
+	 */
+
+	if (objv[2]->typePtr == &lambdaType) {
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+	}
+	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+	    result = SetLambdaFromAny(interp, objv[2]);
+	    if (result != TCL_OK) {
+		return result;
 	    }
-	    TclEmitOpcode(INST_POP, envPtr);
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
 	}
+
+	memset(&cmd, 0, sizeof(Command));
+	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	cmd.nsPtr = (Namespace *) nsPtr;
+	procPtr->cmdPtr = &cmd;
+	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	TclPopStackFrame(interp);
+	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
+		& TCL_BYTECODE_PRECOMPILED) {
+	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
+		    NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
+	break;
+    }
+    case DISAS_PROC: {
+	Proc *procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+
+	if (procPtr == NULL) {
+	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
+		    "\" isn't a procedure", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Compile (if uncompiled) and disassemble a procedure.
+	 */
+
+	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	TclPopStackFrame(interp);
+	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
+		& TCL_BYTECODE_PRECOMPILED) {
+	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
+		    NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
+	break;
+    }
+    case DISAS_SCRIPT:
+	/*
+	 * Compile and disassemble a script.
+	 */
+
+	if (objv[2]->typePtr != &tclByteCodeType) {
+	    if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
+		return TCL_ERROR;
+	    }
+	}
+	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(objv[2]));
+	break;
     }
-    envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
     return TCL_OK;
 }
 
@@ -2003,4 +2912,3 @@ TclCompileNoOp(interp, parsePtr, envPtr)
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index c161d69..dac6aba 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -1,24 +1,23 @@
-/* 
+/*
  * tclRegexp.c --
  *
- *	This file contains the public interfaces to the Tcl regular
- *	expression mechanism.
+ *	This file contains the public interfaces to the Tcl regular expression
+ *	mechanism.
  *
  * Copyright (c) 1998 by Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 #include "tclRegexp.h"
 
 /*
  *----------------------------------------------------------------------
- * The routines in this file use Henry Spencer's regular expression
- * package contained in the following additional source files:
+ * The routines in this file use Henry Spencer's regular expression package
+ * contained in the following additional source files:
  *
  *	regc_color.c	regc_cvec.c	regc_lex.c
  *	regc_nfa.c	regcomp.c	regcustom.h
@@ -27,23 +26,23 @@
  *	regfronts.c	regguts.h
  *
  * Copyright (c) 1998 Henry Spencer.  All rights reserved.
- * 
+ *
  * Development of this software was funded, in part, by Cray Research Inc.,
  * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
- * Corporation, none of whom are responsible for the results.  The author
- * thanks all of them. 
- * 
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
  * Redistribution and use in source and binary forms -- with or without
  * modification -- are permitted for any purpose, provided that
  * redistributions in source form retain this entire copyright notice and
  * indicate the origin and nature of any modifications.
- * 
- * I'd appreciate being given credit for this package in the documentation
- * of software which uses it, but that is not a requirement.
- * 
+ *
+ * I'd appreciate being given credit for this package in the documentation of
+ * software which uses it, but that is not a requirement.
+ *
  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
- * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
  * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
@@ -67,15 +66,14 @@
 
 typedef struct ThreadSpecificData {
     int initialized;		/* Set to 1 when the module is initialized. */
-    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
-				 * regular expression patterns.	 NULL
-				 * means that this slot isn't used.
-				 * Malloc-ed. */
+    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
+				 * expression patterns. NULL means that this
+				 * slot isn't used. Malloc-ed. */
     int patLengths[NUM_REGEXPS];/* Number of non-null characters in
-				 * corresponding entry in patterns.
-				 * -1 means entry isn't used. */
+				 * corresponding entry in patterns. -1 means
+				 * entry isn't used. */
     struct TclRegexp *regexps[NUM_REGEXPS];
-				/* Compiled forms of above strings.  Also
+				/* Compiled forms of above strings. Also
 				 * malloc-ed, or NULL if not in use yet. */
 } ThreadSpecificData;
 
@@ -85,49 +83,46 @@ static Tcl_ThreadDataKey dataKey;
  * Declarations for functions used only in this file.
  */
 
-static TclRegexp *	CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *pattern, int length, int flags));
-static void		DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr));
-static void		FinalizeRegexp _ANSI_ARGS_((ClientData clientData));
-static void		FreeRegexp _ANSI_ARGS_((TclRegexp *regexpPtr));
-static void		FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int		RegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_RegExp re, CONST Tcl_UniChar *uniString,
-			    int numChars, int nmatches, int flags));
-static int		SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
+static TclRegexp *	CompileRegexp(Tcl_Interp *interp, const char *pattern,
+			    int length, int flags);
+static void		DupRegexpInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
+static void		FinalizeRegexp(ClientData clientData);
+static void		FreeRegexp(TclRegexp *regexpPtr);
+static void		FreeRegexpInternalRep(Tcl_Obj *objPtr);
+static int		RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
+			    const Tcl_UniChar *uniString, int numChars,
+			    int nmatches, int flags);
+static int		SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
- * The regular expression Tcl object type.  This serves as a cache
- * of the compiled form of the regular expression.
+ * The regular expression Tcl object type. This serves as a cache of the
+ * compiled form of the regular expression.
  */
 
-static Tcl_ObjType tclRegexpType = {
+Tcl_ObjType tclRegexpType = {
     "regexp",				/* name */
     FreeRegexpInternalRep,		/* freeIntRepProc */
     DupRegexpInternalRep,		/* dupIntRepProc */
     NULL,				/* updateStringProc */
     SetRegexpFromAny			/* setFromAnyProc */
 };
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_RegExpCompile --
  *
- *	Compile a regular expression into a form suitable for fast
- *	matching.  This procedure is DEPRECATED in favor of the
- *	object version of the command.
+ *	Compile a regular expression into a form suitable for fast matching.
+ *	This function is DEPRECATED in favor of the object version of the
+ *	command.
  *
  * Results:
- *	The return value is a pointer to the compiled form of string,
- *	suitable for passing to Tcl_RegExpExec.  This compiled form
- *	is only valid up until the next call to this procedure, so
- *	don't keep these around for a long time!  If an error occurred
- *	while compiling the pattern, then NULL is returned and an error
- *	message is left in the interp's result.
+ *	The return value is a pointer to the compiled form of string, suitable
+ *	for passing to Tcl_RegExpExec. This compiled form is only valid up
+ *	until the next call to this function, so don't keep these around for a
+ *	long time! If an error occurred while compiling the pattern, then NULL
+ *	is returned and an error message is left in the interp's result.
  *
  * Side effects:
  *	Updates the cache of compiled regexps.
@@ -136,13 +131,13 @@ static Tcl_ObjType tclRegexpType = {
  */
 
 Tcl_RegExp
-Tcl_RegExpCompile(interp, string)
-    Tcl_Interp *interp;		/* For use in error reporting and
-				 * to access the interp regexp cache. */
-    CONST char *string;		/* String for which to produce
-				 * compiled regular expression. */
+Tcl_RegExpCompile(
+    Tcl_Interp *interp,		/* For use in error reporting and to access
+				 * the interp regexp cache. */
+    const char *pattern)	/* String for which to produce compiled
+				 * regular expression. */
 {
-    return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),
+    return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern),
 	    REG_ADVANCED);
 }
 
@@ -151,15 +146,14 @@ Tcl_RegExpCompile(interp, string)
  *
  * Tcl_RegExpExec --
  *
- *	Execute the regular expression matcher using a compiled form
- *	of a regular expression and save information about any match
- *	that is found.
+ *	Execute the regular expression matcher using a compiled form of a
+ *	regular expression and save information about any match that is found.
  *
  * Results:
- *	If an error occurs during the matching operation then -1
- *	is returned and the interp's result contains an error message.
- *	Otherwise the return value is 1 if a matching range is
- *	found and 0 if there is no matching range.
+ *	If an error occurs during the matching operation then -1 is returned
+ *	and the interp's result contains an error message. Otherwise the
+ *	return value is 1 if a matching range is found and 0 if there is no
+ *	matching range.
  *
  * Side effects:
  *	None.
@@ -168,27 +162,27 @@ Tcl_RegExpCompile(interp, string)
  */
 
 int
-Tcl_RegExpExec(interp, re, string, start)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    Tcl_RegExp re;		/* Compiled regular expression;  must have
-				 * been returned by previous call to
+Tcl_RegExpExec(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
+    Tcl_RegExp re,		/* Compiled regular expression; must have been
+				 * returned by previous call to
 				 * Tcl_GetRegExpFromObj. */
-    CONST char *string;		/* String against which to match re. */
-    CONST char *start;		/* If string is part of a larger string,
-				 * this identifies beginning of larger
-				 * string, so that "^" won't match. */
+    const char *text,		/* Text against which to match re. */
+    const char *start)		/* If text is part of a larger string, this
+				 * identifies beginning of larger string, so
+				 * that "^" won't match. */
 {
     int flags, result, numChars;
     TclRegexp *regexp = (TclRegexp *)re;
     Tcl_DString ds;
-    CONST Tcl_UniChar *ustr;
+    const Tcl_UniChar *ustr;
 
     /*
-     * If the starting point is offset from the beginning of the buffer,
-     * then we need to tell the regexp engine not to match "^".
+     * If the starting point is offset from the beginning of the buffer, then
+     * we need to tell the regexp engine not to match "^".
      */
 
-    if (string > start) {
+    if (text > start) {
 	flags = REG_NOTBOL;
     } else {
 	flags = 0;
@@ -198,7 +192,7 @@ Tcl_RegExpExec(interp, re, string, start)
      * Remember the string for use by Tcl_RegExpRange().
      */
 
-    regexp->string = string;
+    regexp->string = text;
     regexp->objPtr = NULL;
 
     /*
@@ -206,10 +200,10 @@ Tcl_RegExpExec(interp, re, string, start)
      */
 
     Tcl_DStringInit(&ds);
-    ustr = Tcl_UtfToUniCharDString(string, -1, &ds);
+    ustr = Tcl_UtfToUniCharDString(text, -1, &ds);
     numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar);
-    result = RegExpExecUniChar(interp, re, ustr, numChars,
-	    -1 /* nmatches */, flags);
+    result = RegExpExecUniChar(interp, re, ustr, numChars, -1 /* nmatches */,
+	    flags);
     Tcl_DStringFree(&ds);
 
     return result;
@@ -225,7 +219,7 @@ Tcl_RegExpExec(interp, re, string, start)
  *
  * Results:
  *	The variables at *startPtr and *endPtr are modified to hold the
- *	addresses of the endpoints of the range given by index.  If the
+ *	addresses of the endpoints of the range given by index. If the
  *	specified range doesn't exist then NULLs are returned.
  *
  * Side effects:
@@ -235,19 +229,19 @@ Tcl_RegExpExec(interp, re, string, start)
  */
 
 void
-Tcl_RegExpRange(re, index, startPtr, endPtr)
-    Tcl_RegExp re;		/* Compiled regular expression that has
-				 * been passed to Tcl_RegExpExec. */
-    int index;			/* 0 means give the range of the entire
-				 * match, > 0 means give the range of
-				 * a matching subrange. */
-    CONST char **startPtr;	/* Store address of first character in
-				 * (sub-) range here. */
-    CONST char **endPtr;	/* Store address of character just after last
-				 * in (sub-) range here. */
+Tcl_RegExpRange(
+    Tcl_RegExp re,		/* Compiled regular expression that has been
+				 * passed to Tcl_RegExpExec. */
+    int index,			/* 0 means give the range of the entire match,
+				 * > 0 means give the range of a matching
+				 * subrange. */
+    const char **startPtr,	/* Store address of first character in
+				 * (sub-)range here. */
+    const char **endPtr)	/* Store address of character just after last
+				 * in (sub-)range here. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) re;
-    CONST char *string;
+    const char *string;
 
     if ((size_t) index > regexpPtr->re.re_nsub) {
 	*startPtr = *endPtr = NULL;
@@ -255,7 +249,7 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
 	*startPtr = *endPtr = NULL;
     } else {
 	if (regexpPtr->objPtr) {
-	    string = Tcl_GetString(regexpPtr->objPtr);
+	    string = TclGetString(regexpPtr->objPtr);
 	} else {
 	    string = regexpPtr->string;
 	}
@@ -270,14 +264,13 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
  * RegExpExecUniChar --
  *
  *	Execute the regular expression matcher using a compiled form of a
- *	regular expression and save information about any match that is
- *	found.
+ *	regular expression and save information about any match that is found.
  *
  * Results:
- *	If an error occurs during the matching operation then -1 is
- *	returned and an error message is left in interp's result.
- *	Otherwise the return value is 1 if a matching range was found or
- *	0 if there was no matching range.
+ *	If an error occurs during the matching operation then -1 is returned
+ *	and an error message is left in interp's result. Otherwise the return
+ *	value is 1 if a matching range was found or 0 if there was no matching
+ *	range.
  *
  * Side effects:
  *	None.
@@ -286,17 +279,17 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
  */
 
 static int
-RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    Tcl_RegExp re;		/* Compiled regular expression; returned by
-				 * a previous call to Tcl_GetRegExpFromObj */
-    CONST Tcl_UniChar *wString;	/* String against which to match re. */
-    int numChars;		/* Length of Tcl_UniChar string (must
-				 * be >= 0). */
-    int nmatches;		/* How many subexpression matches (counting
-				 * the whole match as subexpression 0) are
-				 * of interest.  -1 means "don't know". */
-    int flags;			/* Regular expression flags. */
+RegExpExecUniChar(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
+    Tcl_RegExp re,		/* Compiled regular expression; returned by a
+				 * previous call to Tcl_GetRegExpFromObj */
+    const Tcl_UniChar *wString,	/* String against which to match re. */
+    int numChars,		/* Length of Tcl_UniChar string (must be
+				 * >=0). */
+    int nmatches,		/* How many subexpression matches (counting
+				 * the whole match as subexpression 0) are of
+				 * interest. -1 means "don't know". */
+    int flags)			/* Regular expression flags. */
 {
     int status;
     TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -338,8 +331,8 @@ RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
  *
  * Results:
  *	The variables at *startPtr and *endPtr are modified to hold the
- *	offsets of the endpoints of the range given by index.  If the
- *	specified range doesn't exist then -1s are supplied.
+ *	offsets of the endpoints of the range given by index. If the specified
+ *	range doesn't exist then -1s are supplied.
  *
  * Side effects:
  *	None.
@@ -348,17 +341,17 @@ RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
  */
 
 void
-TclRegExpRangeUniChar(re, index, startPtr, endPtr)
-    Tcl_RegExp re;		/* Compiled regular expression that has
-				 * been passed to Tcl_RegExpExec. */
-    int index;			/* 0 means give the range of the entire
-				 * match, > 0 means give the range of
-				 * a matching subrange, -1 means the
-				 * range of the rm_extend field. */
-    int *startPtr;		/* Store address of first character in
-				 * (sub-) range here. */
-    int *endPtr;		/* Store address of character just after last
-				 * in (sub-) range here. */
+TclRegExpRangeUniChar(
+    Tcl_RegExp re,		/* Compiled regular expression that has been
+				 * passed to Tcl_RegExpExec. */
+    int index,			/* 0 means give the range of the entire match,
+				 * > 0 means give the range of a matching
+				 * subrange, -1 means the range of the
+				 * rm_extend field. */
+    int *startPtr,		/* Store address of first character in
+				 * (sub-)range here. */
+    int *endPtr)		/* Store address of character just after last
+				 * in (sub-)range here. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) re;
 
@@ -382,10 +375,9 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr)
  *	See if a string matches a regular expression.
  *
  * Results:
- *	If an error occurs during the matching operation then -1
- *	is returned and the interp's result contains an error message.
- *	Otherwise the return value is 1 if "string" matches "pattern"
- *	and 0 otherwise.
+ *	If an error occurs during the matching operation then -1 is returned
+ *	and the interp's result contains an error message. Otherwise the
+ *	return value is 1 if "text" matches "pattern" and 0 otherwise.
  *
  * Side effects:
  *	None.
@@ -394,11 +386,10 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr)
  */
 
 int
-Tcl_RegExpMatch(interp, string, pattern)
-    Tcl_Interp *interp;		/* Used for error reporting. May be NULL. */
-    CONST char *string;		/* String. */
-    CONST char *pattern;	/* Regular expression to match against
-				 * string. */
+Tcl_RegExpMatch(
+    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
+    const char *text,		/* Text to search for pattern matches. */
+    const char *pattern)	/* Regular expression to match against text. */
 {
     Tcl_RegExp re;
 
@@ -406,7 +397,7 @@ Tcl_RegExpMatch(interp, string, pattern)
     if (re == NULL) {
 	return -1;
     }
-    return Tcl_RegExpExec(interp, re, string, string);
+    return Tcl_RegExpExec(interp, re, text, text);
 }
 
 /*
@@ -417,10 +408,9 @@ Tcl_RegExpMatch(interp, string, pattern)
  *	Execute a precompiled regexp against the given object.
  *
  * Results:
- *	If an error occurs during the matching operation then -1
- *	is returned and the interp's result contains an error message.
- *	Otherwise the return value is 1 if "string" matches "pattern"
- *	and 0 otherwise.
+ *	If an error occurs during the matching operation then -1 is returned
+ *	and the interp's result contains an error message. Otherwise the
+ *	return value is 1 if "string" matches "pattern" and 0 otherwise.
  *
  * Side effects:
  *	Converts the object to a Unicode object.
@@ -429,38 +419,59 @@ Tcl_RegExpMatch(interp, string, pattern)
  */
 
 int
-Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
-    Tcl_RegExp re;		/* Compiled regular expression;  must have
-				 * been returned by previous call to
+Tcl_RegExpExecObj(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
+    Tcl_RegExp re,		/* Compiled regular expression; must have been
+				 * returned by previous call to
 				 * Tcl_GetRegExpFromObj. */
-    Tcl_Obj *objPtr;		/* String against which to match re. */
-    int offset;			/* Character index that marks where matching
+    Tcl_Obj *textObj,		/* Text against which to match re. */
+    int offset,			/* Character index that marks where matching
 				 * should begin. */
-    int nmatches;		/* How many subexpression matches (counting
-				 * the whole match as subexpression 0) are
-				 * of interest.  -1 means all of them. */
-    int flags;			/* Regular expression execution flags. */
+    int nmatches,		/* How many subexpression matches (counting
+				 * the whole match as subexpression 0) are of
+				 * interest. -1 means all of them. */
+    int flags)			/* Regular expression execution flags. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) re;
     Tcl_UniChar *udata;
     int length;
+    int reflags = regexpPtr->flags;
+#define TCL_REG_GLOBOK_FLAGS (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
+
+    /*
+     * Take advantage of the equivalent glob pattern, if one exists.
+     * This is possible based only on the right mix of incoming flags (0)
+     * and regexp compile flags.
+     */
+    if ((offset == 0) && (nmatches == 0) && (flags == 0)
+	    && !(reflags & ~TCL_REG_GLOBOK_FLAGS)
+	    && (regexpPtr->globObjPtr != NULL)) {
+	int nocase = (reflags & TCL_REG_NOCASE) ? TCL_MATCH_NOCASE : 0;
+
+	/*
+	 * Pass to TclStringMatchObj for obj-specific handling.
+	 * XXX: Currently doesn't take advantage of exact-ness that
+	 * XXX: TclReToGlob tells us about
+	 */
+
+	return TclStringMatchObj(textObj, regexpPtr->globObjPtr, nocase);
+    }
 
     /*
      * Save the target object so we can extract strings from it later.
      */
 
     regexpPtr->string = NULL;
-    regexpPtr->objPtr = objPtr;
+    regexpPtr->objPtr = textObj;
 
-    udata = Tcl_GetUnicodeFromObj(objPtr, &length);
+    udata = Tcl_GetUnicodeFromObj(textObj, &length);
 
     if (offset > length) {
 	offset = length;
     }
     udata += offset;
     length -= offset;
-    
+
     return RegExpExecUniChar(interp, re, udata, length, nmatches, flags);
 }
 
@@ -472,10 +483,9 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags)
  *	See if an object matches a regular expression.
  *
  * Results:
- *	If an error occurs during the matching operation then -1
- *	is returned and the interp's result contains an error message.
- *	Otherwise the return value is 1 if "string" matches "pattern"
- *	and 0 otherwise.
+ *	If an error occurs during the matching operation then -1 is returned
+ *	and the interp's result contains an error message. Otherwise the
+ *	return value is 1 if "text" matches "pattern" and 0 otherwise.
  *
  * Side effects:
  *	Changes the internal rep of the pattern and string objects.
@@ -484,10 +494,10 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags)
  */
 
 int
-Tcl_RegExpMatchObj(interp, stringObj, patternObj)
-    Tcl_Interp *interp;		/* Used for error reporting. May be NULL. */
-    Tcl_Obj *stringObj;		/* Object containing the String to search. */
-    Tcl_Obj *patternObj;	/* Regular expression to match against
+Tcl_RegExpMatchObj(
+    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
+    Tcl_Obj *textObj,		/* Object containing the String to search. */
+    Tcl_Obj *patternObj)	/* Regular expression to match against
 				 * string. */
 {
     Tcl_RegExp re;
@@ -497,7 +507,7 @@ Tcl_RegExpMatchObj(interp, stringObj, patternObj)
     if (re == NULL) {
 	return -1;
     }
-    return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */,
+    return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
 	    0 /* nmatches */, 0 /* flags */);
 }
 
@@ -518,9 +528,9 @@ Tcl_RegExpMatchObj(interp, stringObj, patternObj)
  */
 
 void
-Tcl_RegExpGetInfo(regexp, infoPtr)
-    Tcl_RegExp regexp;		/* Pattern from which to get subexpressions. */
-    Tcl_RegExpInfo *infoPtr;	/* Match information is stored here.  */
+Tcl_RegExpGetInfo(
+    Tcl_RegExp regexp,		/* Pattern from which to get subexpressions. */
+    Tcl_RegExpInfo *infoPtr)	/* Match information is stored here. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) regexp;
 
@@ -534,14 +544,14 @@ Tcl_RegExpGetInfo(regexp, infoPtr)
  *
  * Tcl_GetRegExpFromObj --
  *
- *	Compile a regular expression into a form suitable for fast
- *	matching.  This procedure caches the result in a Tcl_Obj.
+ *	Compile a regular expression into a form suitable for fast matching.
+ *	This function caches the result in a Tcl_Obj.
  *
  * Results:
- *	The return value is a pointer to the compiled form of string,
- *	suitable for passing to Tcl_RegExpExec.  If an error occurred
- *	while compiling the pattern, then NULL is returned and an error
- *	message is left in the interp's result.
+ *	The return value is a pointer to the compiled form of string, suitable
+ *	for passing to Tcl_RegExpExec. If an error occurred while compiling
+ *	the pattern, then NULL is returned and an error message is left in the
+ *	interp's result.
  *
  * Side effects:
  *	Updates the native rep of the Tcl_Obj.
@@ -550,25 +560,28 @@ Tcl_RegExpGetInfo(regexp, infoPtr)
  */
 
 Tcl_RegExp
-Tcl_GetRegExpFromObj(interp, objPtr, flags)
-    Tcl_Interp *interp;		/* For use in error reporting, and to access
+Tcl_GetRegExpFromObj(
+    Tcl_Interp *interp,		/* For use in error reporting, and to access
 				 * the interp regexp cache. */
-    Tcl_Obj *objPtr;		/* Object whose string rep contains regular
-				 * expression pattern.  Internal rep will be
+    Tcl_Obj *objPtr,		/* Object whose string rep contains regular
+				 * expression pattern. Internal rep will be
 				 * changed to compiled form of this regular
 				 * expression. */
-    int flags;			/* Regular expression compilation flags. */
+    int flags)			/* Regular expression compilation flags. */
 {
     int length;
-    Tcl_ObjType *typePtr;
     TclRegexp *regexpPtr;
     char *pattern;
 
-    typePtr = objPtr->typePtr;
-    regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+    /*
+     * This is OK because we only actually interpret this value properly as a
+     * TclRegexp* when the type is tclRegexpType.
+     */
+
+    regexpPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;
 
-    if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
-	pattern = Tcl_GetStringFromObj(objPtr, &length);
+    if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+	pattern = TclGetStringFromObj(objPtr, &length);
 
 	regexpPtr = CompileRegexp(interp, pattern, length, flags);
 	if (regexpPtr == NULL) {
@@ -577,7 +590,7 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
 
 	/*
 	 * Add a reference to the regexp so it will persist even if it is
-	 * pushed out of the current thread's regexp cache.  This reference
+	 * pushed out of the current thread's regexp cache. This reference
 	 * will be removed when the object's internal rep is freed.
 	 */
 
@@ -587,10 +600,8 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
 	 * Free the old representation and set our type.
 	 */
 
-	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	    (*typePtr->freeIntRepProc)(objPtr);
-	}
-	objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
+	TclFreeIntRep(objPtr);
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) regexpPtr;
 	objPtr->typePtr = &tclRegexpType;
     }
     return (Tcl_RegExp) regexpPtr;
@@ -604,10 +615,10 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
  *	Return information about a compiled regular expression.
  *
  * Results:
- *	The return value is -1 for failure, 0 for success, although at
- *	the moment there's nothing that could fail.  On success, a list
- *	is left in the interp's result:  first element is the subexpression
- *	count, second is a list of re_info bit names.
+ *	The return value is -1 for failure, 0 for success, although at the
+ *	moment there's nothing that could fail. On success, a list is left in
+ *	the interp's result: first element is the subexpression count, second
+ *	is a list of re_info bit names.
  *
  * Side effects:
  *	None.
@@ -616,16 +627,16 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
  */
 
 int
-TclRegAbout(interp, re)
-    Tcl_Interp *interp;		/* For use in variable assignment. */
-    Tcl_RegExp re;		/* The compiled regular expression. */
+TclRegAbout(
+    Tcl_Interp *interp,		/* For use in variable assignment. */
+    Tcl_RegExp re)		/* The compiled regular expression. */
 {
-    TclRegexp *regexpPtr = (TclRegexp *)re;
-    char buf[TCL_INTEGER_SPACE];
-    static struct infoname {
+    TclRegexp *regexpPtr = (TclRegexp *) re;
+    struct infoname {
 	int bit;
-	char *text;
-    } infonames[] = {
+	const char *text;
+    };
+    static const struct infoname infonames[] = {
 	{REG_UBACKREF,		"REG_UBACKREF"},
 	{REG_ULOOKAHEAD,	"REG_ULOOKAHEAD"},
 	{REG_UBOUNDS,		"REG_UBOUNDS"},
@@ -640,37 +651,40 @@ TclRegAbout(interp, re)
 	{REG_UEMPTYMATCH,	"REG_UEMPTYMATCH"},
 	{REG_UIMPOSSIBLE,	"REG_UIMPOSSIBLE"},
 	{REG_USHORTEST,		"REG_USHORTEST"},
-	{0,			""}
+	{0,			NULL}
     };
-    struct infoname *inf;
-    int n;
+    const struct infoname *inf;
+    Tcl_Obj *infoObj;
+
+    /*
+     * The reset here guarantees that the interpreter result is empty and
+     * unshared. This means that we can use Tcl_ListObjAppendElement on the
+     * result object quite safely.
+     */
 
     Tcl_ResetResult(interp);
 
-    sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));
-    Tcl_AppendElement(interp, buf);
+    /*
+     * Assume that there will never be more than INT_MAX subexpressions. This
+     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
+     * well and Tcl has other limits that constrain things as well...
+     */
+
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+	    Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
 
     /*
-     * Must count bits before generating list, because we must know
-     * whether {} are needed before we start appending names.
+     * Now append a list of all the bit-flags set for the RE.
      */
-    n = 0;
-    for (inf = infonames; inf->bit != 0; inf++) {
-	if (regexpPtr->re.re_info&inf->bit) {
-	    n++;
-	}
-    }
-    if (n != 1) {
-	Tcl_AppendResult(interp, " {", NULL);
-    }
-    for (inf = infonames; inf->bit != 0; inf++) {
-	if (regexpPtr->re.re_info&inf->bit) {
-	    Tcl_AppendElement(interp, inf->text);
+
+    TclNewObj(infoObj);
+    for (inf=infonames ; inf->bit != 0 ; inf++) {
+	if (regexpPtr->re.re_info & inf->bit) {
+	    Tcl_ListObjAppendElement(NULL, infoObj,
+		    Tcl_NewStringObj(inf->text, -1));
 	}
     }
-    if (n != 1) {
-	Tcl_AppendResult(interp, "}", NULL);
-    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), infoObj);
 
     return 0;
 }
@@ -692,26 +706,25 @@ TclRegAbout(interp, re)
  */
 
 void
-TclRegError(interp, msg, status)
-    Tcl_Interp *interp;		/* Interpreter for error reporting. */
-    CONST char *msg;		/* Message to prepend to error. */
-    int status;			/* Status code to report. */
+TclRegError(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    const char *msg,		/* Message to prepend to error. */
+    int status)			/* Status code to report. */
 {
     char buf[100];		/* ample in practice */
     char cbuf[100];		/* lots in practice */
     size_t n;
-    char *p;
+    const char *p;
 
     Tcl_ResetResult(interp);
-    n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
+    n = TclReError(status, NULL, buf, sizeof(buf));
     p = (n > sizeof(buf)) ? "..." : "";
     Tcl_AppendResult(interp, msg, buf, p, NULL);
 
     sprintf(cbuf, "%d", status);
-    (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));
+    (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
     Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -731,10 +744,10 @@ TclRegError(interp, msg, status)
  */
 
 static void
-FreeRegexpInternalRep(objPtr)
-    Tcl_Obj *objPtr;		/* Regexp object with internal rep to free. */
+FreeRegexpInternalRep(
+    Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
 {
-    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;
 
     /*
      * If this is the last reference to the regexp, free it.
@@ -743,6 +756,7 @@ FreeRegexpInternalRep(objPtr)
     if (--(regexpRepPtr->refCount) <= 0) {
 	FreeRegexp(regexpRepPtr);
     }
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -750,8 +764,8 @@ FreeRegexpInternalRep(objPtr)
  *
  * DupRegexpInternalRep --
  *
- *	We copy the reference to the compiled regexp and bump its
- *	reference count.
+ *	We copy the reference to the compiled regexp and bump its reference
+ *	count.
  *
  * Results:
  *	None.
@@ -763,13 +777,14 @@ FreeRegexpInternalRep(objPtr)
  */
 
 static void
-DupRegexpInternalRep(srcPtr, copyPtr)
-    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
+DupRegexpInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
+    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.twoPtrValue.ptr1;
+
     regexpPtr->refCount++;
-    copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
+    copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
     copyPtr->typePtr = &tclRegexpType;
 }
 
@@ -794,9 +809,9 @@ DupRegexpInternalRep(srcPtr, copyPtr)
  */
 
 static int
-SetRegexpFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr;		/* The object to convert. */
+SetRegexpFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
 {
     if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
 	return TCL_ERROR;
@@ -809,37 +824,36 @@ SetRegexpFromAny(interp, objPtr)
  *
  * CompileRegexp --
  *
- *	Attempt to compile the given regexp pattern.  If the compiled
- *	regular expression can be found in the per-thread cache, it
- *	will be used instead of compiling a new copy.
+ *	Attempt to compile the given regexp pattern. If the compiled regular
+ *	expression can be found in the per-thread cache, it will be used
+ *	instead of compiling a new copy.
  *
  * Results:
- *	The return value is a pointer to a newly allocated TclRegexp
- *	that represents the compiled pattern, or NULL if the pattern
- *	could not be compiled.  If NULL is returned, an error message is
- *	left in the interp's result.
+ *	The return value is a pointer to a newly allocated TclRegexp that
+ *	represents the compiled pattern, or NULL if the pattern could not be
+ *	compiled. If NULL is returned, an error message is left in the
+ *	interp's result.
  *
  * Side effects:
- *	The thread-local regexp cache is updated and a new TclRegexp may
- *	be allocated.
+ *	The thread-local regexp cache is updated and a new TclRegexp may be
+ *	allocated.
  *
  *----------------------------------------------------------------------
  */
 
 static TclRegexp *
-CompileRegexp(interp, string, length, flags)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    CONST char *string;		/* The regexp to compile (UTF-8). */
-    int length;			/* The length of the string in bytes. */
-    int flags;			/* Compilation flags. */
+CompileRegexp(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    const char *string,		/* The regexp to compile (UTF-8). */
+    int length,			/* The length of the string in bytes. */
+    int flags)			/* Compilation flags. */
 {
     TclRegexp *regexpPtr;
-    CONST Tcl_UniChar *uniString;
-    int numChars;
+    const Tcl_UniChar *uniString;
+    int numChars, status, i, exact;
     Tcl_DString stringBuf;
-    int status, i;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- 
+
     if (!tsdPtr->initialized) {
 	tsdPtr->initialized = 1;
 	Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
@@ -847,14 +861,14 @@ CompileRegexp(interp, string, length, flags)
 
     /*
      * This routine maintains a second-level regular expression cache in
-     * addition to the per-object regexp cache.  The per-thread cache is needed
+     * addition to the per-object regexp cache. The per-thread cache is needed
      * to handle the case where for various reasons the object is lost between
      * invocations of the regexp command, but the literal pattern is the same.
      */
 
     /*
-     * Check the per-thread compiled regexp cache.  We can only reuse
-     * a regexp if it has the same pattern and the same flags.
+     * Check the per-thread compiled regexp cache. We can only reuse a regexp
+     * if it has the same pattern and the same flags.
      */
 
     for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
@@ -862,8 +876,8 @@ CompileRegexp(interp, string, length, flags)
 		&& (tsdPtr->regexps[i]->flags == flags)
 		&& (strcmp(string, tsdPtr->patterns[i]) == 0)) {
 	    /*
-	     * Move the matched pattern to the first slot in the
-	     * cache and shift the other patterns down one position.
+	     * Move the matched pattern to the first slot in the cache and
+	     * shift the other patterns down one position.
 	     */
 
 	    if (i != 0) {
@@ -888,7 +902,7 @@ CompileRegexp(interp, string, length, flags)
     /*
      * This is a new expression, so compile it and add it to the cache.
      */
-    
+
     regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
     regexpPtr->objPtr = NULL;
     regexpPtr->string = NULL;
@@ -919,15 +933,29 @@ CompileRegexp(interp, string, length, flags)
 	ckfree((char *)regexpPtr);
 	if (interp) {
 	    TclRegError(interp,
-		    "couldn't compile regular expression pattern: ",
-		    status);
+		    "couldn't compile regular expression pattern: ", status);
 	}
 	return NULL;
     }
 
     /*
-     * Allocate enough space for all of the subexpressions, plus one
-     * extra for the entire pattern.
+     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
+     * is not possible, then globObjPtr will be NULL.  This is used by
+     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
+     */
+
+    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
+	regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf),
+		Tcl_DStringLength(&stringBuf));
+	Tcl_IncrRefCount(regexpPtr->globObjPtr);
+	Tcl_DStringFree(&stringBuf);
+    } else {
+	regexpPtr->globObjPtr = NULL;
+    }
+
+    /*
+     * Allocate enough space for all of the subexpressions, plus one extra for
+     * the entire pattern.
      */
 
     regexpPtr->matches = (regmatch_t *) ckalloc(
@@ -981,10 +1009,13 @@ CompileRegexp(interp, string, length, flags)
  */
 
 static void
-FreeRegexp(regexpPtr)
-    TclRegexp *regexpPtr;	/* Compiled regular expression to free. */
+FreeRegexp(
+    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
 {
     TclReFree(&regexpPtr->re);
+    if (regexpPtr->globObjPtr) {
+	TclDecrRefCount(regexpPtr->globObjPtr);
+    }
     if (regexpPtr->matches) {
 	ckfree((char *) regexpPtr->matches);
     }
@@ -996,8 +1027,7 @@ FreeRegexp(regexpPtr)
  *
  * FinalizeRegexp --
  *
- *	Release the storage associated with the per-thread regexp
- *	cache.
+ *	Release the storage associated with the per-thread regexp cache.
  *
  * Results:
  *	None.
@@ -1009,8 +1039,8 @@ FreeRegexp(regexpPtr)
  */
 
 static void
-FinalizeRegexp(clientData)
-    ClientData clientData;	/* Not used. */
+FinalizeRegexp(
+    ClientData clientData)	/* Not used. */
 {
     int i;
     TclRegexp *regexpPtr;
@@ -1030,3 +1060,11 @@ FinalizeRegexp(clientData)
      */
     tsdPtr->initialized = 0;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index f4c4cb6..8650776 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -1,14 +1,14 @@
-/* 
+/*
  * tclRegexp.h --
  *
- * 	This file contains definitions used internally by Henry
- *	Spencer's regular expression code.
+ *	This file contains definitions used internally by Henry Spencer's
+ *	regular expression code.
  *
  * Copyright (c) 1998 by Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #ifndef _TCLREGEXP
@@ -16,18 +16,12 @@
 
 #include "regex.h"
 
-#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
 /*
- * The TclRegexp structure encapsulates a compiled regex_t,
- * the flags that were used to compile it, and an array of pointers
- * that are used to indicate subexpressions after a call to Tcl_RegExpExec.
- * Note that the string and objPtr are mutually exclusive.  These values
- * are needed by Tcl_RegExpRange in order to return pointers into the
- * original string.
+ * The TclRegexp structure encapsulates a compiled regex_t, the flags that
+ * were used to compile it, and an array of pointers that are used to indicate
+ * subexpressions after a call to Tcl_RegExpExec. Note that the string and
+ * objPtr are mutually exclusive. These values are needed by Tcl_RegExpRange
+ * in order to return pointers into the original string.
  */
 
 typedef struct TclRegexp {
@@ -36,6 +30,7 @@ typedef struct TclRegexp {
 				 * subexpressions. */
     CONST char *string;		/* Last string passed to Tcl_RegExpExec. */
     Tcl_Obj *objPtr;		/* Last object passed to Tcl_RegExpExecObj. */
+    Tcl_Obj *globObjPtr;	/* Glob pattern rep of RE or NULL if none. */
     regmatch_t *matches;	/* Array of indices into the Tcl_UniChar
 				 * representation of the last string matched
 				 * with this regexp to indicate the location
@@ -47,3 +42,11 @@ typedef struct TclRegexp {
 } TclRegexp;
 
 #endif /* _TCLREGEXP */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index 4463436..8bb5e2b 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -1,111 +1,107 @@
 /*
  * tclResolve.c --
  *
- *      Contains hooks for customized command/variable name resolution
- *      schemes.  These hooks allow extensions like [incr Tcl] to add
- *      their own name resolution rules to the Tcl language.  Rules can
- *      be applied to a particular namespace, to the interpreter as a
- *      whole, or both.
+ *	Contains hooks for customized command/variable name resolution
+ *	schemes. These hooks allow extensions like [incr Tcl] to add their own
+ *	name resolution rules to the Tcl language. Rules can be applied to a
+ *	particular namespace, to the interpreter as a whole, or both.
  *
  * Copyright (c) 1998 Lucent Technologies, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * Declarations for procedures local to this file:
+ * Declarations for functions local to this file:
  */
 
-static void		BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
-
+static void		BumpCmdRefEpochs(Namespace *nsPtr);
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_AddInterpResolvers --
  *
- *	Adds a set of command/variable resolution procedures to an
- *	interpreter.  These procedures are consulted when commands
- *	are resolved in Tcl_FindCommand, and when variables are
- *	resolved in TclLookupVar and LookupCompiledLocal.  Each
- *	namespace may also have its own set of resolution procedures
- *	which take precedence over those for the interpreter.
+ *	Adds a set of command/variable resolution functions to an interpreter.
+ *	These functions are consulted when commands are resolved in
+ *	Tcl_FindCommand, and when variables are resolved in TclLookupVar and
+ *	LookupCompiledLocal. Each namespace may also have its own set of
+ *	resolution functions which take precedence over those for the
+ *	interpreter.
  *
- *	When a name is resolved, it is handled as follows.  First,
- *	the name is passed to the resolution procedures for the
- *	namespace.  If not resolved, the name is passed to each of
- *	the resolution procedures added to the interpreter.  Finally,
- *	if still not resolved, the name is handled using the default
- *	Tcl rules for name resolution.
+ *	When a name is resolved, it is handled as follows. First, the name is
+ *	passed to the resolution functions for the namespace. If not resolved,
+ *	the name is passed to each of the resolution functions added to the
+ *	interpreter. Finally, if still not resolved, the name is handled using
+ *	the default Tcl rules for name resolution.
  *
  * Results:
- *	Returns pointers to the current name resolution procedures
- *	in the cmdProcPtr, varProcPtr and compiledVarProcPtr
- *	arguments.
+ *	Returns pointers to the current name resolution functions in the
+ *	cmdProcPtr, varProcPtr and compiledVarProcPtr arguments.
  *
  * Side effects:
- *	If a compiledVarProc is specified, this procedure bumps the
- *	compileEpoch for the interpreter, forcing all code to be
- *	recompiled.  If a cmdProc is specified, this procedure bumps
- *	the cmdRefEpoch in all namespaces, forcing commands to be
- *	resolved again using the new rules.
+ *	If a compiledVarProc is specified, this function bumps the
+ *	compileEpoch for the interpreter, forcing all code to be recompiled.
+ *	If a cmdProc is specified, this function bumps the cmdRefEpoch in all
+ *	namespaces, forcing commands to be resolved again using the new rules.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
-
-    Tcl_Interp *interp;			/* Interpreter whose name resolution
-					 * rules are being modified. */
-    CONST char *name;			/* Name of this resolution scheme. */
-    Tcl_ResolveCmdProc *cmdProc;	/* New procedure for command
-					 * resolution */
-    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
-					 * at runtime */
-    Tcl_ResolveCompiledVarProc *compiledVarProc;
-					/* Procedure for variable resolution
-					 * at compile time. */
+Tcl_AddInterpResolvers(
+    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
+				 * being modified. */
+    CONST char *name,		/* Name of this resolution scheme. */
+    Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */
+    Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+				 * runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarProc)
+				/* Function for variable resolution at compile
+				 * time. */
 {
-    Interp *iPtr = (Interp*)interp;
+    Interp *iPtr = (Interp *) interp;
     ResolverScheme *resPtr;
 
     /*
-     *  Since we're adding a new name resolution scheme, we must force
-     *  all code to be recompiled to use the new scheme.  If there
-     *  are new compiled variable resolution rules, bump the compiler
-     *  epoch to invalidate compiled code.  If there are new command
-     *  resolution rules, bump the cmdRefEpoch in all namespaces.
+     * Since we're adding a new name resolution scheme, we must force all code
+     * to be recompiled to use the new scheme. If there are new compiled
+     * variable resolution rules, bump the compiler epoch to invalidate
+     * compiled code. If there are new command resolution rules, bump the
+     * cmdRefEpoch in all namespaces.
      */
+
     if (compiledVarProc) {
-        iPtr->compileEpoch++;
+	iPtr->compileEpoch++;
     }
     if (cmdProc) {
-        BumpCmdRefEpochs(iPtr->globalNsPtr);
+	BumpCmdRefEpochs(iPtr->globalNsPtr);
     }
 
     /*
-     *  Look for an existing scheme with the given name.  If found,
-     *  then replace its rules.
+     * Look for an existing scheme with the given name. If found, then replace
+     * its rules.
      */
-    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
-        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
-            resPtr->cmdResProc = cmdProc;
-            resPtr->varResProc = varProc;
-            resPtr->compiledVarResProc = compiledVarProc;
-            return;
-        }
+
+    for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) {
+	if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+	    resPtr->cmdResProc = cmdProc;
+	    resPtr->varResProc = varProc;
+	    resPtr->compiledVarResProc = compiledVarProc;
+	    return;
+	}
     }
 
     /*
-     *  Otherwise, this is a new scheme.  Add it to the FRONT
-     *  of the linked list, so that it overrides existing schemes.
+     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
+     * list, so that it overrides existing schemes.
      */
+
     resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
-    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
+    resPtr->name = (char *) ckalloc((unsigned)(strlen(name) + 1));
     strcpy(resPtr->name, name);
     resPtr->cmdResProc = cmdProc;
     resPtr->varResProc = varProc;
@@ -119,15 +115,14 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
  *
  * Tcl_GetInterpResolvers --
  *
- *	Looks for a set of command/variable resolution procedures with
- *	the given name in an interpreter.  These procedures are
- *	registered by calling Tcl_AddInterpResolvers.
+ *	Looks for a set of command/variable resolution functions with the
+ *	given name in an interpreter. These functions are registered by
+ *	calling Tcl_AddInterpResolvers.
  *
  * Results:
- *	If the name is recognized, this procedure returns non-zero,
- *	along with pointers to the name resolution procedures in
- *	the Tcl_ResolverInfo structure.  If the name is not recognized,
- *	this procedure returns zero.
+ *	If the name is recognized, this function returns non-zero, along with
+ *	pointers to the name resolution functions in the Tcl_ResolverInfo
+ *	structure. If the name is not recognized, this function returns zero.
  *
  * Side effects:
  *	None.
@@ -136,28 +131,29 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
  */
 
 int
-Tcl_GetInterpResolvers(interp, name, resInfoPtr)
-
-    Tcl_Interp *interp;			/* Interpreter whose name resolution
-					 * rules are being queried. */
-    CONST char *name;                   /* Look for a scheme with this name. */
-    Tcl_ResolverInfo *resInfoPtr;	/* Returns pointers to the procedures,
-					 * if found */
+Tcl_GetInterpResolvers(
+    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
+				 * being queried. */
+    CONST char *name,		/* Look for a scheme with this name. */
+    Tcl_ResolverInfo *resInfoPtr)
+				/* Returns pointers to the functions, if
+				 * found */
 {
-    Interp *iPtr = (Interp*)interp;
+    Interp *iPtr = (Interp *) interp;
     ResolverScheme *resPtr;
 
     /*
-     *  Look for an existing scheme with the given name.  If found,
-     *  then return pointers to its procedures.
+     * Look for an existing scheme with the given name. If found, then return
+     * pointers to its functions.
      */
-    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
-        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+
+    for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) {
+	if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
 	    resInfoPtr->cmdResProc = resPtr->cmdResProc;
 	    resInfoPtr->varResProc = resPtr->varResProc;
 	    resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
-            return 1;
-        }
+	    return 1;
+	}
     }
 
     return 0;
@@ -168,68 +164,69 @@ Tcl_GetInterpResolvers(interp, name, resInfoPtr)
  *
  * Tcl_RemoveInterpResolvers --
  *
- *	Removes a set of command/variable resolution procedures
- *	previously added by Tcl_AddInterpResolvers.  The next time
- *	a command/variable name is resolved, these procedures
- *	won't be consulted.
+ *	Removes a set of command/variable resolution functions previously
+ *	added by Tcl_AddInterpResolvers. The next time a command/variable name
+ *	is resolved, these functions won't be consulted.
  *
  * Results:
- *	Returns non-zero if the name was recognized and the
- *	resolution scheme was deleted.  Returns zero otherwise.
+ *	Returns non-zero if the name was recognized and the resolution scheme
+ *	was deleted. Returns zero otherwise.
  *
  * Side effects:
- *	If a scheme with a compiledVarProc was deleted, this procedure
- *	bumps the compileEpoch for the interpreter, forcing all code
- *	to be recompiled.  If a scheme with a cmdProc was deleted,
- *	this procedure bumps the cmdRefEpoch in all namespaces,
- *	forcing commands to be resolved again using the new rules.
+ *	If a scheme with a compiledVarProc was deleted, this function bumps
+ *	the compileEpoch for the interpreter, forcing all code to be
+ *	recompiled. If a scheme with a cmdProc was deleted, this function
+ *	bumps the cmdRefEpoch in all namespaces, forcing commands to be
+ *	resolved again using the new rules.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_RemoveInterpResolvers(interp, name)
-
-    Tcl_Interp *interp;			/* Interpreter whose name resolution
-					 * rules are being modified. */
-    CONST char *name;                   /* Name of the scheme to be removed. */
+Tcl_RemoveInterpResolvers(
+    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
+				 * being modified. */
+    CONST char *name)		/* Name of the scheme to be removed. */
 {
-    Interp *iPtr = (Interp*)interp;
+    Interp *iPtr = (Interp *) interp;
     ResolverScheme **prevPtrPtr, *resPtr;
 
     /*
-     *  Look for an existing scheme with the given name.
+     * Look for an existing scheme with the given name.
      */
+
     prevPtrPtr = &iPtr->resolverPtr;
-    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
-        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
-            break;
-        }
-        prevPtrPtr = &resPtr->nextPtr;
+    for (resPtr=iPtr->resolverPtr ; resPtr!=NULL ; resPtr=resPtr->nextPtr) {
+	if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
+	    break;
+	}
+	prevPtrPtr = &resPtr->nextPtr;
     }
 
     /*
-     *  If we found the scheme, delete it.
+     * If we found the scheme, delete it.
      */
+
     if (resPtr) {
-        /*
-         *  If we're deleting a scheme with compiled variable resolution
-         *  rules, bump the compiler epoch to invalidate compiled code.
-         *  If we're deleting a scheme with command resolution rules,
-         *  bump the cmdRefEpoch in all namespaces.
-         */
-        if (resPtr->compiledVarResProc) {
-            iPtr->compileEpoch++;
-        }
-        if (resPtr->cmdResProc) {
-            BumpCmdRefEpochs(iPtr->globalNsPtr);
-        }
-
-        *prevPtrPtr = resPtr->nextPtr;
-        ckfree(resPtr->name);
-        ckfree((char *) resPtr);
-
-        return 1;
+	/*
+	 * If we're deleting a scheme with compiled variable resolution rules,
+	 * bump the compiler epoch to invalidate compiled code. If we're
+	 * deleting a scheme with command resolution rules, bump the
+	 * cmdRefEpoch in all namespaces.
+	 */
+
+	if (resPtr->compiledVarResProc) {
+	    iPtr->compileEpoch++;
+	}
+	if (resPtr->cmdResProc) {
+	    BumpCmdRefEpochs(iPtr->globalNsPtr);
+	}
+
+	*prevPtrPtr = resPtr->nextPtr;
+	ckfree(resPtr->name);
+	ckfree((char *) resPtr);
+
+	return 1;
     }
     return 0;
 }
@@ -239,134 +236,127 @@ Tcl_RemoveInterpResolvers(interp, name)
  *
  * BumpCmdRefEpochs --
  *
- *	This procedure is used to bump the cmdRefEpoch counters in
- *	the specified namespace and all of its child namespaces.
- *	It is used whenever name resolution schemes are added/removed
- *	from an interpreter, to invalidate all command references.
+ *	This function is used to bump the cmdRefEpoch counters in the
+ *	specified namespace and all of its child namespaces. It is used
+ *	whenever name resolution schemes are added/removed from an
+ *	interpreter, to invalidate all command references.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Bumps the cmdRefEpoch in the specified namespace and its
- *	children, recursively.
+ *	Bumps the cmdRefEpoch in the specified namespace and its children,
+ *	recursively.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-BumpCmdRefEpochs(nsPtr)
-    Namespace *nsPtr;			/* Namespace being modified. */
+BumpCmdRefEpochs(
+    Namespace *nsPtr)		/* Namespace being modified. */
 {
     Tcl_HashEntry *entry;
     Tcl_HashSearch search;
-    Namespace *childNsPtr;
 
     nsPtr->cmdRefEpoch++;
 
     for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-	    entry != NULL;
-	    entry = Tcl_NextHashEntry(&search)) {
-
-        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
-        BumpCmdRefEpochs(childNsPtr);
+	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+	Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+	BumpCmdRefEpochs(childNsPtr);
     }
+    TclInvalidateNsPath(nsPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SetNamespaceResolvers --
  *
- *	Sets the command/variable resolution procedures for a namespace,
- *	thereby changing the way that command/variable names are
- *	interpreted.  This allows extension writers to support different
- *	name resolution schemes, such as those for object-oriented
- *	packages.
- *
- *	Command resolution is handled by a procedure of the following
- *	type:
- *
- *	  typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
- *		Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
- *              int flags, Tcl_Command *rPtr));
- *          
- *	Whenever a command is executed or Tcl_FindCommand is invoked
- *	within the namespace, this procedure is called to resolve the
- *	command name.  If this procedure is able to resolve the name,
- *	it should return the status code TCL_OK, along with the
- *	corresponding Tcl_Command in the rPtr argument.  Otherwise,
- *	the procedure can return TCL_CONTINUE, and the command will
- *	be treated under the usual name resolution rules.  Or, it can
- *	return TCL_ERROR, and the command will be considered invalid.
- *
- *	Variable resolution is handled by two procedures.  The first
- *	is called whenever a variable needs to be resolved at compile
- *	time:
- *
- *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
- *	        Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
- *	        Tcl_ResolvedVarInfo *rPtr));
- *
- *      If this procedure is able to resolve the name, it should return
- *      the status code TCL_OK, along with variable resolution info in
- *      the rPtr argument; this info will be used to set up compiled
- *	locals in the call frame at runtime.  The procedure may also
- *	return TCL_CONTINUE, and the variable will be treated under
- *	the usual name resolution rules.  Or, it can return TCL_ERROR,
- *	and the variable will be considered invalid.
- *
- *	Another procedure is used whenever a variable needs to be
- *	resolved at runtime but it is not recognized as a compiled local.
- *	(For example, the variable may be requested via
- *	Tcl_FindNamespaceVar.) This procedure has the following type:
- *
- *	  typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
- *	        Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
- *	        int flags, Tcl_Var *rPtr));
- *
- *	This procedure is quite similar to the compile-time version.
- *	It returns the same status codes, but if variable resolution
- *	succeeds, this procedure returns a Tcl_Var directly via the
- *	rPtr argument.
+ *	Sets the command/variable resolution functions for a namespace,
+ *	thereby changing the way that command/variable names are interpreted.
+ *	This allows extension writers to support different name resolution
+ *	schemes, such as those for object-oriented packages.
+ *
+ *	Command resolution is handled by a function of the following type:
+ *
+ *	  typedef int (*Tcl_ResolveCmdProc)(Tcl_Interp *interp,
+ *		  CONST char *name, Tcl_Namespace *context,
+ *		  int flags, Tcl_Command *rPtr);
+ *
+ *	Whenever a command is executed or Tcl_FindCommand is invoked within
+ *	the namespace, this function is called to resolve the command name. If
+ *	this function is able to resolve the name, it should return the status
+ *	code TCL_OK, along with the corresponding Tcl_Command in the rPtr
+ *	argument. Otherwise, the function can return TCL_CONTINUE, and the
+ *	command will be treated under the usual name resolution rules. Or, it
+ *	can return TCL_ERROR, and the command will be considered invalid.
+ *
+ *	Variable resolution is handled by two functions. The first is called
+ *	whenever a variable needs to be resolved at compile time:
+ *
+ *	  typedef int (*Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
+ *		  CONST char *name, Tcl_Namespace *context,
+ *		  Tcl_ResolvedVarInfo *rPtr);
+ *
+ *	If this function is able to resolve the name, it should return the
+ *	status code TCL_OK, along with variable resolution info in the rPtr
+ *	argument; this info will be used to set up compiled locals in the call
+ *	frame at runtime. The function may also return TCL_CONTINUE, and the
+ *	variable will be treated under the usual name resolution rules. Or, it
+ *	can return TCL_ERROR, and the variable will be considered invalid.
+ *
+ *	Another function is used whenever a variable needs to be resolved at
+ *	runtime but it is not recognized as a compiled local. (For example,
+ *	the variable may be requested via Tcl_FindNamespaceVar.) This function
+ *	has the following type:
+ *
+ *	  typedef int (*Tcl_ResolveVarProc)(Tcl_Interp *interp,
+ *		  CONST char *name, Tcl_Namespace *context,
+ *		  int flags, Tcl_Var *rPtr);
+ *
+ *	This function is quite similar to the compile-time version. It returns
+ *	the same status codes, but if variable resolution succeeds, this
+ *	function returns a Tcl_Var directly via the rPtr argument.
  *
  * Results:
  *	Nothing.
  *
  * Side effects:
- *	Bumps the command epoch counter for the namespace, invalidating
- *	all command references in that namespace.  Also bumps the
- *	resolver epoch counter for the namespace, forcing all code
- *	in the namespace to be recompiled.
+ *	Bumps the command epoch counter for the namespace, invalidating all
+ *	command references in that namespace. Also bumps the resolver epoch
+ *	counter for the namespace, forcing all code in the namespace to be
+ *	recompiled.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
-    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
-					 * are being modified. */
-    Tcl_ResolveCmdProc *cmdProc;	/* Procedure for command resolution */
-    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
-					 * at runtime */
-    Tcl_ResolveCompiledVarProc *compiledVarProc;
-					/* Procedure for variable resolution
-					 * at compile time. */
+Tcl_SetNamespaceResolvers(
+    Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+				 * modified. */
+    Tcl_ResolveCmdProc *cmdProc,/* Function for command resolution */
+    Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+				 * run-time */
+    Tcl_ResolveCompiledVarProc *compiledVarProc)
+				/* Function for variable resolution at compile
+				 * time. */
 {
-    Namespace *nsPtr = (Namespace*)namespacePtr;
+    Namespace *nsPtr = (Namespace *) namespacePtr;
 
     /*
-     *  Plug in the new command resolver, and bump the epoch counters
-     *  so that all code will have to be recompiled and all commands
-     *  will have to be resolved again using the new policy.
+     * Plug in the new command resolver, and bump the epoch counters so that
+     * all code will have to be recompiled and all commands will have to be
+     * resolved again using the new policy.
      */
+
     nsPtr->cmdResProc = cmdProc;
     nsPtr->varResProc = varProc;
     nsPtr->compiledVarResProc = compiledVarProc;
 
     nsPtr->cmdRefEpoch++;
     nsPtr->resolverEpoch++;
+    TclInvalidateNsPath(nsPtr);
 }
 
 /*
@@ -374,17 +364,15 @@ Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
  *
  * Tcl_GetNamespaceResolvers --
  *
- *	Returns the current command/variable resolution procedures
- *	for a namespace.  By default, these procedures are NULL.
- *	New procedures can be installed by calling
- *	Tcl_SetNamespaceResolvers, to provide new name resolution
- *	rules.
+ *	Returns the current command/variable resolution functions for a
+ *	namespace. By default, these functions are NULL. New functions can be
+ *	installed by calling Tcl_SetNamespaceResolvers, to provide new name
+ *	resolution rules.
  *
  * Results:
- *	Returns non-zero if any name resolution procedures have been
- *	assigned to this namespace; also returns pointers to the
- *	procedures in the Tcl_ResolverInfo structure.  Returns zero
- *	otherwise.
+ *	Returns non-zero if any name resolution functions have been assigned
+ *	to this namespace; also returns pointers to the functions in the
+ *	Tcl_ResolverInfo structure. Returns zero otherwise.
  *
  * Side effects:
  *	None.
@@ -393,24 +381,30 @@ Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
  */
 
 int
-Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
-
-    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
-					 * are being modified. */
-    Tcl_ResolverInfo *resInfoPtr;	/* Returns: pointers for all
-					 * name resolution procedures
-					 * assigned to this namespace. */
+Tcl_GetNamespaceResolvers(
+    Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+				 * modified. */
+    Tcl_ResolverInfo *resInfoPtr)
+				/* Returns: pointers for all name resolution
+				 * functions assigned to this namespace. */
 {
-    Namespace *nsPtr = (Namespace*)namespacePtr;
+    Namespace *nsPtr = (Namespace *) namespacePtr;
 
     resInfoPtr->cmdResProc = nsPtr->cmdResProc;
     resInfoPtr->varResProc = nsPtr->varResProc;
     resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
 
-    if (nsPtr->cmdResProc != NULL ||
-        nsPtr->varResProc != NULL ||
-        nsPtr->compiledVarResProc != NULL) {
+    if (nsPtr->cmdResProc != NULL || nsPtr->varResProc != NULL ||
+	    nsPtr->compiledVarResProc != NULL) {
 	return 1;
     }
     return 0;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 6dbdd90..7b58d44 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1,39 +1,207 @@
-/* 
+/*
  * tclResult.c --
  *
  *	This file contains code to manage the interpreter result.
  *
  * Copyright (c) 1997 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * Function prototypes for local procedures in this file:
+ * Indices of the standard return options dictionary keys.
+ */
+
+enum returnKeys {
+    KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
+    KEY_LEVEL,	KEY_OPTIONS,	KEY_LAST
+};
+
+/*
+ * Function prototypes for local functions in this file:
  */
 
-static void             ResetObjResult _ANSI_ARGS_((Interp *iPtr));
-static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
-			    int newSpace));
+static Tcl_Obj **	GetKeys(void);
+static void		ReleaseKeys(ClientData clientData);
+static void		ResetObjResult(Interp *iPtr);
+static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
 
+/*
+ * This structure is used to take a snapshot of the interpreter state in
+ * Tcl_SaveInterpState. You can snapshot the state, execute a command, and
+ * then back up to the result or the error that was previously in progress.
+ */
+
+typedef struct InterpState {
+    int status;			/* return code status */
+    int flags;			/* Each remaining field saves the */
+    int returnLevel;		/* corresponding field of the Interp */
+    int returnCode;		/* struct. These fields taken together are */
+    Tcl_Obj *errorInfo;		/* the "state" of the interp. */
+    Tcl_Obj *errorCode;
+    Tcl_Obj *returnOpts;
+    Tcl_Obj *objResult;
+} InterpState;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SaveInterpState --
+ *
+ *	Fills a token with a snapshot of the current state of the interpreter.
+ *	The snapshot can be restored at any point by TclRestoreInterpState.
+ *
+ *	The token returned must be eventally passed to one of the routines
+ *	TclRestoreInterpState or TclDiscardInterpState, or there will be a
+ *	memory leak.
+ *
+ * Results:
+ *	Returns a token representing the interp state.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_InterpState
+Tcl_SaveInterpState(
+    Tcl_Interp *interp,		/* Interpreter's state to be saved */
+    int status)			/* status code for current operation */
+{
+    Interp *iPtr = (Interp *)interp;
+    InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));
+
+    statePtr->status = status;
+    statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
+    statePtr->returnLevel = iPtr->returnLevel;
+    statePtr->returnCode = iPtr->returnCode;
+    statePtr->errorInfo = iPtr->errorInfo;
+    if (statePtr->errorInfo) {
+	Tcl_IncrRefCount(statePtr->errorInfo);
+    }
+    statePtr->errorCode = iPtr->errorCode;
+    if (statePtr->errorCode) {
+	Tcl_IncrRefCount(statePtr->errorCode);
+    }
+    statePtr->returnOpts = iPtr->returnOpts;
+    if (statePtr->returnOpts) {
+	Tcl_IncrRefCount(statePtr->returnOpts);
+    }
+    statePtr->objResult = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(statePtr->objResult);
+    return (Tcl_InterpState) statePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RestoreInterpState --
+ *
+ *	Accepts an interp and a token previously returned by
+ *	Tcl_SaveInterpState. Restore the state of the interp to what it was at
+ *	the time of the Tcl_SaveInterpState call.
+ *
+ * Results:
+ *	Returns the status value originally passed in to Tcl_SaveInterpState.
+ *
+ * Side effects:
+ *	Restores the interp state and frees memory held by token.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RestoreInterpState(
+    Tcl_Interp *interp,		/* Interpreter's state to be restored. */
+    Tcl_InterpState state)	/* Saved interpreter state. */
+{
+    Interp *iPtr = (Interp *)interp;
+    InterpState *statePtr = (InterpState *)state;
+    int status = statePtr->status;
+
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    iPtr->flags |= (statePtr->flags & ERR_ALREADY_LOGGED);
+
+    iPtr->returnLevel = statePtr->returnLevel;
+    iPtr->returnCode = statePtr->returnCode;
+    if (iPtr->errorInfo) {
+	Tcl_DecrRefCount(iPtr->errorInfo);
+    }
+    iPtr->errorInfo = statePtr->errorInfo;
+    if (iPtr->errorInfo) {
+	Tcl_IncrRefCount(iPtr->errorInfo);
+    }
+    if (iPtr->errorCode) {
+	Tcl_DecrRefCount(iPtr->errorCode);
+    }
+    iPtr->errorCode = statePtr->errorCode;
+    if (iPtr->errorCode) {
+	Tcl_IncrRefCount(iPtr->errorCode);
+    }
+    if (iPtr->returnOpts) {
+	Tcl_DecrRefCount(iPtr->returnOpts);
+    }
+    iPtr->returnOpts = statePtr->returnOpts;
+    if (iPtr->returnOpts) {
+	Tcl_IncrRefCount(iPtr->returnOpts);
+    }
+    Tcl_SetObjResult(interp, statePtr->objResult);
+    Tcl_DiscardInterpState(state);
+    return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DiscardInterpState --
+ *
+ *	Accepts a token previously returned by Tcl_SaveInterpState. Frees the
+ *	memory it uses.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DiscardInterpState(
+    Tcl_InterpState state)	/* saved interpreter state */
+{
+    InterpState *statePtr = (InterpState *)state;
+
+    if (statePtr->errorInfo) {
+	Tcl_DecrRefCount(statePtr->errorInfo);
+    }
+    if (statePtr->errorCode) {
+	Tcl_DecrRefCount(statePtr->errorCode);
+    }
+    if (statePtr->returnOpts) {
+	Tcl_DecrRefCount(statePtr->returnOpts);
+    }
+    Tcl_DecrRefCount(statePtr->objResult);
+    ckfree((char *) statePtr);
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SaveResult --
  *
- *      Takes a snapshot of the current result state of the interpreter.
- *      The snapshot can be restored at any point by
- *      Tcl_RestoreResult. Note that this routine does not 
- *	preserve the errorCode, errorInfo, or flags fields so it
- *	should not be used if an error is in progress.
+ *	Takes a snapshot of the current result state of the interpreter. The
+ *	snapshot can be restored at any point by Tcl_RestoreResult. Note that
+ *	this routine does not preserve the errorCode, errorInfo, or flags
+ *	fields so it should not be used if an error is in progress.
  *
- *      Once a snapshot is saved, it must be restored by calling
- *      Tcl_RestoreResult, or discarded by calling
- *      Tcl_DiscardResult.
+ *	Once a snapshot is saved, it must be restored by calling
+ *	Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult.
  *
  * Results:
  *	None.
@@ -45,24 +213,24 @@ static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
  */
 
 void
-Tcl_SaveResult(interp, statePtr)
-    Tcl_Interp *interp;		/* Interpreter to save. */
-    Tcl_SavedResult *statePtr;	/* Pointer to state structure. */
+Tcl_SaveResult(
+    Tcl_Interp *interp,		/* Interpreter to save. */
+    Tcl_SavedResult *statePtr)	/* Pointer to state structure. */
 {
     Interp *iPtr = (Interp *) interp;
 
     /*
-     * Move the result object into the save state.  Note that we don't need
-     * to change its refcount because we're moving it, not adding a new
-     * reference.  Put an empty object into the interpreter.
+     * Move the result object into the save state. Note that we don't need to
+     * change its refcount because we're moving it, not adding a new
+     * reference. Put an empty object into the interpreter.
      */
 
     statePtr->objResultPtr = iPtr->objResultPtr;
-    iPtr->objResultPtr = Tcl_NewObj(); 
-    Tcl_IncrRefCount(iPtr->objResultPtr); 
+    iPtr->objResultPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(iPtr->objResultPtr);
 
     /*
-     * Save the string result. 
+     * Save the string result.
      */
 
     statePtr->freeProc = iPtr->freeProc;
@@ -105,23 +273,23 @@ Tcl_SaveResult(interp, statePtr)
  *
  * Tcl_RestoreResult --
  *
- *      Restores the state of the interpreter to a snapshot taken
- *      by Tcl_SaveResult.  After this call, the token for
- *      the interpreter state is no longer valid.
+ *	Restores the state of the interpreter to a snapshot taken by
+ *	Tcl_SaveResult. After this call, the token for the interpreter state
+ *	is no longer valid.
  *
  * Results:
- *      None.
+ *	None.
  *
  * Side effects:
- *      Restores the interpreter result.
+ *	Restores the interpreter result.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_RestoreResult(interp, statePtr)
-    Tcl_Interp* interp;		/* Interpreter being restored. */
-    Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */
+Tcl_RestoreResult(
+    Tcl_Interp *interp,		/* Interpreter being restored. */
+    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -145,7 +313,7 @@ Tcl_RestoreResult(interp, statePtr)
 	 */
 
 	if (iPtr->appendResult != NULL) {
-	    ckfree((char *)iPtr->appendResult);
+	    ckfree((char *) iPtr->appendResult);
 	}
 
 	iPtr->appendResult = statePtr->appendResult;
@@ -173,23 +341,22 @@ Tcl_RestoreResult(interp, statePtr)
  *
  * Tcl_DiscardResult --
  *
- *      Frees the memory associated with an interpreter snapshot
- *      taken by Tcl_SaveResult.  If the snapshot is not
- *      restored, this procedure must be called to discard it,
- *      or the memory will be lost.
+ *	Frees the memory associated with an interpreter snapshot taken by
+ *	Tcl_SaveResult. If the snapshot is not restored, this function must be
+ *	called to discard it, or the memory will be lost.
  *
  * Results:
- *      None.
+ *	None.
  *
  * Side effects:
- *      None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DiscardResult(statePtr)
-    Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */
+Tcl_DiscardResult(
+    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
 {
     TclDecrRefCount(statePtr->objResultPtr);
 
@@ -209,39 +376,39 @@ Tcl_DiscardResult(statePtr)
  *
  * Tcl_SetResult --
  *
- *	Arrange for "string" to be the Tcl return value.
+ *	Arrange for "result" to be the Tcl return value.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	interp->result is left pointing either to "string" (if "copy" is 0)
- *	or to a copy of string. Also, the object result is reset.
+ *	interp->result is left pointing either to "result" or to a copy of it.
+ *	Also, the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetResult(interp, string, freeProc)
-    Tcl_Interp *interp;		/* Interpreter with which to associate the
+Tcl_SetResult(
+    Tcl_Interp *interp,		/* Interpreter with which to associate the
 				 * return value. */
-    register char *string;	/* Value to be returned.  If NULL, the
-				 * result is set to an empty string. */
-    Tcl_FreeProc *freeProc;	/* Gives information about the string:
-				 * TCL_STATIC, TCL_VOLATILE, or the address
-				 * of a Tcl_FreeProc such as free. */
+    register char *result,	/* Value to be returned. If NULL, the result
+				 * is set to an empty string. */
+    Tcl_FreeProc *freeProc)	/* Gives information about the string:
+				 * TCL_STATIC, TCL_VOLATILE, or the address of
+				 * a Tcl_FreeProc such as free. */
 {
     Interp *iPtr = (Interp *) interp;
     int length;
     register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
     char *oldResult = iPtr->result;
 
-    if (string == NULL) {
+    if (result == NULL) {
 	iPtr->resultSpace[0] = 0;
 	iPtr->result = iPtr->resultSpace;
 	iPtr->freeProc = 0;
     } else if (freeProc == TCL_VOLATILE) {
-	length = strlen(string);
+	length = strlen(result);
 	if (length > TCL_RESULT_SIZE) {
 	    iPtr->result = (char *) ckalloc((unsigned) length+1);
 	    iPtr->freeProc = TCL_DYNAMIC;
@@ -249,16 +416,16 @@ Tcl_SetResult(interp, string, freeProc)
 	    iPtr->result = iPtr->resultSpace;
 	    iPtr->freeProc = 0;
 	}
-	strcpy(iPtr->result, string);
+	strcpy(iPtr->result, result);
     } else {
-	iPtr->result = string;
+	iPtr->result = result;
 	iPtr->freeProc = freeProc;
     }
 
     /*
-     * If the old result was dynamically-allocated, free it up.  Do it
-     * here, rather than at the beginning, in case the new result value
-     * was part of the old result value.
+     * If the old result was dynamically-allocated, free it up. Do it here,
+     * rather than at the beginning, in case the new result value was part of
+     * the old result value.
      */
 
     if (oldFreeProc != 0) {
@@ -294,17 +461,17 @@ Tcl_SetResult(interp, string, freeProc)
  */
 
 CONST char *
-Tcl_GetStringResult(interp)
-     register Tcl_Interp *interp; /* Interpreter whose result to return. */
+Tcl_GetStringResult(
+    register Tcl_Interp *interp)/* Interpreter whose result to return. */
 {
     /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
+     * If the string result is empty, move the object result to the string
+     * result, then reset the object result.
      */
-    
+
     if (*(interp->result) == 0) {
 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
+		TCL_VOLATILE);
     }
     return interp->result;
 }
@@ -320,22 +487,20 @@ Tcl_GetStringResult(interp)
  *	None.
  *
  * Side effects:
- *	interp->objResultPtr is left pointing to the object referenced
- *	by objPtr. The object's reference count is incremented since
- *	there is now a new reference to it. The reference count for any
- *	old objResultPtr value is decremented. Also, the string result
- *	is reset.
+ *	interp->objResultPtr is left pointing to the object referenced by
+ *	objPtr. The object's reference count is incremented since there is now
+ *	a new reference to it. The reference count for any old objResultPtr
+ *	value is decremented. Also, the string result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetObjResult(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter with which to associate the
+Tcl_SetObjResult(
+    Tcl_Interp *interp,		/* Interpreter with which to associate the
 				 * return object value. */
-    register Tcl_Obj *objPtr;	/* Tcl object to be returned. If NULL, the
-				 * obj result is made an empty string
-				 * object. */
+    register Tcl_Obj *objPtr)	/* Tcl object to be returned. If NULL, the obj
+				 * result is made an empty string object. */
 {
     register Interp *iPtr = (Interp *) interp;
     register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
@@ -344,10 +509,10 @@ Tcl_SetObjResult(interp, objPtr)
     Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */
 
     /*
-     * We wait until the end to release the old object result, in case
-     * we are setting the result to itself.
+     * We wait until the end to release the old object result, in case we are
+     * setting the result to itself.
      */
-    
+
     TclDecrRefCount(oldObjResult);
 
     /*
@@ -372,41 +537,41 @@ Tcl_SetObjResult(interp, objPtr)
  * Tcl_GetObjResult --
  *
  *	Returns an interpreter's result value as a Tcl object. The object's
- *	reference count is not modified; the caller must do that if it
- *	needs to hold on to a long-term reference to it.
+ *	reference count is not modified; the caller must do that if it needs
+ *	to hold on to a long-term reference to it.
  *
  * Results:
  *	The interpreter's result as an object.
  *
  * Side effects:
- *	If the interpreter has a non-empty string result, the result object
- *	is either empty or stale because some procedure set interp->result
- *	directly. If so, the string result is moved to the result object
- *	then the string result is reset.
+ *	If the interpreter has a non-empty string result, the result object is
+ *	either empty or stale because some function set interp->result
+ *	directly. If so, the string result is moved to the result object then
+ *	the string result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_GetObjResult(interp)
-    Tcl_Interp *interp;		/* Interpreter whose result to return. */
+Tcl_GetObjResult(
+    Tcl_Interp *interp)		/* Interpreter whose result to return. */
 {
     register Interp *iPtr = (Interp *) interp;
     Tcl_Obj *objResultPtr;
     int length;
 
     /*
-     * If the string result is non-empty, move the string result to the
-     * object result, then reset the string result.
+     * If the string result is non-empty, move the string result to the object
+     * result, then reset the string result.
      */
-    
+
     if (*(iPtr->result) != 0) {
 	ResetObjResult(iPtr);
-	
+
 	objResultPtr = iPtr->objResultPtr;
 	length = strlen(iPtr->result);
 	TclInitStringRep(objResultPtr, iPtr->result, length);
-	
+
 	if (iPtr->freeProc != NULL) {
 	    if (iPtr->freeProc == TCL_DYNAMIC) {
 		ckfree(iPtr->result);
@@ -426,110 +591,51 @@ Tcl_GetObjResult(interp)
  *
  * Tcl_AppendResultVA --
  *
- *	Append a variable number of strings onto the interpreter's string
- *	result.
+ *	Append a variable number of strings onto the interpreter's result.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The result of the interpreter given by the first argument is
- *	extended by the strings in the va_list (up to a terminating NULL
- *	argument).
+ *	The result of the interpreter given by the first argument is extended
+ *	by the strings in the va_list (up to a terminating NULL argument).
  *
- *	If the string result is empty, the object result is moved to the
- *	string result, then the object result is reset.
+ *	If the string result is non-empty, the object result forced to be a
+ *	duplicate of it first. There will be a string result afterwards.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendResultVA (interp, argList)
-    Tcl_Interp *interp;		/* Interpreter with which to associate the
+Tcl_AppendResultVA(
+    Tcl_Interp *interp,		/* Interpreter with which to associate the
 				 * return value. */
-    va_list argList;		/* Variable argument list. */
+    va_list argList)		/* Variable argument list. */
 {
-#define STATIC_LIST_SIZE 16
-    Interp *iPtr = (Interp *) interp;
-    char *string, *static_list[STATIC_LIST_SIZE];
-    char **args = static_list;
-    int nargs_space = STATIC_LIST_SIZE;
-    int nargs, newSpace, i;
-
-    /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
-     */
+    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
 
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult((Tcl_Interp *) iPtr,
-	        TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)),
-	        TCL_VOLATILE);
-    }
-    
-    /*
-     * Scan through all the arguments to see how much space is needed
-     * and save pointers to the arguments in the args array,
-     * reallocating as necessary.
-     */
-
-    nargs = 0;
-    newSpace = 0;
-    while (1) {
- 	string = va_arg(argList, char *);
-	if (string == NULL) {
-	    break;
-	}
- 	if (nargs >= nargs_space) {
- 	    /* 
- 	     * Expand the args buffer
- 	     */
- 	    nargs_space += STATIC_LIST_SIZE;
- 	    if (args == static_list) {
- 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
- 		for (i = 0; i < nargs; ++i) {
- 		    args[i] = static_list[i];
- 		}
- 	    } else {
- 		args = (void *)ckrealloc((void *)args,
-			nargs_space * sizeof(char *));
- 	    }
- 	}
-  	newSpace += strlen(string);
-	args[nargs++] = string;
+    if (Tcl_IsShared(objPtr)) {
+	objPtr = Tcl_DuplicateObj(objPtr);
     }
+    Tcl_AppendStringsToObjVA(objPtr, argList);
+    Tcl_SetObjResult(interp, objPtr);
 
     /*
-     * If the append buffer isn't already setup and large enough to hold
-     * the new data, set it up.
+     * Strictly we should call Tcl_GetStringResult(interp) here to make sure
+     * that interp->result is correct according to the old contract, but that
+     * makes the performance of much code (e.g. in Tk) absolutely awful. So we
+     * leave it out; code that really wants interp->result can just insert the
+     * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
      */
 
-    if ((iPtr->result != iPtr->appendResult)
-	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
-	    || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
-       SetupAppendBuffer(iPtr, newSpace);
-    }
-
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
     /*
-     * Now go through all the argument strings again, copying them into the
-     * buffer.
+     * Ensure that the interp->result is legal so old Tcl 7.* code still
+     * works. There's still embarrasingly much of it about...
      */
 
-    for (i = 0; i < nargs; ++i) {
- 	string = args[i];
-  	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
-  	iPtr->appendUsed += strlen(string);
-    }
- 
-    /*
-     * If we had to allocate a buffer from the heap, 
-     * free it now.
-     */
- 
-    if (args != static_list) {
-     	ckfree((void *)args);
-    }
-#undef STATIC_LIST_SIZE
+    (void) Tcl_GetStringResult(interp);
+#endif /* USE_DIRECT_INTERP_RESULT_ACCESS */
 }
 
 /*
@@ -537,30 +643,29 @@ Tcl_AppendResultVA (interp, argList)
  *
  * Tcl_AppendResult --
  *
- *	Append a variable number of strings onto the interpreter's string
- *	result.
+ *	Append a variable number of strings onto the interpreter's result.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The result of the interpreter given by the first argument is
- *	extended by the strings given by the second and following arguments
- *	(up to a terminating NULL argument).
+ *	The result of the interpreter given by the first argument is extended
+ *	by the strings given by the second and following arguments (up to a
+ *	terminating NULL argument).
  *
- *	If the string result is empty, the object result is moved to the
- *	string result, then the object result is reset.
+ *	If the string result is non-empty, the object result forced to be a
+ *	duplicate of it first. There will be a string result afterwards.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_AppendResult(
+    Tcl_Interp *interp, ...)
 {
-    Tcl_Interp *interp;
     va_list argList;
 
-    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    va_start(argList, interp);
     Tcl_AppendResultVA(interp, argList);
     va_end(argList);
 }
@@ -577,10 +682,10 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
  *	None.
  *
  * Side effects:
- *	The result in the interpreter given by the first argument is
- *	extended with a list element converted from string. A separator
- *	space is added before the converted list element unless the current
- *	result is empty, contains the single character "{", or ends in " {".
+ *	The result in the interpreter given by the first argument is extended
+ *	with a list element converted from string. A separator space is added
+ *	before the converted list element unless the current result is empty,
+ *	contains the single character "{", or ends in " {".
  *
  *	If the string result is empty, the object result is moved to the
  *	string result, then the object result is reset.
@@ -589,11 +694,11 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
  */
 
 void
-Tcl_AppendElement(interp, string)
-    Tcl_Interp *interp;		/* Interpreter whose result is to be
+Tcl_AppendElement(
+    Tcl_Interp *interp,		/* Interpreter whose result is to be
 				 * extended. */
-    CONST char *string;		/* String to convert to list element and
-				 * add to result. */
+    CONST char *element)	/* String to convert to list element and add
+				 * to result. */
 {
     Interp *iPtr = (Interp *) interp;
     char *dst;
@@ -601,30 +706,27 @@ Tcl_AppendElement(interp, string)
     int flags;
 
     /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
+     * If the string result is empty, move the object result to the string
+     * result, then reset the object result.
      */
 
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
-    }
+    (void) Tcl_GetStringResult(interp);
 
     /*
-     * See how much space is needed, and grow the append buffer if
-     * needed to accommodate the list element.
+     * See how much space is needed, and grow the append buffer if needed to
+     * accommodate the list element.
      */
 
-    size = Tcl_ScanElement(string, &flags) + 1;
+    size = Tcl_ScanElement(element, &flags) + 1;
     if ((iPtr->result != iPtr->appendResult)
 	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
 	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
-       SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
+	SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
     }
 
     /*
-     * Convert the string into a list element and copy it to the
-     * buffer that's forming, with a space separator if needed.
+     * Convert the string into a list element and copy it to the buffer that's
+     * forming, with a space separator if needed.
      */
 
     dst = iPtr->appendResult + iPtr->appendUsed;
@@ -632,8 +734,16 @@ Tcl_AppendElement(interp, string)
 	iPtr->appendUsed++;
 	*dst = ' ';
 	dst++;
+
+	/*
+	 * If we need a space to separate this element from preceding stuff,
+	 * then this element will not lead a list, and need not have it's
+	 * leading '#' quoted.
+	 */
+
+	flags |= TCL_DONT_QUOTE_HASH;
     }
-    iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
+    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
 }
 
 /*
@@ -641,10 +751,10 @@ Tcl_AppendElement(interp, string)
  *
  * SetupAppendBuffer --
  *
- *	This procedure makes sure that there is an append buffer properly
- *	initialized, if necessary, from the interpreter's result, and
- *	that it has at least enough room to accommodate newSpace new
- *	bytes of information.
+ *	This function makes sure that there is an append buffer properly
+ *	initialized, if necessary, from the interpreter's result, and that it
+ *	has at least enough room to accommodate newSpace new bytes of
+ *	information.
  *
  * Results:
  *	None.
@@ -656,10 +766,10 @@ Tcl_AppendElement(interp, string)
  */
 
 static void
-SetupAppendBuffer(iPtr, newSpace)
-    Interp *iPtr;		/* Interpreter whose result is being set up. */
-    int newSpace;		/* Make sure that at least this many bytes
-				 * of new information may be added. */
+SetupAppendBuffer(
+    Interp *iPtr,		/* Interpreter whose result is being set up. */
+    int newSpace)		/* Make sure that at least this many bytes of
+				 * new information may be added. */
 {
     int totalSpace;
 
@@ -671,9 +781,9 @@ SetupAppendBuffer(iPtr, newSpace)
 
     if (iPtr->result != iPtr->appendResult) {
 	/*
-	 * If an oversized buffer was used recently, then free it up
-	 * so we go back to a smaller buffer.  This avoids tying up
-	 * memory forever after a large operation.
+	 * If an oversized buffer was used recently, then free it up so we go
+	 * back to a smaller buffer. This avoids tying up memory forever after
+	 * a large operation.
 	 */
 
 	if (iPtr->appendAvl > 500) {
@@ -685,13 +795,13 @@ SetupAppendBuffer(iPtr, newSpace)
     } else if (iPtr->result[iPtr->appendUsed] != 0) {
 	/*
 	 * Most likely someone has modified a result created by
-	 * Tcl_AppendResult et al. so that it has a different size.
-	 * Just recompute the size.
+	 * Tcl_AppendResult et al. so that it has a different size. Just
+	 * recompute the size.
 	 */
 
 	iPtr->appendUsed = strlen(iPtr->result);
     }
-    
+
     totalSpace = newSpace + iPtr->appendUsed;
     if (totalSpace >= iPtr->appendAvl) {
 	char *new;
@@ -711,7 +821,7 @@ SetupAppendBuffer(iPtr, newSpace)
     } else if (iPtr->result != iPtr->appendResult) {
 	strcpy(iPtr->appendResult, iPtr->result);
     }
-    
+
     Tcl_FreeResult((Tcl_Interp *) iPtr);
     iPtr->result = iPtr->appendResult;
 }
@@ -721,9 +831,9 @@ SetupAppendBuffer(iPtr, newSpace)
  *
  * Tcl_FreeResult --
  *
- *	This procedure frees up the memory associated with an interpreter's
+ *	This function frees up the memory associated with an interpreter's
  *	string result. It also resets the interpreter's result object.
- *	Tcl_FreeResult is most commonly used when a procedure is about to
+ *	Tcl_FreeResult is most commonly used when a function is about to
  *	replace one result value with another.
  *
  * Results:
@@ -731,19 +841,19 @@ SetupAppendBuffer(iPtr, newSpace)
  *
  * Side effects:
  *	Frees the memory associated with interp's string result and sets
- *	interp->freeProc to zero, but does not change interp->result or
- *	clear error state. Resets interp's result object to an unshared
- *	empty object.
+ *	interp->freeProc to zero, but does not change interp->result or clear
+ *	error state. Resets interp's result object to an unshared empty
+ *	object.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_FreeResult(interp)
-    register Tcl_Interp *interp; /* Interpreter for which to free result. */
+Tcl_FreeResult(
+    register Tcl_Interp *interp)/* Interpreter for which to free result. */
 {
     register Interp *iPtr = (Interp *) interp;
-    
+
     if (iPtr->freeProc != NULL) {
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
@@ -752,7 +862,7 @@ Tcl_FreeResult(interp)
 	}
 	iPtr->freeProc = 0;
     }
-    
+
     ResetObjResult(iPtr);
 }
 
@@ -761,24 +871,23 @@ Tcl_FreeResult(interp)
  *
  * Tcl_ResetResult --
  *
- *	This procedure resets both the interpreter's string and object
- *	results.
+ *	This function resets both the interpreter's string and object results.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	It resets the result object to an unshared empty object. It
- *	then restores the interpreter's string result area to its default
- *	initialized state, freeing up any memory that may have been
- *	allocated. It also clears any error information for the interpreter.
+ *	It resets the result object to an unshared empty object. It then
+ *	restores the interpreter's string result area to its default
+ *	initialized state, freeing up any memory that may have been allocated.
+ *	It also clears any error information for the interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_ResetResult(interp)
-    register Tcl_Interp *interp; /* Interpreter for which to clear result. */
+Tcl_ResetResult(
+    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
 {
     register Interp *iPtr = (Interp *) interp;
 
@@ -793,7 +902,31 @@ Tcl_ResetResult(interp)
     }
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
-    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+    if (iPtr->errorCode) {
+	/* Legacy support */
+	if (iPtr->flags & ERR_LEGACY_COPY) {
+	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+		    iPtr->errorCode, TCL_GLOBAL_ONLY);
+	}
+	Tcl_DecrRefCount(iPtr->errorCode);
+	iPtr->errorCode = NULL;
+    }
+    if (iPtr->errorInfo) {
+	/* Legacy support */
+	if (iPtr->flags & ERR_LEGACY_COPY) {
+	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	}
+	Tcl_DecrRefCount(iPtr->errorInfo);
+	iPtr->errorInfo = NULL;
+    }
+    iPtr->returnLevel = 1;
+    iPtr->returnCode = TCL_OK;
+    if (iPtr->returnOpts) {
+	Tcl_DecrRefCount(iPtr->returnOpts);
+	iPtr->returnOpts = NULL;
+    }
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY);
 }
 
 /*
@@ -801,22 +934,22 @@ Tcl_ResetResult(interp)
  *
  * ResetObjResult --
  *
- *	Procedure used to reset an interpreter's Tcl result object.
+ *	Function used to reset an interpreter's Tcl result object.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	Resets the interpreter's result object to an unshared empty string
- *	object with ref count one. It does not clear any error information
- *	in the interpreter.
+ *	object with ref count one. It does not clear any error information in
+ *	the interpreter.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-ResetObjResult(iPtr)
-    register Interp *iPtr;	/* Points to the interpreter whose result
+ResetObjResult(
+    register Interp *iPtr)	/* Points to the interpreter whose result
 				 * object should be reset. */
 {
     register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
@@ -827,17 +960,15 @@ ResetObjResult(iPtr)
 	Tcl_IncrRefCount(objResultPtr);
 	iPtr->objResultPtr = objResultPtr;
     } else {
-	if ((objResultPtr->bytes != NULL)
-	        && (objResultPtr->bytes != tclEmptyStringRep)) {
-	    ckfree((char *) objResultPtr->bytes);
-	}
-	objResultPtr->bytes  = tclEmptyStringRep;
-	objResultPtr->length = 0;
-	if ((objResultPtr->typePtr != NULL)
-	        && (objResultPtr->typePtr->freeIntRepProc != NULL)) {
-	    objResultPtr->typePtr->freeIntRepProc(objResultPtr);
+	if (objResultPtr->bytes != tclEmptyStringRep) {
+	    if (objResultPtr->bytes) {
+		ckfree((char *) objResultPtr->bytes);
+	    }
+	    objResultPtr->bytes = tclEmptyStringRep;
+	    objResultPtr->length = 0;
 	}
-	objResultPtr->typePtr = (Tcl_ObjType *) NULL;
+	TclFreeIntRep(objResultPtr);
+	objResultPtr->typePtr = NULL;
     }
 }
 
@@ -846,48 +977,40 @@ ResetObjResult(iPtr)
  *
  * Tcl_SetErrorCodeVA --
  *
- *	This procedure is called to record machine-readable information
- *	about an error that is about to be returned.
+ *	This function is called to record machine-readable information about
+ *	an error that is about to be returned.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The errorCode global variable is modified to hold all of the
- *	arguments to this procedure, in a list form with each argument
- *	becoming one element of the list.  A flag is set internally
- *	to remember that errorCode has been set, so the variable doesn't
- *	get set automatically when the error is returned.
+ *	The errorCode field of the interp is modified to hold all of the
+ *	arguments to this function, in a list form with each argument becoming
+ *	one element of the list.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetErrorCodeVA (interp, argList)
-    Tcl_Interp *interp;		/* Interpreter in which to access the errorCode
-				 * variable. */
-    va_list argList;		/* Variable argument list. */
+Tcl_SetErrorCodeVA(
+    Tcl_Interp *interp,		/* Interpreter in which to set errorCode */
+    va_list argList)		/* Variable argument list. */
 {
-    char *string;
-    int flags;
-    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *errorObj = Tcl_NewObj();
 
     /*
-     * Scan through the arguments one at a time, appending them to
-     * $errorCode as list elements.
+     * Scan through the arguments one at a time, appending them to the
+     * errorCode field as list elements.
      */
 
-    flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
     while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
+	char *elem = va_arg(argList, char *);
+	if (elem == NULL) {
 	    break;
 	}
-	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
-		(char *) NULL, string, flags);
-	flags |= TCL_APPEND_VALUE;
+	Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
     }
-    iPtr->flags |= ERROR_CODE_SET;
+    Tcl_SetObjErrorCode(interp, errorObj);
 }
 
 /*
@@ -895,34 +1018,32 @@ Tcl_SetErrorCodeVA (interp, argList)
  *
  * Tcl_SetErrorCode --
  *
- *	This procedure is called to record machine-readable information
- *	about an error that is about to be returned.
+ *	This function is called to record machine-readable information about
+ *	an error that is about to be returned.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The errorCode global variable is modified to hold all of the
- *	arguments to this procedure, in a list form with each argument
- *	becoming one element of the list.  A flag is set internally
- *	to remember that errorCode has been set, so the variable doesn't
- *	get set automatically when the error is returned.
+ *	The errorCode field of the interp is modified to hold all of the
+ *	arguments to this function, in a list form with each argument becoming
+ *	one element of the list.
  *
  *----------------------------------------------------------------------
  */
-	/* VARARGS2 */
+
 void
-Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_SetErrorCode(
+    Tcl_Interp *interp, ...)
 {
-    Tcl_Interp *interp;
     va_list argList;
 
     /*
-     * Scan through the arguments one at a time, appending them to
-     * $errorCode as list elements.
+     * Scan through the arguments one at a time, appending them to the
+     * errorCode field as list elements.
      */
 
-    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    va_start(argList, interp);
     Tcl_SetErrorCodeVA(interp, argList);
     va_end(argList);
 }
@@ -932,32 +1053,484 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
  *
  * Tcl_SetObjErrorCode --
  *
- *	This procedure is called to record machine-readable information
- *	about an error that is about to be returned. The caller should
- *	build a list object up and pass it to this routine.
+ *	This function is called to record machine-readable information about
+ *	an error that is about to be returned. The caller should build a list
+ *	object up and pass it to this routine.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The errorCode global variable is modified to be the new value.
- *	A flag is set internally to remember that errorCode has been
- *	set, so the variable doesn't get set automatically when the
- *	error is returned.
+ *	The errorCode field of the interp is set to the new value.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetObjErrorCode(interp, errorObjPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj *errorObjPtr;
+Tcl_SetObjErrorCode(
+    Tcl_Interp *interp,
+    Tcl_Obj *errorObjPtr)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->errorCode) {
+	Tcl_DecrRefCount(iPtr->errorCode);
+    }
+    iPtr->errorCode = errorObjPtr;
+    Tcl_IncrRefCount(iPtr->errorCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetKeys --
+ *
+ *	Returns a Tcl_Obj * array of the standard keys used in the return
+ *	options dictionary.
+ *
+ *	Broadly sharing one copy of these key values helps with both memory
+ *	efficiency and dictionary lookup times.
+ *
+ * Results:
+ *	A Tcl_Obj * array.
+ *
+ * Side effects:
+ * 	First time called in a thread, creates the keys (allocating memory)
+ * 	and arranges for their cleanup at thread exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj **
+GetKeys(void)
 {
-    Interp *iPtr;
-    
-    iPtr = (Interp *) interp;
-    Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);
-    iPtr->flags |= ERROR_CODE_SET;
+    static Tcl_ThreadDataKey returnKeysKey;
+    Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey,
+	    (int) (KEY_LAST * sizeof(Tcl_Obj *)));
+
+    if (keys[0] == NULL) {
+	/*
+	 * First call in this thread, create the keys...
+	 */
+
+	int i;
+
+	TclNewLiteralStringObj(keys[KEY_CODE],	    "-code");
+	TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
+	TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
+	TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
+	TclNewLiteralStringObj(keys[KEY_LEVEL],	    "-level");
+	TclNewLiteralStringObj(keys[KEY_OPTIONS],   "-options");
+
+	for (i = KEY_CODE; i < KEY_LAST; i++) {
+	    Tcl_IncrRefCount(keys[i]);
+	}
+
+	/*
+	 * ... and arrange for their clenaup.
+	 */
+
+	Tcl_CreateThreadExitHandler(ReleaseKeys, (ClientData) keys);
+    }
+    return keys;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseKeys --
+ *
+ *	Called as a thread exit handler to cleanup return options dictionary
+ *	keys.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ * 	Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseKeys(
+    ClientData clientData)
+{
+    Tcl_Obj **keys = (Tcl_Obj **)clientData;
+    int i;
+
+    for (i = KEY_CODE; i < KEY_LAST; i++) {
+	Tcl_DecrRefCount(keys[i]);
+	keys[i] = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessReturn --
+ *
+ *	Does the work of the [return] command based on the code, level, and
+ *	returnOpts arguments. Note that the code argument must agree with the
+ *	-code entry in returnOpts and the level argument must agree with the
+ *	-level entry in returnOpts, as is the case for values returned from
+ *	TclMergeReturnOptions.
+ *
+ * Results:
+ *	Returns the return code the [return] command should return.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclProcessReturn(
+    Tcl_Interp *interp,
+    int code,
+    int level,
+    Tcl_Obj *returnOpts)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *valuePtr;
+    Tcl_Obj **keys = GetKeys();
+
+    /*
+     * Store the merged return options.
+     */
+
+    if (iPtr->returnOpts != returnOpts) {
+	if (iPtr->returnOpts) {
+	    Tcl_DecrRefCount(iPtr->returnOpts);
+	}
+	iPtr->returnOpts = returnOpts;
+	Tcl_IncrRefCount(iPtr->returnOpts);
+    }
+
+    if (code == TCL_ERROR) {
+	if (iPtr->errorInfo) {
+	    Tcl_DecrRefCount(iPtr->errorInfo);
+	    iPtr->errorInfo = NULL;
+	}
+	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr);
+	if (valuePtr != NULL) {
+	    int infoLen;
+
+	    (void) TclGetStringFromObj(valuePtr, &infoLen);
+	    if (infoLen) {
+		iPtr->errorInfo = valuePtr;
+		Tcl_IncrRefCount(iPtr->errorInfo);
+		iPtr->flags |= ERR_ALREADY_LOGGED;
+	    }
+	}
+	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+	if (valuePtr != NULL) {
+	    Tcl_SetObjErrorCode(interp, valuePtr);
+	} else {
+	    Tcl_SetErrorCode(interp, "NONE", NULL);
+	}
+
+	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], &valuePtr);
+	if (valuePtr != NULL) {
+	    TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
+	}
+    }
+    if (level != 0) {
+	iPtr->returnLevel = level;
+	iPtr->returnCode = code;
+	return TCL_RETURN;
+    }
+    if (code == TCL_ERROR) {
+	iPtr->flags |= ERR_LEGACY_COPY;
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMergeReturnOptions --
+ *
+ *	Parses, checks, and stores the options to the [return] command.
+ *
+ * Results:
+ *	Returns TCL_ERROR is any of the option values are invalid. Otherwise,
+ *	returns TCL_OK, and writes the returnOpts, code, and level values to
+ *	the pointers provided.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMergeReturnOptions(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[],	/* Argument objects. */
+    Tcl_Obj **optionsPtrPtr,	/* If not NULL, points to space for a (Tcl_Obj
+				 * *) where the pointer to the merged return
+				 * options dictionary should be written */
+    int *codePtr,		/* If not NULL, points to space where the
+				 * -code value should be written */
+    int *levelPtr)		/* If not NULL, points to space where the
+				 * -level value should be written */
+{
+    int code=TCL_OK;
+    int level = 1;
+    Tcl_Obj *valuePtr;
+    Tcl_Obj *returnOpts = Tcl_NewObj();
+    Tcl_Obj **keys = GetKeys();
+
+    for (;  objc > 1;  objv += 2, objc -= 2) {
+	int optLen;
+	CONST char *opt = TclGetStringFromObj(objv[0], &optLen);
+	int compareLen;
+	CONST char *compare =
+		TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
+
+	if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
+	    Tcl_DictSearch search;
+	    int done = 0;
+	    Tcl_Obj *keyPtr;
+	    Tcl_Obj *dict = objv[1];
+
+	nestedOptions:
+	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict, &search,
+		    &keyPtr, &valuePtr, &done)) {
+		/*
+		 * Value is not a legal dictionary.
+		 */
+
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "bad ", compare,
+			" value: expected dictionary but got \"",
+			TclGetString(objv[1]), "\"", NULL);
+		goto error;
+	    }
+
+	    while (!done) {
+		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);
+		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
+	    }
+
+	    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_OPTIONS], &valuePtr);
+	    if (valuePtr != NULL) {
+		dict = valuePtr;
+		Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_OPTIONS]);
+		goto nestedOptions;
+	    }
+
+	} else {
+	    Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]);
+	}
+    }
+
+    /*
+     * Check for bogus -code value.
+     */
+
+    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
+    if ((valuePtr != NULL)
+	    && (TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &code))) {
+	static CONST char *returnCodes[] = {
+	    "ok", "error", "return", "break", "continue", NULL
+	};
+
+	if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
+		NULL, TCL_EXACT, &code)) {
+	    /*
+	     * Value is not a legal return code.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "bad completion code \"",
+		    TclGetString(valuePtr),
+		    "\": must be ok, error, return, break, "
+		    "continue, or an integer", NULL);
+	    goto error;
+	}
+    }
+    if (valuePtr != NULL) {
+	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
+    }
+
+    /*
+     * Check for bogus -level value.
+     */
+
+    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr);
+    if (valuePtr != NULL) {
+	if ((TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &level))
+		|| (level < 0)) {
+	    /*
+	     * Value is not a legal level.
+	     */
+
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "bad -level value: "
+		    "expected non-negative integer but got \"",
+		    TclGetString(valuePtr), "\"", NULL);
+	    goto error;
+	}
+	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
+    }
+
+    /*
+     * Check for bogus -errorcode value.
+     */
+
+    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+    if (valuePtr != NULL) {
+	int length;
+
+	if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
+	    /*
+	     * Value is not a list, which is illegal for -errorcode.
+	     */
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "bad -errorcode value: "
+			     "expected a list but got \"",
+			     TclGetString(valuePtr), "\"", NULL);
+	    goto error;
+	}
+    }
+
+    /*
+     * Convert [return -code return -level X] to [return -code ok -level X+1]
+     */
+
+    if (code == TCL_RETURN) {
+	level++;
+	code = TCL_OK;
+    }
+
+    if (codePtr != NULL) {
+	*codePtr = code;
+    }
+    if (levelPtr != NULL) {
+	*levelPtr = level;
+    }
+
+    if (optionsPtrPtr == NULL) {
+	/*
+	 * Not passing back the options (?!), so clean them up.
+	 */
+
+	Tcl_DecrRefCount(returnOpts);
+    } else {
+	*optionsPtrPtr = returnOpts;
+    }
+    return TCL_OK;
+
+  error:
+    Tcl_DecrRefCount(returnOpts);
+    return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_GetReturnOptions --
+ *
+ *	Packs up the interp state into a dictionary of return options.
+ *
+ * Results:
+ *	A dictionary of return options.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetReturnOptions(
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *options;
+    Tcl_Obj **keys = GetKeys();
+
+    if (iPtr->returnOpts) {
+	options = Tcl_DuplicateObj(iPtr->returnOpts);
+    } else {
+	options = Tcl_NewObj();
+    }
+
+    if (result == TCL_RETURN) {
+	Tcl_DictObjPut(NULL, options, keys[KEY_CODE],
+		Tcl_NewIntObj(iPtr->returnCode));
+	Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL],
+		Tcl_NewIntObj(iPtr->returnLevel));
+    } else {
+	Tcl_DictObjPut(NULL, options, keys[KEY_CODE],
+		Tcl_NewIntObj(result));
+	Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL],
+		Tcl_NewIntObj(0));
+    }
+
+    if (result == TCL_ERROR) {
+	Tcl_AddObjErrorInfo(interp, "", -1);
+    }
+    if (iPtr->errorCode) {
+	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
+    }
+    if (iPtr->errorInfo) {
+	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
+	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE],
+		Tcl_NewIntObj(iPtr->errorLine));
+    }
+    return options;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_SetReturnOptions --
+ *
+ *	Accepts an interp and a dictionary of return options, and sets the
+ *	return options of the interp to match the dictionary.
+ *
+ * Results:
+ *	A standard status code. Usually TCL_OK, but TCL_ERROR if an invalid
+ *	option value was found in the dictionary. If a -level value of 0 is in
+ *	the dictionary, then the -code value in the dictionary will be
+ *	returned (TCL_OK default).
+ *
+ * Side effects:
+ *	Sets the state of the interp.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tcl_SetReturnOptions(
+    Tcl_Interp *interp,
+    Tcl_Obj *options)
+{
+    int objc, level, code;
+    Tcl_Obj **objv, *mergedOpts;
+
+    Tcl_IncrRefCount(options);
+    if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
+	    || (objc % 2)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "expected dict but got \"",
+		TclGetString(options), "\"", NULL);
+	code = TCL_ERROR;
+    } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
+	    &mergedOpts, &code, &level)) {
+	code = TCL_ERROR;
+    } else {
+	code = TclProcessReturn(interp, code, level, mergedOpts);
+    }
+
+    Tcl_DecrRefCount(options);
+    return code;
 }
 
 /*
@@ -965,83 +1538,72 @@ Tcl_SetObjErrorCode(interp, errorObjPtr)
  *
  * TclTransferResult --
  *
- *	Copy the result (and error information) from one interp to 
- *	another.  Used when one interp has caused another interp to 
- *	evaluate a script and then wants to transfer the results back
- *	to itself.
+ *	Copy the result (and error information) from one interp to another.
+ *	Used when one interp has caused another interp to evaluate a script
+ *	and then wants to transfer the results back to itself.
  *
- *	This routine copies the string reps of the result and error 
- *	information.  It does not simply increment the refcounts of the
- *	result and error information objects themselves.
- *	It is not legal to exchange objects between interps, because an
- *	object may be kept alive by one interp, but have an internal rep 
- *	that is only valid while some other interp is alive.  
+ *	This routine copies the string reps of the result and error
+ *	information. It does not simply increment the refcounts of the result
+ *	and error information objects themselves. It is not legal to exchange
+ *	objects between interps, because an object may be kept alive by one
+ *	interp, but have an internal rep that is only valid while some other
+ *	interp is alive.
  *
  * Results:
  *	The target interp's result is set to a copy of the source interp's
- *	result.  The source's error information "$errorInfo" may be
- *	appended to the target's error information and the source's error
- *	code "$errorCode" may be stored in the target's error code.
+ *	result. The source's errorInfo field may be transferred to the
+ *	target's errorInfo field, and the source's errorCode field may be
+ *	transferred to the target's errorCode field.
  *
  * Side effects:
  *	None.
  *
  *-------------------------------------------------------------------------
  */
-	
+
 void
-TclTransferResult(sourceInterp, result, targetInterp)
-    Tcl_Interp *sourceInterp;	/* Interp whose result and error information
-				 * should be moved to the target interp.  
-				 * After moving result, this interp's result 
+TclTransferResult(
+    Tcl_Interp *sourceInterp,	/* Interp whose result and error information
+				 * should be moved to the target interp.
+				 * After moving result, this interp's result
 				 * is reset. */
-    int result;			/* TCL_OK if just the result should be copied, 
-				 * TCL_ERROR if both the result and error 
+    int result,			/* TCL_OK if just the result should be copied,
+				 * TCL_ERROR if both the result and error
 				 * information should be copied. */
-    Tcl_Interp *targetInterp;	/* Interp where result and error information 
-				 * should be stored.  If source and target
-				 * are the same, nothing is done. */
+    Tcl_Interp *targetInterp)	/* Interp where result and error information
+				 * should be stored. If source and target are
+				 * the same, nothing is done. */
 {
-    Interp *iPtr;
-    Tcl_Obj *objPtr;
+    Interp *tiPtr = (Interp *) targetInterp;
+    Interp *siPtr = (Interp *) sourceInterp;
 
     if (sourceInterp == targetInterp) {
 	return;
     }
 
-    if (result == TCL_ERROR) {
+    if (result == TCL_OK && siPtr->returnOpts == NULL) {
 	/*
-	 * An error occurred, so transfer error information from the source
-	 * interpreter to the target interpreter.  Setting the flags tells
-	 * the target interp that it has inherited a partial traceback
-	 * chain, not just a simple error message.
+	 * Special optimization for the common case of normal command return
+	 * code and no explicit return options.
 	 */
 
-	iPtr = (Interp *) sourceInterp;
-        if ((iPtr->flags & ERR_ALREADY_LOGGED) == 0) {
-            Tcl_AddErrorInfo(sourceInterp, "");
-        }
-        iPtr->flags &= ~(ERR_ALREADY_LOGGED);
-        
-        Tcl_ResetResult(targetInterp);
-        
-	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL,
-		TCL_GLOBAL_ONLY);
-	if (objPtr) {
-	    Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,
-		    TCL_GLOBAL_ONLY);
-	    ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS;
+	if (tiPtr->returnOpts) {
+	    Tcl_DecrRefCount(tiPtr->returnOpts);
+	    tiPtr->returnOpts = NULL;
 	}
-
-	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
-		TCL_GLOBAL_ONLY);
-	if (objPtr) {
-	    Tcl_SetObjErrorCode(targetInterp, objPtr);
-	}
-
+    } else {
+	Tcl_SetReturnOptions(targetInterp,
+		Tcl_GetReturnOptions(sourceInterp, result));
+	tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
     }
-
-    ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode;
     Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
     Tcl_ResetResult(sourceInterp);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclScan.c b/generic/tclScan.c
index b72bd88..d83c8c9 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -1,41 +1,31 @@
-/* 
+/*
  * tclScan.c --
  *
  *	This file contains the implementation of the "scan" command.
  *
  * Copyright (c) 1998 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-/*
- * For strtoll() and strtoull() declarations on some platforms...
- */
-#include "tclPort.h"
 
 /*
  * Flag values used by Tcl_ScanObjCmd.
  */
 
-#define SCAN_NOSKIP	0x1		  /* Don't skip blanks. */
-#define SCAN_SUPPRESS	0x2		  /* Suppress assignment. */
-#define SCAN_UNSIGNED	0x4		  /* Read an unsigned value. */
-#define SCAN_WIDTH	0x8		  /* A width value was supplied. */
-
-#define SCAN_SIGNOK	0x10		  /* A +/- character is allowed. */
-#define SCAN_NODIGITS	0x20		  /* No digits have been scanned. */
-#define SCAN_NOZERO	0x40		  /* No zero digits have been scanned. */
-#define SCAN_XOK	0x80		  /* An 'x' is allowed. */
-#define SCAN_PTOK	0x100		  /* Decimal point is allowed. */
-#define SCAN_EXPOK	0x200		  /* An exponent is allowed. */
+#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
+#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
+#define SCAN_UNSIGNED	0x4		/* Read an unsigned value. */
+#define SCAN_WIDTH	0x8		/* A width value was supplied. */
 
-#define SCAN_LONGER	0x400		  /* Asked for a wide value. */
+#define SCAN_LONGER	0x400		/* Asked for a wide value. */
+#define SCAN_BIG	0x800		/* Asked for a bignum value. */
 
 /*
- * The following structure contains the information associated with
- * a character set.
+ * The following structure contains the information associated with a
+ * character set.
  */
 
 typedef struct CharSet {
@@ -53,20 +43,20 @@ typedef struct CharSet {
  * Declarations for functions used only in this file.
  */
 
-static char *	BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));
-static int	CharInSet _ANSI_ARGS_((CharSet *cset, int ch));
-static void	ReleaseCharSet _ANSI_ARGS_((CharSet *cset));
-static int	ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
-		    int numVars, int *totalVars));
+static char *		BuildCharSet(CharSet *cset, char *format);
+static int		CharInSet(CharSet *cset, int ch);
+static void		ReleaseCharSet(CharSet *cset);
+static int		ValidateFormat(Tcl_Interp *interp, char *format,
+			    int numVars, int *totalVars);
 
 /*
  *----------------------------------------------------------------------
  *
  * BuildCharSet --
  *
- *	This function examines a character set format specification
- *	and builds a CharSet containing the individual characters and
- *	character ranges specified.
+ *	This function examines a character set format specification and builds
+ *	a CharSet containing the individual characters and character ranges
+ *	specified.
  *
  * Results:
  *	Returns the next format position.
@@ -78,16 +68,16 @@ static int	ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
  */
 
 static char *
-BuildCharSet(cset, format)
-    CharSet *cset;
-    char *format;		/* Points to first char of set. */
+BuildCharSet(
+    CharSet *cset,
+    char *format)		/* Points to first char of set. */
 {
     Tcl_UniChar ch, start;
     int offset, nranges;
     char *end;
 
     memset(cset, 0, sizeof(CharSet));
-    
+
     offset = Tcl_UtfToUniChar(format, &ch);
     if (ch == '^') {
 	cset->exclude = 1;
@@ -111,8 +101,8 @@ BuildCharSet(cset, format)
 	end += Tcl_UtfToUniChar(end, &ch);
     }
 
-    cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)
-	    * (end - format - 1));
+    cset->chars = (Tcl_UniChar *)
+	    ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
     if (nranges > 0) {
 	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
     } else {
@@ -133,8 +123,8 @@ BuildCharSet(cset, format)
     while (ch != ']') {
 	if (*format == '-') {
 	    /*
-	     * This may be the first character of a range, so don't add
-	     * it yet.
+	     * This may be the first character of a range, so don't add it
+	     * yet.
 	     */
 
 	    start = ch;
@@ -161,7 +151,7 @@ BuildCharSet(cset, format)
 		} else {
 		    cset->ranges[cset->nranges].start = ch;
 		    cset->ranges[cset->nranges].end = start;
-		}		    
+		}
 		cset->nranges++;
 	    }
 	} else {
@@ -189,13 +179,14 @@ BuildCharSet(cset, format)
  */
 
 static int
-CharInSet(cset, c)
-    CharSet *cset;
-    int c;			/* Character to test, passed as int because
-				 * of non-ANSI prototypes. */
+CharInSet(
+    CharSet *cset,
+    int c)			/* Character to test, passed as int because of
+				 * non-ANSI prototypes. */
 {
     Tcl_UniChar ch = (Tcl_UniChar) c;
     int i, match = 0;
+
     for (i = 0; i < cset->nchars; i++) {
 	if (cset->chars[i] == ch) {
 	    match = 1;
@@ -204,14 +195,13 @@ CharInSet(cset, c)
     }
     if (!match) {
 	for (i = 0; i < cset->nranges; i++) {
-	    if ((cset->ranges[i].start <= ch)
-		    && (ch <= cset->ranges[i].end)) {
+	    if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) {
 		match = 1;
 		break;
 	    }
 	}
     }
-    return (cset->exclude ? !match : match);    
+    return (cset->exclude ? !match : match);
 }
 
 /*
@@ -231,8 +221,8 @@ CharInSet(cset, c)
  */
 
 static void
-ReleaseCharSet(cset)
-    CharSet *cset;
+ReleaseCharSet(
+    CharSet *cset)
 {
     ckfree((char *)cset->chars);
     if (cset->ranges) {
@@ -245,8 +235,8 @@ ReleaseCharSet(cset)
  *
  * ValidateFormat --
  *
- *	Parse the format string and verify that it is properly formed
- *	and that there are exactly enough variables on the command line.
+ *	Parse the format string and verify that it is properly formed and that
+ *	there are exactly enough variables on the command line.
  *
  * Results:
  *	A standard Tcl result.
@@ -258,33 +248,27 @@ ReleaseCharSet(cset)
  */
 
 static int
-ValidateFormat(interp, format, numVars, totalSubs)
-    Tcl_Interp *interp;		/* Current interpreter. */
-    char *format;		/* The format string. */
-    int numVars;		/* The number of variables passed to the
-				 * scan command. */
-    int *totalSubs;		/* The number of variables that will be
+ValidateFormat(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    char *format,		/* The format string. */
+    int numVars,		/* The number of variables passed to the scan
+				 * command. */
+    int *totalSubs)		/* The number of variables that will be
 				 * required. */
 {
-#define STATIC_LIST_SIZE 16
     int gotXpg, gotSequential, value, i, flags;
     char *end;
     Tcl_UniChar ch;
-    int staticAssign[STATIC_LIST_SIZE];
-    int *nassign = staticAssign;
-    int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+    int objIndex, xpgSize, nspace = numVars;
+    int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int));
     char buf[TCL_UTF_MAX+1];
 
     /*
-     * Initialize an array that records the number of times a variable
-     * is assigned to by the format string.  We use this to detect if
-     * a variable is multiply assigned or left unassigned.
+     * Initialize an array that records the number of times a variable is
+     * assigned to by the format string. We use this to detect if a variable
+     * is multiply assigned or left unassigned.
      */
 
-    if (numVars > nspace) {
-	nassign = (int*)ckalloc(sizeof(int) * numVars);
-	nspace = numVars;
-    }
     for (i = 0; i < nspace; i++) {
 	nassign[i] = 0;
     }
@@ -309,14 +293,14 @@ ValidateFormat(interp, format, numVars, totalSubs)
 	    goto xpgCheckDone;
 	}
 
-	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
 	    /*
-	     * Check for an XPG3-style %n$ specification.  Note: there
-	     * must not be a mixture of XPG3 specs and non-XPG3 specs
-	     * in the same format string.
+	     * Check for an XPG3-style %n$ specification. Note: there must
+	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
+	     * format string.
 	     */
 
-	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
 	    if (*end != '$') {
 		goto notXpg;
 	    }
@@ -333,31 +317,31 @@ ValidateFormat(interp, format, numVars, totalSubs)
 		/*
 		 * In the case where no vars are specified, the user can
 		 * specify %9999$ legally, so we have to consider special
-		 * rules for growing the assign array.  'value' is
-		 * guaranteed to be > 0.
+		 * rules for growing the assign array. 'value' is guaranteed
+		 * to be > 0.
 		 */
 		xpgSize = (xpgSize > value) ? xpgSize : value;
 	    }
 	    goto xpgCheckDone;
 	}
 
-	notXpg:
+    notXpg:
 	gotSequential = 1;
 	if (gotXpg) {
-	    mixedXPG:
+	mixedXPG:
 	    Tcl_SetResult(interp,
 		    "cannot mix \"%\" and \"%n$\" conversion specifiers",
 		    TCL_STATIC);
 	    goto error;
 	}
 
-	xpgCheckDone:
+    xpgCheckDone:
 	/*
 	 * Parse any width specifier.
 	 */
 
-	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
-	    value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    value = strtoul(format-1, &format, 10);	/* INTL: "C" locale. */
 	    flags |= SCAN_WIDTH;
 	    format += Tcl_UtfToUniChar(format, &ch);
 	}
@@ -368,6 +352,12 @@ ValidateFormat(interp, format, numVars, totalSubs)
 
 	switch (ch) {
 	case 'l':
+	    if (*format == 'l') {
+		flags |= SCAN_BIG;
+		format += 1;
+		format += Tcl_UtfToUniChar(format, &ch);
+		break;
+	    }
 	case 'L':
 	    flags |= SCAN_LONGER;
 	case 'h':
@@ -383,104 +373,104 @@ ValidateFormat(interp, format, numVars, totalSubs)
 	 */
 
 	switch (ch) {
-	    case 'c':
-                if (flags & SCAN_WIDTH) {
-		    Tcl_SetResult(interp,
-			    "field width may not be specified in %c conversion",
-			    TCL_STATIC);
-		    goto error;
-                }
-		/*
-		 * Fall through!
-		 */
-	    case 'n':
-	    case 's':
-		if (flags & SCAN_LONGER) {
-		invalidLonger:
-		    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			   "'l' modifier may not be specified in %", buf,
-			   " conversion", NULL);
-		    goto error;
-		}
-		/*
-		 * Fall through!
-		 */
-	    case 'd':
-	    case 'e':
-	    case 'f':
-	    case 'g':
-	    case 'i':
-	    case 'o':
-	    case 'u':
-	    case 'x':
- 		break;
-		/*
-		 * Bracket terms need special checking
-		 */
-	    case '[':
-		if (flags & SCAN_LONGER) {
-		    goto invalidLonger;
-		}
+	case 'c':
+	    if (flags & SCAN_WIDTH) {
+		Tcl_SetResult(interp,
+			"field width may not be specified in %c conversion",
+			TCL_STATIC);
+		goto error;
+	    }
+	    /*
+	     * Fall through!
+	     */
+	case 'n':
+	case 's':
+	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
+	    invalidFieldSize:
+		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+		Tcl_AppendResult(interp,
+			"field size modifier may not be specified in %", buf,
+			" conversion", NULL);
+		goto error;
+	    }
+	    /*
+	     * Fall through!
+	     */
+	case 'd':
+	case 'e':
+	case 'f':
+	case 'g':
+	case 'i':
+	case 'o':
+	case 'x':
+	    break;
+	case 'u':
+	    if (flags & SCAN_BIG) {
+		Tcl_SetResult(interp,
+			"unsigned bignum scans are invalid", TCL_STATIC);
+		goto error;
+	    }
+	    break;
+	    /*
+	     * Bracket terms need special checking
+	     */
+	case '[':
+	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
+		goto invalidFieldSize;
+	    }
+	    if (*format == '\0') {
+		goto badSet;
+	    }
+	    format += Tcl_UtfToUniChar(format, &ch);
+	    if (ch == '^') {
 		if (*format == '\0') {
 		    goto badSet;
 		}
 		format += Tcl_UtfToUniChar(format, &ch);
-		if (ch == '^') {
-		    if (*format == '\0') {
-			goto badSet;
-		    }
-		    format += Tcl_UtfToUniChar(format, &ch);
-		}
-		if (ch == ']') {
-		    if (*format == '\0') {
-			goto badSet;
-		    }
-		    format += Tcl_UtfToUniChar(format, &ch);
+	    }
+	    if (ch == ']') {
+		if (*format == '\0') {
+		    goto badSet;
 		}
-		while (ch != ']') {
-		    if (*format == '\0') {
-			goto badSet;
-		    }
-		    format += Tcl_UtfToUniChar(format, &ch);
+		format += Tcl_UtfToUniChar(format, &ch);
+	    }
+	    while (ch != ']') {
+		if (*format == '\0') {
+		    goto badSet;
 		}
-		break;
-	    badSet:
-		Tcl_SetResult(interp, "unmatched [ in format string",
-			TCL_STATIC);
-		goto error;
-	    default:
+		format += Tcl_UtfToUniChar(format, &ch);
+	    }
+	    break;
+	badSet:
+	    Tcl_SetResult(interp, "unmatched [ in format string",
+		    TCL_STATIC);
+	    goto error;
+	default:
 	    {
 		char buf[TCL_UTF_MAX+1];
 
 		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"bad scan conversion character \"", buf, "\"", NULL);
+		Tcl_AppendResult(interp, "bad scan conversion character \"",
+			buf, "\"", NULL);
 		goto error;
 	    }
 	}
 	if (!(flags & SCAN_SUPPRESS)) {
 	    if (objIndex >= nspace) {
 		/*
-		 * Expand the nassign buffer.  If we are using XPG specifiers,
-		 * make sure that we grow to a large enough size.  xpgSize is
+		 * Expand the nassign buffer. If we are using XPG specifiers,
+		 * make sure that we grow to a large enough size. xpgSize is
 		 * guaranteed to be at least one larger than objIndex.
 		 */
+
 		value = nspace;
 		if (xpgSize) {
 		    nspace = xpgSize;
 		} else {
-		    nspace += STATIC_LIST_SIZE;
-		}
-		if (nassign == staticAssign) {
-		    nassign = (void *)ckalloc(nspace * sizeof(int));
-		    for (i = 0; i < STATIC_LIST_SIZE; ++i) {
-			nassign[i] = staticAssign[i];
-		    }
-		} else {
-		    nassign = (void *)ckrealloc((void *)nassign,
-			    nspace * sizeof(int));
+		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
 		}
+		nassign = (int *) TclStackRealloc(interp, nassign,
+			nspace * sizeof(int));
 		for (i = value; i < nspace; i++) {
 		    nassign[i] = 0;
 		}
@@ -506,39 +496,39 @@ ValidateFormat(interp, format, numVars, totalSubs)
     }
     for (i = 0; i < numVars; i++) {
 	if (nassign[i] > 1) {
-	    Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
+	    Tcl_SetResult(interp,
+		    "variable is assigned by multiple \"%n$\" conversion specifiers",
+		    TCL_STATIC);
 	    goto error;
 	} else if (!xpgSize && (nassign[i] == 0)) {
 	    /*
-	     * If the space is empty, and xpgSize is 0 (means XPG wasn't
-	     * used, and/or numVars != 0), then too many vars were given
+	     * If the space is empty, and xpgSize is 0 (means XPG wasn't used,
+	     * and/or numVars != 0), then too many vars were given
 	     */
-	    Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
+
+	    Tcl_SetResult(interp,
+		    "variable is not assigned by any conversion specifiers",
+		    TCL_STATIC);
 	    goto error;
 	}
     }
 
-    if (nassign != staticAssign) {
-	ckfree((char *)nassign);
-    }
+    TclStackFree(interp, nassign);
     return TCL_OK;
 
-    badIndex:
+  badIndex:
     if (gotXpg) {
 	Tcl_SetResult(interp, "\"%n$\" argument index out of range",
 		TCL_STATIC);
     } else {
-	Tcl_SetResult(interp, 
+	Tcl_SetResult(interp,
 		"different numbers of variable names and field specifiers",
 		TCL_STATIC);
     }
 
-    error:
-    if (nassign != staticAssign) {
-	ckfree((char *)nassign);
-    }
+  error:
+    TclStackFree(interp, nassign);
     return TCL_ERROR;
-#undef STATIC_LIST_SIZE
 }
 
 /*
@@ -546,8 +536,8 @@ ValidateFormat(interp, format, numVars, totalSubs)
  *
  * Tcl_ScanObjCmd --
  *
- *	This procedure is invoked to process the "scan" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "scan" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -560,35 +550,29 @@ ValidateFormat(interp, format, numVars, totalSubs)
 
 	/* ARGSUSED */
 int
-Tcl_ScanObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;    	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ScanObjCmd(
+    ClientData dummy,    	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     char *format;
     int numVars, nconversions, totalVars = -1;
     int objIndex, offset, i, result, code;
     long value;
-    char *string, *end, *baseString;
+    CONST char *string, *end, *baseString;
     char op = 0;
-    int base = 0;
-    int underflow = 0;
-    size_t width;
-    long (*fn)() = NULL;
-#ifndef TCL_WIDE_INT_IS_LONG
-    Tcl_WideInt (*lfn)() = NULL;
+    int width, underflow = 0;
     Tcl_WideInt wideValue;
-#endif
     Tcl_UniChar ch, sch;
     Tcl_Obj **objs = NULL, *objPtr = NULL;
     int flags;
-    char buf[513];			  /* Temporary buffer to hold scanned
-					   * number strings before they are
-					   * passed to strtoul. */
+    char buf[513];		/* Temporary buffer to hold scanned number
+				 * strings before they are passed to
+				 * strtoul. */
 
     if (objc < 3) {
-        Tcl_WrongNumArgs(interp, 1, objv,
+	Tcl_WrongNumArgs(interp, 1, objv,
 		"string format ?varName varName ...?");
 	return TCL_ERROR;
     }
@@ -599,7 +583,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     /*
      * Check for errors in the format string.
      */
-    
+
     if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
 	return TCL_ERROR;
     }
@@ -619,14 +603,15 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     baseString = string;
 
     /*
-     * Iterate over the format string filling in the result objects until
-     * we reach the end of input, the end of the format string, or there
-     * is a mismatch.
+     * Iterate over the format string filling in the result objects until we
+     * reach the end of input, the end of the format string, or there is a
+     * mismatch.
      */
 
     objIndex = 0;
     nconversions = 0;
     while (*format != '\0') {
+	int parseFlag = TCL_PARSE_NO_WHITESPACE;
 	format += Tcl_UtfToUniChar(format, &ch);
 
 	flags = 0;
@@ -646,9 +631,9 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	    }
 	    continue;
 	}
-	    
+
 	if (ch != '%') {
-	    literal:
+	literal:
 	    if (*string == '\0') {
 		underflow = 1;
 		goto done;
@@ -666,17 +651,18 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	}
 
 	/*
-	 * Check for assignment suppression ('*') or an XPG3-style
-	 * assignment ('%n$').
+	 * Check for assignment suppression ('*') or an XPG3-style assignment
+	 * ('%n$').
 	 */
 
 	if (ch == '*') {
 	    flags |= SCAN_SUPPRESS;
 	    format += Tcl_UtfToUniChar(format, &ch);
-	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
-	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
-	    if (*end == '$') {
-		format = end+1;
+	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    char *formatEnd;
+	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
+	    if (*formatEnd == '$') {
+		format = formatEnd+1;
 		format += Tcl_UtfToUniChar(format, &ch);
 		objIndex = (int) value - 1;
 	    }
@@ -686,8 +672,8 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	 * Parse any width specifier.
 	 */
 
-	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
-	    width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    width = (int) strtoul(format-1, &format, 10);/* INTL: "C" locale. */
 	    format += Tcl_UtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
@@ -699,6 +685,12 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 
 	switch (ch) {
 	case 'l':
+	    if (*format == 'l') {
+		flags |= SCAN_BIG;
+		format += 1;
+		format += Tcl_UtfToUniChar(format, &ch);
+		break;
+	    }
 	case 'L':
 	    flags |= SCAN_LONGER;
 	    /*
@@ -713,90 +705,70 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	 */
 
 	switch (ch) {
-	    case 'n':
-		if (!(flags & SCAN_SUPPRESS)) {
-		    objPtr = Tcl_NewIntObj(string - baseString);
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
-		}
-		nconversions++;
-		continue;
+	case 'n':
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewIntObj(string - baseString);
+		Tcl_IncrRefCount(objPtr);
+		objs[objIndex++] = objPtr;
+	    }
+	    nconversions++;
+	    continue;
 
-	    case 'd':
-		op = 'i';
-		base = 10;
-		fn = (long (*)())strtol;
-#ifndef TCL_WIDE_INT_IS_LONG
-		lfn = (Tcl_WideInt (*)())strtoll;
-#endif
-		break;
-	    case 'i':
-		op = 'i';
-		base = 0;
-		fn = (long (*)())strtol;
-#ifndef TCL_WIDE_INT_IS_LONG
-		lfn = (Tcl_WideInt (*)())strtoll;
-#endif
-		break;
-	    case 'o':
-		op = 'i';
-		base = 8;
-		fn = (long (*)())strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
-		lfn = (Tcl_WideInt (*)())strtoull;
-#endif
-		break;
-	    case 'x':
-		op = 'i';
-		base = 16;
-		fn = (long (*)())strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
-		lfn = (Tcl_WideInt (*)())strtoull;
-#endif
-		break;
-	    case 'u':
-		op = 'i';
-		base = 10;
-		flags |= SCAN_UNSIGNED;
-		fn = (long (*)())strtoul;
-#ifndef TCL_WIDE_INT_IS_LONG
-		lfn = (Tcl_WideInt (*)())strtoull;
-#endif
-		break;
+	case 'd':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
+	    break;
+	case 'i':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_SCAN_PREFIXES;
+	    break;
+	case 'o':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
+	    break;
+	case 'x':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
+	    break;
+	case 'u':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
+	    flags |= SCAN_UNSIGNED;
+	    break;
 
-	    case 'f':
-	    case 'e':
-	    case 'g':
-		op = 'f';
-		break;
+	case 'f':
+	case 'e':
+	case 'g':
+	    op = 'f';
+	    break;
 
-	    case 's':
-		op = 's';
-		break;
+	case 's':
+	    op = 's';
+	    break;
 
-	    case 'c':
-		op = 'c';
-		flags |= SCAN_NOSKIP;
-		break;
-	    case '[':
-		op = '[';
-		flags |= SCAN_NOSKIP;
-		break;
+	case 'c':
+	    op = 'c';
+	    flags |= SCAN_NOSKIP;
+	    break;
+	case '[':
+	    op = '[';
+	    flags |= SCAN_NOSKIP;
+	    break;
 	}
 
 	/*
-	 * At this point, we will need additional characters from the
-	 * string to proceed.
+	 * At this point, we will need additional characters from the string
+	 * to proceed.
 	 */
 
 	if (*string == '\0') {
 	    underflow = 1;
 	    goto done;
 	}
-	
+
 	/*
-	 * Skip any leading whitespace at the beginning of a field unless
-	 * the format suppresses this behavior.
+	 * Skip any leading whitespace at the beginning of a field unless the
+	 * format suppresses this behavior.
 	 */
 
 	if (!(flags & SCAN_NOSKIP)) {
@@ -816,373 +788,217 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	/*
 	 * Perform the requested scanning operation.
 	 */
-	
+
 	switch (op) {
-	    case 's':
-		/*
-		 * Scan a string up to width characters or whitespace.
-		 */
+	case 's':
+	    /*
+	     * Scan a string up to width characters or whitespace.
+	     */
 
-		if (width == 0) {
-		    width = (size_t) ~0;
-		}
-		end = string;
-		while (*end != '\0') {
-		    offset = Tcl_UtfToUniChar(end, &sch);
-		    if (Tcl_UniCharIsSpace(sch)) {
-			break;
-		    }
-		    end += offset;
-		    if (--width == 0) {
-			break;
-		    }
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    end = string;
+	    while (*end != '\0') {
+		offset = Tcl_UtfToUniChar(end, &sch);
+		if (Tcl_UniCharIsSpace(sch)) {
+		    break;
 		}
-		if (!(flags & SCAN_SUPPRESS)) {
-		    objPtr = Tcl_NewStringObj(string, end-string);
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
+		end += offset;
+		if (--width == 0) {
+		    break;
 		}
-		string = end;
-		break;
-
-	    case '[': {
-		CharSet cset;
+	    }
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewStringObj(string, end-string);
+		Tcl_IncrRefCount(objPtr);
+		objs[objIndex++] = objPtr;
+	    }
+	    string = end;
+	    break;
 
-		if (width == 0) {
-		    width = (size_t) ~0;
-		}
-		end = string;
+	case '[': {
+	    CharSet cset;
 
-		format = BuildCharSet(&cset, format);
-		while (*end != '\0') {
-		    offset = Tcl_UtfToUniChar(end, &sch);
-		    if (!CharInSet(&cset, (int)sch)) {
-			break;
-		    }
-		    end += offset;
-		    if (--width == 0) {
-			break;
-		    }
-		}
-		ReleaseCharSet(&cset);
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    end = string;
 
-		if (string == end) {
-		    /*
-		     * Nothing matched the range, stop processing
-		     */
-		    goto done;
+	    format = BuildCharSet(&cset, format);
+	    while (*end != '\0') {
+		offset = Tcl_UtfToUniChar(end, &sch);
+		if (!CharInSet(&cset, (int)sch)) {
+		    break;
 		}
-		if (!(flags & SCAN_SUPPRESS)) {
-		    objPtr = Tcl_NewStringObj(string, end-string);
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
+		end += offset;
+		if (--width == 0) {
+		    break;
 		}
-		string = end;
-		
-		break;
 	    }
-	    case 'c':
-		/*
-		 * Scan a single Unicode character.
-		 */
-
-		string += Tcl_UtfToUniChar(string, &sch);
-		if (!(flags & SCAN_SUPPRESS)) {
-		    objPtr = Tcl_NewIntObj((int)sch);
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
-		}
-		break;
+	    ReleaseCharSet(&cset);
 
-	    case 'i':
+	    if (string == end) {
 		/*
-		 * Scan an unsigned or signed integer.
+		 * Nothing matched the range, stop processing.
 		 */
+		goto done;
+	    }
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewStringObj(string, end-string);
+		Tcl_IncrRefCount(objPtr);
+		objs[objIndex++] = objPtr;
+	    }
+	    string = end;
 
-		if ((width == 0) || (width > sizeof(buf) - 1)) {
-		    width = sizeof(buf) - 1;
-		}
-		flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
-		for (end = buf; width > 0; width--) {
-		    switch (*string) {
-			/*
-			 * The 0 digit has special meaning at the beginning of
-			 * a number.  If we are unsure of the base, it
-			 * indicates that we are in base 8 or base 16 (if it is
-			 * followed by an 'x').
-			 *
-			 * 8.1 - 8.3.4 incorrectly handled 0x... base-16
-			 * cases for %x by not reading the 0x as the
-			 * auto-prelude for base-16. [Bug #495213]
-			 */
-			case '0':
-			    if (base == 0) {
-				base = 8;
-				flags |= SCAN_XOK;
-			    }
-			    if (base == 16) {
-				flags |= SCAN_XOK;
-			    }
-			    if (flags & SCAN_NOZERO) {
-				flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS
-					| SCAN_NOZERO);
-			    } else {
-				flags &= ~(SCAN_SIGNOK | SCAN_XOK
-					| SCAN_NODIGITS);
-			    }
-			    goto addToInt;
-
-			case '1': case '2': case '3': case '4':
-			case '5': case '6': case '7':
-			    if (base == 0) {
-				base = 10;
-			    }
-			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
-			    goto addToInt;
-
-			case '8': case '9':
-			    if (base == 0) {
-				base = 10;
-			    }
-			    if (base <= 8) {
-				break;
-			    }
-			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
-			    goto addToInt;
-
-			case 'A': case 'B': case 'C':
-			case 'D': case 'E': case 'F': 
-			case 'a': case 'b': case 'c':
-			case 'd': case 'e': case 'f':
-			    if (base <= 10) {
-				break;
-			    }
-			    flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
-			    goto addToInt;
-
-			case '+': case '-':
-			    if (flags & SCAN_SIGNOK) {
-				flags &= ~SCAN_SIGNOK;
-				goto addToInt;
-			    }
-			    break;
-
-			case 'x': case 'X':
-			    if ((flags & SCAN_XOK) && (end == buf+1)) {
-				base = 16;
-				flags &= ~SCAN_XOK;
-				goto addToInt;
-			    }
-			    break;
-		    }
-
-		    /*
-		     * We got an illegal character so we are done accumulating.
-		     */
-
-		    break;
+	    break;
+	}
+	case 'c':
+	    /*
+	     * Scan a single Unicode character.
+	     */
 
-		    addToInt:
-		    /*
-		     * Add the character to the temporary buffer.
-		     */
+	    string += Tcl_UtfToUniChar(string, &sch);
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewIntObj((int)sch);
+		Tcl_IncrRefCount(objPtr);
+		objs[objIndex++] = objPtr;
+	    }
+	    break;
 
-		    *end++ = *string++;
-		    if (*string == '\0') {
-			break;
+	case 'i':
+	    /*
+	     * Scan an unsigned or signed integer.
+	     */
+	    objPtr = Tcl_NewLongObj(0);
+	    Tcl_IncrRefCount(objPtr);
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+		    &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
+		Tcl_DecrRefCount(objPtr);
+		if (width < 0) {
+		    if (*end == '\0') {
+			underflow = 1;
 		    }
-		}
-
-		/*
-		 * Check to see if we need to back up because we only got a
-		 * sign or a trailing x after a 0.
-		 */
-
-		if (flags & SCAN_NODIGITS) {
-		    if (*string == '\0') {
+		} else {
+		    if (end == string + width) {
 			underflow = 1;
 		    }
-		    goto done;
-		} else if (end[-1] == 'x' || end[-1] == 'X') {
-		    end--;
-		    string--;
 		}
-
-
-		/*
-		 * Scan the value from the temporary buffer.  If we are
-		 * returning a large unsigned value, we have to convert it back
-		 * to a string since Tcl only supports signed values.
-		 */
-
-		if (!(flags & SCAN_SUPPRESS)) {
-		    *end = '\0';
-#ifndef TCL_WIDE_INT_IS_LONG
-		    if (flags & SCAN_LONGER) {
-			wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base);
-			if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
-			    /* INTL: ISO digit */
-			    sprintf(buf, "%" TCL_LL_MODIFIER "u",
-				    (Tcl_WideUInt)wideValue);
-			    objPtr = Tcl_NewStringObj(buf, -1);
-			} else {
-			    objPtr = Tcl_NewWideIntObj(wideValue);
-			}
-		    } else {
-#endif /* !TCL_WIDE_INT_IS_LONG */
-			value = (long) (*fn)(buf, NULL, base);
-			if ((flags & SCAN_UNSIGNED) && (value < 0)) {
-			    sprintf(buf, "%lu", value); /* INTL: ISO digit */
-			    objPtr = Tcl_NewStringObj(buf, -1);
-			} else if ((flags & SCAN_LONGER)
-				|| (unsigned long) value > UINT_MAX) {
-			    objPtr = Tcl_NewLongObj(value);
-			} else {
-			    objPtr = Tcl_NewIntObj(value);
-			}
-#ifndef TCL_WIDE_INT_IS_LONG
+		goto done;
+	    }
+	    string = end;
+	    if (flags & SCAN_SUPPRESS) {
+		Tcl_DecrRefCount(objPtr);
+		break;
+	    }
+	    if (flags & SCAN_LONGER) {
+		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
+		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
+		    if (TclGetString(objPtr)[0] == '-') {
+			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
 		    }
-#endif
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
 		}
-
-		break;
-
-	    case 'f':
-		/*
-		 * Scan a floating point number
-		 */
-
-		if ((width == 0) || (width > sizeof(buf) - 1)) {
-		    width = sizeof(buf) - 1;
+		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
+		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
+			    (Tcl_WideUInt)wideValue);
+		    Tcl_SetStringObj(objPtr, buf, -1);
+		} else {
+		    Tcl_SetWideIntObj(objPtr, wideValue);
 		}
-		flags &= ~SCAN_LONGER;
-		flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
-		for (end = buf; width > 0; width--) {
-		    switch (*string) {
-			case '0': case '1': case '2': case '3':
-			case '4': case '5': case '6': case '7':
-			case '8': case '9':
-			    flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
-			    goto addToFloat;
-			case '+': case '-':
-			    if (flags & SCAN_SIGNOK) {
-				flags &= ~SCAN_SIGNOK;
-				goto addToFloat;
-			    }
-			    break;
-			case '.':
-			    if (flags & SCAN_PTOK) {
-				flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
-				goto addToFloat;
-			    }
-			    break;
-			case 'e': case 'E':
-			    /*
-			     * An exponent is not allowed until there has
-			     * been at least one digit.
-			     */
-
-			    if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))
-				    == SCAN_EXPOK) {
-				flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
-				    | SCAN_SIGNOK | SCAN_NODIGITS;
-				goto addToFloat;
-			    }
-			    break;
-		    }
-
-		    /*
-		     * We got an illegal character so we are done accumulating.
-		     */
-
-		    break;
-
-		    addToFloat:
-		    /*
-		     * Add the character to the temporary buffer.
-		     */
-
-		    *end++ = *string++;
-		    if (*string == '\0') {
-			break;
+	    } else if (!(flags & SCAN_BIG)) {
+		if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
+		    if (TclGetString(objPtr)[0] == '-') {
+			value = LONG_MIN;
+		    } else {
+			value = LONG_MAX;
 		    }
 		}
+		if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
+		    Tcl_SetStringObj(objPtr, buf, -1);
+		} else {
+		    Tcl_SetLongObj(objPtr, value);
+		}
+	    }
+	    objs[objIndex++] = objPtr;
+	    break;
 
-		/*
-		 * Check to see if we need to back up because we saw a
-		 * trailing 'e' or sign.
-		 */
+	case 'f':
+	    /*
+	     * Scan a floating point number
+	     */
 
-		if (flags & SCAN_NODIGITS) {
-		    if (flags & SCAN_EXPOK) {
-			/*
-			 * There were no digits at all so scanning has
-			 * failed and we are done.
-			 */
-			if (*string == '\0') {
-			    underflow = 1;
-			}
-			goto done;
+	    objPtr = Tcl_NewDoubleObj(0.0);
+	    Tcl_IncrRefCount(objPtr);
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
+		Tcl_DecrRefCount(objPtr);
+		if (width < 0) {
+		    if (*end == '\0') {
+			underflow = 1;
 		    }
-
-		    /*
-		     * We got a bad exponent ('e' and maybe a sign).
-		     */
-
-		    end--;
-		    string--;
-		    if (*end != 'e' && *end != 'E') {
-			end--;
-			string--;
+		} else {
+		    if (end == string + width) {
+			underflow = 1;
 		    }
 		}
-
-		/*
-		 * Scan the value from the temporary buffer.
-		 */
-
-		if (!(flags & SCAN_SUPPRESS)) {
-		    double dvalue;
-		    *end = '\0';
-		    dvalue = strtod(buf, NULL);
-		    objPtr = Tcl_NewDoubleObj(dvalue);
-		    Tcl_IncrRefCount(objPtr);
-		    objs[objIndex++] = objPtr;
+		goto done;
+	    } else if (flags & SCAN_SUPPRESS) {
+		Tcl_DecrRefCount(objPtr);
+		string = end;
+	    } else {
+		double dvalue;
+		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
+#ifdef ACCEPT_NAN
+		    if (objPtr->typePtr == &tclDoubleType) {
+			dvalue = objPtr->internalRep.doubleValue;
+		    } else
+#endif
+		    {
+			Tcl_DecrRefCount(objPtr);
+			goto done;
+		    }
 		}
-		break;
+		Tcl_SetDoubleObj(objPtr, dvalue);
+		objs[objIndex++] = objPtr;
+		string = end;
+	    }
 	}
 	nconversions++;
     }
 
-    done:
+  done:
     result = 0;
     code = TCL_OK;
 
     if (numVars) {
 	/*
-	 * In this case, variables were specified (classic scan)
+	 * In this case, variables were specified (classic scan).
 	 */
+
 	for (i = 0; i < totalVars; i++) {
-	    if (objs[i] != NULL) {
-		Tcl_Obj *tmpPtr;
-		
-		result++;
-		tmpPtr = Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0);
-		Tcl_DecrRefCount(objs[i]);
-		if (tmpPtr == NULL) {
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "couldn't set variable \"",
-			    Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
-		    code = TCL_ERROR;
-		}
+	    if (objs[i] == NULL) {
+		continue;
+	    }
+	    result++;
+	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
+		Tcl_AppendResult(interp, "couldn't set variable \"",
+			TclGetString(objv[i+3]), "\"", NULL);
+		code = TCL_ERROR;
 	    }
+	    Tcl_DecrRefCount(objs[i]);
 	}
     } else {
 	/*
 	 * Here no vars were specified, we want a list returned (inline scan)
 	 */
+
 	objPtr = Tcl_NewObj();
 	for (i = 0; i < totalVars; i++) {
 	    if (objs[i] != NULL) {
@@ -1190,9 +1006,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 		Tcl_DecrRefCount(objs[i]);
 	    } else {
 		/*
-		 * More %-specifiers than matching chars, so we
-		 * just spit out empty strings for these
+		 * More %-specifiers than matching chars, so we just spit out
+		 * empty strings for these.
 		 */
+
 		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
 	    }
 	}
@@ -1218,3 +1035,11 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     }
     return code;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
new file mode 100755
index 0000000..76adf75
--- /dev/null
+++ b/generic/tclStrToD.c
@@ -0,0 +1,4991 @@
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclStrToD.c --
+ *
+ *	This file contains a collection of procedures for managing conversions
+ *	to/from floating-point in Tcl. They include TclParseNumber, which
+ *	parses numbers from strings; TclDoubleDigits, which formats numbers
+ *	into strings of digits, and procedures for interconversion among
+ *	'double' and 'mp_int' types.
+ *
+ * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *----------------------------------------------------------------------
+ */
+
+#include "tclInt.h"
+#include "tommath.h"
+#include <math.h>
+
+/*
+ * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
+ * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
+ */
+
+#undef	KILL_OCTAL
+
+/*
+ * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
+ * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
+ * uniquely determined by radix and by the widths of significand and exponent.
+ */
+
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+#   define IEEE_FLOATING_POINT
+#endif
+
+/*
+ * gcc on x86 needs access to rounding controls, because of a questionable
+ * feature where it retains intermediate results as IEEE 'long double' values
+ * somewhat unpredictably. It is tempting to include fpu_control.h, but that
+ * file exists only on Linux; it is missing on Cygwin and MinGW. Most gcc-isms
+ * and ix86-isms are factored out here.
+ */
+
+#if defined(__GNUC__) && defined(__i386)
+typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
+#define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw))
+#define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw))
+#   define FPU_IEEE_ROUNDING	0x027f
+#   define ADJUST_FPU_CONTROL_WORD
+#endif
+
+/* Sun ProC needs sunmath for rounding control on x86 like gcc above.
+ *
+ *
+ */
+#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+#include <sunmath.h>
+#endif
+
+/*
+ * MIPS floating-point units need special settings in control registers
+ * to use gradual underflow as we expect.  This fix is for the MIPSpro
+ * compiler.  
+ */
+#if defined(__sgi) && defined(_COMPILER_VERSION)
+#include <sys/fpu.h>
+#endif
+/*
+ * HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN.
+ * Everyone else uses 7ff8000000000000. (Why, HP, why?)
+ */
+
+#ifdef __hppa
+#   define NAN_START 0x7ff4
+#   define NAN_MASK (((Tcl_WideUInt) 1) << 50)
+#else
+#   define NAN_START 0x7ff8
+#   define NAN_MASK (((Tcl_WideUInt) 1) << 51)
+#endif
+
+/*
+ * Constants used by this file (most of which are only ever calculated at
+ * runtime).
+ */
+
+/* Magic constants */
+
+#define LOG10_2 0.3010299956639812
+#define TWO_OVER_3LOG10 0.28952965460216784
+#define LOG10_3HALVES_PLUS_FUDGE 0.1760912590558
+
+/* Definitions of the parts of an IEEE754-format floating point number */
+
+#define SIGN_BIT 		0x80000000
+				/* Mask for the sign bit in the first
+				 * word of a double */
+#define EXP_MASK	     	0x7ff00000
+				/* Mask for the exponent field in the
+				 * first word of a double */
+#define EXP_SHIFT		20
+				/* Shift count to make the exponent an 
+				 * integer */
+#define HIDDEN_BIT		(((Tcl_WideUInt) 0x00100000) << 32)
+				/* Hidden 1 bit for the significand */
+#define HI_ORDER_SIG_MASK	0x000fffff
+				/* Mask for the high-order part of the
+				 * significand in the first word of a
+				 * double */
+#define SIG_MASK		(((Tcl_WideUInt) HI_ORDER_SIG_MASK << 32) \
+				 | 0xffffffff)
+				/* Mask for the 52-bit significand. */
+#define FP_PRECISION		53
+				/* Number of bits of significand plus the
+				 * hidden bit */
+#define EXPONENT_BIAS		0x3ff
+				/* Bias of the exponent 0 */
+
+/* Derived quantities */
+
+#define TEN_PMAX		22
+				/* floor(FP_PRECISION*log(2)/log(5)) */
+#define QUICK_MAX		14
+				/* floor((FP_PRECISION-1)*log(2)/log(10)) - 1 */
+#define BLETCH			0x10
+				/* Highest power of two that is greater than
+				 * DBL_MAX_10_EXP, divided by 16 */
+#define DIGIT_GROUP		8
+				/* floor(DIGIT_BIT*log(2)/log(10)) */
+
+/* Union used to dismantle floating point numbers. */
+
+typedef union Double {
+    struct {
+#ifdef WORDS_BIGENDIAN
+	int word0;
+	int word1;
+#else
+	int word1;
+	int word0;
+#endif
+    } w;
+    double d;
+    Tcl_WideUInt q;
+} Double;
+
+static int maxpow10_wide;	/* The powers of ten that can be represented
+				 * exactly as wide integers. */
+static Tcl_WideUInt *pow10_wide;
+#define MAXPOW	22
+static double pow10vals[MAXPOW+1];
+				/* The powers of ten that can be represented
+				 * exactly as IEEE754 doubles. */
+static int mmaxpow;		/* Largest power of ten that can be
+				 * represented exactly in a 'double'. */
+static int log10_DIGIT_MAX;	/* The number of decimal digits that fit in an
+				 * mp_digit. */
+static int log2FLT_RADIX;	/* Logarithm of the floating point radix. */
+static int mantBits;		/* Number of bits in a double's significand */
+static mp_int pow5[9];		/* Table of powers of 5**(2**n), up to
+				 * 5**256 */
+static double tiny = 0.0;		/* The smallest representable double */
+static int maxDigits;		/* The maximum number of digits to the left of
+				 * the decimal point of a double. */
+static int minDigits;		/* The maximum number of digits to the right
+				 * of the decimal point in a double. */
+static const double pow_10_2_n[] = {	/* Inexact higher powers of ten. */
+    1.0,
+    100.0,
+    10000.0,
+    1.0e+8,
+    1.0e+16,
+    1.0e+32,
+    1.0e+64,
+    1.0e+128,
+    1.0e+256
+};
+
+static int n770_fp;		/* Flag is 1 on Nokia N770 floating point.
+				 * Nokia's floating point has the words
+				 * reversed: if big-endian is 7654 3210,
+				 * and little-endian is       0123 4567,
+				 * then Nokia's FP is         4567 0123;
+				 * little-endian within the 32-bit words
+				 * but big-endian between them. */
+
+/* Table of powers of 5 that are small enough to fit in an mp_digit. */
+
+static const mp_digit dpow5[13] = {
+               1,              5,             25,            125,
+             625,           3125,          15625,          78125,
+          390625,        1953125,        9765625,       48828125,
+       244140625
+};
+
+/* Table of powers: pow5_13[n] = 5**(13*2**(n+1)) */
+static mp_int pow5_13[5];	/* Table of powers: 5**13, 5**26, 5**52,
+				 * 5**104, 5**208 */
+static const double tens[] = {
+    1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09,
+    1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+    1e20, 1e21, 1e22
+};
+
+static const int itens [] = {
+    1,
+    10,
+    100,
+    1000,
+    10000,
+    100000,
+    1000000,
+    10000000,
+    100000000
+};
+
+static const double bigtens[] = {
+    1e016, 1e032, 1e064, 1e128, 1e256
+};
+#define N_BIGTENS 5
+
+static const int log2pow5[27] = {
+    01,  3,  5,  7, 10, 12, 14, 17, 19, 21,
+    24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
+    47, 49, 52, 54, 56, 59, 61
+};
+#define N_LOG2POW5 27
+
+static const Tcl_WideUInt wuipow5[27] = {
+    (Tcl_WideUInt) 1,		/* 5**0 */
+    (Tcl_WideUInt) 5,
+    (Tcl_WideUInt) 25,
+    (Tcl_WideUInt) 125,
+    (Tcl_WideUInt) 625,
+    (Tcl_WideUInt) 3125,	/* 5**5 */
+    (Tcl_WideUInt) 3125*5,
+    (Tcl_WideUInt) 3125*25,
+    (Tcl_WideUInt) 3125*125,
+    (Tcl_WideUInt) 3125*625,
+    (Tcl_WideUInt) 3125*3125,	/* 5**10 */
+    (Tcl_WideUInt) 3125*3125*5,
+    (Tcl_WideUInt) 3125*3125*25,
+    (Tcl_WideUInt) 3125*3125*125,
+    (Tcl_WideUInt) 3125*3125*625,
+    (Tcl_WideUInt) 3125*3125*3125, /* 5**15 */
+    (Tcl_WideUInt) 3125*3125*3125*5,
+    (Tcl_WideUInt) 3125*3125*3125*25,
+    (Tcl_WideUInt) 3125*3125*3125*125,
+    (Tcl_WideUInt) 3125*3125*3125*625,
+    (Tcl_WideUInt) 3125*3125*3125*3125,	/* 5**20 */
+    (Tcl_WideUInt) 3125*3125*3125*3125*5,
+    (Tcl_WideUInt) 3125*3125*3125*3125*25,
+    (Tcl_WideUInt) 3125*3125*3125*3125*125,
+    (Tcl_WideUInt) 3125*3125*3125*3125*625,
+    (Tcl_WideUInt) 3125*3125*3125*3125*3125,  /* 5**25 */
+    (Tcl_WideUInt) 3125*3125*3125*3125*3125*5 /* 5**26 */
+};
+
+/*
+ * Static functions defined in this file.
+ */
+
+static int		AccumulateDecimalDigit(unsigned, int, 
+			    Tcl_WideUInt *, mp_int *, int);
+static double		MakeHighPrecisionDouble(int signum,
+			    mp_int *significand, int nSigDigs, int exponent);
+static double		MakeLowPrecisionDouble(int signum,
+			    Tcl_WideUInt significand, int nSigDigs,
+			    int exponent);
+static double		MakeNaN(int signum, Tcl_WideUInt tag);
+static double		RefineApproximation(double approx,
+			    mp_int *exactSignificand, int exponent);
+static void		MulPow5(mp_int*, unsigned, mp_int*);
+static int 		NormalizeRightward(Tcl_WideUInt*);
+static int		RequiredPrecision(Tcl_WideUInt);
+static void		DoubleToExpAndSig(double, Tcl_WideUInt*, int*, int*);
+static void		TakeAbsoluteValue(Double*, int*);
+static char*		FormatInfAndNaN(Double*, int*, char**);
+static char*		FormatZero(int*, char**);
+static int		ApproximateLog10(Tcl_WideUInt, int, int);
+static int		BetterLog10(double, int, int*);
+static void		ComputeScale(int, int, int*, int*, int*, int*);
+static void		SetPrecisionLimits(int, int, int*, int*, int*, int*);
+static char*		BumpUp(char*, char*, int*);
+static int		AdjustRange(double*, int);
+static char*		ShorteningQuickFormat(double, int, int, double, 
+			    char*, int*);
+static char*		StrictQuickFormat(double, int, int, double,
+			    char*, int*);
+static char*		QuickConversion(double, int, int, int, int, int, int,
+			    int*, char**);
+static void		CastOutPowersOf2(int*, int*, int*);
+static char*		ShorteningInt64Conversion(Double*, int, Tcl_WideUInt,
+			    int, int, int, int, int, int, int, int, int,
+			    int, int, int*, char**);
+static char*		StrictInt64Conversion(Double*, int, Tcl_WideUInt,
+			    int, int, int, int, int, int,
+			    int, int, int*, char**);
+static int		ShouldBankerRoundUpPowD(mp_int*, int, int);
+static int		ShouldBankerRoundUpToNextPowD(mp_int*, mp_int*,
+			    int, int, int, mp_int*);
+static char*		ShorteningBignumConversionPowD(Double* dPtr, 
+			    int convType, Tcl_WideUInt bw, int b2, int b5,
+			    int m2plus, int m2minus, int m5,
+			    int sd, int k, int len, 
+			    int ilim, int ilim1, int* decpt,
+			    char** endPtr);
+static char*		StrictBignumConversionPowD(Double* dPtr, int convType,
+			    Tcl_WideUInt bw, int b2, int b5,
+			    int sd, int k, int len, 
+			    int ilim, int ilim1, int* decpt,
+			    char** endPtr);
+static int		ShouldBankerRoundUp(mp_int*, mp_int*, int);
+static int		ShouldBankerRoundUpToNext(mp_int*, mp_int*, mp_int*,
+			    int, int, mp_int*);
+static char*		ShorteningBignumConversion(Double* dPtr, int convType,
+			    Tcl_WideUInt bw, int b2,
+			    int m2plus, int m2minus,
+			    int s2, int s5, int k, int len, 
+			    int ilim, int ilim1, int* decpt,
+			    char** endPtr);
+static char*		StrictBignumConversion(Double* dPtr, int convType,
+			    Tcl_WideUInt bw, int b2,
+			    int s2, int s5, int k, int len, 
+			    int ilim, int ilim1, int* decpt,
+			    char** endPtr);
+static double		BignumToBiasedFrExp(mp_int *big, int *machexp);
+static double		Pow10TimesFrExp(int exponent, double fraction,
+			    int *machexp);
+static double		SafeLdExp(double fraction, int exponent);
+static Tcl_WideUInt	Nokia770Twiddle(Tcl_WideUInt w);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseNumber --
+ *
+ *	Scans bytes, interpreted as characters in Tcl's internal encoding, and
+ *	parses the longest prefix that is the string representation of a
+ *	number in a format recognized by Tcl.
+ *
+ *	The arguments bytes, numBytes, and objPtr are the inputs which
+ *	determine the string to be parsed. If bytes is non-NULL, it points to
+ *	the first byte to be scanned. If bytes is NULL, then objPtr must be
+ *	non-NULL, and the string representation of objPtr will be scanned
+ *	(generated first, if necessary). The numBytes argument determines the
+ *	number of bytes to be scanned. If numBytes is negative, the first NUL
+ *	byte encountered will terminate the scan. If numBytes is non-negative,
+ *	then no more than numBytes bytes will be scanned.
+ *
+ *	The argument flags is an input that controls the numeric formats
+ *	recognized by the parser. The flag bits are:
+ *
+ *	- TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
+ *		strings that denote floating point values (or accept only the
+ *		leading portion of them that are integer values).
+ *	- TCL_PARSE_SCAN_PREFIXES:	ignore the prefixes 0b and 0o that are
+ *		not part of the [scan] command's vocabulary. Use only in
+ *		combination with TCL_PARSE_INTEGER_ONLY.
+ * 	- TCL_PARSE_OCTAL_ONLY:		parse only in the octal format, whether
+ *		or not a prefix is present that would lead to octal parsing.
+ *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
+ * 	- TCL_PARSE_HEXADECIMAL_ONLY:	parse only in the hexadecimal format,
+ *		whether or not a prefix is present that would lead to
+ *		hexadecimal parsing. Use only in combination with
+ *		TCL_PARSE_INTEGER_ONLY.
+ * 	- TCL_PARSE_DECIMAL_ONLY:	parse only in the decimal format, no
+ *		matter whether a 0 prefix would normally force a different
+ *		base.
+ *	- TCL_PARSE_NO_WHITESPACE:	reject any leading/trailing whitespace
+ *
+ *	The arguments interp and expected are inputs that control error
+ *	message generation. If interp is NULL, no error message will be
+ *	generated. If interp is non-NULL, then expected must also be non-NULL.
+ *	When TCL_ERROR is returned, an error message will be left in the
+ *	result of interp, and the expected argument will appear in the error
+ *	message as the thing TclParseNumber expected, but failed to find in
+ *	the string.
+ *
+ *	The arguments objPtr and endPtrPtr as well as the return code are the
+ *	outputs.
+ *
+ *	When the parser cannot find any prefix of the string that matches a
+ *	format it is looking for, TCL_ERROR is returned and an error message
+ *	may be generated and returned as described above. The contents of
+ *	objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to the
+ *	character in the string that terminated the scan will be written to
+ *	*endPtrPtr.
+ *
+ *	When the parser determines that the entire string matches a format it
+ *	is looking for, TCL_OK is returned, and if objPtr is non-NULL, then
+ *	the internal rep and Tcl_ObjType of objPtr are set to the "canonical"
+ *	numeric value that matches the scanned string. If endPtrPtr is not
+ *	NULL, a pointer to the end of the string will be written to *endPtrPtr
+ *	(that is, either bytes+numBytes or a pointer to a terminating NUL
+ *	byte).
+ *
+ *	When the parser determines that a partial string matches a format it
+ *	is looking for, the value of endPtrPtr determines what happens:
+ *
+ *	- If endPtrPtr is NULL, then TCL_ERROR is returned, with error message
+ *		generation as above.
+ *
+ *	- If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr
+ *		internals are set as above. Also, a pointer to the first
+ *		character following the parsed numeric string is written to
+ *		*endPtrPtr.
+ *
+ *	In some cases where the string being scanned is the string rep of
+ *	objPtr, this routine can leave objPtr in an inconsistent state where
+ *	its string rep and its internal rep do not agree. In these cases the
+ *	internal rep will be in agreement with only some substring of the
+ *	string rep. This might happen if the caller passes in a non-NULL bytes
+ *	value that points somewhere into the string rep. It might happen if
+ *	the caller passes in a numBytes value that limits the scan to only a
+ *	prefix of the string rep. Or it might happen if a non-NULL value of
+ *	endPtrPtr permits a TCL_OK return from only a partial string match. It
+ *	is the responsibility of the caller to detect and correct such
+ *	inconsistencies when they can and do arise.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	The string representaton of objPtr may be generated.
+ *
+ *	The internal representation and Tcl_ObjType of objPtr may be changed.
+ *	This may involve allocation and/or freeing of memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclParseNumber(
+    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
+    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
+    const char *expected,	/* Description of the type of number the
+				 * caller expects to be able to parse
+				 * ("integer", "boolean value", etc.). */
+    const char *bytes,		/* Pointer to the start of the string to
+				 * scan. */
+    int numBytes,		/* Maximum number of bytes to scan, see
+				 * above. */
+    const char **endPtrPtr,	/* Place to store pointer to the character
+				 * that terminated the scan. */
+    int flags)			/* Flags governing the parse. */
+{
+    enum State {
+	INITIAL, SIGNUM, ZERO, ZERO_X,
+	ZERO_O, ZERO_B, BINARY,
+	HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
+	LEADING_RADIX_POINT, FRACTION,
+	EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
+	sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
+#ifdef IEEE_FLOATING_POINT
+	, sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
+#endif
+    } state = INITIAL;
+    enum State acceptState = INITIAL;
+
+    int signum = 0;		/* Sign of the number being parsed */
+    Tcl_WideUInt significandWide = 0;
+				/* Significand of the number being parsed (if
+				 * no overflow) */
+    mp_int significandBig;	/* Significand of the number being parsed (if
+				 * it overflows significandWide) */
+    int significandOverflow = 0;/* Flag==1 iff significandBig is used */
+    Tcl_WideUInt octalSignificandWide = 0;
+				/* Significand of an octal number; needed
+				 * because we don't know whether a number with
+				 * a leading zero is octal or decimal until
+				 * we've scanned forward to a '.' or 'e' */
+    mp_int octalSignificandBig;	/* Significand of octal number once
+				 * octalSignificandWide overflows */
+    int octalSignificandOverflow = 0;
+				/* Flag==1 if octalSignificandBig is used */
+    int numSigDigs = 0;		/* Number of significant digits in the decimal
+				 * significand */
+    int numTrailZeros = 0;	/* Number of trailing zeroes at the current
+				 * point in the parse. */
+    int numDigitsAfterDp = 0;	/* Number of digits scanned after the decimal
+				 * point */
+    int exponentSignum = 0;	/* Signum of the exponent of a floating point
+				 * number */
+    long exponent = 0;		/* Exponent of a floating point number */
+    const char *p;		/* Pointer to next character to scan */
+    size_t len;			/* Number of characters remaining after p */
+    const char *acceptPoint;	/* Pointer to position after last character in
+				 * an acceptable number */
+    size_t acceptLen;		/* Number of characters following that
+				 * point. */
+    int status = TCL_OK;	/* Status to return to caller */
+    char d = 0;			/* Last hexadecimal digit scanned; initialized
+				 * to avoid a compiler warning. */
+    int shift = 0;		/* Amount to shift when accumulating binary */
+    int explicitOctal = 0;
+
+#define ALL_BITS	(~(Tcl_WideUInt)0)
+#define MOST_BITS	(ALL_BITS >> 1)
+
+    /*
+     * Initialize bytes to start of the object's string rep if the caller
+     * didn't pass anything else.
+     */
+
+    if (bytes == NULL) {
+	bytes = TclGetString(objPtr);
+    }
+
+    p = bytes;
+    len = numBytes;
+    acceptPoint = p;
+    acceptLen = len;
+    while (1) {
+	char c = len ? *p : '\0';
+	switch (state) {
+
+	case INITIAL:
+	    /*
+	     * Initial state. Acceptable characters are +, -, digits, period,
+	     * I, N, and whitespace.
+	     */
+
+	    if (TclIsSpaceProc(c)) {
+		if (flags & TCL_PARSE_NO_WHITESPACE) {
+		    goto endgame;
+		}
+		break;
+	    } else if (c == '+') {
+		state = SIGNUM;
+		break;
+	    } else if (c == '-') {
+		signum = 1;
+		state = SIGNUM;
+		break;
+	    }
+	    /* FALLTHROUGH */
+
+	case SIGNUM:
+	    /*
+	     * Scanned a leading + or -. Acceptable characters are digits,
+	     * period, I, and N.
+	     */
+
+	    if (c == '0') {
+		if (flags & TCL_PARSE_DECIMAL_ONLY) {
+		    state = DECIMAL;
+		} else {
+		    state = ZERO;
+		}
+		break;
+	    } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
+		goto zerox;
+	    } else if (flags & TCL_PARSE_OCTAL_ONLY) {
+		goto zeroo;
+	    } else if (isdigit(UCHAR(c))) {
+		significandWide = c - '0';
+		numSigDigs = 1;
+		state = DECIMAL;
+		break;
+	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
+		goto endgame;
+	    } else if (c == '.') {
+		state = LEADING_RADIX_POINT;
+		break;
+	    } else if (c == 'I' || c == 'i') {
+		state = sI;
+		break;
+#ifdef IEEE_FLOATING_POINT
+	    } else if (c == 'N' || c == 'n') {
+		state = sN;
+		break;
+#endif
+	    }
+	    goto endgame;
+
+	case ZERO:
+	    /*
+	     * Scanned a leading zero (perhaps with a + or -). Acceptable
+	     * inputs are digits, period, X, b, and E. If 8 or 9 is encountered,
+	     * the number can't be octal. This state and the OCTAL state
+	     * differ only in whether they recognize 'X' and 'b'.
+	     */
+
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (c == 'x' || c == 'X') {
+		state = ZERO_X;
+		break;
+	    }
+	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
+		goto zerox;
+	    }
+	    if (flags & TCL_PARSE_SCAN_PREFIXES) {
+		goto zeroo;
+	    }
+	    if (c == 'b' || c == 'B') {
+		state = ZERO_B;
+		break;
+	    }
+	    if (c == 'o' || c == 'O') {
+		explicitOctal = 1;
+		state = ZERO_O;
+		break;
+	    }
+#ifdef KILL_OCTAL
+	    goto decimal;
+#endif
+	    /* FALLTHROUGH */
+
+	case OCTAL:
+	    /*
+	     * Scanned an optional + or -, followed by a string of octal
+	     * digits. Acceptable inputs are more digits, period, or E. If 8
+	     * or 9 is encountered, commit to floating point.
+	     */
+
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    /* FALLTHROUGH */
+	case ZERO_O:
+	zeroo:
+	    if (c == '0') {
+		numTrailZeros++;
+		state = OCTAL;
+		break;
+	    } else if (c >= '1' && c <= '7') {
+		if (objPtr != NULL) {
+		    shift = 3 * (numTrailZeros + 1);
+		    significandOverflow = AccumulateDecimalDigit(
+			    (unsigned)(c-'0'), numTrailZeros,
+			    &significandWide, &significandBig,
+			    significandOverflow);
+
+		    if (!octalSignificandOverflow) {
+			/*
+			 * Shifting by more bits than are in the value being
+			 * shifted is at least de facto nonportable. Check for
+			 * too large shifts first.
+			 */
+
+			if ((octalSignificandWide != 0)
+				&& (((size_t)shift >=
+					CHAR_BIT*sizeof(Tcl_WideUInt))
+				|| (octalSignificandWide >
+					(~(Tcl_WideUInt)0 >> shift)))) {
+			    octalSignificandOverflow = 1;
+			    TclBNInitBignumFromWideUInt(&octalSignificandBig,
+				    octalSignificandWide);
+			}
+		    }
+		    if (!octalSignificandOverflow) {
+			octalSignificandWide =
+				(octalSignificandWide << shift) + (c - '0');
+		    } else {
+			mp_mul_2d(&octalSignificandBig, shift,
+				&octalSignificandBig);
+			mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'),
+				&octalSignificandBig);
+		    }
+		}
+		if (numSigDigs != 0) {
+		    numSigDigs += numTrailZeros+1;
+		} else {
+		    numSigDigs = 1;
+		}
+		numTrailZeros = 0;
+		state = OCTAL;
+		break;
+	    }
+	    /* FALLTHROUGH */
+
+	case BAD_OCTAL:
+	    if (explicitOctal) {
+		/*
+		 * No forgiveness for bad digits in explicitly octal numbers.
+		 */
+
+		goto endgame;
+	    }
+	    if (flags & TCL_PARSE_INTEGER_ONLY) {
+		/*
+		 * No seeking floating point when parsing only integer.
+		 */
+
+		goto endgame;
+	    }
+#ifndef KILL_OCTAL
+
+	    /*
+	     * Scanned a number with a leading zero that contains an 8, 9,
+	     * radix point or E. This is an invalid octal number, but might
+	     * still be floating point.
+	     */
+
+	    if (c == '0') {
+		numTrailZeros++;
+		state = BAD_OCTAL;
+		break;
+	    } else if (isdigit(UCHAR(c))) {
+		if (objPtr != NULL) {
+		    significandOverflow = AccumulateDecimalDigit(
+			    (unsigned)(c-'0'), numTrailZeros,
+			    &significandWide, &significandBig,
+			    significandOverflow);
+		}
+		if (numSigDigs != 0) {
+		    numSigDigs += (numTrailZeros + 1);
+		} else {
+		    numSigDigs = 1;
+		}
+		numTrailZeros = 0;
+		state = BAD_OCTAL;
+		break;
+	    } else if (c == '.') {
+		state = FRACTION;
+		break;
+	    } else if (c == 'E' || c == 'e') {
+		state = EXPONENT_START;
+		break;
+	    }
+#endif
+	    goto endgame;
+
+	    /*
+	     * Scanned 0x. If state is HEXADECIMAL, scanned at least one
+	     * character following the 0x. The only acceptable inputs are
+	     * hexadecimal digits.
+	     */
+
+	case HEXADECIMAL:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    /* FALLTHROUGH */
+
+	case ZERO_X:
+	zerox:
+	    if (c == '0') {
+		numTrailZeros++;
+		state = HEXADECIMAL;
+		break;
+	    } else if (isdigit(UCHAR(c))) {
+		d = (c-'0');
+	    } else if (c >= 'A' && c <= 'F') {
+		d = (c-'A'+10);
+	    } else if (c >= 'a' && c <= 'f') {
+		d = (c-'a'+10);
+	    } else {
+		goto endgame;
+	    }
+	    if (objPtr != NULL) {
+		shift = 4 * (numTrailZeros + 1);
+		if (!significandOverflow) {
+		    /*
+		     * Shifting by more bits than are in the value being
+		     * shifted is at least de facto nonportable. Check for too
+		     * large shifts first.
+		     */
+
+		    if (significandWide != 0 &&
+			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+			    significandWide > (~(Tcl_WideUInt)0 >> shift))) {
+			significandOverflow = 1;
+			TclBNInitBignumFromWideUInt(&significandBig,
+				significandWide);
+		    }
+		}
+		if (!significandOverflow) {
+		    significandWide = (significandWide << shift) + d;
+		} else {
+		    mp_mul_2d(&significandBig, shift, &significandBig);
+		    mp_add_d(&significandBig, (mp_digit) d, &significandBig);
+		}
+	    }
+	    numTrailZeros = 0;
+	    state = HEXADECIMAL;
+	    break;
+
+	case BINARY:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	case ZERO_B:
+	    if (c == '0') {
+		numTrailZeros++;
+		state = BINARY;
+		break;
+	    } else if (c != '1') {
+		goto endgame;
+	    }
+	    if (objPtr != NULL) {
+		shift = numTrailZeros + 1;
+		if (!significandOverflow) {
+		    /*
+		     * Shifting by more bits than are in the value being
+		     * shifted is at least de facto nonportable. Check for too
+		     * large shifts first.
+		     */
+
+		    if (significandWide != 0 &&
+			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+			    significandWide > (~(Tcl_WideUInt)0 >> shift))) {
+			significandOverflow = 1;
+			TclBNInitBignumFromWideUInt(&significandBig,
+				significandWide);
+		    }
+		}
+		if (!significandOverflow) {
+		    significandWide = (significandWide << shift) + 1;
+		} else {
+		    mp_mul_2d(&significandBig, shift, &significandBig);
+		    mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
+		}
+	    }
+	    numTrailZeros = 0;
+	    state = BINARY;
+	    break;
+
+	case DECIMAL:
+	    /*
+	     * Scanned an optional + or - followed by a string of decimal
+	     * digits.
+	     */
+
+#ifdef KILL_OCTAL
+	decimal:
+#endif
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (c == '0') {
+		numTrailZeros++;
+		state = DECIMAL;
+		break;
+	    } else if (isdigit(UCHAR(c))) {
+		if (objPtr != NULL) {
+		    significandOverflow = AccumulateDecimalDigit(
+			    (unsigned)(c - '0'), numTrailZeros,
+			    &significandWide, &significandBig,
+			    significandOverflow);
+		}
+		numSigDigs += numTrailZeros+1;
+		numTrailZeros = 0;
+		state = DECIMAL;
+		break;
+	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
+		goto endgame;
+	    } else if (c == '.') {
+		state = FRACTION;
+		break;
+	    } else if (c == 'E' || c == 'e') {
+		state = EXPONENT_START;
+		break;
+	    }
+	    goto endgame;
+
+	    /*
+	     * Found a decimal point. If no digits have yet been scanned, E is
+	     * not allowed; otherwise, it introduces the exponent. If at least
+	     * one digit has been found, we have a possible complete number.
+	     */
+
+	case FRACTION:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (c == 'E' || c=='e') {
+		state = EXPONENT_START;
+		break;
+	    }
+	    /* FALLTHROUGH */
+
+	case LEADING_RADIX_POINT:
+	    if (c == '0') {
+		numDigitsAfterDp++;
+		numTrailZeros++;
+		state = FRACTION;
+		break;
+	    } else if (isdigit(UCHAR(c))) {
+		numDigitsAfterDp++;
+		if (objPtr != NULL) {
+		    significandOverflow = AccumulateDecimalDigit(
+			    (unsigned)(c-'0'), numTrailZeros,
+			    &significandWide, &significandBig,
+			    significandOverflow);
+		}
+		if (numSigDigs != 0) {
+		    numSigDigs += numTrailZeros+1;
+		} else {
+		    numSigDigs = 1;
+		}
+		numTrailZeros = 0;
+		state = FRACTION;
+		break;
+	    }
+	    goto endgame;
+
+	case EXPONENT_START:
+	    /*
+	     * Scanned the E at the start of an exponent. Make sure a legal
+	     * character follows before using the C library strtol routine,
+	     * which allows whitespace.
+	     */
+
+	    if (c == '+') {
+		state = EXPONENT_SIGNUM;
+		break;
+	    } else if (c == '-') {
+		exponentSignum = 1;
+		state = EXPONENT_SIGNUM;
+		break;
+	    }
+	    /* FALLTHROUGH */
+
+	case EXPONENT_SIGNUM:
+	    /*
+	     * Found the E at the start of the exponent, followed by a sign
+	     * character.
+	     */
+
+	    if (isdigit(UCHAR(c))) {
+		exponent = c - '0';
+		state = EXPONENT;
+		break;
+	    }
+	    goto endgame;
+
+	case EXPONENT:
+	    /*
+	     * Found an exponent with at least one digit. Accumulate it,
+	     * making sure to hard-pin it to LONG_MAX on overflow.
+	     */
+
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (isdigit(UCHAR(c))) {
+		if (exponent < (LONG_MAX - 9) / 10) {
+		    exponent = 10 * exponent + (c - '0');
+		} else {
+		    exponent = LONG_MAX;
+		}
+		state = EXPONENT;
+		break;
+	    }
+	    goto endgame;
+
+	    /*
+	     * Parse out INFINITY by simply spelling it out. INF is accepted
+	     * as an abbreviation; other prefices are not.
+	     */
+
+	case sI:
+	    if (c == 'n' || c == 'N') {
+		state = sIN;
+		break;
+	    }
+	    goto endgame;
+	case sIN:
+	    if (c == 'f' || c == 'F') {
+		state = sINF;
+		break;
+	    }
+	    goto endgame;
+	case sINF:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (c == 'i' || c == 'I') {
+		state = sINFI;
+		break;
+	    }
+	    goto endgame;
+	case sINFI:
+	    if (c == 'n' || c == 'N') {
+		state = sINFIN;
+		break;
+	    }
+	    goto endgame;
+	case sINFIN:
+	    if (c == 'i' || c == 'I') {
+		state = sINFINI;
+		break;
+	    }
+	    goto endgame;
+	case sINFINI:
+	    if (c == 't' || c == 'T') {
+		state = sINFINIT;
+		break;
+	    }
+	    goto endgame;
+	case sINFINIT:
+	    if (c == 'y' || c == 'Y') {
+		state = sINFINITY;
+		break;
+	    }
+	    goto endgame;
+
+	    /*
+	     * Parse NaN's.
+	     */
+#ifdef IEEE_FLOATING_POINT
+	case sN:
+	    if (c == 'a' || c == 'A') {
+		state = sNA;
+		break;
+	    }
+	    goto endgame;
+	case sNA:
+	    if (c == 'n' || c == 'N') {
+		state = sNAN;
+		break;
+	    }
+	    goto endgame;
+	case sNAN:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    if (c == '(') {
+		state = sNANPAREN;
+		break;
+	    }
+	    goto endgame;
+
+	    /*
+	     * Parse NaN(hexdigits)
+	     */
+	case sNANHEX:
+	    if (c == ')') {
+		state = sNANFINISH;
+		break;
+	    }
+	    /* FALLTHROUGH */
+	case sNANPAREN:
+	    if (TclIsSpaceProc(c)) {
+		break;
+	    }
+	    if (numSigDigs < 13) {
+		if (c >= '0' && c <= '9') {
+		    d = c - '0';
+		} else if (c >= 'a' && c <= 'f') {
+		    d = 10 + c - 'a';
+		} else if (c >= 'A' && c <= 'F') {
+		    d = 10 + c - 'A';
+		} else {
+		    goto endgame;
+		}
+		numSigDigs++;
+		significandWide = (significandWide << 4) + d;
+		state = sNANHEX;
+		break;
+	    }
+	    goto endgame;
+	case sNANFINISH:
+#endif
+
+	case sINFINITY:
+	    acceptState = state;
+	    acceptPoint = p;
+	    acceptLen = len;
+	    goto endgame;
+	}
+	p++;
+	len--;
+    }
+
+  endgame:
+    if (acceptState == INITIAL) {
+	/*
+	 * No numeric string at all found.
+	 */
+
+	status = TCL_ERROR;
+	if (endPtrPtr != NULL) {
+	    *endPtrPtr = p;
+	}
+    } else {
+	/*
+	 * Back up to the last accepting state in the lexer.
+	 */
+
+	p = acceptPoint;
+	len = acceptLen;
+	if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
+	    /*
+	     * Accept trailing whitespace.
+	     */
+
+	    while (len != 0 && TclIsSpaceProc(*p)) {
+		p++;
+		len--;
+	    }
+	}
+	if (endPtrPtr == NULL) {
+	    if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
+		status = TCL_ERROR;
+	    }
+	} else {
+	    *endPtrPtr = p;
+	}
+    }
+
+    /*
+     * Generate and store the appropriate internal rep.
+     */
+
+    if (status == TCL_OK && objPtr != NULL) {
+	TclFreeIntRep(objPtr);
+	switch (acceptState) {
+	case SIGNUM:
+	case BAD_OCTAL:
+	case ZERO_X:
+	case ZERO_O:
+	case ZERO_B:
+	case LEADING_RADIX_POINT:
+	case EXPONENT_START:
+	case EXPONENT_SIGNUM:
+	case sI:
+	case sIN:
+	case sINFI:
+	case sINFIN:
+	case sINFINI:
+	case sINFINIT:
+#ifdef IEEE_FLOATING_POINT
+	case sN:
+	case sNA:
+	case sNANPAREN:
+	case sNANHEX:
+	    Tcl_Panic("TclParseNumber: bad acceptState %d parsing '%s'",
+		    acceptState, bytes);
+#endif
+	case BINARY:
+	    shift = numTrailZeros;
+	    if (!significandOverflow && significandWide != 0 &&
+		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+		    significandWide > (MOST_BITS + signum) >> shift)) {
+		significandOverflow = 1;
+		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+	    }
+	    if (shift) {
+		if (!significandOverflow) {
+		    significandWide <<= shift;
+		} else {
+		    mp_mul_2d(&significandBig, shift, &significandBig);
+		}
+	    }
+	    goto returnInteger;
+
+	case HEXADECIMAL:
+	    /*
+	     * Returning a hex integer. Final scaling step.
+	     */
+
+	    shift = 4 * numTrailZeros;
+	    if (!significandOverflow && significandWide !=0 &&
+		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+		    significandWide > (MOST_BITS + signum) >> shift)) {
+		significandOverflow = 1;
+		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+	    }
+	    if (shift) {
+		if (!significandOverflow) {
+		    significandWide <<= shift;
+		} else {
+		    mp_mul_2d(&significandBig, shift, &significandBig);
+		}
+	    }
+	    goto returnInteger;
+
+	case OCTAL:
+	    /*
+	     * Returning an octal integer. Final scaling step
+	     */
+
+	    shift = 3 * numTrailZeros;
+	    if (!octalSignificandOverflow && octalSignificandWide != 0 &&
+		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
+		    octalSignificandWide > (MOST_BITS + signum) >> shift)) {
+		octalSignificandOverflow = 1;
+		TclBNInitBignumFromWideUInt(&octalSignificandBig,
+			octalSignificandWide);
+	    }
+	    if (shift) {
+		if (!octalSignificandOverflow) {
+		    octalSignificandWide <<= shift;
+		} else {
+		    mp_mul_2d(&octalSignificandBig, shift,
+			    &octalSignificandBig);
+		}
+	    }
+	    if (!octalSignificandOverflow) {
+		if (octalSignificandWide >
+			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
+#ifndef NO_WIDE_TYPE
+		    if (octalSignificandWide <= (MOST_BITS + signum)) {
+			objPtr->typePtr = &tclWideIntType;
+			if (signum) {
+			    objPtr->internalRep.wideValue =
+				    - (Tcl_WideInt) octalSignificandWide;
+			} else {
+			    objPtr->internalRep.wideValue =
+				    (Tcl_WideInt) octalSignificandWide;
+			}
+			break;
+		    }
+#endif
+		    TclBNInitBignumFromWideUInt(&octalSignificandBig,
+			    octalSignificandWide);
+		    octalSignificandOverflow = 1;
+		} else {
+		    objPtr->typePtr = &tclIntType;
+		    if (signum) {
+			objPtr->internalRep.longValue =
+				- (long) octalSignificandWide;
+		    } else {
+			objPtr->internalRep.longValue =
+				(long) octalSignificandWide;
+		    }
+		}
+	    }
+	    if (octalSignificandOverflow) {
+		if (signum) {
+		    mp_neg(&octalSignificandBig, &octalSignificandBig);
+		}
+		TclSetBignumIntRep(objPtr, &octalSignificandBig);
+	    }
+	    break;
+
+	case ZERO:
+	case DECIMAL:
+	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
+		    &significandWide, &significandBig, significandOverflow);
+	    if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
+		significandOverflow = 1;
+		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+	    }
+	returnInteger:
+	    if (!significandOverflow) {
+		if (significandWide >
+			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
+#ifndef NO_WIDE_TYPE
+		    if (significandWide <= MOST_BITS+signum) {
+			objPtr->typePtr = &tclWideIntType;
+			if (signum) {
+			    objPtr->internalRep.wideValue =
+				    - (Tcl_WideInt) significandWide;
+			} else {
+			    objPtr->internalRep.wideValue =
+				    (Tcl_WideInt) significandWide;
+			}
+			break;
+		    }
+#endif
+		    TclBNInitBignumFromWideUInt(&significandBig,
+			    significandWide);
+		    significandOverflow = 1;
+		} else {
+		    objPtr->typePtr = &tclIntType;
+		    if (signum) {
+			objPtr->internalRep.longValue =
+				- (long) significandWide;
+		    } else {
+			objPtr->internalRep.longValue =
+				(long) significandWide;
+		    }
+		}
+	    }
+	    if (significandOverflow) {
+		if (signum) {
+		    mp_neg(&significandBig, &significandBig);
+		}
+		TclSetBignumIntRep(objPtr, &significandBig);
+	    }
+	    break;
+
+	case FRACTION:
+	case EXPONENT:
+
+	    /*
+	     * Here, we're parsing a floating-point number. 'significandWide'
+	     * or 'significandBig' contains the exact significand, according
+	     * to whether 'significandOverflow' is set. The desired floating
+	     * point value is significand * 10**k, where
+	     * k = numTrailZeros+exponent-numDigitsAfterDp.
+	     */
+
+	    objPtr->typePtr = &tclDoubleType;
+	    if (exponentSignum) {
+		exponent = - exponent;
+	    }
+	    if (!significandOverflow) {
+		objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
+			signum, significandWide, numSigDigs,
+			(numTrailZeros + exponent - numDigitsAfterDp));
+	    } else {
+		objPtr->internalRep.doubleValue = MakeHighPrecisionDouble(
+			signum, &significandBig, numSigDigs,
+			(numTrailZeros + exponent - numDigitsAfterDp));
+	    }
+	    break;
+
+	case sINF:
+	case sINFINITY:
+	    if (signum) {
+		objPtr->internalRep.doubleValue = -HUGE_VAL;
+	    } else {
+		objPtr->internalRep.doubleValue = HUGE_VAL;
+	    }
+	    objPtr->typePtr = &tclDoubleType;
+	    break;
+
+#ifdef IEEE_FLOATING_POINT
+	case sNAN:
+	case sNANFINISH:
+	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
+	    objPtr->typePtr = &tclDoubleType;
+	    break;
+#endif
+	case INITIAL:
+	    /* This case only to silence compiler warning */
+	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
+	}
+    }
+
+    /*
+     * Format an error message when an invalid number is encountered.
+     */
+
+    if (status != TCL_OK) {
+	if (interp != NULL) {
+	    Tcl_Obj *msg;
+
+	    TclNewLiteralStringObj(msg, "expected ");
+	    Tcl_AppendToObj(msg, expected, -1);
+	    Tcl_AppendToObj(msg, " but got \"", -1);
+	    Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
+	    Tcl_AppendToObj(msg, "\"", -1);
+	    if (state == BAD_OCTAL) {
+		Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
+	    }
+	    Tcl_SetObjResult(interp, msg);
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+	}
+    }
+
+    /*
+     * Free memory.
+     */
+
+    if (octalSignificandOverflow) {
+	mp_clear(&octalSignificandBig);
+    }
+    if (significandOverflow) {
+	mp_clear(&significandBig);
+    }
+    return status;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AccumulateDecimalDigit --
+ *
+ *	Consume a decimal digit in a number being scanned.
+ *
+ * Results:
+ *	Returns 1 if the number has overflowed to a bignum, 0 if it still fits
+ *	in a wide integer.
+ *
+ * Side effects:
+ *	Updates either the wide or bignum representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AccumulateDecimalDigit(
+    unsigned digit,		/* Digit being scanned. */
+    int numZeros,		/* Count of zero digits preceding the digit
+				 * being scanned. */
+    Tcl_WideUInt *wideRepPtr,	/* Representation of the partial number as a
+				 * wide integer. */
+    mp_int *bignumRepPtr,	/* Representation of the partial number as a
+				 * bignum. */
+    int bignumFlag)		/* Flag == 1 if the number overflowed previous
+				 * to this digit. */
+{
+    int i, n;
+    Tcl_WideUInt w;
+
+    /*
+     * Try wide multiplication first
+     */
+
+    if (!bignumFlag) {
+	w = *wideRepPtr;
+	if (w == 0) {
+	    /*
+	     * There's no need to multiply if the multiplicand is zero.
+	     */
+
+	    *wideRepPtr = digit;
+	    return 0;
+	} else if (numZeros >= maxpow10_wide
+		  || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) {
+	    /*
+	     * Wide multiplication will overflow.  Expand the
+	     * number to a bignum and fall through into the bignum case.
+	     */
+
+	    TclBNInitBignumFromWideUInt(bignumRepPtr, w);
+	} else {
+	    /*
+	     * Wide multiplication.
+	     */
+	    *wideRepPtr = w * pow10_wide[numZeros+1] + digit;
+	    return 0;
+	}
+    }
+
+    /*
+     * Bignum multiplication.
+     */
+
+    if (numZeros < log10_DIGIT_MAX) {
+	/*
+	 * Up to about 8 zeros - single digit multiplication.
+	 */
+
+	mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1],
+		bignumRepPtr);
+	mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
+    } else {
+	/*
+	 * More than single digit multiplication. Multiply by the appropriate
+	 * small powers of 5, and then shift. Large strings of zeroes are
+	 * eaten 256 at a time; this is less efficient than it could be, but
+	 * seems implausible. We presume that DIGIT_BIT is at least 27. The
+	 * first multiplication, by up to 10**7, is done with a one-DIGIT
+	 * multiply (this presumes that DIGIT_BIT >= 24).
+	 */
+
+	n = numZeros + 1;
+	mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr);
+	for (i=3; i<=7; ++i) {
+	    if (n & (1 << i)) {
+		mp_mul(bignumRepPtr, pow5+i, bignumRepPtr);
+	    }
+	}
+	while (n >= 256) {
+	    mp_mul(bignumRepPtr, pow5+8, bignumRepPtr);
+	    n -= 256;
+	}
+	mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr);
+	mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
+    }
+
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeLowPrecisionDouble --
+ *
+ *	Makes the double precision number, signum*significand*10**exponent.
+ *
+ * Results:
+ *	Returns the constructed number.
+ *
+ *	Common cases, where there are few enough digits that the number can be
+ *	represented with at most roundoff, are handled specially here. If the
+ *	number requires more than one rounded operation to compute, the code
+ *	promotes the significand to a bignum and calls MakeHighPrecisionDouble
+ *	to do it instead.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+MakeLowPrecisionDouble(
+    int signum,			/* 1 if the number is negative, 0 otherwise */
+    Tcl_WideUInt significand,	/* Significand of the number */
+    int numSigDigs,		/* Number of digits in the significand */
+    int exponent)		/* Power of ten */
+{
+    double retval;		/* Value of the number */
+    mp_int significandBig;	/* Significand expressed as a bignum */
+
+    /*
+     * With gcc on x86, the floating point rounding mode is double-extended.
+     * This causes the result of double-precision calculations to be rounded
+     * twice: once to the precision of double-extended and then again to the
+     * precision of double. Double-rounding introduces gratuitous errors of 1
+     * ulp, so we need to change rounding mode to 53-bits.
+     */
+
+#if defined(__GNUC__) && defined(__i386)
+    fpu_control_t roundTo53Bits = 0x027f;
+    fpu_control_t oldRoundingMode;
+    _FPU_GETCW(oldRoundingMode);
+    _FPU_SETCW(roundTo53Bits);
+#endif
+#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+    ieee_flags("set","precision","double",NULL);
+#endif
+
+    /*
+     * Test for the easy cases.
+     */
+
+    if (numSigDigs <= DBL_DIG) {
+	if (exponent >= 0) {
+	    if (exponent <= mmaxpow) {
+		/*
+		 * The significand is an exact integer, and so is
+		 * 10**exponent. The product will be correct to within 1/2 ulp
+		 * without special handling.
+		 */
+
+		retval = (double)(Tcl_WideInt)significand * pow10vals[exponent];
+		goto returnValue;
+	    } else {
+		int diff = DBL_DIG - numSigDigs;
+		if (exponent-diff <= mmaxpow) {
+		    /*
+		     * 10**exponent is not an exact integer, but
+		     * 10**(exponent-diff) is exact, and so is
+		     * significand*10**diff, so we can still compute the value
+		     * with only one roundoff.
+		     */
+
+		    volatile double factor =
+			    (double)(Tcl_WideInt)significand * pow10vals[diff];
+		    retval = factor * pow10vals[exponent-diff];
+		    goto returnValue;
+		}
+	    }
+	} else {
+	    if (exponent >= -mmaxpow) {
+		/*
+		 * 10**-exponent is an exact integer, and so is the
+		 * significand. Compute the result by one division, again with
+		 * only one rounding.
+		 */
+
+		retval = (double)(Tcl_WideInt)significand / pow10vals[-exponent];
+		goto returnValue;
+	    }
+	}
+    }
+
+    /*
+     * All the easy cases have failed. Promote ths significand to bignum and
+     * call MakeHighPrecisionDouble to do it the hard way.
+     */
+
+    TclBNInitBignumFromWideUInt(&significandBig, significand);
+    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
+	    exponent);
+    mp_clear(&significandBig);
+
+    /*
+     * Come here to return the computed value.
+     */
+
+  returnValue:
+    if (signum) {
+	retval = -retval;
+    }
+
+    /*
+     * On gcc on x86, restore the floating point mode word.
+     */
+
+#if defined(__GNUC__) && defined(__i386)
+    _FPU_SETCW(oldRoundingMode);
+#endif
+#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+    ieee_flags("clear","precision",NULL,NULL);
+#endif
+
+    return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeHighPrecisionDouble --
+ *
+ *	Makes the double precision number, signum*significand*10**exponent.
+ *
+ * Results:
+ *	Returns the constructed number.
+ *
+ *	MakeHighPrecisionDouble is used when arbitrary-precision arithmetic is
+ *	needed to ensure correct rounding. It begins by calculating a
+ *	low-precision approximation to the desired number, and then refines
+ *	the answer in high precision.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+MakeHighPrecisionDouble(
+    int signum,			/* 1=negative, 0=nonnegative */
+    mp_int *significand,	/* Exact significand of the number */
+    int numSigDigs,		/* Number of significant digits */
+    int exponent)		/* Power of 10 by which to multiply */
+{
+    double retval;
+    int machexp;		/* Machine exponent of a power of 10 */
+
+    /*
+     * With gcc on x86, the floating point rounding mode is double-extended.
+     * This causes the result of double-precision calculations to be rounded
+     * twice: once to the precision of double-extended and then again to the
+     * precision of double. Double-rounding introduces gratuitous errors of 1
+     * ulp, so we need to change rounding mode to 53-bits.
+     */
+
+#if defined(__GNUC__) && defined(__i386)
+    fpu_control_t roundTo53Bits = 0x027f;
+    fpu_control_t oldRoundingMode;
+    _FPU_GETCW(oldRoundingMode);
+    _FPU_SETCW(roundTo53Bits);
+#endif
+#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+    ieee_flags("set","precision","double",NULL);
+#endif
+
+    /*
+     * Quick checks for over/underflow.
+     */
+
+    if (numSigDigs+exponent-1 > maxDigits) {
+	retval = HUGE_VAL;
+	goto returnValue;
+    }
+    if (numSigDigs+exponent-1 < minDigits) {
+	retval = 0;
+	goto returnValue;
+    }
+
+    /*
+     * Develop a first approximation to the significand. It is tempting simply
+     * to force bignum to double, but that will overflow on input numbers like
+     * 1.[string repeat 0 1000]1; while this is a not terribly likely
+     * scenario, we still have to deal with it. Use fraction and exponent
+     * instead. Once we have the significand, multiply by 10**exponent. Test
+     * for overflow. Convert back to a double, and test for underflow.
+     */
+
+    retval = BignumToBiasedFrExp(significand, &machexp);
+    retval = Pow10TimesFrExp(exponent, retval, &machexp);
+    if (machexp > DBL_MAX_EXP*log2FLT_RADIX) {
+	retval = HUGE_VAL;
+	goto returnValue;
+    }
+    retval = SafeLdExp(retval, machexp);
+    if (tiny == 0.0) {
+	tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
+    }
+    if (retval < tiny) {
+	retval = tiny;
+    }
+
+    /*
+     * Refine the result twice. (The second refinement should be necessary
+     * only if the best approximation is a power of 2 minus 1/2 ulp).
+     */
+
+    retval = RefineApproximation(retval, significand, exponent);
+    retval = RefineApproximation(retval, significand, exponent);
+
+    /*
+     * Come here to return the computed value.
+     */
+
+  returnValue:
+    if (signum) {
+	retval = -retval;
+    }
+
+    /*
+     * On gcc on x86, restore the floating point mode word.
+     */
+
+#if defined(__GNUC__) && defined(__i386)
+    _FPU_SETCW(oldRoundingMode);
+#endif
+#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+    ieee_flags("clear","precision",NULL,NULL);
+#endif
+    return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeNaN --
+ *
+ *	Makes a "Not a Number" given a set of bits to put in the tag bits
+ *
+ *	Note that a signalling NaN is never returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef IEEE_FLOATING_POINT
+static double
+MakeNaN(
+    int signum,			/* Sign bit (1=negative, 0=nonnegative */
+    Tcl_WideUInt tags)	 	/* Tag bits to put in the NaN */
+{
+    union {
+	Tcl_WideUInt iv;
+	double dv;
+    } theNaN;
+
+    theNaN.iv = tags;
+    theNaN.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
+    if (signum) {
+	theNaN.iv |= ((Tcl_WideUInt) (0x8000 | NAN_START)) << 48;
+    } else {
+	theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48;
+    }
+    if (n770_fp) {
+	theNaN.iv = Nokia770Twiddle(theNaN.iv);
+    }
+    return theNaN.dv;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefineApproximation --
+ *
+ *	Given a poor approximation to a floating point number, returns a
+ *	better one. (The better approximation is correct to within 1 ulp, and
+ *	is entirely correct if the poor approximation is correct to 1 ulp.)
+ *
+ * Results:
+ *	Returns the improved result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+RefineApproximation(
+    double approxResult,	/* Approximate result of conversion */
+    mp_int *exactSignificand,	/* Integer significand */
+    int exponent)		/* Power of 10 to multiply by significand */
+{
+    int M2, M5;			/* Powers of 2 and of 5 needed to put the
+				 * decimal and binary numbers over a common
+				 * denominator. */
+    double significand;		/* Sigificand of the binary number */
+    int binExponent;		/* Exponent of the binary number */
+    int msb;			/* Most significant bit position of an
+				 * intermediate result */
+    int nDigits;		/* Number of mp_digit's in an intermediate
+				 * result */
+    mp_int twoMv;		/* Approx binary value expressed as an exact
+				 * integer scaled by the multiplier 2M */
+    mp_int twoMd;		/* Exact decimal value expressed as an exact
+				 * integer scaled by the multiplier 2M */
+    int scale;			/* Scale factor for M */
+    int multiplier;		/* Power of two to scale M */
+    double num, den;		/* Numerator and denominator of the correction
+				 * term */
+    double quot;		/* Correction term */
+    double minincr;		/* Lower bound on the absolute value of the
+				 * correction term. */
+    int i;
+
+    /*
+     * The first approximation is always low. If we find that it's HUGE_VAL,
+     * we're done.
+     */
+
+    if (approxResult == HUGE_VAL) {
+	return approxResult;
+    }
+
+    /*
+     * Find a common denominator for the decimal and binary fractions. The
+     * common denominator will be 2**M2 + 5**M5.
+     */
+
+    significand = frexp(approxResult, &binExponent);
+    i = mantBits - binExponent;
+    if (i < 0) {
+	M2 = 0;
+    } else {
+	M2 = i;
+    }
+    if (exponent > 0) {
+	M5 = 0;
+    } else {
+	M5 = -exponent;
+	if ((M5-1) > M2) {
+	    M2 = M5-1;
+	}
+    }
+
+    /*
+     * The floating point number is significand*2**binExponent. Compute the
+     * large integer significand*2**(binExponent+M2+1). The 2**-1 bit of the
+     * significand (the most significant) corresponds to the
+     * 2**(binExponent+M2 + 1) bit of 2*M2*v. Allocate enough digits to hold
+     * that quantity, then convert the significand to a large integer, scaled
+     * appropriately. Then multiply by the appropriate power of 5.
+     */
+
+    msb = binExponent + M2;	/* 1008 */
+    nDigits = msb / DIGIT_BIT + 1;
+    mp_init_size(&twoMv, nDigits);
+    i = (msb % DIGIT_BIT + 1);
+    twoMv.used = nDigits;
+    significand *= SafeLdExp(1.0, i);
+    while (--nDigits >= 0) {
+	twoMv.dp[nDigits] = (mp_digit) significand;
+	significand -= (mp_digit) significand;
+	significand = SafeLdExp(significand, DIGIT_BIT);
+    }
+    for (i = 0; i <= 8; ++i) {
+	if (M5 & (1 << i)) {
+	    mp_mul(&twoMv, pow5+i, &twoMv);
+	}
+    }
+
+    /*
+     * Collect the decimal significand as a high precision integer. The least
+     * significant bit corresponds to bit M2+exponent+1 so it will need to be
+     * shifted left by that many bits after being multiplied by
+     * 5**(M5+exponent).
+     */
+
+    mp_init_copy(&twoMd, exactSignificand);
+    for (i=0; i<=8; ++i) {
+	if ((M5+exponent) & (1 << i)) {
+	    mp_mul(&twoMd, pow5+i, &twoMd);
+	}
+    }
+    mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);
+    mp_sub(&twoMd, &twoMv, &twoMd);
+
+    /*
+     * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
+     * term. Because 2M may well overflow a double, we need to scale the
+     * denominator by a factor of 2**binExponent-mantBits
+     */
+
+    scale = binExponent - mantBits - 1;
+
+    mp_set(&twoMv, 1);
+    for (i=0; i<=8; ++i) {
+	if (M5 & (1 << i)) {
+	    mp_mul(&twoMv, pow5+i, &twoMv);
+	}
+    }
+    multiplier = M2 + scale + 1;
+    if (multiplier > 0) {
+	mp_mul_2d(&twoMv, multiplier, &twoMv);
+    } else if (multiplier < 0) {
+	mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
+    }
+
+    /*
+     * If the result is less than unity, the error is less than 1/2 unit in
+     * the last place, so there's no correction to make.
+     */
+
+    if (mp_cmp_mag(&twoMd, &twoMv) == MP_LT) {
+        mp_clear(&twoMd);
+        mp_clear(&twoMv);
+	return approxResult;
+    }
+
+    /*
+     * Convert the numerator and denominator of the corrector term accurately
+     * to floating point numbers.
+     */
+
+    num = TclBignumToDouble(&twoMd);
+    den = TclBignumToDouble(&twoMv);
+
+    quot = SafeLdExp(num/den, scale);
+    minincr = SafeLdExp(1.0, binExponent-mantBits);
+
+    if (quot<0. && quot>-minincr) {
+	quot = -minincr;
+    } else if (quot>0. && quot<minincr) {
+	quot = minincr;
+    }
+
+    mp_clear(&twoMd);
+    mp_clear(&twoMv);
+
+    return approxResult + quot;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * MultPow5 --
+ *
+ *	Multiply a bignum by a power of 5.
+ *
+ * Side effects:
+ *	Stores base*5**n in result
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+MulPow5(mp_int* base, 		/* Number to multiply */
+	 unsigned n,		/* Power of 5 to multiply by */
+	 mp_int* result)	/* Place to store the result */
+{
+    mp_int* p = base;
+    int n13 = n / 13;
+    int r = n % 13;
+    if (r != 0) {
+	mp_mul_d(p, dpow5[r], result);
+	p = result;
+    }
+    r = 0;
+    while (n13 != 0) {
+	if (n13 & 1) {
+	    mp_mul(p, pow5_13+r, result);
+	    p = result;
+	}
+	n13 >>= 1;
+	++r;
+    }
+    if (p != result) {
+	mp_copy(p, result);
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * NormalizeRightward --
+ *
+ *	Shifts a number rightward until it is odd (that is, until the
+ *	least significant bit is nonzero.
+ *
+ * Results:
+ *	Returns the number of bit positions by which the number was shifted.
+ *
+ * Side effects:
+ *	Shifts the number in place; *wPtr is replaced by the shifted number.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+NormalizeRightward(Tcl_WideUInt* wPtr)
+				/* INOUT: Number to shift */
+{
+    int rv = 0;
+    Tcl_WideUInt w = *wPtr;
+    if (!(w & (Tcl_WideUInt) 0xffffffff)) {
+	w >>= 32; rv += 32;
+    } 
+    if (!(w & (Tcl_WideUInt) 0xffff)) {
+	w >>= 16; rv += 16;
+    }
+    if (!(w & (Tcl_WideUInt) 0xff)) {
+	w >>= 8; rv += 8;
+    }
+    if (!(w & (Tcl_WideUInt) 0xf)) {
+	w >>= 4; rv += 4;
+    }
+    if (!(w & 0x3)) {
+	w >>= 2; rv += 2;
+    }
+    if (!(w & 0x1)) {
+	w >>= 1; ++rv;
+    }
+    *wPtr = w;
+    return rv;
+}
+
+/*
+ *-----------------------------------------------------------------------------0
+ *
+ * RequiredPrecision --
+ *
+ *	Determines the number of bits needed to hold an intger.
+ *
+ * Results:
+ *	Returns the position of the most significant bit (0 - 63).
+ *	Returns 0 if the number is zero.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+static int
+RequiredPrecision(Tcl_WideUInt w)
+				/* Number to interrogate */
+{
+    int rv;
+    unsigned long wi;
+    if (w & ((Tcl_WideUInt) 0xffffffff << 32)) {
+	wi = (unsigned long) (w >> 32); rv = 32;
+    } else {
+	wi = (unsigned long) w; rv = 0;
+    }
+    if (wi & 0xffff0000) {
+	wi >>= 16; rv += 16;
+    }
+    if (wi & 0xff00) {
+	wi >>= 8; rv += 8;
+    }
+    if (wi & 0xf0) {
+	wi >>= 4; rv += 4;
+    }
+    if (wi & 0xc) {
+	wi >>= 2; rv += 2;
+    }
+    if (wi & 0x2) {
+	wi >>= 1; ++rv;
+    }
+    if (wi & 0x1) {
+	++rv;
+    }
+    return rv;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DoubleToExpAndSig --
+ *
+ *	Separates a 'double' into exponent and significand.
+ *
+ * Side effects:
+ *	Stores the significand in '*significand' and the exponent in
+ *	'*expon' so that dv == significand * 2.0**expon, and significand
+ *	is odd.  Also stores the position of the leftmost 1-bit in 'significand'
+ *	in 'bits'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+DoubleToExpAndSig(double dv,	/* Number to convert */
+		  Tcl_WideUInt* significand,
+				/* OUTPUT: Significand of the number */
+		  int* expon,	/* OUTPUT: Exponent to multiply the number by */
+		  int* bits)	/* OUTPUT: Number of significant bits */
+{
+    Double d;			/* Number being converted */
+    Tcl_WideUInt z;		/* Significand under construction */
+    int de;			/* Exponent of the number */
+    int k;			/* Bit count */
+
+    d.d = dv;
+
+    /* Extract exponent and significand */
+
+    de = (d.w.word0 & EXP_MASK) >> EXP_SHIFT;
+    z = d.q & SIG_MASK;
+    if (de != 0) {
+	z |= HIDDEN_BIT;
+	k = NormalizeRightward(&z);
+	*bits = FP_PRECISION - k;
+	*expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1);
+    } else {
+	k = NormalizeRightward(&z);
+	*expon = k + (de - EXPONENT_BIAS) - (FP_PRECISION-1) + 1;
+	*bits = RequiredPrecision(z);
+    }
+    *significand = z;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TakeAbsoluteValue --
+ *
+ *	Takes the absolute value of a 'double' including 0, Inf and NaN
+ *
+ * Side effects:
+ *	The 'double' in *d is replaced with its absolute value. The
+ *	signum is stored in 'sign': 1 for negative, 0 for nonnegative.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+TakeAbsoluteValue(Double* d,	/* Number to replace with absolute value */
+		  int* sign)	/* Place to put the signum */
+{
+    if (d->w.word0 & SIGN_BIT) {
+	*sign = 1;
+	d->w.word0 &= ~SIGN_BIT;
+    } else {
+	*sign = 0;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FormatInfAndNaN --
+ *
+ *	Bailout for formatting infinities and Not-A-Number.
+ *
+ * Results:
+ *	Returns one of the strings 'Infinity' and 'NaN'.
+ *
+ * Side effects:
+ *	Stores 9999 in *decpt, and sets '*endPtr' to designate the
+ *	terminating NUL byte of the string if 'endPtr' is not NULL. 
+ *
+ * The string returned must be freed by the caller using 'ckfree'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+FormatInfAndNaN(Double* d,	/* Exceptional number to format */
+		int* decpt,	/* Decimal point to set to a bogus value */
+		char** endPtr)	/* Pointer to the end of the formatted data */
+{
+    char* retval;
+    *decpt = 9999;
+    if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
+	retval = ckalloc(9);
+	strcpy(retval, "Infinity");
+	if (endPtr) {
+	    *endPtr = retval + 8;
+	}
+    } else {
+	retval = ckalloc(4);
+	strcpy(retval, "NaN");
+	if (endPtr) {
+	    *endPtr = retval + 3;
+	}
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FormatZero --
+ *
+ *	Bailout to format a zero floating-point number.
+ *
+ * Results:
+ *	Returns the constant string "0"
+ *
+ * Side effects:
+ *	Stores 1 in '*decpt' and puts a pointer to the NUL byte terminating
+ *	the string in '*endPtr' if 'endPtr' is not NULL.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+FormatZero(int* decpt,		/* Location of the decimal point */
+	   char** endPtr)	/* Pointer to the end of the formatted data */
+{
+    char* retval = ckalloc(2);
+    strcpy(retval, "0");
+    if (endPtr) {
+	*endPtr = retval+1;
+    }
+    *decpt = 0;
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ApproximateLog10 --
+ *
+ *	Computes a two-term Taylor series approximation to the common
+ *	log of a number, and computes the number's binary log.
+ *
+ * Results:
+ *	Return an approximation to floor(log10(bw*2**be)) that is either
+ *	exact or 1 too high.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+ApproximateLog10(Tcl_WideUInt bw,
+				/* Integer significand of the number */
+		 int be,	/* Power of two to scale bw */
+		 int bbits)	/* Number of bits of precision in bw */
+{
+    int i;			/* Log base 2 of the number */
+    int k;			/* Floor(Log base 10 of the number) */
+    double ds;			/* Mantissa of the number */
+    Double d2;
+
+    /*
+     * Compute i and d2 such that d = d2*2**i, and 1 < d2 < 2.
+     * Compute an approximation to log10(d), 
+     *   log10(d) ~ log10(2) * i + log10(1.5) 
+     *            + (significand-1.5)/(1.5 * log(10))
+     */
+
+    d2.q = bw << (FP_PRECISION - bbits) & SIG_MASK;
+    d2.w.word0 |= (EXPONENT_BIAS) << EXP_SHIFT;
+    i = be + bbits - 1;
+    ds = (d2.d - 1.5) * TWO_OVER_3LOG10
+	+ LOG10_3HALVES_PLUS_FUDGE
+	+ LOG10_2 * i;
+    k = (int) ds;
+    if (k > ds) {
+	--k;
+    }
+    return k;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BetterLog10 --
+ *
+ *	Improves the result of ApproximateLog10 for numbers in the range
+ *	1 .. 10**(TEN_PMAX)-1
+ *
+ * Side effects:
+ *	Sets k_check to 0 if the new result is known to be exact, and to
+ *	1 if it may still be one too high.
+ *
+ * Results:
+ *	Returns the improved approximation to log10(d)
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+BetterLog10(double d,		/* Original number to format */
+	  int k,		/* Characteristic(Log base 10) of the number */
+	  int* k_check)		/* Flag == 1 if k is inexact */
+{
+    /* 
+     * Performance hack. If k is in the range 0..TEN_PMAX, then we can
+     * use a powers-of-ten table to check it.
+     */
+    if (k >= 0 && k <= TEN_PMAX) {
+	if (d < tens[k]) {
+	    k--;
+	}
+	*k_check = 0;
+    } else {
+	*k_check = 1;
+    }
+    return k;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ComputeScale --
+ *
+ *	Prepares to format a floating-point number as decimal.
+ *
+ * Parameters:
+ *	floor(log10*x) is k (or possibly k-1).  floor(log2(x) is i.
+ *	The significand of x requires bbits bits to represent.
+ *
+ * Results:
+ *	Determines integers b2, b5, s2, s5 so that sig*2**b2*5**b5/2**s2*2**s5
+ *	exactly represents the value of the x/10**k. This value will lie
+ *	in the range [1 .. 10), and allows for computing successive digits
+ *	by multiplying sig%10 by 10.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+ComputeScale(int be,		/* Exponent part of number: d = bw * 2**be */
+	     int k,		/* Characteristic of log10(number) */
+	     int* b2,		/* OUTPUT: Power of 2 in the numerator */
+	     int* b5,		/* OUTPUT: Power of 5 in the numerator */
+	     int* s2,		/* OUTPUT: Power of 2 in the denominator */
+	     int* s5)		/* OUTPUT: Power of 5 in the denominator */
+{
+
+    /* 
+     * Scale numerator and denominator powers of 2 so that the
+     * input binary number is the ratio of integers
+     */
+    if (be <= 0) {
+	*b2 = 0;
+	*s2 = -be;
+    } else {
+	*b2 = be;
+	*s2 = 0;
+    }
+
+    /* 
+     * Scale numerator and denominator so that the output decimal number
+     * is the ratio of integers
+     */
+    if (k >= 0) {
+	*b5 = 0;
+	*s5 = k;
+	*s2 += k;
+    } else {
+	*b2 -= k;
+	*b5 = -k;
+	*s5 = 0;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SetPrecisionLimits --
+ *
+ *	Determines how many digits of significance should be computed
+ *	(and, hence, how much memory need be allocated) for formatting a
+ *	floating point number.
+ *
+ * Given that 'k' is floor(log10(x)):
+ * if 'shortest' format is used, there will be at most 18 digits in the result.
+ * if 'F' format is used, there will be at most 'ndigits' + k + 1 digits
+ * if 'E' format is used, there will be exactly 'ndigits' digits.
+ *
+ * Side effects:
+ *	Adjusts '*ndigitsPtr' to have a valid value.
+ *	Stores the maximum memory allocation needed in *iPtr.
+ *	Sets '*iLimPtr' to the limiting number of digits to convert if k
+ *	has been guessed correctly, and '*iLim1Ptr' to the limiting number
+ *	of digits to convert if k has been guessed to be one too high.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+SetPrecisionLimits(int convType,
+				/* Type of conversion:
+				 *   TCL_DD_SHORTEST
+				 *   TCL_DD_STEELE0
+				 *   TCL_DD_E_FMT
+				 *   TCL_DD_F_FMT */
+		   int k,	/* Floor(log10(number to convert)) */
+		   int* ndigitsPtr,
+				/* IN/OUT: Number of digits requested
+				 *         (Will be adjusted if needed) */
+		   int* iPtr,	/* OUT: Maximum number of digits
+				 *      to return */
+		   int *iLimPtr,/* OUT: Number of digits of significance
+				 *      if the bignum method is used.*/
+		   int *iLim1Ptr)
+				/* OUT: Number of digits of significance
+				 *      if the quick method is used. */
+{
+    switch(convType) {
+    case TCL_DD_SHORTEST0:
+    case TCL_DD_STEELE0:
+	*iLimPtr = *iLim1Ptr = -1;
+	*iPtr = 18;
+	*ndigitsPtr = 0;
+	break;
+    case TCL_DD_E_FORMAT:
+	if (*ndigitsPtr <= 0) {
+	    *ndigitsPtr = 1;
+	}
+	*iLimPtr = *iLim1Ptr = *iPtr = *ndigitsPtr;
+	break;
+    case TCL_DD_F_FORMAT:
+	*iPtr = *ndigitsPtr + k + 1;
+	*iLimPtr = *iPtr;
+	*iLim1Ptr = *iPtr - 1;
+	if (*iPtr <= 0) {
+	    *iPtr = 1;
+	}
+	break;
+    default:
+	*iPtr = -1;
+	*iLimPtr = -1;
+	*iLim1Ptr = -1;
+	Tcl_Panic("impossible conversion type in TclDoubleDigits");
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BumpUp --
+ *
+ *	Increases a string of digits ending in a series of nines to
+ *	designate the next higher number.  xxxxb9999... -> xxxx(b+1)0000...
+ *
+ * Results:
+ *	Returns a pointer to the end of the adjusted string.
+ *
+ * Side effects:
+ *	In the case that the string consists solely of '999999', sets it
+ *	to "1" and moves the decimal point (*kPtr) one place to the right.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+
+inline static char*
+BumpUp(char* s,		    	/* Cursor pointing one past the end of the
+				 * string */ 
+       char* retval,		/* Start of the string of digits */
+       int* kPtr)		/* Position of the decimal point */
+{
+    while (*--s == '9') {
+	if (s == retval) {
+	    ++(*kPtr);
+	    *s = '1';
+	    return s+1;
+	}
+    }
+    ++*s;
+    ++s;
+    return s;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AdjustRange --
+ *
+ *	Rescales a 'double' in preparation for formatting it using the
+ *	'quick' double-to-string method.
+ *
+ * Results:
+ *	Returns the precision that has been lost in the prescaling as
+ *	a count of units in the least significant place.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+AdjustRange(double* dPtr,	/* INOUT: Number to adjust */
+	    int k)		/* IN: floor(log10(d)) */
+{
+    int ieps;			/* Number of roundoff errors that have
+				 * accumulated */
+    double d = *dPtr;		/* Number to adjust */
+    double ds;
+    int i, j, j1;
+
+    ieps = 2;
+
+    if (k > 0) {
+	/*
+	 * The number must be reduced to bring it into range.
+	 */
+	ds = tens[k & 0xf];
+	j = k >> 4;
+	if (j & BLETCH) {
+	    j &= (BLETCH-1);
+	    d /= bigtens[N_BIGTENS - 1];
+	    ieps++;
+	}
+	i = 0;
+	for (; j != 0; j>>=1) {
+	    if (j & 1) {
+		ds *= bigtens[i];
+		++ieps;
+	    }
+	    ++i;
+	}
+	d /= ds;
+    } else if ((j1 = -k) != 0) {
+	/*
+	 * The number must be increased to bring it into range
+	 */
+	d *= tens[j1 & 0xf];
+	i = 0;
+	for (j = j1>>4; j; j>>=1) {
+	    if (j & 1) {
+		ieps++;
+		d *= bigtens[i];
+	    }
+	    ++i;
+	}
+    }
+
+    *dPtr = d;
+    return ieps;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShorteningQuickFormat --
+ *
+ *	Returns a 'quick' format of a double precision number to a string
+ *	of digits, preferring a shorter string of digits if the shorter
+ *	string is still within 1/2 ulp of the number. 
+ *
+ * Results:
+ *	Returns the string of digits. Returns NULL if the 'quick' method
+ *	fails and the bignum method must be used.
+ *
+ * Side effects:
+ *	Stores the position of the decimal point at '*kPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+ShorteningQuickFormat(double d,	/* Number to convert */
+		      int k,	/* floor(log10(d)) */
+		      int ilim,	/* Number of significant digits to return */
+		      double eps,
+		      		/* Estimated roundoff error */
+		      char* retval,
+		      		/* Buffer to receive the digit string */
+		      int* kPtr)
+				/* Pointer to stash the position of
+				 * the decimal point */
+{
+    char* s = retval;		/* Cursor in the return value */
+    int digit;			/* Current digit */
+    int i;
+
+    eps = 0.5 / tens[ilim-1] - eps;
+    i = 0;
+    for (;;) {
+	/* Convert a digit */
+
+	digit = (int) d;
+	d -= digit;
+	*s++ = '0' + digit;
+
+	/*
+	 * Truncate the conversion if the string of digits is within
+	 * 1/2 ulp of the actual value.
+	 */
+
+	if (d < eps) {
+	    *kPtr = k;
+	    return s;
+	}
+	if ((1. - d) < eps) {
+	    *kPtr = k;
+	    return BumpUp(s, retval, kPtr);
+	}
+
+	/*
+	 * Bail out if the conversion fails to converge to a sufficiently
+	 * precise value
+	 */
+
+	if (++i >= ilim) {
+	    return NULL;
+	}
+
+	/*
+	 * Bring the next digit to the integer part.
+	 */
+
+	eps *= 10;
+	d *= 10.0;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StrictQuickFormat --
+ *
+ *	Convert a double precision number of a string of a precise number
+ *	of digits, using the 'quick' double precision method.
+ *
+ * Results:
+ *	Returns the digit string, or NULL if the bignum method must be
+ *	used to do the formatting.
+ *
+ * Side effects:
+ *	Stores the position of the decimal point in '*kPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+StrictQuickFormat(double d,	/* Number to convert */
+		  int k,	/* floor(log10(d)) */
+		  int ilim,	/* Number of significant digits to return */
+		  double eps,	/* Estimated roundoff error */
+		  char* retval,	/* Start of the digit string */
+		  int* kPtr)	/* Pointer to stash the position of
+				 * the decimal point */
+{
+    char* s = retval;		/* Cursor in the return value */
+    int digit;			/* Current digit of the answer */
+    int i;
+
+    eps *= tens[ilim-1];
+    i = 1;
+    for (;;) {
+	/* Extract a digit */
+	digit = (int) d;
+	d -= digit;
+	if (d == 0.0) {
+	    ilim = i;
+	}
+	*s++ = '0' + digit;
+
+	/* 
+	 * When the given digit count is reached, handle trailing strings
+	 * of 0 and 9.
+	 */
+	if (i == ilim) {
+	    if (d > 0.5 + eps) {
+		*kPtr = k;
+		return BumpUp(s, retval, kPtr);
+	    } else if (d < 0.5 - eps) {
+		while (*--s == '0') {
+		    /* do nothing */
+		}
+		s++;
+		*kPtr = k;
+		return s;
+	    } else {
+		return NULL;
+	    }
+	}
+
+	/* Advance to the next digit */
+	++i;
+	d *= 10.0;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * QuickConversion --
+ *
+ *	Converts a floating point number the 'quick' way, when only a limited
+ *	number of digits is required and floating point arithmetic can
+ *	therefore be used for the intermediate results.
+ *
+ * Results:
+ *	Returns the converted string, or NULL if the bignum method must
+ *	be used.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+QuickConversion(double e,	/* Number to format */
+		int k,		/* floor(log10(d)), approximately */
+		int k_check,	/* 0 if k is exact, 1 if it may be too high */
+		int flags,	/* Flags passed to dtoa:
+				 *    TCL_DD_SHORTEN_FLAG */
+		int len,	/* Length of the return value */
+		int ilim,	/* Number of digits to store */
+		int ilim1,	/* Number of digits to store if we
+				 * musguessed k */
+		int* decpt,	/* OUTPUT: Location of the decimal point */
+		char** endPtr)	/* OUTPUT: Pointer to the terminal null byte */
+{
+    int ieps;			/* Number of 1-ulp roundoff errors that have
+				 * accumulated in the calculation*/
+    Double eps;			/* Estimated roundoff error */
+    char* retval;		/* Returned string */
+    char* end;			/* Pointer to the terminal null byte in the
+				 * returned string */
+    volatile double d;		/* Workaround for a bug in mingw gcc 3.4.5 */
+
+    /*
+     * Bring d into the range [1 .. 10)
+     */
+    ieps = AdjustRange(&e, k);
+    d = e;
+
+    /*
+     * If the guessed value of k didn't get d into range, adjust it
+     * by one. If that leaves us outside the range in which quick format
+     * is accurate, bail out.
+     */
+    if (k_check && d < 1. && ilim > 0) {
+	if (ilim1 < 0) {
+	    return NULL;
+	}
+	ilim = ilim1;
+	--k;
+	d *= 10.0;
+	++ieps;
+    }
+
+    /*
+     * Compute estimated roundoff error
+     */
+    eps.d = ieps * d + 7.;
+    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;
+
+    /*
+     * Handle the peculiar case where the result has no significant
+     * digits.
+     */
+    retval = ckalloc(len + 1);
+    if (ilim == 0) {
+	d -= 5.;
+	if (d > eps.d) {
+	    *retval = '1';
+	    *decpt = k;
+	    return retval;
+	} else if (d < -eps.d) {
+	    *decpt = k;
+	    return retval;
+	} else {
+	    ckfree(retval);
+	    return NULL;
+	}
+    }
+
+    /* Format the digit string */
+
+    if (flags & TCL_DD_SHORTEN_FLAG) {
+	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
+    } else {
+	end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
+    }
+    if (end == NULL) {
+	ckfree(retval);
+	return NULL;
+    }
+    *end = '\0';
+    if (endPtr != NULL) {
+	*endPtr = end;
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CastOutPowersOf2 --
+ *
+ *	Adjust the factors 'b2', 'm2', and 's2' to cast out common powers
+ *	of 2 from numerator and denominator in preparation for the 'bignum'
+ *	method of floating point conversion.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static void
+CastOutPowersOf2(int* b2,	/* Power of 2 to multiply the significand  */
+		 int* m2,	/* Power of 2 to multiply 1/2 ulp  */
+		 int* s2)	/* Power of 2 to multiply the common
+				 * denominator */
+{
+    int i;
+    if (*m2 > 0 && *s2 > 0) {	/* Find the smallest power of 2 in the
+				 * numerator */
+        if (*m2 < *s2) {	/* Find the lowest common denominatorr */
+	    i = *m2;
+	} else {
+	    i = *s2;
+	}
+	*b2 -= i;		/* Reduce to lowest terms */
+	*m2 -= i;
+	*s2 -= i;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShorteningInt64Conversion --
+ *
+ *	Converts a double-precision number to the shortest string of
+ *	digits that reconverts exactly to the given number, or to
+ *	'ilim' digits if that will yield a shorter result. The numerator and
+ *	denominator in David Gay's conversion algorithm are known to fit
+ *	in Tcl_WideUInt, giving considerably faster arithmetic than mp_int's.
+ *
+ * Results:
+ *	Returns the string of significant decimal digits, in newly
+ *	allocated memory
+ *
+ * Side effects:
+ *	Stores the location of the decimal point in '*decpt' and the
+ *      location of the terminal null byte in '*endPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+ShorteningInt64Conversion(Double* dPtr,
+				/* Original number to convert */
+			  int convType,
+				/* Type of conversion (shortest, Steele,
+				   E format, F format) */
+			  Tcl_WideUInt bw,
+				/* Integer significand */
+			  int b2, int b5,
+				/* Scale factor for the significand
+				 * in the numerator */
+			  int m2plus, int m2minus, int m5,
+				/* Scale factors for 1/2 ulp in
+				 * the numerator (will be different if
+				 * bw == 1 */
+			  int s2, int s5,
+				/* Scale factors for the denominator */
+			  int k,
+				/* Number of output digits before the decimal
+				 * point */
+			  int len,
+				/* Number of digits to allocate */
+			  int ilim,
+				/* Number of digits to convert if b >= s */
+			  int ilim1,
+				/* Number of digits to convert if b < s */
+			  int* decpt,
+				/* OUTPUT: Position of the decimal point */
+			  char** endPtr)
+				/* OUTPUT: Position of the terminal '\0'
+				 *         at the end of the returned string */
+{
+    
+    char* retval = ckalloc(len + 1);
+				/* Output buffer */
+    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
+				/* Numerator of the fraction being converted */
+    Tcl_WideUInt S = wuipow5[s5] << s2;
+				/* Denominator of the fraction being 
+				 * converted */
+    Tcl_WideUInt mplus, mminus;	/* Ranges for testing whether the result
+				 * is within roundoff of being exact */
+    int digit;			/* Current output digit */
+    char* s = retval;		/* Cursor in the output buffer */
+    int i;			/* Current position in the output buffer */
+
+    /* Adjust if the logarithm was guessed wrong */
+
+    if (b < S) {
+	b = 10 * b;
+	++m2plus; ++m2minus; ++m5;
+	ilim = ilim1;
+	--k;
+    }
+
+    /* Compute roundoff ranges */
+
+    mplus = wuipow5[m5] << m2plus;
+    mminus = wuipow5[m5] << m2minus;
+
+    /* Loop through the digits */
+
+    i = 1;
+    for (;;) {
+	digit = (int)(b / S);
+	if (digit > 10) {
+	    Tcl_Panic("wrong digit!");
+	}
+	b = b % S;
+
+	/* 
+	 * Does the current digit put us on the low side of the exact value
+	 * but within within roundoff of being exact?
+	 */
+	if (b < mplus
+	    || (b == mplus
+		&& convType != TCL_DD_STEELE0
+		&& (dPtr->w.word1 & 1) == 0)) {
+	    /*
+	     * Make sure we shouldn't be rounding *up* instead,
+	     * in case the next number above is closer
+	     */
+	    if (2 * b > S
+		|| (2 * b == S
+		    && (digit & 1) != 0)) {
+		++digit;
+		if (digit == 10) {
+		    *s++ = '9';
+		    s = BumpUp(s, retval, &k);
+		    break;
+		}
+	    }
+
+	    /* Stash the current digit */
+
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/*
+	 * Does one plus the current digit put us within roundoff of the
+	 * number?
+	 */
+	if (b > S - mminus
+	    || (b == S - mminus
+		&& convType != TCL_DD_STEELE0
+		&& (dPtr->w.word1 & 1) == 0)) {
+	    if (digit == 9) {
+		*s++ = '9';
+		s = BumpUp(s, retval, &k);
+		break;
+	    }
+	    ++digit;
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/*
+	 * Have we converted all the requested digits?
+	 */
+	*s++ = '0' + digit;
+	if (i == ilim) {
+	    if (2*b > S
+		|| (2*b == S && (digit & 1) != 0)) {
+		s = BumpUp(s, retval, &k);
+	    }
+	    break;
+	}
+	
+	/* Advance to the next digit */
+	
+	b = 10 * b;
+	mplus = 10 * mplus;
+	mminus = 10 * mminus;
+	++i;
+    }
+
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StrictInt64Conversion --
+ *
+ *	Converts a double-precision number to a fixed-length string of
+ *	'ilim' digits that reconverts exactly to the given number.
+ *	('ilim' should be replaced with 'ilim1' in the case where
+ *	log10(d) has been overestimated).  The numerator and
+ *	denominator in David Gay's conversion algorithm are known to fit
+ *	in Tcl_WideUInt, giving considerably faster arithmetic than mp_int's.
+ *
+ * Results:
+ *	Returns the string of significant decimal digits, in newly
+ *	allocated memory
+ *
+ * Side effects:
+ *	Stores the location of the decimal point in '*decpt' and the
+ *      location of the terminal null byte in '*endPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+StrictInt64Conversion(Double* dPtr,
+				/* Original number to convert */
+		      int convType,
+				/* Type of conversion (shortest, Steele,
+				   E format, F format) */
+		      Tcl_WideUInt bw,
+				/* Integer significand */
+		      int b2, int b5,
+				/* Scale factor for the significand
+				 * in the numerator */
+		      int s2, int s5,
+				/* Scale factors for the denominator */
+		      int k,
+				/* Number of output digits before the decimal
+				 * point */
+		      int len,
+				/* Number of digits to allocate */
+		      int ilim,
+				/* Number of digits to convert if b >= s */
+		      int ilim1,
+				/* Number of digits to convert if b < s */
+		      int* decpt,
+				/* OUTPUT: Position of the decimal point */
+		      char** endPtr)
+				/* OUTPUT: Position of the terminal '\0'
+				 *         at the end of the returned string */
+{
+    
+    char* retval = ckalloc(len + 1);
+				/* Output buffer */
+    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
+				/* Numerator of the fraction being converted */
+    Tcl_WideUInt S = wuipow5[s5] << s2;
+				/* Denominator of the fraction being 
+				 * converted */
+    int digit;			/* Current output digit */
+    char* s = retval;		/* Cursor in the output buffer */
+    int i;			/* Current position in the output buffer */
+
+    /* Adjust if the logarithm was guessed wrong */
+
+    if (b < S) {
+	b = 10 * b;
+	ilim = ilim1;
+	--k;
+    }
+
+    /* Loop through the digits */
+
+    i = 1;
+    for (;;) {
+	digit = (int)(b / S);
+	if (digit > 10) {
+	    Tcl_Panic("wrong digit!");
+	}
+	b = b % S;
+
+	/*
+	 * Have we converted all the requested digits?
+	 */
+	*s++ = '0' + digit;
+	if (i == ilim) {
+	    if (2*b > S
+		|| (2*b == S && (digit & 1) != 0)) {
+		s = BumpUp(s, retval, &k);
+	    } else {
+		while (*--s == '0') {
+		    /* do nothing */
+		}
+		++s;
+	    }
+	    break;
+	}
+	
+	/* Advance to the next digit */
+	
+	b = 10 * b;
+	++i;
+    }
+
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpPowD --
+ *
+ *	Test whether bankers' rounding should round a digit up. Assumption
+ *	is made that the denominator of the fraction being tested is
+ *	a power of 2**DIGIT_BIT.
+ *
+ * Results:
+ *	Returns 1 iff the fraction is more than 1/2, or if the fraction
+ *	is exactly 1/2 and the digit is odd.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpPowD(mp_int* b,
+				/* Numerator of the fraction */
+			int sd,	/* Denominator is 2**(sd*DIGIT_BIT) */
+			int isodd)
+				/* 1 if the digit is odd, 0 if even */
+{
+    int i;
+    static const mp_digit topbit = (1<<(DIGIT_BIT-1));
+    if (b->used < sd || (b->dp[sd-1] & topbit) == 0) {
+	return 0;
+    }
+    if (b->dp[sd-1] != topbit) {
+	return 1;
+    }
+    for (i = sd-2; i >= 0; --i) {
+	if (b->dp[i] != 0) {
+	    return 1;
+	}
+    }
+    return isodd;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpToNextPowD --
+ *
+ *	Tests whether bankers' rounding will round down in the
+ *	"denominator is a power of 2**MP_DIGIT" case.
+ *
+ * Results:
+ *	Returns 1 if the rounding will be performed - which increases the
+ *	digit by one - and 0 otherwise.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpToNextPowD(mp_int* b,
+				/* Numerator of the fraction */
+			      mp_int* m,
+				/* Numerator of the rounding tolerance */
+			      int sd, 
+				/* Common denominator is 2**(sd*DIGIT_BIT) */
+			      int convType,
+				/* Conversion type: STEELE defeats 
+				 * round-to-even (Not sure why one wants to
+				 * do this; I copied it from Gay) FIXME */
+			      int isodd,
+				/* 1 if the integer significand is odd */
+			      mp_int* temp)
+				/* Work area for the calculation */
+{
+    int i;
+
+    /* 
+     * Compare B and S-m -- which is the same as comparing B+m and S --
+     * which we do by computing b+m and doing a bitwhack compare against
+     * 2**(DIGIT_BIT*sd)
+     */
+    mp_add(b, m, temp);
+    if (temp->used <= sd) {	/* too few digits to be > S */
+	return 0;
+    }
+    if (temp->used > sd+1 || temp->dp[sd] > 1) {
+				/* >= 2s */
+	return 1;
+    }
+    for (i = sd-1; i >= 0; --i) {
+				/* check for ==s */
+	if (temp->dp[i] != 0) {	/* > s */
+	    return 1;
+	}
+    }
+    if (convType == TCL_DD_STEELE0) {
+				/* biased rounding */
+	return 0;
+    }
+    return isodd;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShorteningBignumConversionPowD --
+ *
+ *	Converts a double-precision number to the shortest string of
+ *	digits that reconverts exactly to the given number, or to
+ *	'ilim' digits if that will yield a shorter result. The denominator
+ *	in David Gay's conversion algorithm is known to be a power of
+ *	2**DIGIT_BIT, and hence the division in the main loop may be replaced
+ *	by a digit shift and mask.
+ *
+ * Results:
+ *	Returns the string of significant decimal digits, in newly
+ *	allocated memory
+ *
+ * Side effects:
+ *	Stores the location of the decimal point in '*decpt' and the
+ *      location of the terminal null byte in '*endPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+ShorteningBignumConversionPowD(Double* dPtr,
+				/* Original number to convert */
+			       int convType,
+				/* Type of conversion (shortest, Steele,
+				   E format, F format) */
+			       Tcl_WideUInt bw,
+				/* Integer significand */
+			       int b2, int b5,
+				/* Scale factor for the significand
+				 * in the numerator */
+			       int m2plus, int m2minus, int m5,
+				/* Scale factors for 1/2 ulp in
+				 * the numerator (will be different if
+				 * bw == 1 */
+			       int sd,
+				/* Scale factor for the denominator */
+			       int k,
+				/* Number of output digits before the decimal
+				 * point */
+			       int len,
+				/* Number of digits to allocate */
+			       int ilim,
+				/* Number of digits to convert if b >= s */
+			       int ilim1,
+				/* Number of digits to convert if b < s */
+			       int* decpt,
+				/* OUTPUT: Position of the decimal point */
+			       char** endPtr)
+				/* OUTPUT: Position of the terminal '\0'
+				 *         at the end of the returned string */
+{
+    
+    char* retval = ckalloc(len + 1);
+				/* Output buffer */
+    mp_int b;			/* Numerator of the fraction being converted */
+    mp_int mplus, mminus;	/* Bounds for roundoff */
+    mp_digit digit;		/* Current output digit */
+    char* s = retval;		/* Cursor in the output buffer */
+    int i;			/* Index in the output buffer */
+    mp_int temp;
+    int r1;
+
+    /* 
+     * b = bw * 2**b2 * 5**b5
+     * mminus = 5**m5
+     */
+
+    TclBNInitBignumFromWideUInt(&b, bw);
+    mp_init_set_int(&mminus, 1);
+    MulPow5(&b, b5, &b);
+    mp_mul_2d(&b, b2, &b);
+
+    /* Adjust if the logarithm was guessed wrong */
+
+    if (b.used <= sd) {
+	mp_mul_d(&b, 10, &b);
+	++m2plus; ++m2minus; ++m5;
+	ilim = ilim1;
+	--k;
+    }
+
+    /*
+     * mminus = 5**m5 * 2**m2minus
+     * mplus = 5**m5 * 2**m2plus
+     */
+
+    mp_mul_2d(&mminus, m2minus, &mminus);
+    MulPow5(&mminus, m5, &mminus);
+    if (m2plus > m2minus) {
+	mp_init_copy(&mplus, &mminus);
+	mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
+    }
+    mp_init(&temp);
+
+    /* Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
+     * by mp_digit extraction */
+
+    i = 0;
+    for (;;) {
+	if (b.used <= sd) {
+	    digit = 0;
+	} else {
+	    digit = b.dp[sd];
+	    if (b.used > sd+1 || digit >= 10) {
+		Tcl_Panic("wrong digit!");
+	    }
+	    --b.used; mp_clamp(&b);
+	}
+
+	/* 
+	 * Does the current digit put us on the low side of the exact value
+	 * but within within roundoff of being exact?
+	 */
+	
+	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
+	if (r1 == MP_LT
+	    || (r1 == MP_EQ
+		&& convType != TCL_DD_STEELE0
+		&& (dPtr->w.word1 & 1) == 0)) {
+	    /*
+	     * Make sure we shouldn't be rounding *up* instead,
+	     * in case the next number above is closer
+	     */
+	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+		++digit;
+		if (digit == 10) {
+		    *s++ = '9';
+		    s = BumpUp(s, retval, &k);
+		    break;
+		}
+	    }
+
+	    /* Stash the last digit */
+
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/*
+	 * Does one plus the current digit put us within roundoff of the
+	 * number?
+	 */
+	
+	if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, 
+					   convType, dPtr->w.word1 & 1,
+					   &temp)) {
+	    if (digit == 9) {
+		*s++ = '9';
+		s = BumpUp(s, retval, &k);
+		break;
+	    }
+	    ++digit;
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/*
+	 * Have we converted all the requested digits?
+	 */
+	*s++ = '0' + digit;
+	if (i == ilim) {
+	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+		s = BumpUp(s, retval, &k);
+	    }
+	    break;
+	}
+	
+	/* Advance to the next digit */
+	
+	mp_mul_d(&b, 10, &b);
+	mp_mul_d(&mminus, 10, &mminus);
+	if (m2plus > m2minus) {
+	    mp_mul_2d(&mminus, m2plus-m2minus, &mplus);
+	}
+	++i;
+    }
+
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    if (m2plus > m2minus) {
+	mp_clear(&mplus);
+    }
+    mp_clear_multi(&b, &mminus, &temp, NULL);
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StrictBignumConversionPowD --
+ *
+ *	Converts a double-precision number to a fixed-lengt string of
+ *	'ilim' digits (or 'ilim1' if log10(d) has been overestimated.)
+ *	The denominator in David Gay's conversion algorithm is known to
+ *	be a power of 2**DIGIT_BIT, and hence the division in the main 
+ *	loop may be replaced by a digit shift and mask.
+ *
+ * Results:
+ *	Returns the string of significant decimal digits, in newly
+ *	allocated memory.
+ *
+ * Side effects:
+ *	Stores the location of the decimal point in '*decpt' and the
+ *      location of the terminal null byte in '*endPtr'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+StrictBignumConversionPowD(Double* dPtr,
+				/* Original number to convert */
+			   int convType,
+				/* Type of conversion (shortest, Steele,
+				   E format, F format) */
+			   Tcl_WideUInt bw,
+				/* Integer significand */
+			   int b2, int b5,
+				/* Scale factor for the significand
+				 * in the numerator */
+			   int sd,
+				/* Scale factor for the denominator */
+			   int k,
+				/* Number of output digits before the decimal
+				 * point */
+			   int len,
+				/* Number of digits to allocate */
+			   int ilim,
+				/* Number of digits to convert if b >= s */
+			   int ilim1,
+				/* Number of digits to convert if b < s */
+			   int* decpt,
+				/* OUTPUT: Position of the decimal point */
+			   char** endPtr)
+				/* OUTPUT: Position of the terminal '\0'
+				 *         at the end of the returned string */
+{
+    
+    char* retval = ckalloc(len + 1);
+				/* Output buffer */
+    mp_int b;			/* Numerator of the fraction being converted */
+    mp_digit digit;		/* Current output digit */
+    char* s = retval;		/* Cursor in the output buffer */
+    int i;			/* Index in the output buffer */
+    mp_int temp;
+
+    /* 
+     * b = bw * 2**b2 * 5**b5
+     */
+
+    TclBNInitBignumFromWideUInt(&b, bw);
+    MulPow5(&b, b5, &b);
+    mp_mul_2d(&b, b2, &b);
+
+    /* Adjust if the logarithm was guessed wrong */
+
+    if (b.used <= sd) {
+	mp_mul_d(&b, 10, &b);
+	ilim = ilim1;
+	--k;
+    }
+    mp_init(&temp);
+
+    /* 
+     * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
+     * by mp_digit extraction 
+     */
+
+    i = 1;
+    for (;;) {
+	if (b.used <= sd) {
+	    digit = 0;
+	} else {
+	    digit = b.dp[sd];
+	    if (b.used > sd+1 || digit >= 10) {
+		Tcl_Panic("wrong digit!");
+	    }
+	    --b.used; mp_clamp(&b);
+	}
+
+	/*
+	 * Have we converted all the requested digits?
+	 */
+	*s++ = '0' + digit;
+	if (i == ilim) {
+	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
+		s = BumpUp(s, retval, &k);
+	    } else {
+		while (*--s == '0') {
+		    /* do nothing */
+		}
+		++s;
+	    }
+	    break;
+	}
+	
+	/* Advance to the next digit */
+	
+	mp_mul_d(&b, 10, &b);
+	++i;
+    }
+
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    mp_clear_multi(&b, &temp, NULL);
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUp --
+ *
+ *	Tests whether a digit should be rounded up or down when finishing
+ *	bignum-based floating point conversion.
+ *
+ * Results:
+ *	Returns 1 if the number needs to be rounded up, 0 otherwise.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUp(mp_int* twor,
+				/* 2x the remainder from thd division that
+				 * produced the last digit */
+		    mp_int* S,	/* Denominator */
+		    int isodd)	/* Flag == 1 if the last digit is odd */
+{
+    int r = mp_cmp_mag(twor, S);
+    switch (r) {
+    case MP_LT:
+	return 0;
+    case MP_EQ:
+	return isodd;
+    case MP_GT:
+	return 1;
+    }
+    Tcl_Panic("in ShouldBankerRoundUp, trichotomy fails!");
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShouldBankerRoundUpToNext --
+ *
+ *	Tests whether the remainder is great enough to force rounding
+ *	to the next higher digit.
+ *
+ * Results:
+ *	Returns 1 if the number should be rounded up, 0 otherwise.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static int
+ShouldBankerRoundUpToNext(mp_int* b,
+				/* Remainder from the division that produced
+				 * the last digit. */
+			  mp_int* m,
+				/* Numerator of the rounding tolerance */
+			  mp_int* S,
+				/* Denominator */
+			  int convType,
+				/* Conversion type: STEELE0 defeats
+				 * round-to-even. (Not sure why one would
+				 * want this; I coped it from Gay. FIXME */
+			  int isodd,
+				/* 1 if the integer significand is odd */
+			  mp_int* temp)
+				/* Work area needed for the calculation */
+{
+    int r;
+    /* Compare b and S-m: this is the same as comparing B+m and S. */
+    mp_add(b, m, temp);
+    r = mp_cmp_mag(temp, S);
+    switch(r) {
+    case MP_LT:
+	return 0;
+    case MP_EQ:
+	if (convType == TCL_DD_STEELE0) {
+	    return 0;
+	} else {
+	    return isodd;
+	}
+    case MP_GT:
+	return 1;
+    }
+    Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!");
+    return 0;
+}
+		 
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ShorteningBignumConversion --
+ *
+ *	Convert a floating point number to a variable-length digit string
+ *	using the multiprecision method.
+ *
+ * Results:
+ *	Returns the string of digits.
+ *
+ * Side effects:
+ *	Stores the position of the decimal point in *decpt.
+ *	Stores a pointer to the end of the number in *endPtr.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+ShorteningBignumConversion(Double* dPtr,
+				/* Original number being converted */
+			   int convType,
+				/* Conversion type */
+			   Tcl_WideUInt bw,
+				/* Integer significand and exponent */
+			   int b2,
+				/* Scale factor for the significand */
+			   int m2plus, int m2minus,
+				/* Scale factors for 1/2 ulp in numerator */
+			   int s2, int s5,
+				/* Scale factors for denominator */
+			   int k,
+				/* Guessed position of the decimal point */
+			   int len,
+				/* Size of the digit buffer to allocate */
+			   int ilim,
+				/* Number of digits to convert if b >= s */
+			   int ilim1,
+				/* Number of digits to convert if b < s */
+			   int* decpt,
+				/* OUTPUT: Position of the decimal point */
+			   char** endPtr)
+				/* OUTPUT: Pointer to the end of the number */
+{
+    char* retval = ckalloc(len+1);
+				/* Buffer of digits to return */
+    char* s = retval;		/* Cursor in the return value */
+    mp_int b;			/* Numerator of the result */
+    mp_int mminus;		/* 1/2 ulp below the result */
+    mp_int mplus;		/* 1/2 ulp above the result */
+    mp_int S;			/* Denominator of the result */
+    mp_int dig;			/* Current digit of the result */
+    int digit;			/* Current digit of the result */
+    mp_int temp;		/* Work area */
+    int minit = 1;		/* Fudge factor for when we misguess k */
+    int i;
+    int r1;
+
+    /*
+     * b = bw * 2**b2 * 5**b5
+     * S = 2**s2 * 5*s5
+     */
+
+    TclBNInitBignumFromWideUInt(&b, bw);
+    mp_mul_2d(&b, b2, &b);
+    mp_init_set_int(&S, 1);
+    MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
+
+    /*
+     * Handle the case where we guess the position of the decimal point 
+     * wrong. 
+     */
+    
+    if (mp_cmp_mag(&b, &S) == MP_LT) {
+	mp_mul_d(&b, 10, &b);
+	minit = 10;
+	ilim =ilim1;
+	--k;
+    }
+
+    /* mminus = 2**m2minus * 5**m5 */
+
+    mp_init_set_int(&mminus, minit);
+    mp_mul_2d(&mminus, m2minus, &mminus);
+    if (m2plus > m2minus) {
+	mp_init_copy(&mplus, &mminus);
+	mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
+    }
+    mp_init(&temp);
+
+    /* Loop through the digits */
+
+    mp_init(&dig);
+    i = 1;
+    for (;;) {
+	mp_div(&b, &S, &dig, &b);
+	if (dig.used > 1 || dig.dp[0] >= 10) {
+	    Tcl_Panic("wrong digit!");
+	}
+	digit = dig.dp[0];
+
+	/* 
+	 * Does the current digit leave us with a remainder small enough to
+	 * round to it?
+	 */
+
+	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
+	if (r1 == MP_LT
+	    || (r1 == MP_EQ
+		&& convType != TCL_DD_STEELE0
+		&& (dPtr->w.word1 & 1) == 0)) {
+	    mp_mul_2d(&b, 1, &b);
+	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+		++digit;
+		if (digit == 10) {
+		    *s++ = '9';
+		    s = BumpUp(s, retval, &k);
+		    break;
+		}
+	    }
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/*
+	 * Does the current digit leave us with a remainder large enough
+	 * to commit to rounding up to the next higher digit?
+	 */
+
+	if (ShouldBankerRoundUpToNext(&b, &mminus, &S, convType,
+				      dPtr->w.word1 & 1, &temp)) {
+	    ++digit;
+	    if (digit == 10) {
+		*s++ = '9';
+		s = BumpUp(s, retval, &k);
+		break;
+	    }
+	    *s++ = '0' + digit;
+	    break;
+	}
+
+	/* Have we converted all the requested digits? */
+
+	*s++ = '0' + digit;
+	if (i == ilim) {
+	    mp_mul_2d(&b, 1, &b);
+	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+		s = BumpUp(s, retval, &k);  
+	    }
+	    break;
+	}
+
+	/* Advance to the next digit */
+
+	if (s5 > 0) {
+
+	    /* Can possibly shorten the denominator */
+	    mp_mul_2d(&b, 1, &b);
+	    mp_mul_2d(&mminus, 1, &mminus);
+	    if (m2plus > m2minus) {
+		mp_mul_2d(&mplus, 1, &mplus);
+	    }
+	    mp_div_d(&S, 5, &S, NULL);
+	    --s5;
+	    /* 
+	     * IDEA: It might possibly be a win to fall back to
+	     *       int64 arithmetic here if S < 2**64/10. But it's
+	     *       a win only for a fairly narrow range of magnitudes
+	     *       so perhaps not worth bothering. We already know that
+	     *       we shorten the denominator by at least 1 mp_digit, perhaps
+	     *       2. as we do the conversion for 17 digits of significance.
+	     * Possible savings:
+	     * 10**26   1 trip through loop before fallback possible
+	     * 10**27   1 trip
+	     * 10**28   2 trips     
+	     * 10**29   3 trips
+	     * 10**30   4 trips
+	     * 10**31   5 trips
+	     * 10**32   6 trips
+	     * 10**33   7 trips
+	     * 10**34   8 trips
+	     * 10**35   9 trips
+	     * 10**36  10 trips
+	     * 10**37  11 trips
+	     * 10**38  12 trips
+	     * 10**39  13 trips
+	     * 10**40  14 trips
+	     * 10**41  15 trips
+	     * 10**42  16 trips
+	     * thereafter  no gain.
+	     */
+	} else {
+	    mp_mul_d(&b, 10, &b);
+	    mp_mul_d(&mminus, 10, &mminus);
+	    if (m2plus > m2minus) {
+		mp_mul_2d(&mplus, 10, &mplus);
+	    }
+	}
+
+	++i;
+    }
+
+
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    if (m2plus > m2minus) {
+	mp_clear(&mplus);
+    }
+    mp_clear_multi(&b, &mminus, &temp, &dig, &S, NULL);
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+
+}
+		 
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StrictBignumConversion --
+ *
+ *	Convert a floating point number to a fixed-length digit string
+ *	using the multiprecision method.
+ *
+ * Results:
+ *	Returns the string of digits.
+ *
+ * Side effects:
+ *	Stores the position of the decimal point in *decpt.
+ *	Stores a pointer to the end of the number in *endPtr.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+inline static char*
+StrictBignumConversion(Double* dPtr,
+				/* Original number being converted */
+		       int convType,
+				/* Conversion type */
+		       Tcl_WideUInt bw,
+				/* Integer significand and exponent */
+		       int b2,	/* Scale factor for the significand */
+		       int s2, int s5,
+				/* Scale factors for denominator */
+		       int k,	/* Guessed position of the decimal point */
+		       int len,	/* Size of the digit buffer to allocate */
+		       int ilim,
+				/* Number of digits to convert if b >= s */
+		       int ilim1,
+				/* Number of digits to convert if b < s */
+		       int* decpt,
+				/* OUTPUT: Position of the decimal point */
+		       char** endPtr)
+				/* OUTPUT: Pointer to the end of the number */
+{
+    char* retval = ckalloc(len+1);
+				/* Buffer of digits to return */
+    char* s = retval;		/* Cursor in the return value */
+    mp_int b;			/* Numerator of the result */
+    mp_int S;			/* Denominator of the result */
+    mp_int dig;			/* Current digit of the result */
+    int digit;			/* Current digit of the result */
+    mp_int temp;		/* Work area */
+    int g;			/* Size of the current digit groun */
+    int i, j;
+    
+    /*
+     * b = bw * 2**b2 * 5**b5
+     * S = 2**s2 * 5*s5
+     */
+
+    mp_init_multi(&temp, &dig, NULL);
+    TclBNInitBignumFromWideUInt(&b, bw);
+    mp_mul_2d(&b, b2, &b);
+    mp_init_set_int(&S, 1);
+    MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
+
+    /*
+     * Handle the case where we guess the position of the decimal point 
+     * wrong. 
+     */
+    
+    if (mp_cmp_mag(&b, &S) == MP_LT) {
+	mp_mul_d(&b, 10, &b);
+	ilim =ilim1;
+	--k;
+    }
+
+    /* Convert the leading digit */
+
+    i = 0;
+    mp_div(&b, &S, &dig, &b);
+    if (dig.used > 1 || dig.dp[0] >= 10) {
+	Tcl_Panic("wrong digit!");
+    }
+    digit = dig.dp[0];
+
+    /* Is a single digit all that was requested? */
+
+    *s++ = '0' + digit;
+    if (++i >= ilim) {
+	mp_mul_2d(&b, 1, &b);
+	if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+	    s = BumpUp(s, retval, &k);  
+	}
+    } else {
+
+	for (;;) {
+
+	    /* Shift by a group of digits. */
+
+	    g = ilim - i;
+	    if (g > DIGIT_GROUP) {
+		g = DIGIT_GROUP;
+	    }
+	    if (s5 >= g) {
+		mp_div_d(&S, dpow5[g], &S, NULL);
+		s5 -= g;
+	    } else if (s5 > 0) {
+		mp_div_d(&S, dpow5[s5], &S, NULL);
+		mp_mul_d(&b, dpow5[g - s5], &b);
+		s5 = 0;
+	    } else {
+		mp_mul_d(&b, dpow5[g], &b);
+	    }
+	    mp_mul_2d(&b, g, &b);
+	    
+	    /*
+	     * As with the shortening bignum conversion, it's possible at
+	     * this point that we will have reduced the denominator to
+	     * less than 2**64/10, at which point it would be possible to
+	     * fall back to to int64 arithmetic. But the potential payoff
+	     * is tremendously less - unless we're working in F format -
+	     * because we know that three groups of digits will always
+	     * suffice for %#.17e, the longest format that doesn't introduce
+	     * empty precision.
+	     */
+
+	    /* Extract the next group of digits */
+	    
+	    mp_div(&b, &S, &dig, &b);
+	    if (dig.used > 1) {
+		Tcl_Panic("wrong digit!");
+	    }
+	    digit = dig.dp[0];
+	    for (j = g-1; j >= 0; --j) {
+		int t = itens[j];
+		*s++ = digit / t + '0';
+		digit %= t;
+	    }
+	    i += g;
+	    
+	    /* Have we converted all the requested digits? */
+	    
+	    if (i == ilim) {
+		mp_mul_2d(&b, 1, &b);
+		if (ShouldBankerRoundUp(&b, &S, digit&1)) {
+		    s = BumpUp(s, retval, &k);  
+		} else {
+		    while (*--s == '0') {
+			/* do nothing */
+		    }
+		    ++s;
+		}	
+	    break;
+	    }
+	}
+    }
+    /* 
+     * Endgame - store the location of the decimal point and the end of the
+     * string.
+     */
+    mp_clear_multi(&b, &S, &temp, &dig, NULL);
+    *s = '\0';
+    *decpt = k;
+    if (endPtr) {
+	*endPtr = s;
+    }
+    return retval;
+
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclDoubleDigits --
+ *
+ *	Core of Tcl's conversion of double-precision floating point numbers
+ *	to decimal.
+ *
+ * Results:
+ *	Returns a newly-allocated string of digits.
+ *
+ * Side effects:
+ *	Sets *decpt to the index of the character in the string before the
+ *	place that the decimal point should go. If 'endPtr' is not NULL,
+ *	sets endPtr to point to the terminating '\0' byte of the string.
+ *	Sets *sign to 1 if a minus sign should be printed with the number,
+ *	or 0 if a plus sign (or no sign) should appear.
+ *
+ * This function is a service routine that produces the string of digits
+ * for floating-point-to-decimal conversion. It can do a number of things
+ * according to the 'flags' argument. Valid values for 'flags' include:
+ *	TCL_DD_SHORTEST - This is the default for floating point conversion
+ *		if ::tcl_precision is 0. It constructs the shortest string
+ *		of digits that will reconvert to the given number when scanned.
+ *		For floating point numbers that are exactly between two
+ *		decimal numbers, it resolves using the 'round to even' rule.
+ *		With this value, the 'ndigits' parameter is ignored.
+ *	TCL_DD_STEELE - This value is not recommended and may be removed
+ *		in the future. It follows the conversion algorithm outlined
+ *		in "How to Print Floating-Point Numbers Accurately" by
+ *		Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, 
+ *		pp. 112-126]. This rule has the effect of rendering 1e23
+ *		as 9.9999999999999999e22 - which is a 'better' approximation
+ *		in the sense that it will reconvert correctly even if
+ *		a subsequent input conversion is 'round up' or 'round down'
+ *		rather than 'round to nearest', but is surprising otherwise.
+ *	TCL_DD_E_FORMAT - This value is used to prepare numbers for %e
+ *		format conversion (or for default floating->string if
+ *		tcl_precision is not 0). It constructs a string of at most
+ *		'ndigits' digits, choosing the one that is closest to the
+ *		given number (and resolving ties with 'round to even').
+ *		It is allowed to return fewer than 'ndigits' if the number
+ *		converts exactly; if the TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG 
+ *		is supplied instead, it also returns fewer digits if the 
+ *		shorter string will still reconvert to the given input number.
+ *		In any case, strings of trailing zeroes are suppressed.
+ *	TCL_DD_F_FORMAT - This value is used to prepare numbers for %f
+ *		format conversion. It requests that conversion proceed until
+ *		'ndigits' digits after the decimal point have been converted.
+ *		It is possible for this format to result in a zero-length 
+ *		string if the number is sufficiently small. Again, it
+ *		is permissible for TCL_DD_F_FORMAT to return fewer digits
+ *		for a number that converts exactly, and changing the
+ *		argument to TCL_DD_F_FORMAT|TCL_DD_SHORTEN_FLAG will allow
+ *		the routine also to return fewer digits if the shorter string
+ *		will still reconvert without loss to the given input number.
+ *		Strings of trailing zeroes are suppressed.
+ *
+ *	To any of these flags may be OR'ed TCL_DD_NO_QUICK; this flag
+ *	requires all calculations to be done in exact arithmetic. Normally,
+ *	E and F format with fewer than about 14 digits will be done with
+ *	a quick floating point approximation and fall back on the exact
+ *	arithmetic only if the input number is close enough to the
+ *	midpoint between two decimal strings that more precision is needed
+ *	to resolve which string is correct.
+ *
+ * The value stored in the 'decpt' argument on return may be negative 
+ * (indicating that the decimal point falls to the left of the string) 
+ * or greater than the length of the string.  In addition, the value -9999
+ * is used as a sentinel to indicate that the string is one of the special
+ * values "Infinity" and "NaN", and that no decimal point should be inserted.
+ * 
+ *-----------------------------------------------------------------------------
+ */
+char*
+TclDoubleDigits(double dv,	/* Number to convert */
+		int ndigits,	/* Number of digits requested */
+		int flags,	/* Conversion flags */
+		int* decpt,	/* OUTPUT: Position of the decimal point */
+		int* sign,	/* OUTPUT: 1 if the result is negative */
+		char** endPtr)	/* OUTPUT: If not NULL, receives a pointer
+				 *         to one character beyond the end
+				 *         of the returned string */
+{
+    int convType = (flags & TCL_DD_CONVERSION_TYPE_MASK);
+				/* Type of conversion being performed
+				 * TCL_DD_SHORTEST0
+				 * TCL_DD_STEELE0
+				 * TCL_DD_E_FORMAT
+				 * TCL_DD_F_FORMAT */
+    Double d;			/* Union for deconstructing doubles */
+    Tcl_WideUInt bw;		/* Integer significand */
+    int be;			/* Power of 2 by which b must be multiplied */
+    int bbits;			/* Number of bits needed to represent b */
+    int denorm;			/* Flag == 1 iff the input number was
+				 * denormalized */
+    int k;			/* Estimate of floor(log10(d)) */
+    int k_check;		/* Flag == 1 if d is near enough to a 
+				 * power of ten that k must be checked */
+    int b2, b5, s2, s5;		/* Powers of 2 and 5 in the numerator and
+				 * denominator of intermediate results */
+    int ilim = -1, ilim1 = -1;	/* Number of digits to convert, and number
+				 * to convert if log10(d) has been 
+				 * overestimated */
+    char* retval;		/* Return value from this function */
+    int i = -1;
+
+    /* Put the input number into a union for bit-whacking */
+
+    d.d = dv;
+
+    /* 
+     * Handle the cases of negative numbers (by taking the absolute value:
+     * this includes -Inf and -NaN!), infinity, Not a Number, and zero.
+     */
+
+    TakeAbsoluteValue(&d, sign);
+    if ((d.w.word0 & EXP_MASK) == EXP_MASK) {
+	return FormatInfAndNaN(&d, decpt, endPtr);
+    }
+    if (d.d == 0.0) {
+	return FormatZero(decpt, endPtr);
+    }
+
+    /* 
+     * Unpack the floating point into a wide integer and an exponent.
+     * Determine the number of bits that the big integer requires, and
+     * compute a quick approximation (which may be one too high) of
+     * ceil(log10(d.d)).
+     */
+    denorm = ((d.w.word0 & EXP_MASK) == 0);
+    DoubleToExpAndSig(d.d, &bw, &be, &bbits);
+    k = ApproximateLog10(bw, be, bbits);
+    k = BetterLog10(d.d, k, &k_check);
+
+    /* At this point, we have:
+     *	  d is the number to convert.
+     *    bw are significand and exponent: d == bw*2**be, 
+     *    bbits is the length of bw: 2**bbits-1 <= bw < 2**bbits
+     *	  k is either ceil(log10(d)) or ceil(log10(d))+1. k_check is 0
+     *      if we know that k is exactly ceil(log10(d)) and 1 if we need to
+     *	    check.
+     *    We want a rational number 
+     *      r = b * 10**(1-k) = bw * 2**b2 * 5**b5 / (2**s2 / 5**s5),
+     *    with b2, b5, s2, s5 >= 0.  Note that the most significant decimal
+     *    digit is floor(r) and that successive digits can be obtained
+     *    by setting r <- 10*floor(r) (or b <= 10 * (b % S)).
+     *    Find appropriate b2, b5, s2, s5.
+     */
+
+    ComputeScale(be, k, &b2, &b5, &s2, &s5);
+
+    /*
+     * Correct an incorrect caller-supplied 'ndigits'.
+     * Also determine:
+     *	i = The maximum number of decimal digits that will be returned in the
+     *      formatted string.  This is k + 1 + ndigits for F format, 18 for
+     *	    shortest and Steele, and ndigits for E format.
+     *  ilim = The number of significant digits to convert if
+     *         k has been guessed correctly. This is -1 for shortest and Steele
+     *         (which stop when all significance has been lost), 'ndigits'
+     *	       for E format, and 'k + 1 + ndigits' for F format.
+     *  ilim1 = The minimum number of significant digits to convert if
+     *	        k has been guessed 1 too high. This, too, is -1 for shortest
+     *	        and Steele, and 'ndigits' for E format, but it's 'ndigits-1'
+     *	        for F format.
+     */
+
+    SetPrecisionLimits(convType, k, &ndigits, &i, &ilim, &ilim1);
+
+    /* 
+     * Try to do low-precision conversion in floating point rather
+     * than resorting to expensive multiprecision arithmetic
+     */
+    if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) {
+	if ((retval = QuickConversion(d.d, k, k_check, flags,
+				      i, ilim, ilim1,
+				      decpt, endPtr)) != NULL) {
+	    return retval;
+	}
+    }
+
+    /* 
+     * For shortening conversions, determine the upper and lower bounds
+     * for the remainder at which we can stop.
+     *   m+ = (2**m2plus * 5**m5) / (2**s2 * 5**s5) is the limit on the
+     *        high side, and
+     *   m- = (2**m2minus * 5**m5) / (2**s2 * 5**s5) is the limit on the
+     *        low side.
+     *   We may need to increase s2 to put m2plus, m2minus, b2 over a
+     *   common denominator.
+     */
+
+    if (flags & TCL_DD_SHORTEN_FLAG) {
+	int m2minus = b2;
+	int m2plus;
+	int m5 = b5;
+	int len = i;
+
+	/* 
+	 * Find the quantity i so that (2**i*5**b5)/(2**s2*5**s5)
+	 * is 1/2 unit in the least significant place of the floating 
+	 * point number.
+	 */
+	if (denorm) {
+	    i = be + EXPONENT_BIAS + (FP_PRECISION-1);
+	} else {
+	    i = 1 + FP_PRECISION - bbits;
+	}
+	b2 += i;
+	s2 += i;
+
+	/* 
+	 * Reduce the fractions to lowest terms, since the above calculation
+	 * may have left excess powers of 2 in numerator and denominator
+	 */
+	CastOutPowersOf2(&b2, &m2minus, &s2);
+
+	/*
+	 * In the special case where bw==1, the nearest floating point number
+	 * to it on the low side is 1/4 ulp below it. Adjust accordingly.
+	 */
+	m2plus = m2minus;
+	if (!denorm && bw == 1) {
+	    ++b2;
+	    ++s2;
+	    ++m2plus;
+	}
+
+	if (s5+1 < N_LOG2POW5
+	    && s2+1 + log2pow5[s5+1] <= 64) {
+	    /*
+	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit
+	     * word, then all our intermediate calculations can be done
+	     * using exact 64-bit arithmetic with no need for expensive
+	     * multiprecision operations. (This will be true for all numbers
+	     * in the range [1.0e-3 .. 1.0e+24]).
+	     */
+
+	    return ShorteningInt64Conversion(&d, convType, bw, b2, b5,
+					     m2plus, m2minus, m5,
+					     s2, s5, k, len, ilim, ilim1, 
+					     decpt, endPtr);
+	} else if (s5 == 0) {
+	    /*
+	     * The denominator is a power of 2, so we can replace division
+	     * by digit shifts. First we round up s2 to a multiple of
+	     * DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
+	     * into a version of the comparison that's specialized for
+	     * the 'power of mp_digit in the denominator' case.
+	     */
+	    if (s2 % DIGIT_BIT != 0) {
+		int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
+		b2 += delta;
+		m2plus += delta;
+		m2minus += delta;
+		s2 += delta;
+	    }
+	    return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5,
+						  m2plus, m2minus, m5,
+						  s2/DIGIT_BIT, k, len, 
+						  ilim, ilim1, decpt, endPtr);
+	} else {
+
+	    /* 
+	     * Alas, there's no helpful special case; use full-up
+	     * bignum arithmetic for the conversion
+	     */
+
+	    return ShorteningBignumConversion(&d, convType, bw,
+					      b2, m2plus, m2minus,
+					      s2, s5, k, len,
+					      ilim, ilim1, decpt, endPtr);
+
+	}
+
+    } else {
+
+	/* Non-shortening conversion */
+
+	int len = i;
+
+	/* Reduce numerator and denominator to lowest terms */
+
+	if (b2 >= s2 && s2 > 0) {
+	    b2 -= s2; s2 = 0;
+	} else if (s2 >= b2 && b2 > 0) {
+	    s2 -= b2; b2 = 0;
+	}
+
+	if (s5+1 < N_LOG2POW5
+	    && s2+1 + log2pow5[s5+1] <= 64) {
+	    /*
+	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit
+	     * word, then all our intermediate calculations can be done
+	     * using exact 64-bit arithmetic with no need for expensive
+	     * multiprecision operations.
+	     */
+
+	    return StrictInt64Conversion(&d, convType, bw, b2, b5,
+					 s2, s5, k, len, ilim, ilim1, 
+					 decpt, endPtr);
+
+	} else if (s5 == 0) {
+	    /*
+	     * The denominator is a power of 2, so we can replace division
+	     * by digit shifts. First we round up s2 to a multiple of
+	     * DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
+	     * into a version of the comparison that's specialized for
+	     * the 'power of mp_digit in the denominator' case.
+	     */
+	    if (s2 % DIGIT_BIT != 0) {
+		int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
+		b2 += delta;
+		s2 += delta;
+	    }
+	    return StrictBignumConversionPowD(&d, convType, bw, b2, b5,
+					      s2/DIGIT_BIT, k, len, 
+					      ilim, ilim1, decpt, endPtr);
+	} else {
+	    /*
+	     * There are no helpful special cases, but at least we know
+	     * in advance how many digits we will convert. We can run the
+	     * conversion in steps of DIGIT_GROUP digits, so as to
+	     * have many fewer mp_int divisions.
+	     */
+	    return StrictBignumConversion(&d, convType, bw, b2, s2, s5,
+					  k, len, ilim, ilim1, decpt, endPtr);
+	}
+    } 
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitDoubleConversion --
+ *
+ *	Initializes constants that are needed for conversions to and from
+ *	'double'
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The log base 2 of the floating point radix, the number of bits in a
+ *	double mantissa, and a table of the powers of five and ten are
+ *	computed and stored.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitDoubleConversion(void)
+{
+    int i;
+    int x;
+    Tcl_WideUInt u;
+    double d;
+
+#ifdef IEEE_FLOATING_POINT
+    union {
+	double dv;
+	Tcl_WideUInt iv;
+    } bitwhack;
+#endif
+
+#if defined(__sgi) && defined(_COMPILER_VERSION)
+    union fpc_csr mipsCR;
+
+    mipsCR.fc_word = get_fpc_csr();
+    mipsCR.fc_struct.flush = 0;
+    set_fpc_csr(mipsCR.fc_word);
+#endif
+
+    /*
+     * Initialize table of powers of 10 expressed as wide integers.
+     */
+
+    maxpow10_wide = (int)
+	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
+    pow10_wide = (Tcl_WideUInt *)
+	    ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
+    u = 1;
+    for (i = 0; i < maxpow10_wide; ++i) {
+	pow10_wide[i] = u;
+	u *= 10;
+    }
+    pow10_wide[i] = u;
+
+    /*
+     * Determine how many bits of precision a double has, and how many
+     * decimal digits that represents.
+     */
+
+    if (frexp((double) FLT_RADIX, &log2FLT_RADIX) != 0.5) {
+	Tcl_Panic("This code doesn't work on a decimal machine!");
+    }
+    log2FLT_RADIX--;
+    mantBits = DBL_MANT_DIG * log2FLT_RADIX;
+    d = 1.0;
+
+    /*
+     * Initialize a table of powers of ten that can be exactly represented
+     * in a double.
+     */
+
+    x = (int) (DBL_MANT_DIG * log((double) FLT_RADIX) / log(5.0));
+    if (x < MAXPOW) {
+	mmaxpow = x;
+    } else {
+	mmaxpow = MAXPOW;
+    }
+    for (i=0 ; i<=mmaxpow ; ++i) {
+	pow10vals[i] = d;
+	d *= 10.0;
+    }
+
+    /*
+     * Initialize a table of large powers of five.
+     */
+
+    for (i=0; i<9; ++i) {
+	mp_init(pow5 + i);
+    }
+    mp_set(pow5, 5);
+    for (i=0; i<8; ++i) {
+	mp_sqr(pow5+i, pow5+i+1);
+    }
+    mp_init_set_int(pow5_13, 1220703125);
+    for (i = 1; i < 5; ++i) {
+	mp_init(pow5_13 + i);
+	mp_sqr(pow5_13 + i - 1, pow5_13 + i);
+    }
+
+    /*
+     * Determine the number of decimal digits to the left and right of the
+     * decimal point in the largest and smallest double, the smallest double
+     * that differs from zero, and the number of mp_digits needed to represent
+     * the significand of a double.
+     */
+
+    maxDigits = (int) ((DBL_MAX_EXP * log((double) FLT_RADIX)
+	    + 0.5 * log(10.)) / log(10.));
+    minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG)
+	    * log((double) FLT_RADIX) / log(10.));
+    log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.));
+
+    /*
+     * Nokia 770's software-emulated floating point is "middle endian": the
+     * bytes within a 32-bit word are little-endian (like the native
+     * integers), but the two words of a 'double' are presented most
+     * significant word first.
+     */
+
+#ifdef IEEE_FLOATING_POINT
+    bitwhack.dv = 1.000000238418579;
+				/* 3ff0 0000 4000 0000 */
+    if ((bitwhack.iv >> 32) == 0x3ff00000) {
+	n770_fp = 0;
+    } else if ((bitwhack.iv & 0xffffffff) == 0x3ff00000) {
+	n770_fp = 1;
+    } else {
+	Tcl_Panic("unknown floating point word order on this machine");
+    }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeDoubleConversion --
+ *
+ *	Cleans up this file on exit.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Memory allocated by TclInitDoubleConversion is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeDoubleConversion(void)
+{
+    int i;
+
+    ckfree((char *) pow10_wide);
+    for (i=0; i<9; ++i) {
+	mp_clear(pow5 + i);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitBignumFromDouble --
+ *
+ *	Extracts the integer part of a double and converts it to an arbitrary
+ *	precision integer.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the bignum supplied, and stores the converted number in
+ *	it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InitBignumFromDouble(
+    Tcl_Interp *interp,		/* For error message */
+    double d,			/* Number to convert */
+    mp_int *b)			/* Place to store the result */
+{
+    double fract;
+    int expt;
+
+    /*
+     * Infinite values can't convert to bignum.
+     */
+
+    if (TclIsInfinite(d)) {
+	if (interp != NULL) {
+	    const char *s = "integer value too large to represent";
+
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    fract = frexp(d,&expt);
+    if (expt <= 0) {
+	mp_init(b);
+	mp_zero(b);
+    } else {
+	Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
+	int shift = expt - mantBits;
+
+	TclBNInitBignumFromWideInt(b, w);
+	if (shift < 0) {
+	    mp_div_2d(b, -shift, b, NULL);
+	} else if (shift > 0) {
+	    mp_mul_2d(b, shift, b);
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBignumToDouble --
+ *
+ *	Convert an arbitrary-precision integer to a native floating point
+ *	number.
+ *
+ * Results:
+ *	Returns the converted number. Sets errno to ERANGE if the number is
+ *	too large to convert.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclBignumToDouble(
+    mp_int *a)			/* Integer to convert. */
+{
+    mp_int b;
+    int bits, shift, i, lsb;
+    double r;
+
+
+    /*
+     * We need a 'mantBits'-bit significand.  Determine what shift will 
+     * give us that.
+     */
+
+    bits = mp_count_bits(a);
+    if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
+	errno = ERANGE;
+	if (a->sign == MP_ZPOS) {
+	    return HUGE_VAL;
+	} else {
+	    return -HUGE_VAL;
+	}
+    }
+    shift = mantBits - bits;
+
+    /* 
+     * If shift > 0, shift the significand left by the requisite number of
+     * bits.  If shift == 0, the significand is already exactly 'mantBits'
+     * in length.  If shift < 0, we will need to shift the significand right
+     * by the requisite number of bits, and round it. If the '1-shift'
+     * least significant bits are 0, but the 'shift'th bit is nonzero,
+     * then the significand lies exactly between two values and must be
+     * 'rounded to even'.
+     */
+
+    mp_init(&b);
+    if (shift == 0) {
+	mp_copy(a, &b);
+    } else if (shift > 0) {
+	mp_mul_2d(a, shift, &b);
+    } else if (shift < 0) {
+	lsb = mp_cnt_lsb(a);
+	if (lsb == -1-shift) {
+
+	    /*
+	     * Round to even
+	     */
+
+	    mp_div_2d(a, -shift, &b, NULL);
+	    if (mp_isodd(&b)) {
+		if (b.sign == MP_ZPOS) {
+		    mp_add_d(&b, 1, &b);
+		} else {
+		    mp_sub_d(&b, 1, &b);
+		}
+	    }
+	} else {
+
+	    /*
+	     * Ordinary rounding
+	     */
+
+	    mp_div_2d(a, -1-shift, &b, NULL);
+	    if (b.sign == MP_ZPOS) {
+		mp_add_d(&b, 1, &b);
+	    } else {
+		mp_sub_d(&b, 1, &b);
+	    }
+	    mp_div_2d(&b, 1, &b, NULL);
+	}
+    }
+
+    /*
+     * Accumulate the result, one mp_digit at a time.
+     */
+
+    r = 0.0;
+    for (i=b.used-1 ; i>=0 ; --i) {
+	r = ldexp(r, DIGIT_BIT) + b.dp[i];
+    }
+    mp_clear(&b);
+
+    /*
+     * Scale the result to the correct number of bits.
+     */
+
+    r = ldexp(r, bits - mantBits);
+
+    /*
+     * Return the result with the appropriate sign.
+     */
+
+    if (a->sign == MP_ZPOS) {
+	return r;
+    } else {
+	return -r;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclCeil --
+ *
+ *	Computes the smallest floating point number that is at least the
+ *	mp_int argument.
+ *
+ * Results:
+ *	Returns the floating point number.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+double
+TclCeil(
+    mp_int *a)			/* Integer to convert. */
+{
+    double r = 0.0;
+    mp_int b;
+
+    mp_init(&b);
+    if (mp_cmp_d(a, 0) == MP_LT) {
+	mp_neg(a, &b);
+	r = -TclFloor(&b);
+    } else {
+	int bits = mp_count_bits(a);
+
+	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
+	    r = HUGE_VAL;
+	} else {
+	    int i, exact = 1, shift = mantBits - bits;
+
+	    if (shift > 0) {
+		mp_mul_2d(a, shift, &b);
+	    } else if (shift < 0) {
+		mp_int d;
+		mp_init(&d);
+		mp_div_2d(a, -shift, &b, &d);
+		exact = mp_iszero(&d);
+		mp_clear(&d);
+	    } else {
+		mp_copy(a, &b);
+	    }
+	    if (!exact) {
+		mp_add_d(&b, 1, &b);
+	    }
+	    for (i=b.used-1 ; i>=0 ; --i) {
+		r = ldexp(r, DIGIT_BIT) + b.dp[i];
+	    }
+	    r = ldexp(r, bits - mantBits);
+	}
+    }
+    mp_clear(&b);
+    return r;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclFloor --
+ *
+ *	Computes the largest floating point number less than or equal to
+ *	the mp_int argument.
+ *
+ * Results:
+ *	Returns the floating point value.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+double
+TclFloor(
+    mp_int *a)			/* Integer to convert. */
+{
+    double r = 0.0;
+    mp_int b;
+
+    mp_init(&b);
+    if (mp_cmp_d(a, 0) == MP_LT) {
+	mp_neg(a, &b);
+	r = -TclCeil(&b);
+    } else {
+	int bits = mp_count_bits(a);
+
+	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
+	    r = DBL_MAX;
+	} else {
+	    int i, shift = mantBits - bits;
+
+	    if (shift > 0) {
+		mp_mul_2d(a, shift, &b);
+	    } else if (shift < 0) {
+		mp_div_2d(a, -shift, &b, NULL);
+	    } else {
+		mp_copy(a, &b);
+	    }
+	    for (i=b.used-1 ; i>=0 ; --i) {
+		r = ldexp(r, DIGIT_BIT) + b.dp[i];
+	    }
+	    r = ldexp(r, bits - mantBits);
+	}
+    }
+    mp_clear(&b);
+    return r;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BignumToBiasedFrExp --
+ *
+ *	Convert an arbitrary-precision integer to a native floating point
+ *	number in the range [0.5,1) times a power of two. NOTE: Intentionally
+ *	converts to a number that's a few ulp too small, so that
+ *	RefineApproximation will not overflow near the high end of the
+ *	machine's arithmetic range.
+ *
+ * Results:
+ *	Returns the converted number.
+ *
+ * Side effects:
+ *	Stores the exponent of two in 'machexp'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+BignumToBiasedFrExp(
+    mp_int *a,			/* Integer to convert */
+    int *machexp)		/* Power of two */
+{
+    mp_int b;
+    int bits;
+    int shift;
+    int i;
+    double r;
+
+    /*
+     * Determine how many bits we need, and extract that many from the input.
+     * Round to nearest unit in the last place.
+     */
+
+    bits = mp_count_bits(a);
+    shift = mantBits - 2 - bits;
+    mp_init(&b);
+    if (shift > 0) {
+	mp_mul_2d(a, shift, &b);
+    } else if (shift < 0) {
+	mp_div_2d(a, -shift, &b, NULL);
+    } else {
+	mp_copy(a, &b);
+    }
+
+    /*
+     * Accumulate the result, one mp_digit at a time.
+     */
+
+    r = 0.0;
+    for (i=b.used-1; i>=0; --i) {
+	r = ldexp(r, DIGIT_BIT) + b.dp[i];
+    }
+    mp_clear(&b);
+
+    /*
+     * Return the result with the appropriate sign.
+     */
+
+    *machexp = bits - mantBits + 2;
+    return ((a->sign == MP_ZPOS) ? r : -r);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pow10TimesFrExp --
+ *
+ *	Multiply a power of ten by a number expressed as fraction and
+ *	exponent.
+ *
+ * Results:
+ *	Returns the significand of the result.
+ *
+ * Side effects:
+ *	Overwrites the 'machexp' parameter with the exponent of the result.
+ *
+ * Assumes that 'exponent' is such that 10**exponent would be a double, even
+ * though 'fraction*10**(machexp+exponent)' might overflow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+Pow10TimesFrExp(
+    int exponent,	 	/* Power of 10 to multiply by */
+    double fraction,		/* Significand of multiplicand */
+    int *machexp)		/* On input, exponent of multiplicand. On
+				 * output, exponent of result. */
+{
+    int i, j;
+    int expt = *machexp;
+    double retval = fraction;
+
+    if (exponent > 0) {
+	/*
+	 * Multiply by 10**exponent
+	 */
+
+	retval = frexp(retval * pow10vals[exponent&0xf], &j);
+	expt += j;
+	for (i=4; i<9; ++i) {
+	    if (exponent & (1<<i)) {
+		retval = frexp(retval * pow_10_2_n[i], &j);
+		expt += j;
+	    }
+	}
+    } else if (exponent < 0) {
+	/*
+	 * Divide by 10**-exponent
+	 */
+
+	retval = frexp(retval / pow10vals[(-exponent) & 0xf], &j);
+	expt += j;
+	for (i=4; i<9; ++i) {
+	    if ((-exponent) & (1<<i)) {
+		retval = frexp(retval / pow_10_2_n[i], &j);
+		expt += j;
+	    }
+	}
+    }
+
+    *machexp = expt;
+    return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SafeLdExp --
+ *
+ *	Do an 'ldexp' operation, but handle denormals gracefully.
+ *
+ * Results:
+ *	Returns the appropriately scaled value.
+ *
+ *	On some platforms, 'ldexp' fails when presented with a number too
+ *	small to represent as a normalized double. This routine does 'ldexp'
+ *	in two steps for those numbers, to return correctly denormalized
+ *	values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+SafeLdExp(
+    double fract,
+    int expt)
+{
+    int minexpt = DBL_MIN_EXP * log2FLT_RADIX;
+    volatile double a, b, retval;
+
+    if (expt < minexpt) {
+	a = ldexp(fract, expt - mantBits - minexpt);
+	b = ldexp(1.0, mantBits + minexpt);
+	retval = a * b;
+    } else {
+	retval = ldexp(fract, expt);
+    }
+    return retval;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFormatNaN --
+ *
+ *	Makes the string representation of a "Not a Number"
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores the string representation in the supplied buffer, which must be
+ *	at least TCL_DOUBLE_SPACE characters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFormatNaN(
+    double value,		/* The Not-a-Number to format. */
+    char *buffer)		/* String representation. */
+{
+#ifndef IEEE_FLOATING_POINT
+    strcpy(buffer, "NaN");
+    return;
+#else
+    union {
+	double dv;
+	Tcl_WideUInt iv;
+    } bitwhack;
+
+    bitwhack.dv = value;
+    if (n770_fp) {
+	bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+    }
+    if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
+	bitwhack.iv &= ~ ((Tcl_WideUInt) 1 << 63);
+	*buffer++ = '-';
+    }
+    *buffer++ = 'N';
+    *buffer++ = 'a';
+    *buffer++ = 'N';
+    bitwhack.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
+    if (bitwhack.iv != 0) {
+	sprintf(buffer, "(%" TCL_LL_MODIFIER "x)", bitwhack.iv);
+    } else {
+	*buffer = '\0';
+    }
+#endif /* IEEE_FLOATING_POINT */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Nokia770Twiddle --
+ *
+ * 	Transpose the two words of a number for Nokia 770 floating
+ *	point handling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideUInt
+Nokia770Twiddle(
+    Tcl_WideUInt w)		/* Number to transpose */
+{
+    return (((w >> 32) & 0xffffffff) | (w << 32));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNokia770Doubles --
+ *
+ * 	Transpose the two words of a number for Nokia 770 floating
+ *	point handling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNokia770Doubles(void)
+{
+    return n770_fp;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8dba3c1..a929d04 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1,108 +1,111 @@
-/* 
+/*
  * tclStringObj.c --
  *
- *	This file contains procedures that implement string operations on Tcl
- *	objects.  Some string operations work with UTF strings and others
- *	require Unicode format.  Functions that require knowledge of the width
+ *	This file contains functions that implement string operations on Tcl
+ *	objects. Some string operations work with UTF strings and others
+ *	require Unicode format. Functions that require knowledge of the width
  *	of each character, such as indexing, operate on Unicode data.
  *
- *	A Unicode string is an internationalized string.  Conceptually, a
- *	Unicode string is an array of 16-bit quantities organized as a sequence
- *	of properly formed UTF-8 characters.  There is a one-to-one map between
- *	Unicode and UTF characters.  Because Unicode characters have a fixed
- *	width, operations such as indexing operate on Unicode data.  The String
- *	object is optimized for the case where each UTF char in a string is
- *	only one byte.  In this case, we store the value of numChars, but we
- *	don't store the Unicode data (unless Tcl_GetUnicode is explicitly
- *	called).
- *
- *	The String object type stores one or both formats.  The default
- *	behavior is to store UTF.  Once Unicode is calculated by a function, it
+ *	A Unicode string is an internationalized string. Conceptually, a
+ *	Unicode string is an array of 16-bit quantities organized as a
+ *	sequence of properly formed UTF-8 characters. There is a one-to-one
+ *	map between Unicode and UTF characters. Because Unicode characters
+ *	have a fixed width, operations such as indexing operate on Unicode
+ *	data. The String object is optimized for the case where each UTF char
+ *	in a string is only one byte. In this case, we store the value of
+ *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
+ *	is explicitly called).
+ *
+ *	The String object type stores one or both formats. The default
+ *	behavior is to store UTF. Once Unicode is calculated by a function, it
  *	is stored in the internal rep for future access (without an additional
  *	O(n) cost).
  *
  *	To allow many appends to be done to an object without constantly
  *	reallocating the space for the string or Unicode representation, we
  *	allocate double the space for the string or Unicode and use the
- *	internal representation to keep track of how much space is used
- *	vs. allocated.
+ *	internal representation to keep track of how much space is used vs.
+ *	allocated.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
+#include "tommath.h"
 
 /*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
  */
 
-static void		AppendUnicodeToUnicodeRep _ANSI_ARGS_((
-    			    Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
-			    int appendNumChars));
-static void		AppendUnicodeToUtfRep _ANSI_ARGS_((
-    			    Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
-			    int numChars));
-static void		AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
-    			    CONST char *bytes, int numBytes));
-static void		AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
-    			    CONST char *bytes, int numBytes));
-static void		DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr));
-static void		FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void		FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void		GrowUnicodeBuffer _ANSI_ARGS_((Tcl_Obj *objPtr,
-			    int needed));
-static int		SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
+static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
+			    const char *format, va_list argList);
+static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
+			    const Tcl_UniChar *unicode, int appendNumChars);
+static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
+			    const Tcl_UniChar *unicode, int numChars);
+static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
+			    const char *bytes, int numBytes);
+static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
+			    const char *bytes, int numBytes);
+static void		DupStringInternalRep(Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr);
+static void		FillUnicodeRep(Tcl_Obj *objPtr);
+static void		FreeStringInternalRep(Tcl_Obj *objPtr);
+static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
+static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		SetUnicodeObj(Tcl_Obj *objPtr,
-			    CONST Tcl_UniChar *unicode, int numChars);
-static int		UnicodeLength _ANSI_ARGS_((CONST Tcl_UniChar *unicode));
-static void		UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
+			    const Tcl_UniChar *unicode, int numChars);
+static int		UnicodeLength(const Tcl_UniChar *unicode);
+static void		UpdateStringOfString(Tcl_Obj *objPtr);
 
 /*
  * The structure below defines the string Tcl object type by means of
- * procedures that can be invoked by generic object code.
+ * functions that can be invoked by generic object code.
  */
 
 Tcl_ObjType tclStringType = {
-    "string",				/* name */
-    FreeStringInternalRep,		/* freeIntRepPro */
-    DupStringInternalRep,		/* dupIntRepProc */
-    UpdateStringOfString,		/* updateStringProc */
-    SetStringFromAny			/* setFromAnyProc */
+    "string",			/* name */
+    FreeStringInternalRep,	/* freeIntRepPro */
+    DupStringInternalRep,	/* dupIntRepProc */
+    UpdateStringOfString,	/* updateStringProc */
+    SetStringFromAny		/* setFromAnyProc */
 };
 
 /*
- * The following structure is the internal rep for a String object.
- * It keeps track of how much memory has been used and how much has been
- * allocated for the Unicode and UTF string to enable growing and
- * shrinking of the UTF and Unicode reps of the String object with fewer
- * mallocs.  To optimize string length and indexing operations, this
- * structure also stores the number of characters (same of UTF and Unicode!)
- * once that value has been computed.
+ * The following structure is the internal rep for a String object. It keeps
+ * track of how much memory has been used and how much has been allocated for
+ * the Unicode and UTF string to enable growing and shrinking of the UTF and
+ * Unicode reps of the String object with fewer mallocs. To optimize string
+ * length and indexing operations, this structure also stores the number of
+ * characters (same of UTF and Unicode!) once that value has been computed.
+ *
+ * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
+ * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
+ * can be officially modified by altering the definition of Tcl_UniChar in
+ * tcl.h, but do not do that unless you are sure what you're doing!
  */
 
 typedef struct String {
-    int numChars;		/* The number of chars in the string.
-				 * -1 means this value has not been
-				 * calculated. >= 0 means that there is a
-				 * valid Unicode rep, or that the number
-				 * of UTF bytes == the number of chars. */
-    size_t allocated;		/* The amount of space actually allocated
-				 * for the UTF string (minus 1 byte for
-				 * the termination char). */
-    size_t uallocated;		/* The amount of space actually allocated
-				 * for the Unicode string (minus 2 bytes for
-				 * the termination char). */
-    int hasUnicode;		/* Boolean determining whether the string
-				 * has a Unicode representation. */
-    Tcl_UniChar unicode[2];	/* The array of Unicode chars.  The actual
-				 * size of this field depends on the
-				 * 'uallocated' field above. */
+    int numChars;		/* The number of chars in the string. -1 means
+				 * this value has not been calculated. >= 0
+				 * means that there is a valid Unicode rep, or
+				 * that the number of UTF bytes == the number
+				 * of chars. */
+    size_t allocated;		/* The amount of space actually allocated for
+				 * the UTF string (minus 1 byte for the
+				 * termination char). */
+    size_t uallocated;		/* The amount of space actually allocated for
+				 * the Unicode string (minus 2 bytes for the
+				 * termination char). */
+    int hasUnicode;		/* Boolean determining whether the string has
+				 * a Unicode representation. */
+    Tcl_UniChar unicode[2];	/* The array of Unicode chars. The actual size
+				 * of this field depends on the 'uallocated'
+				 * field above. */
 } String;
 
 #define STRING_MAXCHARS \
@@ -114,7 +117,7 @@ typedef struct String {
 	? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \
 	: sizeof(String)))
 #define stringCheckLimits(numChars) \
-    if ((unsigned)(numChars) > (unsigned)(STRING_MAXCHARS)) { \
+    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
 	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
 		STRING_MAXCHARS); \
     }
@@ -125,9 +128,9 @@ typedef struct String {
 	(String *) attemptckrealloc((char *) ptr, \
 		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
 #define GET_STRING(objPtr) \
-		((String *) (objPtr)->internalRep.otherValuePtr)
+	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_STRING(objPtr, stringPtr) \
-		(objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
+	((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
 
 /*
  * TCL STRING GROWTH ALGORITHM
@@ -138,31 +141,31 @@ typedef struct String {
  *   Attempt to allocate 2 * (originalLength + appendLength)
  *   On failure:
  *	attempt to allocate originalLength + 2*appendLength +
- *			TCL_GROWTH_MIN_ALLOC 
+ *			TCL_GROWTH_MIN_ALLOC
  *
  * This algorithm allows very good performance, as it rapidly increases the
  * memory allocated for a given string, which minimizes the number of
- * reallocations that must be performed.  However, using only the doubling
- * algorithm can lead to a significant waste of memory.  In particular, it
- * may fail even when there is sufficient memory available to complete the
- * append request (but there is not 2 * totalLength memory available).  So when
- * the doubling fails (because there is not enough memory available), the
+ * reallocations that must be performed. However, using only the doubling
+ * algorithm can lead to a significant waste of memory. In particular, it may
+ * fail even when there is sufficient memory available to complete the append
+ * request (but there is not 2*totalLength memory available). So when the
+ * doubling fails (because there is not enough memory available), the
  * algorithm requests a smaller amount of memory, which is still enough to
- * cover the request, but which hopefully will be less than the total available
- * memory.
- * 
- * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling
- * of very small appends.  Without this extra slush factor, a sequence
- * of several small appends would cause several memory allocations.
- * As long as TCL_GROWTH_MIN_ALLOC is a reasonable size, we can
- * avoid that behavior.
+ * cover the request, but which hopefully will be less than the total
+ * available memory.
+ *
+ * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very
+ * small appends. Without this extra slush factor, a sequence of several small
+ * appends would cause several memory allocations. As long as
+ * TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
  *
  * The growth algorithm can be tuned by adjusting the following parameters:
  *
  * TCL_GROWTH_MIN_ALLOC		Additional space, in bytes, to allocate when
- *				the double allocation has failed.
- *				Default is 1024 (1 kilobyte).
+ *				the double allocation has failed. Default is
+ *				1024 (1 kilobyte).
  */
+
 #ifndef TCL_GROWTH_MIN_ALLOC
 #define TCL_GROWTH_MIN_ALLOC	1024
 #endif
@@ -215,60 +218,55 @@ GrowUnicodeBuffer(
  *
  * Tcl_NewStringObj --
  *
- *	This procedure is normally called when not debugging: i.e., when
+ *	This function is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates a new string object and
  *	initializes it from the byte pointer and length arguments.
  *
- *	When TCL_MEM_DEBUG is defined, this procedure just returns the
- *	result of calling the debugging version Tcl_DbNewStringObj.
+ *	When TCL_MEM_DEBUG is defined, this function just returns the result
+ *	of calling the debugging version Tcl_DbNewStringObj.
  *
  * Results:
  *	A newly created string object is returned that has ref count zero.
  *
  * Side effects:
- *	The new object's internal string representation will be set to a
- *	copy of the length bytes starting at "bytes". If "length" is
- *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
- *	points to a C-style NULL-terminated string. The object's type is set
- *	to NULL. An extra NULL is added to the end of the new object's byte
- *	array.
+ *	The new object's internal string representation will be set to a copy
+ *	of the length bytes starting at "bytes". If "length" is negative, use
+ *	bytes up to the first NUL byte; i.e., assume "bytes" points to a
+ *	C-style NUL-terminated string. The object's type is set to NULL. An
+ *	extra NUL is added to the end of the new object's byte array.
  *
  *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
 #undef Tcl_NewStringObj
-
 Tcl_Obj *
-Tcl_NewStringObj(bytes, length)
-    CONST char *bytes;		/* Points to the first of the length bytes
+Tcl_NewStringObj(
+    const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the new object. */
-    int length;			/* The number of bytes to copy from "bytes"
-				 * when initializing the new object. If 
-				 * negative, use bytes up to the first
-				 * NULL byte. */
+    int length)			/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If
+				 * negative, use bytes up to the first NUL
+				 * byte. */
 {
     return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
 }
-
 #else /* if not TCL_MEM_DEBUG */
-
 Tcl_Obj *
-Tcl_NewStringObj(bytes, length)
-    CONST char *bytes;		/* Points to the first of the length bytes
+Tcl_NewStringObj(
+    const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the new object. */
-    int length;			/* The number of bytes to copy from "bytes"
-				 * when initializing the new object. If 
-				 * negative, use bytes up to the first
-				 * NULL byte. */
+    int length)			/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If
+				 * negative, use bytes up to the first NUL
+				 * byte. */
 {
     register Tcl_Obj *objPtr;
 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
     }
-    TclNewObj(objPtr);
-    TclInitStringRep(objPtr, bytes, length);
+    TclNewStringObj(objPtr, bytes, length);
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -278,45 +276,43 @@ Tcl_NewStringObj(bytes, length)
  *
  * Tcl_DbNewStringObj --
  *
- *	This procedure is normally called when debugging: i.e., when
+ *	This function is normally called when debugging: i.e., when
  *	TCL_MEM_DEBUG is defined. It creates new string objects. It is the
- *	same as the Tcl_NewStringObj procedure above except that it calls
+ *	same as the Tcl_NewStringObj function above except that it calls
  *	Tcl_DbCkalloc directly with the file name and line number from its
  *	caller. This simplifies debugging since then the [memory active]
- *	command	will report the correct file name and line number when
+ *	command will report the correct file name and line number when
  *	reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ *	When TCL_MEM_DEBUG is not defined, this function just returns the
  *	result of calling Tcl_NewStringObj.
  *
  * Results:
  *	A newly created string object is returned that has ref count zero.
  *
  * Side effects:
- *	The new object's internal string representation will be set to a
- *	copy of the length bytes starting at "bytes". If "length" is
- *	negative, use bytes up to the first NULL byte; i.e., assume "bytes"
- *	points to a C-style NULL-terminated string. The object's type is set
- *	to NULL. An extra NULL is added to the end of the new object's byte
- *	array.
+ *	The new object's internal string representation will be set to a copy
+ *	of the length bytes starting at "bytes". If "length" is negative, use
+ *	bytes up to the first NUL byte; i.e., assume "bytes" points to a
+ *	C-style NUL-terminated string. The object's type is set to NULL. An
+ *	extra NUL is added to the end of the new object's byte array.
  *
  *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
-
 Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
-    CONST char *bytes;		/* Points to the first of the length bytes
+Tcl_DbNewStringObj(
+    const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the new object. */
-    int length;			/* The number of bytes to copy from "bytes"
-				 * when initializing the new object. If 
-				 * negative, use bytes up to the first
-				 * NULL byte. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+    int length,			/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If
+				 * negative, use bytes up to the first NUL
+				 * byte. */
+    const char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     register Tcl_Obj *objPtr;
 
@@ -327,21 +323,19 @@ Tcl_DbNewStringObj(bytes, length, file, line)
     TclInitStringRep(objPtr, bytes, length);
     return objPtr;
 }
-
 #else /* if not TCL_MEM_DEBUG */
-
 Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
-    CONST char *bytes;		/* Points to the first of the length bytes
+Tcl_DbNewStringObj(
+    const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the new object. */
-    register int length;	/* The number of bytes to copy from "bytes"
-				 * when initializing the new object. If 
-				 * negative, use bytes up to the first
-				 * NULL byte. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
+    register int length,	/* The number of bytes to copy from "bytes"
+				 * when initializing the new object. If
+				 * negative, use bytes up to the first NUL
+				 * byte. */
+    const char *file,		/* The name of the source file calling this
+				 * function; used for debugging. */
+    int line)			/* Line number in the source file; used for
+				 * debugging. */
 {
     return Tcl_NewStringObj(bytes, length);
 }
@@ -352,14 +346,13 @@ Tcl_DbNewStringObj(bytes, length, file, line)
  *
  * Tcl_NewUnicodeObj --
  *
- *	This procedure is creates a new String object and initializes
- *	it from the given Unicode String.  If the Utf String is the same size
- *	as the Unicode string, don't duplicate the data.
+ *	This function is creates a new String object and initializes it from
+ *	the given Unicode String. If the Utf String is the same size as the
+ *	Unicode string, don't duplicate the data.
  *
  * Results:
- *	The newly created object is returned.  This object will have no
- *	initial string representation.  The returned object has a ref count
- *	of 0.
+ *	The newly created object is returned. This object will have no initial
+ *	string representation. The returned object has a ref count of 0.
  *
  * Side effects:
  *	Memory allocated for new object and copy of Unicode argument.
@@ -368,10 +361,10 @@ Tcl_DbNewStringObj(bytes, length, file, line)
  */
 
 Tcl_Obj *
-Tcl_NewUnicodeObj(unicode, numChars)
-    CONST Tcl_UniChar *unicode;	/* The unicode string used to initialize
-				 * the new object. */
-    int numChars;		/* Number of characters in the unicode
+Tcl_NewUnicodeObj(
+    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
+				 * new object. */
+    int numChars)		/* Number of characters in the unicode
 				 * string. */
 {
     Tcl_Obj *objPtr;
@@ -392,60 +385,63 @@ Tcl_NewUnicodeObj(unicode, numChars)
  *	Pointer to unicode string representing the unicode object.
  *
  * Side effects:
- *	Frees old internal rep.  Allocates memory for new "String"
- *	internal rep.
+ *	Frees old internal rep. Allocates memory for new "String" internal
+ *	rep.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_GetCharLength(objPtr)
-    Tcl_Obj *objPtr;	/* The String object to get the num chars of. */
+Tcl_GetCharLength(
+    Tcl_Obj *objPtr)		/* The String object to get the num chars
+				 * of. */
 {
     String *stringPtr;
-    
+
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
     /*
-     * If numChars is unknown, then calculate the number of characaters
-     * while populating the Unicode string.
+     * If numChars is unknown, then calculate the number of characaters while
+     * populating the Unicode string.
      */
-    
+
     if (stringPtr->numChars == -1) {
 	register int i = objPtr->length;
 	register unsigned char *str = (unsigned char *) objPtr->bytes;
 
 	/*
 	 * This is a speed sensitive function, so run specially over the
-	 * string to count continuous ascii characters before resorting
-	 * to the Tcl_NumUtfChars call.  This is a long form of:
-	 stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
-	*/
+	 * string to count continuous ascii characters before resorting to the
+	 * Tcl_NumUtfChars call. This is a long form of:
+	 stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes,objPtr->length);
+	 *
+	 * TODO: Consider macro-izing this.
+	 */
 
-	while (i && (*str < 0xC0)) { i--; str++; }
+	while (i && (*str < 0xC0)) {
+	    i--;
+	    str++;
+	}
 	stringPtr->numChars = objPtr->length - i;
 	if (i) {
 	    stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
 		    + (objPtr->length - i), i);
 	}
 
- 	if (stringPtr->numChars == objPtr->length) {
-
+	if (stringPtr->numChars == objPtr->length) {
 	    /*
-	     * Since we've just calculated the number of chars, and all
-	     * UTF chars are 1-byte long, we don't need to store the
-	     * unicode string.
+	     * Since we've just calculated the number of chars, and all UTF
+	     * chars are 1-byte long, we don't need to store the unicode
+	     * string.
 	     */
 
 	    stringPtr->hasUnicode = 0;
-
 	} else {
-    
 	    /*
-	     * Since we've just calucalated the number of chars, and not
-	     * all UTF chars are 1-byte long, go ahead and populate the
-	     * unicode string.
+	     * Since we've just calucalated the number of chars, and not all
+	     * UTF chars are 1-byte long, go ahead and populate the unicode
+	     * string.
 	     */
 
 	    FillUnicodeRep(objPtr);
@@ -454,7 +450,7 @@ Tcl_GetCharLength(objPtr)
 	     * We need to fetch the pointer again because we have just
 	     * reallocated the structure to make room for the Unicode data.
 	     */
-	    
+
 	    stringPtr = GET_STRING(objPtr);
 	}
     }
@@ -466,8 +462,8 @@ Tcl_GetCharLength(objPtr)
  *
  * Tcl_GetUniChar --
  *
- *	Get the index'th Unicode character from the String object.  The
- *	index is assumed to be in the appropriate range.
+ *	Get the index'th Unicode character from the String object. The index
+ *	is assumed to be in the appropriate range.
  *
  * Results:
  *	Returns the index'th Unicode character in the Object.
@@ -479,22 +475,21 @@ Tcl_GetCharLength(objPtr)
  */
 
 Tcl_UniChar
-Tcl_GetUniChar(objPtr, index)
-    Tcl_Obj *objPtr;	/* The object to get the Unicode charater from. */
-    int index;		/* Get the index'th Unicode character. */
+Tcl_GetUniChar(
+    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
+				 * from. */
+    int index)			/* Get the index'th Unicode character. */
 {
     Tcl_UniChar unichar;
     String *stringPtr;
-    
+
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
     if (stringPtr->numChars == -1) {
-
 	/*
-	 * We haven't yet calculated the length, so we don't have the
-	 * Unicode str.  We need to know the number of chars before we
-	 * can do indexing.
+	 * We haven't yet calculated the length, so we don't have the Unicode
+	 * str. We need to know the number of chars before we can do indexing.
 	 */
 
 	Tcl_GetCharLength(objPtr);
@@ -503,15 +498,14 @@ Tcl_GetUniChar(objPtr, index)
 	 * We need to fetch the pointer again because we may have just
 	 * reallocated the structure.
 	 */
-	
+
 	stringPtr = GET_STRING(objPtr);
     }
     if (stringPtr->hasUnicode == 0) {
-
 	/*
-	 * All of the characters in the Utf string are 1 byte chars,
-	 * so we don't store the unicode char.  We get the Utf string
-	 * and convert the index'th byte to a Unicode character.
+	 * All of the characters in the Utf string are 1 byte chars, so we
+	 * don't store the unicode char. We get the Utf string and convert the
+	 * index'th byte to a Unicode character.
 	 */
 
 	unichar = (Tcl_UniChar) objPtr->bytes[index];
@@ -526,10 +520,10 @@ Tcl_GetUniChar(objPtr, index)
  *
  * Tcl_GetUnicode --
  *
- *	Get the Unicode form of the String object.  If
- *	the object is not already a String object, it will be converted
- *	to one.  If the String object does not have a Unicode rep, then
- *	one is create from the UTF string format.
+ *	Get the Unicode form of the String object. If the object is not
+ *	already a String object, it will be converted to one. If the String
+ *	object does not have a Unicode rep, then one is create from the UTF
+ *	string format.
  *
  * Results:
  *	Returns a pointer to the object's internal Unicode string.
@@ -541,31 +535,31 @@ Tcl_GetUniChar(objPtr, index)
  */
 
 Tcl_UniChar *
-Tcl_GetUnicode(objPtr)
-    Tcl_Obj *objPtr;	/* The object to find the unicode string for. */
+Tcl_GetUnicode(
+    Tcl_Obj *objPtr)		/* The object to find the unicode string
+				 * for. */
 {
     String *stringPtr;
-    
+
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
-    
-    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
 
+    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
 	/*
-	 * We haven't yet calculated the length, or all of the characters
-	 * in the Utf string are 1 byte chars (so we didn't store the
-	 * unicode str).  Since this function must return a unicode string,
-	 * and one has not yet been stored, force the Unicode to be
-	 * calculated and stored now.
+	 * We haven't yet calculated the length, or all of the characters in
+	 * the Utf string are 1 byte chars (so we didn't store the unicode
+	 * str). Since this function must return a unicode string, and one has
+	 * not yet been stored, force the Unicode to be calculated and stored
+	 * now.
 	 */
 
 	FillUnicodeRep(objPtr);
 
 	/*
-	 * We need to fetch the pointer again because we have just
-	 * reallocated the structure to make room for the Unicode data.
+	 * We need to fetch the pointer again because we have just reallocated
+	 * the structure to make room for the Unicode data.
 	 */
-	
+
 	stringPtr = GET_STRING(objPtr);
     }
     return stringPtr->unicode;
@@ -576,10 +570,10 @@ Tcl_GetUnicode(objPtr)
  *
  * Tcl_GetUnicodeFromObj --
  *
- *	Get the Unicode form of the String object with length.  If
- *	the object is not already a String object, it will be converted
- *	to one.  If the String object does not have a Unicode rep, then
- *	one is create from the UTF string format.
+ *	Get the Unicode form of the String object with length. If the object
+ *	is not already a String object, it will be converted to one. If the
+ *	String object does not have a Unicode rep, then one is create from the
+ *	UTF string format.
  *
  * Results:
  *	Returns a pointer to the object's internal Unicode string.
@@ -591,34 +585,34 @@ Tcl_GetUnicode(objPtr)
  */
 
 Tcl_UniChar *
-Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
-    Tcl_Obj *objPtr;	/* The object to find the unicode string for. */
-    int *lengthPtr;	/* If non-NULL, the location where the
-			 * string rep's unichar length should be
-			 * stored. If NULL, no length is stored. */
+Tcl_GetUnicodeFromObj(
+    Tcl_Obj *objPtr,		/* The object to find the unicode string
+				 * for. */
+    int *lengthPtr)		/* If non-NULL, the location where the string
+				 * rep's unichar length should be stored. If
+				 * NULL, no length is stored. */
 {
     String *stringPtr;
-    
+
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
-    
-    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
 
+    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
 	/*
-	 * We haven't yet calculated the length, or all of the characters
-	 * in the Utf string are 1 byte chars (so we didn't store the
-	 * unicode str).  Since this function must return a unicode string,
-	 * and one has not yet been stored, force the Unicode to be
-	 * calculated and stored now.
+	 * We haven't yet calculated the length, or all of the characters in
+	 * the Utf string are 1 byte chars (so we didn't store the unicode
+	 * str). Since this function must return a unicode string, and one has
+	 * not yet been stored, force the Unicode to be calculated and stored
+	 * now.
 	 */
 
 	FillUnicodeRep(objPtr);
 
 	/*
-	 * We need to fetch the pointer again because we have just
-	 * reallocated the structure to make room for the Unicode data.
+	 * We need to fetch the pointer again because we have just reallocated
+	 * the structure to make room for the Unicode data.
 	 */
-	
+
 	stringPtr = GET_STRING(objPtr);
     }
 
@@ -633,10 +627,10 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
  *
  * Tcl_GetRange --
  *
- *	Create a Tcl Object that contains the chars between first and last
- *	of the object indicated by "objPtr".  If the object is not already
- *	a String object, convert it to one.  The first and last indices
- *	are assumed to be in the appropriate range.
+ *	Create a Tcl Object that contains the chars between first and last of
+ *	the object indicated by "objPtr". If the object is not already a
+ *	String object, convert it to one. The first and last indices are
+ *	assumed to be in the appropriate range.
  *
  * Results:
  *	Returns a new Tcl Object of the String type.
@@ -648,23 +642,21 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
  */
 
 Tcl_Obj *
-Tcl_GetRange(objPtr, first, last)
-    Tcl_Obj *objPtr;		/* The Tcl object to find the range of. */
-    int first;			/* First index of the range. */
-    int last;			/* Last index of the range. */
+Tcl_GetRange(
+    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
+    int first,			/* First index of the range. */
+    int last)			/* Last index of the range. */
 {
     Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     String *stringPtr;
-    
+
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
     if (stringPtr->numChars == -1) {
-    
 	/*
-	 * We haven't yet calculated the length, so we don't have the
-	 * Unicode str.  We need to know the number of chars before we
-	 * can do indexing.
+	 * We haven't yet calculated the length, so we don't have the Unicode
+	 * str. We need to know the number of chars before we can do indexing.
 	 */
 
 	Tcl_GetCharLength(objPtr);
@@ -673,26 +665,26 @@ Tcl_GetRange(objPtr, first, last)
 	 * We need to fetch the pointer again because we may have just
 	 * reallocated the structure.
 	 */
-	
+
 	stringPtr = GET_STRING(objPtr);
     }
 
-    if (objPtr->bytes && stringPtr->numChars == objPtr->length) {
-	char *str = Tcl_GetString(objPtr);
+    if (objPtr->bytes && (stringPtr->numChars == objPtr->length)) {
+	char *str = TclGetString(objPtr);
 
 	/*
-	 * All of the characters in the Utf string are 1 byte chars,
-	 * so we don't store the unicode char.  Create a new string
-	 * object containing the specified range of chars.
+	 * All of the characters in the Utf string are 1 byte chars, so we
+	 * don't store the unicode char. Create a new string object containing
+	 * the specified range of chars.
 	 */
-	
+
 	newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
 
 	/*
-	 * Since we know the new string only has 1-byte chars, we
-	 * can set it's numChars field.
+	 * Since we know the new string only has 1-byte chars, we can set it's
+	 * numChars field.
 	 */
-	
+
 	SetStringFromAny(NULL, newObjPtr);
 	stringPtr = GET_STRING(newObjPtr);
 	stringPtr->numChars = last-first+1;
@@ -709,52 +701,47 @@ Tcl_GetRange(objPtr, first, last)
  * Tcl_SetStringObj --
  *
  *	Modify an object to hold a string that is a copy of the bytes
- *	indicated by the byte pointer and length arguments. 
+ *	indicated by the byte pointer and length arguments.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The object's string representation will be set to a copy of
- *	the "length" bytes starting at "bytes". If "length" is negative, use
- *	bytes up to the first NULL byte; i.e., assume "bytes" points to a
- *	C-style NULL-terminated string. The object's old string and internal
+ *	The object's string representation will be set to a copy of the
+ *	"length" bytes starting at "bytes". If "length" is negative, use bytes
+ *	up to the first NUL byte; i.e., assume "bytes" points to a C-style
+ *	NUL-terminated string. The object's old string and internal
  *	representations are freed and the object's type is set NULL.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetStringObj(objPtr, bytes, length)
-    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
-    CONST char *bytes;		/* Points to the first of the length bytes
+Tcl_SetStringObj(
+    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the object. */
-    register int length;	/* The number of bytes to copy from "bytes"
-				 * when initializing the object. If 
-				 * negative, use bytes up to the first
-				 * NULL byte.*/
+    register int length)	/* The number of bytes to copy from "bytes"
+				 * when initializing the object. If negative,
+				 * use bytes up to the first NUL byte.*/
 {
-    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetStringObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
     }
 
     /*
      * Set the type to NULL and free any internal rep for the old type.
      */
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
+    TclFreeIntRep(objPtr);
     objPtr->typePtr = NULL;
 
     /*
-     * Free any old string rep, then set the string rep to a copy of
-     * the length bytes starting at "bytes".
+     * Free any old string rep, then set the string rep to a copy of the
+     * length bytes starting at "bytes".
      */
 
-    Tcl_InvalidateStringRep(objPtr);
+    TclInvalidateStringRep(objPtr);
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
     }
@@ -766,30 +753,29 @@ Tcl_SetStringObj(objPtr, bytes, length)
  *
  * Tcl_SetObjLength --
  *
- *	This procedure changes the length of the string representation
- *	of an object.
+ *	This function changes the length of the string representation of an
+ *	object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If the size of objPtr's string representation is greater than
- *	length, then it is reduced to length and a new terminating null
- *	byte is stored in the strength.  If the length of the string
- *	representation is greater than length, the storage space is
- *	reallocated to the given length; a null byte is stored at the
- *	end, but other bytes past the end of the original string
- *	representation are undefined.  The object's internal
+ *	If the size of objPtr's string representation is greater than length,
+ *	then it is reduced to length and a new terminating null byte is stored
+ *	in the strength. If the length of the string representation is greater
+ *	than length, the storage space is reallocated to the given length; a
+ *	null byte is stored at the end, but other bytes past the end of the
+ *	original string representation are undefined. The object's internal
  *	representation is changed to "expendable string".
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetObjLength(objPtr, length)
-    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
-				 * not currently be shared. */
-    register int length;	/* Number of bytes desired for string
+Tcl_SetObjLength(
+    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
+				 * currently be shared. */
+    register int length)	/* Number of bytes desired for string
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -804,64 +790,83 @@ Tcl_SetObjLength(objPtr, length)
 		"%d (integer overflow?)", length);
     }
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_SetObjLength called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
     }
     SetStringFromAny(NULL, objPtr);
-    
+
     stringPtr = GET_STRING(objPtr);
-    
-    /* Check that we're not extending a pure unicode string */
-    
-    if ((size_t)length > stringPtr->allocated && 
-	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
-	char *new;
 
+    /*
+     * Check that we're not extending a pure unicode string.
+     */
+
+    if ((size_t)length > stringPtr->allocated &&
+	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
 	/*
-	 * Not enough space in current string. Reallocate the string
-	 * space and free the old string.
+	 * Not enough space in current string. Reallocate the string space and
+	 * free the old string.
 	 */
-	if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
-	    new = (char *) ckrealloc((char *)objPtr->bytes,
-		    (unsigned)(length+1));
+
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    objPtr->bytes = ckrealloc((char *) objPtr->bytes,
+		    (unsigned) (length + 1));
 	} else {
-	    new = (char *) ckalloc((unsigned) (length+1));
+	    char *newBytes = ckalloc((unsigned) (length+1));
+
 	    if (objPtr->bytes != NULL && objPtr->length != 0) {
-		memcpy((VOID *) new, (VOID *) objPtr->bytes,
-			(size_t) objPtr->length);
-		Tcl_InvalidateStringRep(objPtr);
+		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
+		TclInvalidateStringRep(objPtr);
 	    }
+	    objPtr->bytes = newBytes;
 	}
-	objPtr->bytes = new;
 	stringPtr->allocated = length;
-	/* Invalidate the unicode data. */
+
+	/*
+	 * Invalidate the unicode data.
+	 */
+
 	stringPtr->hasUnicode = 0;
     }
-    
+
     if (objPtr->bytes != NULL) {
-        objPtr->length = length;
-        if (objPtr->bytes != tclEmptyStringRep) {
-            /* Ensure the string is NULL-terminated */
-            objPtr->bytes[length] = 0;
-        }
-        /* Invalidate the unicode data. */
-        stringPtr->numChars = -1;
-        stringPtr->hasUnicode = 0;
+	objPtr->length = length;
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    /*
+	     * Ensure the string is NUL-terminated.
+	     */
+
+	    objPtr->bytes[length] = 0;
+	}
+
+	/*
+	 * Invalidate the unicode data.
+	 */
+
+	stringPtr->numChars = -1;
+	stringPtr->hasUnicode = 0;
     } else {
-        /* Changing length of pure unicode string */
-        size_t uallocated = STRING_UALLOC(length);
+	/*
+	 * Changing length of pure unicode string.
+	 */
+
+	size_t uallocated = STRING_UALLOC(length);
 
 	stringCheckLimits(length);
-        if (uallocated > stringPtr->uallocated) {
+	if (uallocated > stringPtr->uallocated) {
 	    stringPtr = stringRealloc(stringPtr, length);
-            SET_STRING(objPtr, stringPtr);
-            stringPtr->uallocated = uallocated;
-        }
-        stringPtr->numChars = length;
-        stringPtr->hasUnicode = (length > 0);
-        /* Ensure the string is NULL-terminated */
-        stringPtr->unicode[length] = 0;
-        stringPtr->allocated = 0;
-        objPtr->length = 0;
+	    SET_STRING(objPtr, stringPtr);
+	    stringPtr->uallocated = uallocated;
+	}
+	stringPtr->numChars = length;
+	stringPtr->hasUnicode = (length > 0);
+
+	/*
+	 * Ensure the string is NUL-terminated.
+	 */
+
+	stringPtr->unicode[length] = 0;
+	stringPtr->allocated = 0;
+	objPtr->length = 0;
     }
 }
 
@@ -870,30 +875,29 @@ Tcl_SetObjLength(objPtr, length)
  *
  * Tcl_AttemptSetObjLength --
  *
- *	This procedure changes the length of the string representation
- *	of an object.  It uses the attempt* (non-panic'ing) memory allocators.
+ *	This function changes the length of the string representation of an
+ *	object. It uses the attempt* (non-panic'ing) memory allocators.
  *
  * Results:
  *	1 if the requested memory was allocated, 0 otherwise.
  *
  * Side effects:
- *	If the size of objPtr's string representation is greater than
- *	length, then it is reduced to length and a new terminating null
- *	byte is stored in the strength.  If the length of the string
- *	representation is greater than length, the storage space is
- *	reallocated to the given length; a null byte is stored at the
- *	end, but other bytes past the end of the original string
- *	representation are undefined.  The object's internal
+ *	If the size of objPtr's string representation is greater than length,
+ *	then it is reduced to length and a new terminating null byte is stored
+ *	in the strength. If the length of the string representation is greater
+ *	than length, the storage space is reallocated to the given length; a
+ *	null byte is stored at the end, but other bytes past the end of the
+ *	original string representation are undefined. The object's internal
  *	representation is changed to "expendable string".
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_AttemptSetObjLength(objPtr, length)
-    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
-				 * not currently be shared. */
-    register int length;	/* Number of bytes desired for string
+Tcl_AttemptSetObjLength(
+    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
+				 * currently be shared. */
+    register int length)	/* Number of bytes desired for string
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -907,56 +911,72 @@ Tcl_AttemptSetObjLength(objPtr, length)
 	return 0;
     }
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_AttemptSetObjLength called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
     }
     SetStringFromAny(NULL, objPtr);
-        
+
     stringPtr = GET_STRING(objPtr);
 
-    /* Check that we're not extending a pure unicode string */
+    /*
+     * Check that we're not extending a pure unicode string.
+     */
 
-    if (length > (int) stringPtr->allocated && 
+    if (length > (int) stringPtr->allocated &&
 	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
-	char *new;
+	char *newBytes;
 
 	/*
-	 * Not enough space in current string. Reallocate the string
-	 * space and free the old string.
+	 * Not enough space in current string. Reallocate the string space and
+	 * free the old string.
 	 */
-	if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
-	    new = (char *) attemptckrealloc((char *)objPtr->bytes,
-		    (unsigned)(length+1));
-	    if (new == NULL) {
+
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    newBytes = attemptckrealloc(objPtr->bytes,
+		    (unsigned)(length + 1));
+	    if (newBytes == NULL) {
 		return 0;
 	    }
 	} else {
-	    new = (char *) attemptckalloc((unsigned) (length+1));
-	    if (new == NULL) {
+	    newBytes = attemptckalloc((unsigned) (length + 1));
+	    if (newBytes == NULL) {
 		return 0;
 	    }
 	    if (objPtr->bytes != NULL && objPtr->length != 0) {
- 	    	memcpy((VOID *) new, (VOID *) objPtr->bytes,
- 		    	(size_t) objPtr->length);
- 	    	Tcl_InvalidateStringRep(objPtr);
+		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
+		TclInvalidateStringRep(objPtr);
 	    }
 	}
-	objPtr->bytes = new;
+	objPtr->bytes = newBytes;
 	stringPtr->allocated = length;
-	/* Invalidate the unicode data. */
+
+	/*
+	 * Invalidate the unicode data.
+	 */
+
 	stringPtr->hasUnicode = 0;
     }
-    
+
     if (objPtr->bytes != NULL) {
 	objPtr->length = length;
 	if (objPtr->bytes != tclEmptyStringRep) {
-	    /* Ensure the string is NULL-terminated */
+	    /*
+	     * Ensure the string is NULL-terminated.
+	     */
+
 	    objPtr->bytes[length] = 0;
 	}
-	/* Invalidate the unicode data. */
+
+	/*
+	 * Invalidate the unicode data.
+	 */
+
 	stringPtr->numChars = -1;
 	stringPtr->hasUnicode = 0;
     } else {
-	/* Changing length of pure unicode string */
+	/*
+	 * Changing length of pure unicode string.
+	 */
+
 	size_t uallocated = STRING_UALLOC(length);
 	if (length > STRING_MAXCHARS) {
 	    return 0;
@@ -965,14 +985,18 @@ Tcl_AttemptSetObjLength(objPtr, length)
 	if (uallocated > stringPtr->uallocated) {
 	    stringPtr = stringAttemptRealloc(stringPtr, length);
 	    if (stringPtr == NULL) {
-	        return 0;
+		return 0;
 	    }
 	    SET_STRING(objPtr, stringPtr);
 	    stringPtr->uallocated = uallocated;
 	}
 	stringPtr->numChars = length;
 	stringPtr->hasUnicode = (length > 0);
-	/* Ensure the string is NULL-terminated */
+
+	/*
+	 * Ensure the string is NUL-terminated.
+	 */
+
 	stringPtr->unicode[length] = 0;
 	stringPtr->allocated = 0;
 	objPtr->length = 0;
@@ -997,27 +1021,23 @@ Tcl_AttemptSetObjLength(objPtr, length)
  */
 
 void
-Tcl_SetUnicodeObj(objPtr, unicode, numChars)
-    Tcl_Obj *objPtr;		/* The object to set the string of. */
-    CONST Tcl_UniChar *unicode;	/* The unicode string used to initialize
-				 * the object. */
-    int numChars;		/* Number of characters in the unicode
+Tcl_SetUnicodeObj(
+    Tcl_Obj *objPtr,		/* The object to set the string of. */
+    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
+				 * object. */
+    int numChars)		/* Number of characters in the unicode
 				 * string. */
 {
-    Tcl_ObjType *typePtr = objPtr->typePtr;
-
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
     }
-    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	typePtr->freeIntRepProc(objPtr);
-    }
+    TclFreeIntRep(objPtr);
     SetUnicodeObj(objPtr, unicode, numChars);
 }
 
 static int
 UnicodeLength(
-    CONST Tcl_UniChar *unicode)
+    const Tcl_UniChar *unicode)
 {
     int numChars = 0;
 
@@ -1031,11 +1051,11 @@ UnicodeLength(
 }
 
 static void
-SetUnicodeObj(objPtr, unicode, numChars)
-    Tcl_Obj *objPtr;		/* The object to set the string of. */
-    CONST Tcl_UniChar *unicode;	/* The unicode string used to initialize
-				 * the object. */
-    int numChars;		/* Number of characters in the unicode
+SetUnicodeObj(
+    Tcl_Obj *objPtr,		/* The object to set the string of. */
+    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
+				 * object. */
+    int numChars)		/* Number of characters in the unicode
 				 * string. */
 {
     String *stringPtr;
@@ -1048,7 +1068,7 @@ SetUnicodeObj(objPtr, unicode, numChars)
     /*
      * Allocate enough space for the String structure + Unicode string.
      */
-	
+
     stringCheckLimits(numChars);
     uallocated = STRING_UALLOC(numChars);
     stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
@@ -1057,10 +1077,10 @@ SetUnicodeObj(objPtr, unicode, numChars)
     stringPtr->uallocated = uallocated;
     stringPtr->hasUnicode = (numChars > 0);
     stringPtr->allocated = 0;
-    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
+    memcpy(stringPtr->unicode, unicode, uallocated);
     stringPtr->unicode[numChars] = 0;
 
-    Tcl_InvalidateStringRep(objPtr);
+    TclInvalidateStringRep(objPtr);
     objPtr->typePtr = &tclStringType;
     SET_STRING(objPtr, stringPtr);
 }
@@ -1068,35 +1088,42 @@ SetUnicodeObj(objPtr, unicode, numChars)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendToObj --
+ * Tcl_AppendLimitedToObj --
  *
- *	This procedure appends a sequence of bytes to an object.
+ *	This function appends a limited number of bytes from a sequence of
+ *	bytes to an object, marking any limitation with an ellipsis.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The bytes at *bytes are appended to the string representation
- *	of objPtr.
+ *	The bytes at *bytes are appended to the string representation of
+ *	objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendToObj(objPtr, bytes, length)
-    register Tcl_Obj *objPtr;	/* Points to the object to append to. */
-    CONST char *bytes;		/* Points to the bytes to append to the
+Tcl_AppendLimitedToObj(
+    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    const char *bytes,		/* Points to the bytes to append to the
 				 * object. */
-    register int length;	/* The number of bytes to append from
-				 * "bytes". If < 0, then append all bytes
-				 * up to NULL byte. */
+    register int length,	/* The number of bytes available to be
+				 * appended from "bytes". If < 0, then all
+				 * bytes up to a NUL byte are available. */
+    register int limit,		/* The maximum number of bytes to append to
+				 * the object. */
+    const char *ellipsis)	/* Ellipsis marker string, appended to the
+				 * object to indicate not all available bytes
+				 * at "bytes" were appended. */
 {
     String *stringPtr;
+    int toCopy = 0;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_AppendToObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
     }
-    
+
     SetStringFromAny(NULL, objPtr);
 
     if (length < 0) {
@@ -1106,29 +1133,76 @@ Tcl_AppendToObj(objPtr, bytes, length)
 	return;
     }
 
+    if (length <= limit) {
+	toCopy = length;
+    } else {
+	if (ellipsis == NULL) {
+	    ellipsis = "...";
+	}
+	toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
+    }
+
     /*
-     * If objPtr has a valid Unicode rep, then append the Unicode
-     * conversion of "bytes" to the objPtr's Unicode rep, otherwise
-     * append "bytes" to objPtr's string rep.
+     * If objPtr has a valid Unicode rep, then append the Unicode conversion
+     * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
+     * objPtr's string rep.
      */
 
     stringPtr = GET_STRING(objPtr);
     if (stringPtr->hasUnicode != 0) {
-	AppendUtfToUnicodeRep(objPtr, bytes, length);
+	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
+    } else {
+	AppendUtfToUtfRep(objPtr, bytes, toCopy);
+    }
 
-	stringPtr = GET_STRING(objPtr);
+    if (length <= limit) {
+	return;
+    }
+
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode != 0) {
+	AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
     } else {
-	AppendUtfToUtfRep(objPtr, bytes, length);
+	AppendUtfToUtfRep(objPtr, ellipsis, -1);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_AppendToObj --
+ *
+ *	This function appends a sequence of bytes to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytes at *bytes are appended to the string representation of
+ *	objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendToObj(
+    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    const char *bytes,		/* Points to the bytes to append to the
+				 * object. */
+    register int length)	/* The number of bytes to append from "bytes".
+				 * If < 0, then append all bytes up to NUL
+				 * byte. */
+{
+    Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_AppendUnicodeToObj --
  *
- *	This procedure appends a Unicode string to an object in the
- *	most efficient manner possible.  Length must be >= 0.
+ *	This function appends a Unicode string to an object in the most
+ *	efficient manner possible. Length must be >= 0.
  *
  * Results:
  *	None.
@@ -1140,16 +1214,16 @@ Tcl_AppendToObj(objPtr, bytes, length)
  */
 
 void
-Tcl_AppendUnicodeToObj(objPtr, unicode, length)
-    register Tcl_Obj *objPtr;	/* Points to the object to append to. */
-    CONST Tcl_UniChar *unicode;	/* The unicode string to append to the
-			         * object. */
-    int length;			/* Number of chars in "unicode". */
+Tcl_AppendUnicodeToObj(
+    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    const Tcl_UniChar *unicode,	/* The unicode string to append to the
+				 * object. */
+    int length)			/* Number of chars in "unicode". */
 {
     String *stringPtr;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_AppendUnicodeToObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
     }
 
     if (length == 0) {
@@ -1160,9 +1234,9 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
     stringPtr = GET_STRING(objPtr);
 
     /*
-     * If objPtr has a valid Unicode rep, then append the "unicode"
-     * to the objPtr's Unicode rep, otherwise the UTF conversion of
-     * "unicode" to objPtr's string rep.
+     * If objPtr has a valid Unicode rep, then append the "unicode" to the
+     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
+     * objPtr's string rep.
      */
 
     if (stringPtr->hasUnicode != 0) {
@@ -1177,23 +1251,23 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
  *
  * Tcl_AppendObjToObj --
  *
- *	This procedure appends the string rep of one object to another.
+ *	This function appends the string rep of one object to another.
  *	"objPtr" cannot be a shared object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The string rep of appendObjPtr is appended to the string 
+ *	The string rep of appendObjPtr is appended to the string
  *	representation of objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendObjToObj(objPtr, appendObjPtr)
-    Tcl_Obj *objPtr;		/* Points to the object to append to. */
-    Tcl_Obj *appendObjPtr;	/* Object to append. */
+Tcl_AppendObjToObj(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    Tcl_Obj *appendObjPtr)	/* Object to append. */
 {
     String *stringPtr;
     int length, numChars, allOneByteChars;
@@ -1202,25 +1276,22 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
     SetStringFromAny(NULL, objPtr);
 
     /*
-     * If objPtr has a valid Unicode rep, then get a Unicode string
-     * from appendObjPtr and append it.
+     * If objPtr has a valid Unicode rep, then get a Unicode string from
+     * appendObjPtr and append it.
      */
 
     stringPtr = GET_STRING(objPtr);
     if (stringPtr->hasUnicode != 0) {
-	
 	/*
 	 * If appendObjPtr is not of the "String" type, don't convert it.
 	 */
 
 	if (appendObjPtr->typePtr == &tclStringType) {
 	    stringPtr = GET_STRING(appendObjPtr);
-	    if ((stringPtr->numChars == -1)
-		    || (stringPtr->hasUnicode == 0)) {
-		
+	    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
 		/*
-		 * If appendObjPtr is a string obj with no valid Unicode
-		 * rep, then fill its unicode rep.
+		 * If appendObjPtr is a string obj with no valid Unicode rep,
+		 * then fill its unicode rep.
 		 */
 
 		FillUnicodeRep(appendObjPtr);
@@ -1229,19 +1300,19 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
 	    AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
 		    stringPtr->numChars);
 	} else {
-	    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+	    bytes = TclGetStringFromObj(appendObjPtr, &length);
 	    AppendUtfToUnicodeRep(objPtr, bytes, length);
 	}
 	return;
     }
 
     /*
-     * Append to objPtr's UTF string rep.  If we know the number of
-     * characters in both objects before appending, then set the combined
-     * number of characters in the final (appended-to) object.
+     * Append to objPtr's UTF string rep. If we know the number of characters
+     * in both objects before appending, then set the combined number of
+     * characters in the final (appended-to) object.
      */
 
-    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+    bytes = TclGetStringFromObj(appendObjPtr, &length);
 
     allOneByteChars = 0;
     numChars = stringPtr->numChars;
@@ -1266,8 +1337,8 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
  *
  * AppendUnicodeToUnicodeRep --
  *
- *	This procedure appends the contents of "unicode" to the Unicode
- *	rep of "objPtr".  objPtr must already have a valid Unicode rep.
+ *	This function appends the contents of "unicode" to the Unicode rep of
+ *	"objPtr". objPtr must already have a valid Unicode rep.
  *
  * Results:
  *	None.
@@ -1279,13 +1350,13 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
  */
 
 static void
-AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
-    Tcl_Obj *objPtr;	        /* Points to the object to append to. */
-    CONST Tcl_UniChar *unicode; /* String to append. */
-    int appendNumChars;	        /* Number of chars of "unicode" to append. */
+AppendUnicodeToUnicodeRep(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    const Tcl_UniChar *unicode,	/* String to append. */
+    int appendNumChars)		/* Number of chars of "unicode" to append. */
 {
     String *stringPtr;
-    size_t numChars;
+    int numChars;
 
     if (appendNumChars < 0) {
 	appendNumChars = UnicodeLength(unicode);
@@ -1298,11 +1369,11 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
     stringPtr = GET_STRING(objPtr);
 
     /*
-     * If not enough space has been allocated for the unicode rep,
-     * reallocate the internal rep object with additional space.  First
-     * try to double the required allocation; if that fails, try a more
-     * modest increase.  See the "TCL STRING GROWTH ALGORITHM" comment at
-     * the top of this file for an explanation of this growth algorithm.
+     * If not enough space has been allocated for the unicode rep, reallocate
+     * the internal rep object with additional space. First try to double the
+     * required allocation; if that fails, try a more modest increase. See the
+     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
+     * explanation of this growth algorithm.
      */
 
     numChars = stringPtr->numChars + appendNumChars;
@@ -1315,11 +1386,11 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
 	 * due to the reallocs below.
 	 */
 	int offset = -1;
-	if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode
+	if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode 
 		+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
 	    offset = unicode - stringPtr->unicode;
 	}
-
+	
 	GrowUnicodeBuffer(objPtr, numChars);
 	stringPtr = GET_STRING(objPtr);
 
@@ -1334,13 +1405,13 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
      * trailing null.
      */
 
-    memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
+    memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
 	    appendNumChars * sizeof(Tcl_UniChar));
     stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
     stringPtr->allocated = 0;
 
-    Tcl_InvalidateStringRep(objPtr);
+    TclInvalidateStringRep(objPtr);
 }
 
 /*
@@ -1348,8 +1419,8 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
  *
  * AppendUnicodeToUtfRep --
  *
- *	This procedure converts the contents of "unicode" to UTF and
- *	appends the UTF to the string rep of "objPtr".
+ *	This function converts the contents of "unicode" to UTF and appends
+ *	the UTF to the string rep of "objPtr".
  *
  * Results:
  *	None.
@@ -1361,14 +1432,14 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
  */
 
 static void
-AppendUnicodeToUtfRep(objPtr, unicode, numChars)
-    Tcl_Obj *objPtr;	        /* Points to the object to append to. */
-    CONST Tcl_UniChar *unicode; /* String to convert to UTF. */
-    int numChars;	        /* Number of chars of "unicode" to convert. */
+AppendUnicodeToUtfRep(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
+    int numChars)		/* Number of chars of "unicode" to convert. */
 {
     Tcl_DString dsPtr;
-    CONST char *bytes;
-    
+    const char *bytes;
+
     if (numChars < 0) {
 	numChars = UnicodeLength(unicode);
     }
@@ -1387,9 +1458,9 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
  *
  * AppendUtfToUnicodeRep --
  *
- *	This procedure converts the contents of "bytes" to Unicode and
- *	appends the Unicode to the Unicode rep of "objPtr".  objPtr must
- *	already have a valid Unicode rep.
+ *	This function converts the contents of "bytes" to Unicode and appends
+ *	the Unicode to the Unicode rep of "objPtr". objPtr must already have a
+ *	valid Unicode rep.
  *
  * Results:
  *	None.
@@ -1401,10 +1472,10 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
  */
 
 static void
-AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
-    Tcl_Obj *objPtr;	/* Points to the object to append to. */
-    CONST char *bytes;	/* String to convert to Unicode. */
-    int numBytes;	/* Number of bytes of "bytes" to convert. */
+AppendUtfToUnicodeRep(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    const char *bytes,		/* String to convert to Unicode. */
+    int numBytes)		/* Number of bytes of "bytes" to convert. */
 {
     Tcl_DString dsPtr;
     int numChars;
@@ -1416,7 +1487,7 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
     if (numBytes == 0) {
 	return;
     }
-    
+
     Tcl_DStringInit(&dsPtr);
     numChars = Tcl_NumUtfChars(bytes, numBytes);
     unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
@@ -1429,8 +1500,8 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
  *
  * AppendUtfToUtfRep --
  *
- *	This procedure appends "numBytes" bytes of "bytes" to the UTF string
- *	rep of "objPtr".  objPtr must already have a valid String rep.
+ *	This function appends "numBytes" bytes of "bytes" to the UTF string
+ *	rep of "objPtr". objPtr must already have a valid String rep.
  *
  * Results:
  *	None.
@@ -1442,10 +1513,10 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
  */
 
 static void
-AppendUtfToUtfRep(objPtr, bytes, numBytes)
-    Tcl_Obj *objPtr;	/* Points to the object to append to. */
-    CONST char *bytes;	/* String to append. */
-    int numBytes;	/* Number of bytes of "bytes" to append. */
+AppendUtfToUtfRep(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    const char *bytes,		/* String to append. */
+    int numBytes)		/* Number of bytes of "bytes" to append. */
 {
     String *stringPtr;
     int newLength, oldLength;
@@ -1470,7 +1541,7 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
 
     stringPtr = GET_STRING(objPtr);
     if (newLength > (int) stringPtr->allocated) {
-        /*
+	/*
 	 * Protect against case where unicode points into the existing
 	 * stringPtr->unicode array.  Force it to follow any relocations
 	 * due to the reallocs below.
@@ -1482,10 +1553,10 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
 	}
 
 	/*
-	 * There isn't currently enough space in the string representation
-	 * so allocate additional space.  First, try to double the length
-	 * required.  If that fails, try a more modest allocation.  See the
-	 * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
+	 * There isn't currently enough space in the string representation so
+	 * allocate additional space. First, try to double the length
+	 * required. If that fails, try a more modest allocation. See the "TCL
+	 * STRING GROWTH ALGORITHM" comment at the top of this file for an
 	 * explanation of this growth algorithm.
 	 */
 
@@ -1497,7 +1568,7 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
 	    unsigned int limit = INT_MAX - newLength;
 	    unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC;
 	    int growth = (int) ((extra > limit) ? limit : extra);
-
+	
 	    Tcl_SetObjLength(objPtr, newLength + growth);
 	}
 
@@ -1510,12 +1581,11 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
     /*
      * Invalidate the unicode data.
      */
-    
+
     stringPtr->numChars = -1;
     stringPtr->hasUnicode = 0;
-    
-    memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
-	    (size_t) numBytes);
+
+    memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
     objPtr->bytes[newLength] = 0;
     objPtr->length = newLength;
 }
@@ -1525,23 +1595,23 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
  *
  * Tcl_AppendStringsToObjVA --
  *
- *	This procedure appends one or more null-terminated strings
- *	to an object.
+ *	This function appends one or more null-terminated strings to an
+ *	object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The contents of all the string arguments are appended to the
- *	string representation of objPtr.
+ *	The contents of all the string arguments are appended to the string
+ *	representation of objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendStringsToObjVA (objPtr, argList)
-    Tcl_Obj *objPtr;		/* Points to the object to append to. */
-    va_list argList;		/* Variable argument list. */
+Tcl_AppendStringsToObjVA(
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
+    va_list argList)		/* Variable argument list. */
 {
 #define STATIC_LIST_SIZE 16
     String *stringPtr;
@@ -1553,7 +1623,7 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     int nargs, i;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_AppendStringsToObj called with shared object");
+	Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
     }
 
     SetStringFromAny(NULL, objPtr);
@@ -1566,10 +1636,10 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     (void) Tcl_GetStringFromObj(objPtr, &oldLength);
 
     /*
-     * Figure out how much space is needed for all the strings, and
-     * expand the string representation if it isn't big enough. If no
-     * bytes would be appended, just return.  Note that on some platforms
-     * (notably OS/390) the argList is an array so we need to use memcpy.
+     * Figure out how much space is needed for all the strings, and expand the
+     * string representation if it isn't big enough. If no bytes would be
+     * appended, just return. Note that on some platforms (notably OS/390) the
+     * argList is an array so we need to use memcpy.
      */
 
     nargs = 0;
@@ -1579,21 +1649,22 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
 	if (string == NULL) {
 	    break;
 	}
- 	if (nargs >= nargs_space) {
- 	    /* 
- 	     * Expand the args buffer
- 	     */
- 	    nargs_space += STATIC_LIST_SIZE;
- 	    if (args == static_list) {
- 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
- 		for (i = 0; i < nargs; ++i) {
- 		    args[i] = static_list[i];
- 		}
- 	    } else {
- 		args = (void *)ckrealloc((void *)args,
+	if (nargs >= nargs_space) {
+	    /*
+	     * Expand the args buffer.
+	     */
+
+	    nargs_space += STATIC_LIST_SIZE;
+	    if (args == static_list) {
+		args = (void *) ckalloc(nargs_space * sizeof(char *));
+		for (i = 0; i < nargs; ++i) {
+		    args[i] = static_list[i];
+		}
+	    } else {
+		args = (void *) ckrealloc((void *) args,
 			nargs_space * sizeof(char *));
- 	    }
- 	}
+	    }
+	}
 	newLength += strlen(string);
 	args[nargs++] = string;
     }
@@ -1603,17 +1674,16 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
 
     stringPtr = GET_STRING(objPtr);
     if (oldLength + newLength > (int) stringPtr->allocated) {
-
 	/*
-	 * There isn't currently enough space in the string
-	 * representation, so allocate additional space.  If the current
-	 * string representation isn't empty (i.e. it looks like we're
-	 * doing a series of appends) then try to allocate extra space to
-	 * accomodate future growth: first try to double the required memory;
-	 * if that fails, try a more modest allocation.  See the "TCL STRING
-	 * GROWTH ALGORITHM" comment at the top of this file for an explanation
-	 * of this growth algorithm.  Otherwise, if the current string
-	 * representation is empty, exactly enough memory is allocated.
+	 * There isn't currently enough space in the string representation, so
+	 * allocate additional space. If the current string representation
+	 * isn't empty (i.e. it looks like we're doing a series of appends)
+	 * then try to allocate extra space to accomodate future growth: first
+	 * try to double the required memory; if that fails, try a more modest
+	 * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the
+	 * top of this file for an explanation of this growth algorithm.
+	 * Otherwise, if the current string representation is empty, exactly
+	 * enough memory is allocated.
 	 */
 
 	if (oldLength == 0) {
@@ -1622,20 +1692,20 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
 	    attemptLength = 2 * (oldLength + newLength);
 	    if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
 		attemptLength = oldLength + (2 * newLength) +
-		    TCL_GROWTH_MIN_ALLOC;
+			TCL_GROWTH_MIN_ALLOC;
 		Tcl_SetObjLength(objPtr, attemptLength);
 	    }
 	}
     }
 
     /*
-     * Make a second pass through the arguments, appending all the
-     * strings to the object.
+     * Make a second pass through the arguments, appending all the strings to
+     * the object.
      */
 
     dst = objPtr->bytes + oldLength;
     for (i = 0; i < nargs; ++i) {
- 	string = args[i];
+	string = args[i];
 	if (string == NULL) {
 	    break;
 	}
@@ -1647,10 +1717,10 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     }
 
     /*
-     * Add a null byte to terminate the string.  However, be careful:
-     * it's possible that the object is totally empty (if it was empty
-     * originally and there was nothing to append).  In this case dst is
-     * NULL; just leave everything alone.
+     * Add a null byte to terminate the string. However, be careful: it's
+     * possible that the object is totally empty (if it was empty originally
+     * and there was nothing to append). In this case dst is NULL; just leave
+     * everything alone.
      */
 
     if (dst != NULL) {
@@ -1658,14 +1728,13 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     }
     objPtr->length = oldLength + newLength;
 
-    done:
+  done:
     /*
-     * If we had to allocate a buffer from the heap, 
-     * free it now.
+     * If we had to allocate a buffer from the heap, free it now.
      */
- 
+
     if (args != static_list) {
-     	ckfree((void *)args);
+	ckfree((void *) args);
     }
 #undef STATIC_LIST_SIZE
 }
@@ -1675,37 +1744,1051 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
  *
  * Tcl_AppendStringsToObj --
  *
- *	This procedure appends one or more null-terminated strings
- *	to an object.
+ *	This function appends one or more null-terminated strings to an
+ *	object.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The contents of all the string arguments are appended to the
- *	string representation of objPtr.
+ *	The contents of all the string arguments are appended to the string
+ *	representation of objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
+Tcl_AppendStringsToObj(
+    Tcl_Obj *objPtr,
+    ...)
 {
-    register Tcl_Obj *objPtr;
     va_list argList;
 
-    objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    va_start(argList, objPtr);
     Tcl_AppendStringsToObjVA(objPtr, argList);
     va_end(argList);
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendFormatToObj --
+ *
+ *	This function appends a list of Tcl_Obj's to a Tcl_Obj according to
+ *	the formatting instructions embedded in the format string. The
+ *	formatting instructions are inspired by sprintf(). Returns TCL_OK when
+ *	successful. If there's an error in the arguments, TCL_ERROR is
+ *	returned, and an error message is written to the interp, if non-NULL.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppendFormatToObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *appendObj,
+    const char *format,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *span = format, *msg;
+    int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
+    int originalLength, limit;
+    static const char *mixedXPG =
+	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
+    static const char *badIndex[2] = {
+	"not enough arguments for all format specifiers",
+	"\"%n$\" argument index out of range"
+    };
+    static const char *overflow = "max size for a Tcl value exceeded";
+
+    if (Tcl_IsShared(appendObj)) {
+	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
+    }
+    TclGetStringFromObj(appendObj, &originalLength);
+    limit = INT_MAX - originalLength;
+
+    /*
+     * Format string is NUL-terminated.
+     */
+
+    while (*format != '\0') {
+	char *end;
+	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
+	int width, gotPrecision, precision, useShort, useWide, useBig;
+	int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
+	Tcl_Obj *segment;
+	Tcl_UniChar ch;
+	int step = Tcl_UtfToUniChar(format, &ch);
+
+	format += step;
+	if (ch != '%') {
+	    numBytes += step;
+	    continue;
+	}
+	if (numBytes) {
+	    if (numBytes > limit) {
+		msg = overflow;
+		goto errorMsg;
+	    }
+	    Tcl_AppendToObj(appendObj, span, numBytes);
+	    limit -= numBytes;
+	    numBytes = 0;
+	}
+
+	/*
+	 * Saw a % : process the format specifier.
+	 *
+	 * Step 0. Handle special case of escaped format marker (i.e., %%).
+	 */
+
+	step = Tcl_UtfToUniChar(format, &ch);
+	if (ch == '%') {
+	    span = format;
+	    numBytes = step;
+	    format += step;
+	    continue;
+	}
+
+	/*
+	 * Step 1. XPG3 position specifier
+	 */
+
+	newXpg = 0;
+	if (isdigit(UCHAR(ch))) {
+	    int position = strtoul(format, &end, 10);
+	    if (*end == '$') {
+		newXpg = 1;
+		objIndex = position - 1;
+		format = end + 1;
+		step = Tcl_UtfToUniChar(format, &ch);
+	    }
+	}
+	if (newXpg) {
+	    if (gotSequential) {
+		msg = mixedXPG;
+		goto errorMsg;
+	    }
+	    gotXpg = 1;
+	} else {
+	    if (gotXpg) {
+		msg = mixedXPG;
+		goto errorMsg;
+	    }
+	    gotSequential = 1;
+	}
+	if ((objIndex < 0) || (objIndex >= objc)) {
+	    msg = badIndex[gotXpg];
+	    goto errorMsg;
+	}
+
+	/*
+	 * Step 2. Set of flags.
+	 */
+
+	gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
+	sawFlag = 1;
+	do {
+	    switch (ch) {
+	    case '-':
+		gotMinus = 1;
+		break;
+	    case '#':
+		gotHash = 1;
+		break;
+	    case '0':
+		gotZero = 1;
+		break;
+	    case ' ':
+		gotSpace = 1;
+		break;
+	    case '+':
+		gotPlus = 1;
+		break;
+	    default:
+		sawFlag = 0;
+	    }
+	    if (sawFlag) {
+		format += step;
+		step = Tcl_UtfToUniChar(format, &ch);
+	    }
+	} while (sawFlag);
+
+	/*
+	 * Step 3. Minimum field width.
+	 */
+
+	width = 0;
+	if (isdigit(UCHAR(ch))) {
+	    width = strtoul(format, &end, 10);
+	    format = end;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	} else if (ch == '*') {
+	    if (objIndex >= objc - 1) {
+		msg = badIndex[gotXpg];
+		goto errorMsg;
+	    }
+	    if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
+		goto error;
+	    }
+	    if (width < 0) {
+		width = -width;
+		gotMinus = 1;
+	    }
+	    objIndex++;
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	}
+	if (width > limit) {
+	    msg = overflow;
+	    goto errorMsg;
+	}
+
+	/*
+	 * Step 4. Precision.
+	 */
+
+	gotPrecision = precision = 0;
+	if (ch == '.') {
+	    gotPrecision = 1;
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	}
+	if (isdigit(UCHAR(ch))) {
+	    precision = strtoul(format, &end, 10);
+	    format = end;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	} else if (ch == '*') {
+	    if (objIndex >= objc - 1) {
+		msg = badIndex[gotXpg];
+		goto errorMsg;
+	    }
+	    if (TclGetIntFromObj(interp, objv[objIndex], &precision)
+		    != TCL_OK) {
+		goto error;
+	    }
+
+	    /*
+	     * TODO: Check this truncation logic.
+	     */
+
+	    if (precision < 0) {
+		precision = 0;
+	    }
+	    objIndex++;
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	}
+
+	/*
+	 * Step 5. Length modifier.
+	 */
+
+	useShort = useWide = useBig = 0;
+	if (ch == 'h') {
+	    useShort = 1;
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	} else if (ch == 'l') {
+	    format += step;
+	    step = Tcl_UtfToUniChar(format, &ch);
+	    if (ch == 'l') {
+		useBig = 1;
+		format += step;
+		step = Tcl_UtfToUniChar(format, &ch);
+	    } else {
+#ifndef TCL_WIDE_INT_IS_LONG
+		useWide = 1;
+#endif
+	    }
+	}
+
+	format += step;
+	span = format;
+
+	/*
+	 * Step 6. The actual conversion character.
+	 */
+
+	segment = objv[objIndex];
+	numChars = -1;
+	if (ch == 'i') {
+	    ch = 'd';
+	}
+	switch (ch) {
+	case '\0':
+	    msg = "format string ended in middle of field specifier";
+	    goto errorMsg;
+	case 's':
+	    if (gotPrecision) {
+		numChars = Tcl_GetCharLength(segment);
+		if (precision < numChars) {
+		    segment = Tcl_GetRange(segment, 0, precision - 1);
+		    numChars = precision;
+		    Tcl_IncrRefCount(segment);
+		    allocSegment = 1;
+		}
+	    }
+	    break;
+	case 'c': {
+	    char buf[TCL_UTF_MAX];
+	    int code, length;
+
+	    if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
+		goto error;
+	    }
+	    length = Tcl_UniCharToUtf(code, buf);
+	    segment = Tcl_NewStringObj(buf, length);
+	    Tcl_IncrRefCount(segment);
+	    allocSegment = 1;
+	    break;
+	}
+
+	case 'u':
+	    if (useBig) {
+		msg = "unsigned bignum format is invalid";
+		goto errorMsg;
+	    }
+	case 'd':
+	case 'o':
+	case 'x':
+	case 'X': {
+	    short int s = 0;	/* Silence compiler warning; only defined and
+				 * used when useShort is true. */
+	    long l;
+	    Tcl_WideInt w;
+	    mp_int big;
+	    int toAppend, isNegative = 0;
+
+	    if (useBig) {
+		if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
+		    goto error;
+		}
+		isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+	    } else if (useWide) {
+		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+		    Tcl_Obj *objPtr;
+
+		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
+			goto error;
+		    }
+		    mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
+		    objPtr = Tcl_NewBignumObj(&big);
+		    Tcl_IncrRefCount(objPtr);
+		    Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+		    Tcl_DecrRefCount(objPtr);
+		}
+		isNegative = (w < (Tcl_WideInt)0);
+	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
+		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+		    Tcl_Obj *objPtr;
+
+		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
+			goto error;
+		    }
+		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+		    objPtr = Tcl_NewBignumObj(&big);
+		    Tcl_IncrRefCount(objPtr);
+		    TclGetLongFromObj(NULL, objPtr, &l);
+		    Tcl_DecrRefCount(objPtr);
+		} else {
+		    l = Tcl_WideAsLong(w);
+		}
+		if (useShort) {
+		    s = (short int) l;
+		    isNegative = (s < (short int)0);
+		} else {
+		    isNegative = (l < (long)0);
+		}
+	    } else if (useShort) {
+		s = (short int) l;
+		isNegative = (s < (short int)0);
+	    } else {
+		isNegative = (l < (long)0);
+	    }
+
+	    segment = Tcl_NewObj();
+	    allocSegment = 1;
+	    segmentLimit = INT_MAX;
+	    Tcl_IncrRefCount(segment);
+
+	    if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) {
+		Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1);
+		segmentLimit -= 1;
+	    }
+
+	    if (gotHash) {
+		switch (ch) {
+		case 'o':
+		    Tcl_AppendToObj(segment, "0", 1);
+		    segmentLimit -= 1;
+		    precision--;
+		    break;
+		case 'x':
+		case 'X':
+		    Tcl_AppendToObj(segment, "0x", 2);
+		    segmentLimit -= 2;
+		    break;
+		}
+	    }
+
+	    switch (ch) {
+	    case 'd': {
+		int length;
+		Tcl_Obj *pure;
+		const char *bytes;
+
+		if (useShort) {
+		    pure = Tcl_NewIntObj((int)(s));
+		} else if (useWide) {
+		    pure = Tcl_NewWideIntObj(w);
+		} else if (useBig) {
+		    pure = Tcl_NewBignumObj(&big);
+		} else {
+		    pure = Tcl_NewLongObj(l);
+		}
+		Tcl_IncrRefCount(pure);
+		bytes = TclGetStringFromObj(pure, &length);
+
+		/*
+		 * Already did the sign above.
+		 */
+
+		if (*bytes == '-') {
+		    length--;
+		    bytes++;
+		}
+		toAppend = length;
+
+		/*
+		 * Canonical decimal string reps for integers are composed
+		 * entirely of one-byte encoded characters, so "length" is the
+		 * number of chars.
+		 */
+
+		if (gotPrecision) {
+		    if (length < precision) {
+			segmentLimit -= (precision - length);
+		    }
+		    while (length < precision) {
+			Tcl_AppendToObj(segment, "0", 1);
+			length++;
+		    }
+		    gotZero = 0;
+		}
+		if (gotZero) {
+		    length += Tcl_GetCharLength(segment);
+		    if (length < width) {
+			segmentLimit -= (width - length);
+		    }
+		    while (length < width) {
+			Tcl_AppendToObj(segment, "0", 1);
+			length++;
+		    }
+		}
+		if (toAppend > segmentLimit) {
+		    msg = overflow;
+		    goto errorMsg;
+		}
+		Tcl_AppendToObj(segment, bytes, toAppend);
+		Tcl_DecrRefCount(pure);
+		break;
+	    }
+
+	    case 'u':
+	    case 'o':
+	    case 'x':
+	    case 'X': {
+		Tcl_WideUInt bits = (Tcl_WideUInt)0;
+		Tcl_WideInt numDigits = (Tcl_WideInt)0;
+		int length, numBits = 4, base = 16;
+		int index = 0, shift = 0;
+		Tcl_Obj *pure;
+		char *bytes;
+
+		if (ch == 'u') {
+		    base = 10;
+		}
+		if (ch == 'o') {
+		    base = 8;
+		    numBits = 3;
+		}
+		if (useShort) {
+		    unsigned short int us = (unsigned short int) s;
+
+		    bits = (Tcl_WideUInt) us;
+		    while (us) {
+			numDigits++;
+			us /= base;
+		    }
+		} else if (useWide) {
+		    Tcl_WideUInt uw = (Tcl_WideUInt) w;
+
+		    bits = uw;
+		    while (uw) {
+			numDigits++;
+			uw /= base;
+		    }
+		} else if (useBig && big.used) {
+		    int leftover = (big.used * DIGIT_BIT) % numBits;
+		    mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
+
+		    numDigits = 1 +
+			    (((Tcl_WideInt)big.used * DIGIT_BIT) / numBits);
+		    while ((mask & big.dp[big.used-1]) == 0) {
+			numDigits--;
+			mask >>= numBits;
+		    }
+		    if (numDigits > INT_MAX) {
+			msg = overflow;
+			goto errorMsg;
+		    }
+		} else if (!useBig) {
+		    unsigned long int ul = (unsigned long int) l;
+
+		    bits = (Tcl_WideUInt) ul;
+		    while (ul) {
+			numDigits++;
+			ul /= base;
+		    }
+		}
+
+		/*
+		 * Need to be sure zero becomes "0", not "".
+		 */
+
+		if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
+		    numDigits = 1;
+		}
+		pure = Tcl_NewObj();
+		Tcl_SetObjLength(pure, (int)numDigits);
+		bytes = TclGetString(pure);
+		toAppend = length = (int)numDigits;
+		while (numDigits--) {
+		    int digitOffset;
+
+		    if (useBig && big.used) {
+			if (index < big.used && (size_t) shift <
+				CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
+			    bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift);
+			    shift += DIGIT_BIT;
+			}
+			shift -= numBits;
+		    }
+		    digitOffset = (int) (bits % base);
+		    if (digitOffset > 9) {
+			bytes[numDigits] = 'a' + digitOffset - 10;
+		    } else {
+			bytes[numDigits] = '0' + digitOffset;
+		    }
+		    bits /= base;
+		}
+		if (useBig) {
+		    mp_clear(&big);
+		}
+		if (gotPrecision) {
+		    if (length < precision) {
+			segmentLimit -= (precision - length);
+		    }
+		    while (length < precision) {
+			Tcl_AppendToObj(segment, "0", 1);
+			length++;
+		    }
+		    gotZero = 0;
+		}
+		if (gotZero) {
+		    length += Tcl_GetCharLength(segment);
+		    if (length < width) {
+			segmentLimit -= (width - length);
+		    }
+		    while (length < width) {
+			Tcl_AppendToObj(segment, "0", 1);
+			length++;
+		    }
+		}
+		if (toAppend > segmentLimit) {
+		    msg = overflow;
+		    goto errorMsg;
+		}
+		Tcl_AppendObjToObj(segment, pure);
+		Tcl_DecrRefCount(pure);
+		break;
+	    }
+
+	    }
+	    break;
+	}
+
+	case 'e':
+	case 'E':
+	case 'f':
+	case 'g':
+	case 'G': {
+#define MAX_FLOAT_SIZE 320
+	    char spec[2*TCL_INTEGER_SPACE + 9], *p = spec;
+	    double d;
+	    int length = MAX_FLOAT_SIZE;
+	    char *bytes;
+
+	    if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) {
+		/* TODO: Figure out ACCEPT_NAN here */
+		goto error;
+	    }
+	    *p++ = '%';
+	    if (gotMinus) {
+		*p++ = '-';
+	    }
+	    if (gotHash) {
+		*p++ = '#';
+	    }
+	    if (gotZero) {
+		*p++ = '0';
+	    }
+	    if (gotSpace) {
+		*p++ = ' ';
+	    }
+	    if (gotPlus) {
+		*p++ = '+';
+	    }
+	    if (width) {
+		p += sprintf(p, "%d", width);
+		if (width > length) {
+		    length = width;
+		}
+	    }
+	    if (gotPrecision) {
+		*p++ = '.';
+		p += sprintf(p, "%d", precision);
+		if (precision > INT_MAX - length) {
+		    msg=overflow;
+		    goto errorMsg;
+		}
+		length += precision;
+	    }
+
+	    /*
+	     * Don't pass length modifiers!
+	     */
+
+	    *p++ = (char) ch;
+	    *p = '\0';
+
+	    segment = Tcl_NewObj();
+	    allocSegment = 1;
+	    if (!Tcl_AttemptSetObjLength(segment, length)) {
+		msg = overflow;
+		goto errorMsg;
+	    }
+	    bytes = TclGetString(segment);
+	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
+		msg = overflow;
+		goto errorMsg;
+	    }
+	    break;
+	}
+	default:
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp,
+			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
+	    }
+	    goto error;
+	}
+
+	switch (ch) {
+	case 'E':
+	case 'G':
+	case 'X': {
+	    Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
+	}
+	}
+
+	if (width > 0) {
+	    if (numChars < 0) {
+		numChars = Tcl_GetCharLength(segment);
+	    }
+	    if (!gotMinus) {
+		if (numChars < width) {
+		    limit -= (width - numChars);
+		}
+		while (numChars < width) {
+		    Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
+		    numChars++;
+		}
+	    }
+	}
+
+	Tcl_GetStringFromObj(segment, &segmentNumBytes);
+	if (segmentNumBytes > limit) {
+	    if (allocSegment) {
+		Tcl_DecrRefCount(segment);
+	    }
+	    msg = overflow;
+	    goto errorMsg;
+	}
+	Tcl_AppendObjToObj(appendObj, segment);
+	limit -= segmentNumBytes;
+	if (allocSegment) {
+	    Tcl_DecrRefCount(segment);
+	}
+	if (width > 0) {
+	    if (numChars < width) {
+		limit -= (width - numChars);
+	    }
+	    while (numChars < width) {
+		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
+		numChars++;
+	    }
+	}
+
+	objIndex += gotSequential;
+    }
+    if (numBytes) {
+	if (numBytes > limit) {
+	    msg = overflow;
+	    goto errorMsg;
+	}
+	Tcl_AppendToObj(appendObj, span, numBytes);
+	limit -= numBytes;
+	numBytes = 0;
+    }
+
+    return TCL_OK;
+
+  errorMsg:
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+    }
+  error:
+    Tcl_SetObjLength(appendObj, originalLength);
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_Format--
+ *
+ * Results:
+ *	A refcount zero Tcl_Obj.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_Format(
+    Tcl_Interp *interp,
+    const char *format,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result;
+    Tcl_Obj *objPtr = Tcl_NewObj();
+    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
+    if (result != TCL_OK) {
+	Tcl_DecrRefCount(objPtr);
+	return NULL;
+    }
+    return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * AppendPrintfToObjVA --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+AppendPrintfToObjVA(
+    Tcl_Obj *objPtr,
+    const char *format,
+    va_list argList)
+{
+    int code, objc;
+    Tcl_Obj **objv, *list = Tcl_NewObj();
+    const char *p;
+    char *end;
+
+    p = format;
+    Tcl_IncrRefCount(list);
+    while (*p != '\0') {
+	int size = 0, seekingConversion = 1, gotPrecision = 0;
+	int lastNum = -1;
+
+	if (*p++ != '%') {
+	    continue;
+	}
+	if (*p == '%') {
+	    p++;
+	    continue;
+	}
+	do {
+	    switch (*p) {
+
+	    case '\0':
+		seekingConversion = 0;
+		break;
+	    case 's': {
+		const char *q, *end, *bytes = va_arg(argList, char *);
+		seekingConversion = 0;
+
+		/*
+		 * The buffer to copy characters from starts at bytes and ends
+		 * at either the first NUL byte, or after lastNum bytes, when
+		 * caller has indicated a limit.
+		 */
+
+		end = bytes;
+		while ((!gotPrecision || lastNum--) && (*end != '\0')) {
+		    end++;
+		}
+
+		/*
+		 * Within that buffer, we trim both ends if needed so that we
+		 * copy only whole characters, and avoid copying any partial
+		 * multi-byte characters.
+		 */
+
+		q = Tcl_UtfPrev(end, bytes);
+		if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
+		    end = q;
+		}
+
+		q = bytes + TCL_UTF_MAX;
+		while ((bytes < end) && (bytes < q)
+			&& ((*bytes & 0xC0) == 0x80)) {
+		    bytes++;
+		}
+
+		Tcl_ListObjAppendElement(NULL, list,
+			Tcl_NewStringObj(bytes , (int)(end - bytes)));
+
+		break;
+	    }
+	    case 'c':
+	    case 'i':
+	    case 'u':
+	    case 'd':
+	    case 'o':
+	    case 'x':
+	    case 'X':
+		seekingConversion = 0;
+		switch (size) {
+		case -1:
+		case 0:
+		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
+			    (long int)va_arg(argList, int)));
+		    break;
+		case 1:
+		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
+			    va_arg(argList, long int)));
+		    break;
+		}
+		break;
+	    case 'e':
+	    case 'E':
+	    case 'f':
+	    case 'g':
+	    case 'G':
+		Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
+			va_arg(argList, double)));
+		seekingConversion = 0;
+		break;
+	    case '*':
+		lastNum = (int)va_arg(argList, int);
+		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
+		p++;
+		break;
+	    case '0': case '1': case '2': case '3': case '4':
+	    case '5': case '6': case '7': case '8': case '9':
+		lastNum = (int) strtoul(p, &end, 10);
+		p = end;
+		break;
+	    case '.':
+		gotPrecision = 1;
+		p++;
+		break;
+	    /* TODO: support for wide (and bignum?) arguments */
+	    case 'l':
+		size = 1;
+		p++;
+		break;
+	    case 'h':
+		size = -1;
+	    default:
+		p++;
+	    }
+	} while (seekingConversion);
+    }
+    TclListObjGetElements(NULL, list, &objc, &objv);
+    code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
+    if (code != TCL_OK) {
+	Tcl_AppendPrintfToObj(objPtr,
+		"Unable to format \"%s\" with supplied arguments: %s",
+		format, Tcl_GetString(list));
+    }
+    Tcl_DecrRefCount(list);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_AppendPrintfToObj --
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendPrintfToObj(
+    Tcl_Obj *objPtr,
+    const char *format,
+    ...)
+{
+    va_list argList;
+
+    va_start(argList, format);
+    AppendPrintfToObjVA(objPtr, format, argList);
+    va_end(argList);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_ObjPrintf --
+ *
+ * Results:
+ *	A refcount zero Tcl_Obj.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjPrintf(
+    const char *format,
+    ...)
+{
+    va_list argList;
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    va_start(argList, format);
+    AppendPrintfToObjVA(objPtr, format, argList);
+    va_end(argList);
+    return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringObjReverse --
+ *
+ *	Implements the [string reverse] operation.
+ *
+ * Results:
+ *	An unshared Tcl value which is the [string reverse] of the argument
+ *	supplied.  When sharing rules permit, the returned value might be
+ *	the argument with modifications done in place.
+ *
+ * Side effects:
+ *	May allocate a new Tcl_Obj.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclStringObjReverse(
+    Tcl_Obj *objPtr)
+{
+    String *stringPtr;
+    int numChars = Tcl_GetCharLength(objPtr);
+    int i = 0, lastCharIdx = numChars - 1;
+    char *bytes;
+
+    if (numChars <= 1) {
+	return objPtr;
+    }
+
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode) {
+	Tcl_UniChar *source = stringPtr->unicode;
+
+	if (Tcl_IsShared(objPtr)) {
+	    Tcl_UniChar *dest, ch = 0;
+
+	    /*
+	     * Create a non-empty, pure unicode value, so we can coax
+	     * Tcl_SetObjLength into growing the unicode rep buffer.
+	     */
+
+	    Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1);
+	    Tcl_SetObjLength(resultPtr, numChars);
+	    dest = Tcl_GetUnicode(resultPtr);
+
+	    while (i < numChars) {
+		dest[i++] = source[lastCharIdx--];
+	    }
+	    return resultPtr;
+	}
+
+	while (i < lastCharIdx) {
+	    Tcl_UniChar tmp = source[lastCharIdx];
+	    source[lastCharIdx--] = source[i];
+	    source[i++] = tmp;
+	}
+	TclInvalidateStringRep(objPtr);
+	stringPtr->allocated = 0;
+	return objPtr;
+    }
+
+    bytes = TclGetString(objPtr);
+    if (Tcl_IsShared(objPtr)) {
+	char *dest;
+	Tcl_Obj *resultPtr = Tcl_NewObj();
+	Tcl_SetObjLength(resultPtr, numChars);
+	dest = TclGetString(resultPtr);
+	while (i < numChars) {
+	    dest[i++] = bytes[lastCharIdx--];
+	}
+	return resultPtr;
+    }
+
+    while (i < lastCharIdx) {
+	char tmp = bytes[lastCharIdx];
+	bytes[lastCharIdx--] = bytes[i];
+	bytes[i++] = tmp;
+    }
+    return objPtr;
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * FillUnicodeRep --
  *
  *	Populate the Unicode internal rep with the Unicode form of its string
- *	rep.  The object must alread have a "String" internal rep.
+ *	rep. The object must alread have a "String" internal rep.
  *
  * Results:
  *	None.
@@ -1717,15 +2800,15 @@ Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
  */
 
 static void
-FillUnicodeRep(objPtr)
-    Tcl_Obj *objPtr;	/* The object in which to fill the unicode rep. */
+FillUnicodeRep(
+    Tcl_Obj *objPtr)		/* The object in which to fill the unicode
+				 * rep. */
 {
     String *stringPtr;
     size_t uallocated;
-    char *src, *srcEnd;
+    char *srcEnd, *src = objPtr->bytes;
     Tcl_UniChar *dst;
-    src = objPtr->bytes;
-    
+
     stringPtr = GET_STRING(objPtr);
     if (stringPtr->numChars == -1) {
 	stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
@@ -1742,13 +2825,13 @@ FillUnicodeRep(objPtr)
     /*
      * Convert src to Unicode and store the coverted data in "unicode".
      */
-    
+
     srcEnd = src + objPtr->length;
     for (dst = stringPtr->unicode; src < srcEnd; dst++) {
 	src += TclUtfToUniChar(src, dst);
     }
     *dst = 0;
-    
+
     SET_STRING(objPtr, stringPtr);
 }
 
@@ -1757,8 +2840,8 @@ FillUnicodeRep(objPtr)
  *
  * DupStringInternalRep --
  *
- *	Initialize the internal representation of a new Tcl_Obj to a
- *	copy of the internal representation of an existing string object.
+ *	Initialize the internal representation of a new Tcl_Obj to a copy of
+ *	the internal representation of an existing string object.
  *
  * Results:
  *	None.
@@ -1771,32 +2854,31 @@ FillUnicodeRep(objPtr)
  */
 
 static void
-DupStringInternalRep(srcPtr, copyPtr)
-    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy.  Must
-				 * have an internal rep of type "String". */
-    register Tcl_Obj *copyPtr;	/* Object with internal rep to set.  Must
-				 * not currently have an internal rep.*/
+DupStringInternalRep(
+    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
+				 * an internal rep of type "String". */
+    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
+				 * currently have an internal rep.*/
 {
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
 
     /*
-     * If the src obj is a string of 1-byte Utf chars, then copy the
-     * string rep of the source object and create an "empty" Unicode
-     * internal rep for the new object.  Otherwise, copy Unicode
-     * internal rep, and invalidate the string rep of the new object.
+     * If the src obj is a string of 1-byte Utf chars, then copy the string
+     * rep of the source object and create an "empty" Unicode internal rep for
+     * the new object. Otherwise, copy Unicode internal rep, and invalidate
+     * the string rep of the new object.
      */
-    
+
     if (srcStringPtr->hasUnicode == 0) {
-    	copyStringPtr = (String *) ckalloc(sizeof(String));
+	copyStringPtr = (String *) ckalloc(sizeof(String));
 	copyStringPtr->uallocated = 0;
     } else {
 	copyStringPtr = (String *) ckalloc(
-	    STRING_SIZE(srcStringPtr->uallocated));
+		STRING_SIZE(srcStringPtr->uallocated));
 	copyStringPtr->uallocated = srcStringPtr->uallocated;
 
-	memcpy((VOID *) copyStringPtr->unicode,
-		(VOID *) srcStringPtr->unicode,
+	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
 		(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
 	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
     }
@@ -1805,9 +2887,9 @@ DupStringInternalRep(srcPtr, copyPtr)
     copyStringPtr->allocated = srcStringPtr->allocated;
 
     /*
-     * Tricky point: the string value was copied by generic object
-     * management code, so it doesn't contain any extra bytes that
-     * might exist in the source object.
+     * Tricky point: the string value was copied by generic object management
+     * code, so it doesn't contain any extra bytes that might exist in the
+     * source object.
      */
 
     copyStringPtr->allocated = copyPtr->length;
@@ -1827,21 +2909,21 @@ DupStringInternalRep(srcPtr, copyPtr)
  *	This operation always succeeds and returns TCL_OK.
  *
  * Side effects:
- *	Any old internal reputation for objPtr is freed and the
- *	internal representation is set to "String".
+ *	Any old internal reputation for objPtr is freed and the internal
+ *	representation is set to "String".
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetStringFromAny(interp, objPtr)
-    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr;	/* The object to convert. */
+SetStringFromAny(
+    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     /*
-     * The Unicode object is optimized for the case where each UTF char
-     * in a string is only one byte.  In this case, we store the value of
-     * numChars, but we don't copy the bytes to the unicodeObj->unicode.
+     * The Unicode object is optimized for the case where each UTF char in a
+     * string is only one byte. In this case, we store the value of numChars,
+     * but we don't copy the bytes to the unicodeObj->unicode.
      */
 
     if (objPtr->typePtr != &tclStringType) {
@@ -1851,9 +2933,7 @@ SetStringFromAny(interp, objPtr)
 	    if (objPtr->bytes == NULL) {
 		objPtr->typePtr->updateStringProc(objPtr);
 	    }
-	    if ((objPtr->typePtr->freeIntRepProc) != NULL) {
-		(*objPtr->typePtr->freeIntRepProc)(objPtr);
-	    }
+	    TclFreeIntRep(objPtr);
 	}
 	objPtr->typePtr = &tclStringType;
 
@@ -1867,10 +2947,10 @@ SetStringFromAny(interp, objPtr)
 	stringPtr->hasUnicode = 0;
 
 	if (objPtr->bytes != NULL) {
-	    stringPtr->allocated = objPtr->length;	    
-	    if (objPtr->bytes != tclEmptyStringRep) {
-		objPtr->bytes[objPtr->length] = 0;
-	    }
+	    stringPtr->allocated = objPtr->length;
+            if (objPtr->bytes != tclEmptyStringRep) {
+	        objPtr->bytes[objPtr->length] = 0;
+            }
 	} else {
 	    objPtr->length = 0;
 	}
@@ -1891,15 +2971,15 @@ SetStringFromAny(interp, objPtr)
  *	None.
  *
  * Side effects:
- *	The object's string may be set by converting its Unicode
- *	represention to UTF format.
+ *	The object's string may be set by converting its Unicode represention
+ *	to UTF format.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfString(objPtr)
-    Tcl_Obj *objPtr;		/* Object with string rep to update. */
+UpdateStringOfString(
+    Tcl_Obj *objPtr)		/* Object with string rep to update. */
 {
     int i, size;
     Tcl_UniChar *unicode;
@@ -1909,12 +2989,10 @@ UpdateStringOfString(objPtr)
 
     stringPtr = GET_STRING(objPtr);
     if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
-
 	if (stringPtr->numChars <= 0) {
-
 	    /*
-	     * If there is no Unicode rep, or the string has 0 chars,
-	     * then set the string rep to an empty string.
+	     * If there is no Unicode rep, or the string has 0 chars, then set
+	     * the string rep to an empty string.
 	     */
 
 	    objPtr->bytes = tclEmptyStringRep;
@@ -1925,12 +3003,12 @@ UpdateStringOfString(objPtr)
 	unicode = stringPtr->unicode;
 
 	/*
-	 * Translate the Unicode string to UTF.  "size" will hold the
-	 * amount of space the UTF string needs.
+	 * Translate the Unicode string to UTF. "size" will hold the amount of
+	 * space the UTF string needs.
 	 */
 
 	if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX
-		&& stringPtr->allocated >= (size_t) (stringPtr->numChars * TCL_UTF_MAX)) {
+	    && stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) {
 	    goto copyBytes;
 	}
 
@@ -1961,21 +3039,30 @@ UpdateStringOfString(objPtr)
  *
  * FreeStringInternalRep --
  *
- *	Deallocate the storage associated with a String data object's
- *	internal representation.
+ *	Deallocate the storage associated with a String data object's internal
+ *	representation.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Frees memory. 
+ *	Frees memory.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeStringInternalRep(objPtr)
-    Tcl_Obj *objPtr;		/* Object with internal rep to free. */
+FreeStringInternalRep(
+    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
     ckfree((char *) GET_STRING(objPtr));
+    objPtr->typePtr = NULL;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 85dfe1c..fd4a222 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -10,7 +10,7 @@
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
+#include "tommath.h"
 
 /*
  * Remove macros that will interfere with the definitions below.
@@ -66,12 +66,26 @@ int TclSockMinimumBuffersOld(sock, size)
     int sock;
     int size;
 {
-    return TclSockMinimumBuffers((void *) (size_t) sock, size);
+    return TclSockMinimumBuffers(INT2PTR(sock), size);
+}
+#endif
+
+MODULE_SCOPE TclIntStubs tclIntStubs;
+MODULE_SCOPE TclIntPlatStubs tclIntPlatStubs;
+MODULE_SCOPE TclPlatStubs tclPlatStubs;
+MODULE_SCOPE TclStubs tclStubs;
+MODULE_SCOPE TclTomMathStubs tclTomMathStubs;
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+#undef TclWinNToHS
+unsigned short TclWinNToHS(unsigned short ns) {
+	return ntohs(ns);
 }
 #endif
 
 #ifdef __WIN32__
 #   define TclUnixWaitForFile 0
+#   define TclUnixCopyFile 0
 #   define TclpReaddir 0
 #   define TclpIsAtty 0
 #elif defined(__CYGWIN__)
@@ -98,12 +112,6 @@ TclWinGetPlatformId()
     return 2; /* VER_PLATFORM_WIN32_NT */;
 }
 
-TclPlatformType *
-TclWinGetPlatform()
-{
-    return &tclPlatform;
-}
-
 void *TclWinGetTclInstance()
 {
     void *hInstance = NULL;
@@ -112,12 +120,6 @@ void *TclWinGetTclInstance()
     return hInstance;
 }
 
-unsigned short
-TclWinNToHS(unsigned short ns)
-{
-    return ntohs(ns);
-}
-
 int
 TclWinSetSockOpt(SOCKET s, int level, int optname,
 	    const char *optval, int optlen)
@@ -190,7 +192,6 @@ Tcl_WinTCharToUtf(
 }
 
 #else /* UNIX and MAC */
-#   define TclpGetPid 0
 #   define TclpLocaltime_unix TclpLocaltime
 #   define TclpGmtime_unix TclpGmtime
 #endif
@@ -207,8 +208,8 @@ TclIntStubs tclIntStubs = {
     TCL_STUB_MAGIC,
     NULL,
     NULL, /* 0 */
-    TclAccessDeleteProc, /* 1 */
-    TclAccessInsertProc, /* 2 */
+    NULL, /* 1 */
+    NULL, /* 2 */
     TclAllocateFreeObjects, /* 3 */
     NULL, /* 4 */
     TclCleanupChildren, /* 5 */
@@ -219,7 +220,7 @@ TclIntStubs tclIntStubs = {
     TclCreateProc, /* 10 */
     TclDeleteCompiledLocalVars, /* 11 */
     TclDeleteVars, /* 12 */
-    TclDoGlob, /* 13 */
+    NULL, /* 13 */
     TclDumpMemoryInfo, /* 14 */
     NULL, /* 15 */
     TclExprFloatError, /* 16 */
@@ -233,13 +234,13 @@ TclIntStubs tclIntStubs = {
     TclFormatInt, /* 24 */
     TclFreePackageInfo, /* 25 */
     NULL, /* 26 */
-    TclGetDate, /* 27 */
+    NULL, /* 27 */
     TclpGetDefaultStdChannel, /* 28 */
     NULL, /* 29 */
     NULL, /* 30 */
     TclGetExtension, /* 31 */
     TclGetFrame, /* 32 */
-    TclGetInterpProc, /* 33 */
+    NULL, /* 33 */
     TclGetIntForIndex, /* 34 */
     NULL, /* 35 */
     TclGetLong, /* 36 */
@@ -249,16 +250,16 @@ TclIntStubs tclIntStubs = {
     TclGetOpenMode, /* 40 */
     TclGetOriginalCommand, /* 41 */
     TclpGetUserHome, /* 42 */
-    TclGlobalInvoke, /* 43 */
+    NULL, /* 43 */
     TclGuessPackageName, /* 44 */
     TclHideUnsafeCommands, /* 45 */
     TclInExit, /* 46 */
     NULL, /* 47 */
     NULL, /* 48 */
-    TclIncrVar2, /* 49 */
+    NULL, /* 49 */
     TclInitCompiledLocals, /* 50 */
     TclInterpInit, /* 51 */
-    TclInvoke, /* 52 */
+    NULL, /* 52 */
     TclInvokeObjectCommand, /* 53 */
     TclInvokeStringCommand, /* 54 */
     TclIsProc, /* 55 */
@@ -271,9 +272,9 @@ TclIntStubs tclIntStubs = {
     TclObjCommandComplete, /* 62 */
     TclObjInterpProc, /* 63 */
     TclObjInvoke, /* 64 */
-    TclObjInvokeGlobal, /* 65 */
-    TclOpenFileChannelDeleteProc, /* 66 */
-    TclOpenFileChannelInsertProc, /* 67 */
+    NULL, /* 65 */
+    NULL, /* 66 */
+    NULL, /* 67 */
     NULL, /* 68 */
     TclpAlloc, /* 69 */
     NULL, /* 70 */
@@ -300,7 +301,7 @@ TclIntStubs tclIntStubs = {
     TclProcCleanupProc, /* 91 */
     TclProcCompileProc, /* 92 */
     TclProcDeleteProc, /* 93 */
-    TclProcInterpProc, /* 94 */
+    NULL, /* 94 */
     NULL, /* 95 */
     TclRenameCommand, /* 96 */
     TclResetShadowedCmdRefs, /* 97 */
@@ -312,8 +313,8 @@ TclIntStubs tclIntStubs = {
     TclSockGetPort, /* 103 */
     TclSockMinimumBuffersOld, /* 104 */
     NULL, /* 105 */
-    TclStatDeleteProc, /* 106 */
-    TclStatInsertProc, /* 107 */
+    NULL, /* 106 */
+    NULL, /* 107 */
     TclTeardownNamespace, /* 108 */
     TclUpdateReturnInfo, /* 109 */
     TclSockMinimumBuffers, /* 110 */
@@ -340,13 +341,13 @@ TclIntStubs tclIntStubs = {
     Tcl_SetNamespaceResolvers, /* 131 */
     TclpHasSockets, /* 132 */
     TclpGetDate, /* 133 */
-    TclpStrftime, /* 134 */
-    TclpCheckStackSpace, /* 135 */
+    NULL, /* 134 */
+    NULL, /* 135 */
     NULL, /* 136 */
     NULL, /* 137 */
     TclGetEnv, /* 138 */
     NULL, /* 139 */
-    TclLooksLikeInt, /* 140 */
+    NULL, /* 140 */
     TclpGetCwd, /* 141 */
     TclSetByteCodeFromAny, /* 142 */
     TclAddLiteralObj, /* 143 */
@@ -381,11 +382,11 @@ TclIntStubs tclIntStubs = {
     TclInThreadExit, /* 172 */
     TclUniCharMatch, /* 173 */
     NULL, /* 174 */
-    NULL, /* 175 */
-    NULL, /* 176 */
-    NULL, /* 177 */
-    NULL, /* 178 */
-    NULL, /* 179 */
+    TclCallVarTraces, /* 175 */
+    TclCleanupVar, /* 176 */
+    TclVarErrMsg, /* 177 */
+    Tcl_SetStartupScript, /* 178 */
+    Tcl_GetStartupScript, /* 179 */
     NULL, /* 180 */
     NULL, /* 181 */
     TclpLocaltime, /* 182 */
@@ -404,58 +405,58 @@ TclIntStubs tclIntStubs = {
     NULL, /* 195 */
     NULL, /* 196 */
     NULL, /* 197 */
-    NULL, /* 198 */
-    TclMatchIsTrivial, /* 199 */
-    NULL, /* 200 */
-    NULL, /* 201 */
-    NULL, /* 202 */
-    NULL, /* 203 */
-    NULL, /* 204 */
-    NULL, /* 205 */
-    NULL, /* 206 */
-    NULL, /* 207 */
-    NULL, /* 208 */
+    TclObjGetFrame, /* 198 */
+    NULL, /* 199 */
+    TclpObjRemoveDirectory, /* 200 */
+    TclpObjCopyDirectory, /* 201 */
+    TclpObjCreateDirectory, /* 202 */
+    TclpObjDeleteFile, /* 203 */
+    TclpObjCopyFile, /* 204 */
+    TclpObjRenameFile, /* 205 */
+    TclpObjStat, /* 206 */
+    TclpObjAccess, /* 207 */
+    TclpOpenFileChannel, /* 208 */
     NULL, /* 209 */
     NULL, /* 210 */
     NULL, /* 211 */
-    NULL, /* 212 */
-    NULL, /* 213 */
-    NULL, /* 214 */
-    NULL, /* 215 */
-    NULL, /* 216 */
-    NULL, /* 217 */
-    NULL, /* 218 */
+    TclpFindExecutable, /* 212 */
+    TclGetObjNameOfExecutable, /* 213 */
+    TclSetObjNameOfExecutable, /* 214 */
+    TclStackAlloc, /* 215 */
+    TclStackFree, /* 216 */
+    TclPushStackFrame, /* 217 */
+    TclPopStackFrame, /* 218 */
     NULL, /* 219 */
     NULL, /* 220 */
     NULL, /* 221 */
     NULL, /* 222 */
     NULL, /* 223 */
-    NULL, /* 224 */
-    NULL, /* 225 */
-    NULL, /* 226 */
-    NULL, /* 227 */
-    NULL, /* 228 */
-    NULL, /* 229 */
-    NULL, /* 230 */
-    NULL, /* 231 */
-    NULL, /* 232 */
-    NULL, /* 233 */
-    NULL, /* 234 */
-    NULL, /* 235 */
-    NULL, /* 236 */
+    TclGetPlatform, /* 224 */
+    TclTraceDictPath, /* 225 */
+    TclObjBeingDeleted, /* 226 */
+    TclSetNsPath, /* 227 */
+    TclObjInterpProcCore, /* 228 */
+    TclPtrMakeUpvar, /* 229 */
+    TclObjLookupVar, /* 230 */
+    TclGetNamespaceFromObj, /* 231 */
+    TclEvalObjEx, /* 232 */
+    TclGetSrcInfoForPc, /* 233 */
+    TclVarHashCreateVar, /* 234 */
+    TclInitVarHashTable, /* 235 */
+    TclBackgroundException, /* 236 */
     NULL, /* 237 */
     NULL, /* 238 */
     NULL, /* 239 */
     NULL, /* 240 */
     NULL, /* 241 */
     NULL, /* 242 */
-    NULL, /* 243 */
+    TclDbDumpActiveObjects, /* 243 */
     NULL, /* 244 */
     NULL, /* 245 */
     NULL, /* 246 */
     NULL, /* 247 */
     NULL, /* 248 */
-    TclUnusedStubEntry, /* 249 */
+    TclDoubleDigits, /* 249 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
@@ -476,7 +477,7 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpLocaltime_unix, /* 11 */
     TclpGmtime_unix, /* 12 */
     TclpInetNtoa, /* 13 */
-    NULL, /* 14 */
+    TclUnixCopyFile, /* 14 */
     NULL, /* 15 */
     NULL, /* 16 */
     NULL, /* 17 */
@@ -511,7 +512,7 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpCreatePipe, /* 14 */
     TclpCreateProcess, /* 15 */
     TclpIsAtty, /* 16 */
-    NULL, /* 17 */
+    TclUnixCopyFile, /* 17 */
     TclpMakeFile, /* 18 */
     TclpOpenFile, /* 19 */
     TclWinAddProcess, /* 20 */
@@ -519,7 +520,7 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpCreateTempFile, /* 22 */
     TclpGetTZName, /* 23 */
     TclWinNoBackslash, /* 24 */
-    TclWinGetPlatform, /* 25 */
+    NULL, /* 25 */
     TclWinSetInterfaces, /* 26 */
     TclWinFlushDirtyChannels, /* 27 */
     TclWinResetInterfaces, /* 28 */
@@ -540,12 +541,12 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpLocaltime_unix, /* 11 */
     TclpGmtime_unix, /* 12 */
     TclpInetNtoa, /* 13 */
-    NULL, /* 14 */
-    NULL, /* 15 */
-    NULL, /* 16 */
-    NULL, /* 17 */
-    NULL, /* 18 */
-    NULL, /* 19 */
+    TclUnixCopyFile, /* 14 */
+    TclMacOSXGetFileAttribute, /* 15 */
+    TclMacOSXSetFileAttribute, /* 16 */
+    TclMacOSXCopyFileAttributes, /* 17 */
+    TclMacOSXMatchType, /* 18 */
+    TclMacOSXNotifierAddRunLoopMode, /* 19 */
     NULL, /* 20 */
     NULL, /* 21 */
     NULL, /* 22 */
@@ -572,6 +573,75 @@ TclPlatStubs tclPlatStubs = {
 #endif /* MACOSX */
 };
 
+TclTomMathStubs tclTomMathStubs = {
+    TCL_STUB_MAGIC,
+    NULL,
+    TclBN_epoch, /* 0 */
+    TclBN_revision, /* 1 */
+    TclBN_mp_add, /* 2 */
+    TclBN_mp_add_d, /* 3 */
+    TclBN_mp_and, /* 4 */
+    TclBN_mp_clamp, /* 5 */
+    TclBN_mp_clear, /* 6 */
+    TclBN_mp_clear_multi, /* 7 */
+    TclBN_mp_cmp, /* 8 */
+    TclBN_mp_cmp_d, /* 9 */
+    TclBN_mp_cmp_mag, /* 10 */
+    TclBN_mp_copy, /* 11 */
+    TclBN_mp_count_bits, /* 12 */
+    TclBN_mp_div, /* 13 */
+    TclBN_mp_div_d, /* 14 */
+    TclBN_mp_div_2, /* 15 */
+    TclBN_mp_div_2d, /* 16 */
+    TclBN_mp_div_3, /* 17 */
+    TclBN_mp_exch, /* 18 */
+    TclBN_mp_expt_d, /* 19 */
+    TclBN_mp_grow, /* 20 */
+    TclBN_mp_init, /* 21 */
+    TclBN_mp_init_copy, /* 22 */
+    TclBN_mp_init_multi, /* 23 */
+    TclBN_mp_init_set, /* 24 */
+    TclBN_mp_init_size, /* 25 */
+    TclBN_mp_lshd, /* 26 */
+    TclBN_mp_mod, /* 27 */
+    TclBN_mp_mod_2d, /* 28 */
+    TclBN_mp_mul, /* 29 */
+    TclBN_mp_mul_d, /* 30 */
+    TclBN_mp_mul_2, /* 31 */
+    TclBN_mp_mul_2d, /* 32 */
+    TclBN_mp_neg, /* 33 */
+    TclBN_mp_or, /* 34 */
+    TclBN_mp_radix_size, /* 35 */
+    TclBN_mp_read_radix, /* 36 */
+    TclBN_mp_rshd, /* 37 */
+    TclBN_mp_shrink, /* 38 */
+    TclBN_mp_set, /* 39 */
+    TclBN_mp_sqr, /* 40 */
+    TclBN_mp_sqrt, /* 41 */
+    TclBN_mp_sub, /* 42 */
+    TclBN_mp_sub_d, /* 43 */
+    TclBN_mp_to_unsigned_bin, /* 44 */
+    TclBN_mp_to_unsigned_bin_n, /* 45 */
+    TclBN_mp_toradix_n, /* 46 */
+    TclBN_mp_unsigned_bin_size, /* 47 */
+    TclBN_mp_xor, /* 48 */
+    TclBN_mp_zero, /* 49 */
+    TclBN_reverse, /* 50 */
+    TclBN_fast_s_mp_mul_digs, /* 51 */
+    TclBN_fast_s_mp_sqr, /* 52 */
+    TclBN_mp_karatsuba_mul, /* 53 */
+    TclBN_mp_karatsuba_sqr, /* 54 */
+    TclBN_mp_toom_mul, /* 55 */
+    TclBN_mp_toom_sqr, /* 56 */
+    TclBN_s_mp_add, /* 57 */
+    TclBN_s_mp_mul_digs, /* 58 */
+    TclBN_s_mp_sqr, /* 59 */
+    TclBN_s_mp_sub, /* 60 */
+    TclBN_mp_init_set_int, /* 61 */
+    TclBN_mp_set_int, /* 62 */
+    TclBN_mp_cnt_lsb, /* 63 */
+};
+
 static TclStubHooks tclStubHooks = {
     &tclPlatStubs,
     &tclIntStubs,
@@ -1099,92 +1169,92 @@ TclStubs tclStubs = {
     Tcl_Seek, /* 491 */
     Tcl_Tell, /* 492 */
     Tcl_ChannelWideSeekProc, /* 493 */
-    NULL, /* 494 */
-    NULL, /* 495 */
-    NULL, /* 496 */
-    NULL, /* 497 */
-    NULL, /* 498 */
-    NULL, /* 499 */
-    NULL, /* 500 */
-    NULL, /* 501 */
-    NULL, /* 502 */
-    NULL, /* 503 */
-    NULL, /* 504 */
-    NULL, /* 505 */
-    NULL, /* 506 */
-    NULL, /* 507 */
-    NULL, /* 508 */
-    NULL, /* 509 */
-    NULL, /* 510 */
-    NULL, /* 511 */
-    NULL, /* 512 */
-    NULL, /* 513 */
-    NULL, /* 514 */
-    NULL, /* 515 */
-    NULL, /* 516 */
-    NULL, /* 517 */
-    NULL, /* 518 */
-    NULL, /* 519 */
-    NULL, /* 520 */
-    NULL, /* 521 */
-    NULL, /* 522 */
-    NULL, /* 523 */
-    NULL, /* 524 */
-    NULL, /* 525 */
-    NULL, /* 526 */
-    NULL, /* 527 */
-    NULL, /* 528 */
-    NULL, /* 529 */
-    NULL, /* 530 */
-    NULL, /* 531 */
-    NULL, /* 532 */
-    NULL, /* 533 */
-    NULL, /* 534 */
-    NULL, /* 535 */
-    NULL, /* 536 */
-    NULL, /* 537 */
-    NULL, /* 538 */
-    NULL, /* 539 */
-    NULL, /* 540 */
-    NULL, /* 541 */
-    NULL, /* 542 */
-    NULL, /* 543 */
-    NULL, /* 544 */
-    NULL, /* 545 */
-    NULL, /* 546 */
-    NULL, /* 547 */
-    NULL, /* 548 */
-    NULL, /* 549 */
-    NULL, /* 550 */
-    NULL, /* 551 */
-    NULL, /* 552 */
-    NULL, /* 553 */
+    Tcl_DictObjPut, /* 494 */
+    Tcl_DictObjGet, /* 495 */
+    Tcl_DictObjRemove, /* 496 */
+    Tcl_DictObjSize, /* 497 */
+    Tcl_DictObjFirst, /* 498 */
+    Tcl_DictObjNext, /* 499 */
+    Tcl_DictObjDone, /* 500 */
+    Tcl_DictObjPutKeyList, /* 501 */
+    Tcl_DictObjRemoveKeyList, /* 502 */
+    Tcl_NewDictObj, /* 503 */
+    Tcl_DbNewDictObj, /* 504 */
+    Tcl_RegisterConfig, /* 505 */
+    Tcl_CreateNamespace, /* 506 */
+    Tcl_DeleteNamespace, /* 507 */
+    Tcl_AppendExportList, /* 508 */
+    Tcl_Export, /* 509 */
+    Tcl_Import, /* 510 */
+    Tcl_ForgetImport, /* 511 */
+    Tcl_GetCurrentNamespace, /* 512 */
+    Tcl_GetGlobalNamespace, /* 513 */
+    Tcl_FindNamespace, /* 514 */
+    Tcl_FindCommand, /* 515 */
+    Tcl_GetCommandFromObj, /* 516 */
+    Tcl_GetCommandFullName, /* 517 */
+    Tcl_FSEvalFileEx, /* 518 */
+    Tcl_SetExitProc, /* 519 */
+    Tcl_LimitAddHandler, /* 520 */
+    Tcl_LimitRemoveHandler, /* 521 */
+    Tcl_LimitReady, /* 522 */
+    Tcl_LimitCheck, /* 523 */
+    Tcl_LimitExceeded, /* 524 */
+    Tcl_LimitSetCommands, /* 525 */
+    Tcl_LimitSetTime, /* 526 */
+    Tcl_LimitSetGranularity, /* 527 */
+    Tcl_LimitTypeEnabled, /* 528 */
+    Tcl_LimitTypeExceeded, /* 529 */
+    Tcl_LimitTypeSet, /* 530 */
+    Tcl_LimitTypeReset, /* 531 */
+    Tcl_LimitGetCommands, /* 532 */
+    Tcl_LimitGetTime, /* 533 */
+    Tcl_LimitGetGranularity, /* 534 */
+    Tcl_SaveInterpState, /* 535 */
+    Tcl_RestoreInterpState, /* 536 */
+    Tcl_DiscardInterpState, /* 537 */
+    Tcl_SetReturnOptions, /* 538 */
+    Tcl_GetReturnOptions, /* 539 */
+    Tcl_IsEnsemble, /* 540 */
+    Tcl_CreateEnsemble, /* 541 */
+    Tcl_FindEnsemble, /* 542 */
+    Tcl_SetEnsembleSubcommandList, /* 543 */
+    Tcl_SetEnsembleMappingDict, /* 544 */
+    Tcl_SetEnsembleUnknownHandler, /* 545 */
+    Tcl_SetEnsembleFlags, /* 546 */
+    Tcl_GetEnsembleSubcommandList, /* 547 */
+    Tcl_GetEnsembleMappingDict, /* 548 */
+    Tcl_GetEnsembleUnknownHandler, /* 549 */
+    Tcl_GetEnsembleFlags, /* 550 */
+    Tcl_GetEnsembleNamespace, /* 551 */
+    Tcl_SetTimeProc, /* 552 */
+    Tcl_QueryTimeProc, /* 553 */
     Tcl_ChannelThreadActionProc, /* 554 */
-    NULL, /* 555 */
-    NULL, /* 556 */
-    NULL, /* 557 */
-    NULL, /* 558 */
-    NULL, /* 559 */
-    NULL, /* 560 */
-    NULL, /* 561 */
-    NULL, /* 562 */
-    NULL, /* 563 */
-    NULL, /* 564 */
-    NULL, /* 565 */
-    NULL, /* 566 */
-    NULL, /* 567 */
-    NULL, /* 568 */
-    NULL, /* 569 */
-    NULL, /* 570 */
-    NULL, /* 571 */
-    NULL, /* 572 */
+    Tcl_NewBignumObj, /* 555 */
+    Tcl_DbNewBignumObj, /* 556 */
+    Tcl_SetBignumObj, /* 557 */
+    Tcl_GetBignumFromObj, /* 558 */
+    Tcl_TakeBignumFromObj, /* 559 */
+    Tcl_TruncateChannel, /* 560 */
+    Tcl_ChannelTruncateProc, /* 561 */
+    Tcl_SetChannelErrorInterp, /* 562 */
+    Tcl_GetChannelErrorInterp, /* 563 */
+    Tcl_SetChannelError, /* 564 */
+    Tcl_GetChannelError, /* 565 */
+    Tcl_InitBignumFromDouble, /* 566 */
+    Tcl_GetNamespaceUnknownHandler, /* 567 */
+    Tcl_SetNamespaceUnknownHandler, /* 568 */
+    Tcl_GetEncodingFromObj, /* 569 */
+    Tcl_GetEncodingSearchPath, /* 570 */
+    Tcl_SetEncodingSearchPath, /* 571 */
+    Tcl_GetEncodingNameFromEnvironment, /* 572 */
     Tcl_PkgRequireProc, /* 573 */
-    NULL, /* 574 */
-    NULL, /* 575 */
-    NULL, /* 576 */
-    NULL, /* 577 */
-    NULL, /* 578 */
-    NULL, /* 579 */
+    Tcl_AppendObjToErrorInfo, /* 574 */
+    Tcl_AppendLimitedToObj, /* 575 */
+    Tcl_Format, /* 576 */
+    Tcl_AppendFormatToObj, /* 577 */
+    Tcl_ObjPrintf, /* 578 */
+    Tcl_AppendPrintfToObj, /* 579 */
     NULL, /* 580 */
     NULL, /* 581 */
     NULL, /* 582 */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 7b62f5e..31fc865 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -12,12 +12,12 @@
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 TclStubs *tclStubsPtr = NULL;
 TclPlatStubs *tclPlatStubsPtr = NULL;
 TclIntStubs *tclIntStubsPtr = NULL;
 TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
+TclTomMathStubs* tclTomMathStubsPtr = NULL;
 
 /*
  * Use our own ISDIGIT to avoid linking to libc on windows
@@ -44,10 +44,10 @@ TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
  */
 #undef Tcl_InitStubs
 CONST char *
-Tcl_InitStubs(interp, version, exact)
-    Tcl_Interp *interp;
-    CONST char *version;
-    int exact;
+Tcl_InitStubs(
+    Tcl_Interp *interp,
+    CONST char *version,
+    int exact)
 {
     Interp *iPtr = (Interp *) interp;
     CONST char *actualVersion = NULL;
@@ -112,6 +112,61 @@ Tcl_InitStubs(interp, version, exact)
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclTomMathInitStubs --
+ *
+ *	Initializes the Stubs table for Tcl's subset of libtommath
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * This procedure should not be called directly, but rather through
+ * the TclTomMath_InitStubs macro, to insure that the Stubs table
+ * matches the header files used in compilation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef TclTomMathInitializeStubs
+
+CONST char*
+TclTomMathInitializeStubs(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    CONST char* version,	/* Tcl version needed */
+    int epoch,			/* Stubs table epoch from the header files */
+    int revision		/* Stubs table revision number from the
+				 * header files */
+) {
+    int exact = 0;
+    const char* packageName = "tcl::tommath";
+    const char* errMsg = NULL;
+    ClientData pkgClientData = NULL;
+    const char* actualVersion = 
+	tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
+    TclTomMathStubs* stubsPtr = (TclTomMathStubs*) pkgClientData;
+    if (actualVersion == NULL) {
+	return NULL;
+    }
+    if (pkgClientData == NULL) {
+	errMsg = "missing stub table pointer";
+    } else if ((stubsPtr->tclBN_epoch)() != epoch) {
+	errMsg = "epoch number mismatch";
+    } else if ((stubsPtr->tclBN_revision)() != revision) {
+	errMsg = "requires a later revision";
+    } else {
+	tclTomMathStubsPtr = stubsPtr;
+	return actualVersion;
+    }
+    tclStubsPtr->tcl_ResetResult(interp);
+    tclStubsPtr->tcl_AppendResult(interp, "error loading ", packageName,
+		     " (requested version ", version,
+		     ", actual version ", actualVersion,
+		     "): ", errMsg, NULL);
+    return NULL;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 51051bd..1ba73e7 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1,29 +1,24 @@
-/* 
+/*
  * tclTest.c --
  *
- *	This file contains C command procedures for a bunch of additional
- *	Tcl commands that are used for testing out Tcl's C interfaces.
- *	These commands are not normally included in Tcl applications;
- *	they're only used for testing.
+ *	This file contains C command functions for a bunch of additional Tcl
+ *	commands that are used for testing out Tcl's C interfaces. These
+ *	commands are not normally included in Tcl applications; they're only
+ *	used for testing.
  *
  * Copyright (c) 1993-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 Ajuba Solutions.
  * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#ifndef _WIN64
-/* See [Bug 3354324]: file mtime sets wrong time */
-#   define _USE_32BIT_TIME_T
-#endif
-
 #define TCL_TEST
-#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclPort.h"
+
+#include <math.h>
 
 /*
  * Required for Testregexp*Cmd
@@ -45,24 +40,25 @@
  */
 
 /*
- * Dynamic string shared by TestdcallCmd and DelCallbackProc;  used
- * to collect the results of the various deletion callbacks.
+ * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
+ * the results of the various deletion callbacks.
  */
 
 static Tcl_DString delString;
 static Tcl_Interp *delInterp;
 
 /*
- * One of the following structures exists for each asynchronous
- * handler created by the "testasync" command".
+ * One of the following structures exists for each asynchronous handler
+ * created by the "testasync" command".
  */
 
 typedef struct TestAsyncHandler {
-    int id;				/* Identifier for this handler. */
-    Tcl_AsyncHandler handler;		/* Tcl's token for the handler. */
-    char *command;			/* Command to invoke when the
-					 * handler is invoked. */
-    struct TestAsyncHandler *nextPtr;	/* Next is list of handlers. */
+    int id;			/* Identifier for this handler. */
+    Tcl_AsyncHandler handler;	/* Tcl's token for the handler. */
+    char *command;		/* Command to invoke when the handler is
+				 * invoked. */
+    struct TestAsyncHandler *nextPtr;
+				/* Next is list of handlers. */
 } TestAsyncHandler;
 
 TCL_DECLARE_MUTEX(asyncTestMutex);
@@ -70,33 +66,33 @@ TCL_DECLARE_MUTEX(asyncTestMutex);
 static TestAsyncHandler *firstHandler = NULL;
 
 /*
- * The dynamic string below is used by the "testdstring" command
- * to test the dynamic string facilities.
+ * The dynamic string below is used by the "testdstring" command to test the
+ * dynamic string facilities.
  */
 
 static Tcl_DString dstring;
 
 /*
- * The command trace below is used by the "testcmdtraceCmd" command
- * to test the command tracing facilities.
+ * The command trace below is used by the "testcmdtraceCmd" command to test
+ * the command tracing facilities.
  */
 
 static Tcl_Trace cmdTrace;
 
 /*
- * One of the following structures exists for each command created
- * by TestdelCmd:
+ * One of the following structures exists for each command created by
+ * TestdelCmd:
  */
 
 typedef struct DelCmd {
     Tcl_Interp *interp;		/* Interpreter in which command exists. */
-    char *deleteCmd;		/* Script to execute when command is
-				 * deleted.  Malloc'ed. */
+    char *deleteCmd;		/* Script to execute when command is deleted.
+				 * Malloc'ed. */
 } DelCmd;
 
 /*
  * The following is used to keep track of an encoding that invokes a Tcl
- * command. 
+ * command.
  */
 
 typedef struct TclEncoding {
@@ -106,337 +102,347 @@ typedef struct TclEncoding {
 } TclEncoding;
 
 /*
- * The counter below is used to determine if the TestsaveresultFree
- * routine was called for a result.
+ * The counter below is used to determine if the TestsaveresultFree routine
+ * was called for a result.
  */
 
 static int freeCount;
 
 /*
- * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
- * commands.
+ * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
  */
+
 static int exitMainLoop = 0;
 
 /*
  * Event structure used in testing the event queue management procedures.
  */
+
 typedef struct TestEvent {
     Tcl_Event header;		/* Header common to all events */
-    Tcl_Interp* interp;		/* Interpreter that will handle the event */
-    Tcl_Obj* command;		/* Command to evaluate when the event occurs */
-    Tcl_Obj* tag;		/* Tag for this event used to delete it */
+    Tcl_Interp *interp;		/* Interpreter that will handle the event */
+    Tcl_Obj *command;		/* Command to evaluate when the event occurs */
+    Tcl_Obj *tag;		/* Tag for this event used to delete it */
 } TestEvent;
 
 /*
+ * Simple detach/attach facility for testchannel cut|splice. Allow testing of
+ * channel transfer in core testsuite.
+ */
+
+typedef struct TestChannel {
+    Tcl_Channel chan;		/* Detached channel */
+    struct TestChannel *nextPtr;/* Next in detached channel pool */
+} TestChannel;
+
+static TestChannel *firstDetached;
+
+/*
  * Forward declarations for procedures defined later in this file:
  */
 
-int			Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-static int		AsyncHandlerProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int code));
-static void		CleanupTestSetassocdataTests _ANSI_ARGS_((
-			    ClientData clientData, Tcl_Interp *interp));
-static void		CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
-static void		CmdDelProc2 _ANSI_ARGS_((ClientData clientData));
-static int		CmdProc1 _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		CmdProc2 _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static void		CmdTraceDeleteProc _ANSI_ARGS_((
+int			Tcltest_Init(Tcl_Interp *interp);
+static int		AsyncHandlerProc(ClientData clientData,
+			    Tcl_Interp *interp, int code);
+#ifdef TCL_THREADS
+static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
+#endif
+static void		CleanupTestSetassocdataTests(
+			    ClientData clientData, Tcl_Interp *interp);
+static void		CmdDelProc1(ClientData clientData);
+static void		CmdDelProc2(ClientData clientData);
+static int		CmdProc1(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		CmdProc2(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static void		CmdTraceDeleteProc(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int level, char *command, Tcl_CmdProc *cmdProc,
 			    ClientData cmdClientData, int argc,
-			    char **argv));
-static void		CmdTraceProc _ANSI_ARGS_((ClientData clientData,
+			    char **argv);
+static void		CmdTraceProc(ClientData clientData,
 			    Tcl_Interp *interp, int level, char *command,
 			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
-                            int argc, char **argv));
-static int		CreatedCommandProc _ANSI_ARGS_((
+			    int argc, char **argv);
+static int		CreatedCommandProc(
 			    ClientData clientData, Tcl_Interp *interp,
-			    int argc, CONST char **argv));
-static int		CreatedCommandProc2 _ANSI_ARGS_((
+			    int argc, const char **argv);
+static int		CreatedCommandProc2(
 			    ClientData clientData, Tcl_Interp *interp,
-			    int argc, CONST char **argv));
-static void		DelCallbackProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
-static int		DelCmdProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static void		DelDeleteProc _ANSI_ARGS_((ClientData clientData));
-static void		EncodingFreeProc _ANSI_ARGS_((ClientData clientData));
-static int		EncodingToUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int argc, const char **argv);
+static void		DelCallbackProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		DelCmdProc(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static void		DelDeleteProc(ClientData clientData);
+static void		EncodingFreeProc(ClientData clientData);
+static int		EncodingToUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst,
 			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static int		EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
-			    CONST char *src, int srcLen, int flags,
+			    int *dstCharsPtr);
+static int		EncodingFromUtfProc(ClientData clientData,
+			    const char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst,
 			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr));
-static void		ExitProcEven _ANSI_ARGS_((ClientData clientData));
-static void		ExitProcOdd _ANSI_ARGS_((ClientData clientData));
-static int              GetTimesCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int argc, CONST char **argv));
-static void		MainLoop _ANSI_ARGS_((void));
-static int              NoopCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int argc, CONST char **argv));
-static int              NoopObjCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		ObjTraceProc _ANSI_ARGS_(( ClientData clientData,
-						   Tcl_Interp* interp,
-						   int level,
-						   CONST char* command,
-						   Tcl_Command commandToken,
-						   int objc,
-						   Tcl_Obj *CONST objv[] ));
-static void		ObjTraceDeleteProc _ANSI_ARGS_(( ClientData ));
-static void		PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
-						Tcl_Parse *parsePtr));
-static void		SpecialFree _ANSI_ARGS_((char *blockPtr));
-static int		StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
-static int		TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		PretendTclpAccess _ANSI_ARGS_((CONST char *path,
-			   int mode));
-static int		TestAccessProc1 _ANSI_ARGS_((CONST char *path,
-			   int mode));
-static int		TestAccessProc2 _ANSI_ARGS_((CONST char *path,
-			   int mode));
-static int		TestAccessProc3 _ANSI_ARGS_((CONST char *path,
-			   int mode));
-static int		TestasyncCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestdcallCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestdelCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestdstringCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, 
-			    Tcl_Obj *CONST objv[]));
-static int		TestevalexObjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, 
-			    Tcl_Obj *CONST objv[]));
-static int		TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, 
-			    Tcl_Obj *CONST objv[]));
-static int		TesteventObjCmd _ANSI_ARGS_((ClientData unused,
-						     Tcl_Interp* interp,
-						     int argc,
-						     Tcl_Obj *CONST objv[]));
-static int		TesteventProc _ANSI_ARGS_((Tcl_Event* event,
-						   int flags));
-static int		TesteventDeleteProc _ANSI_ARGS_((
-			    Tcl_Event* event,
-			    ClientData clientData));
-static int		TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestexprlongobjCmd _ANSI_ARGS_((ClientData dummy,
+			    int *dstCharsPtr);
+static void		ExitProcEven(ClientData clientData);
+static void		ExitProcOdd(ClientData clientData);
+static int		GetTimesCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static void		MainLoop(void);
+static int		NoopCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		NoopObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		ObjTraceProc(ClientData clientData,
+			    Tcl_Interp *interp, int level, const char *command,
+			    Tcl_Command commandToken, int objc,
+			    Tcl_Obj *const objv[]);
+static void		ObjTraceDeleteProc(ClientData clientData);
+static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
+static void		SpecialFree(char *blockPtr);
+static int		StaticInitProc(Tcl_Interp *interp);
+#undef USE_OBSOLETE_FS_HOOKS
+#ifdef USE_OBSOLETE_FS_HOOKS
+static int		TestaccessprocCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestopenfilechannelprocCmd(
+			    ClientData dummy, Tcl_Interp *interp, int argc,
+			    const char **argv);
+static int		TeststatprocCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		PretendTclpAccess(const char *path, int mode);
+static int		TestAccessProc1(const char *path, int mode);
+static int		TestAccessProc2(const char *path, int mode);
+static int		TestAccessProc3(const char *path, int mode);
+static Tcl_Channel	PretendTclpOpenFileChannel(
+			    Tcl_Interp *interp, const char *fileName,
+			    const char *modeString, int permissions);
+static Tcl_Channel	TestOpenFileChannelProc1(
+			    Tcl_Interp *interp, const char *fileName,
+			    const char *modeString, int permissions);
+static Tcl_Channel	TestOpenFileChannelProc2(
+			    Tcl_Interp *interp, const char *fileName,
+			    const char *modeString, int permissions);
+static Tcl_Channel	TestOpenFileChannelProc3(
+			    Tcl_Interp *interp, const char *fileName,
+			    const char *modeString, int permissions);
+static int		PretendTclpStat(const char *path, struct stat *buf);
+static int		TestStatProc1(const char *path, struct stat *buf);
+static int		TestStatProc2(const char *path, struct stat *buf);
+static int		TestStatProc3(const char *path, struct stat *buf);
+#endif
+static int		TestasyncCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestcmdinfoCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestcmdtokenCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestcmdtraceCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestconcatobjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestcreatecommandCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestdcallCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestdelCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestdelassocdataCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestdoubledigitsObjCmd(ClientData dummy,
+					       Tcl_Interp* interp,
+					       int objc, Tcl_Obj* const objv[]);
+static int		TestdstringCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestencodingObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestevalexObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestevalobjvObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TesteventObjCmd(ClientData unused,
+			    Tcl_Interp *interp, int argc,
+			    Tcl_Obj *const objv[]);
+static int		TesteventProc(Tcl_Event *event, int flags);
+static int		TesteventDeleteProc(Tcl_Event *event,
+			    ClientData clientData);
+static int		TestexithandlerCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestexprlongCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestexprlongobjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static int		TestexprdoubleCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestexprdoubleobjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestfileCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int		TestfilelinkCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int		TestfeventCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestgetvarfullnameCmd _ANSI_ARGS_((
+			    Tcl_Obj *const objv[]);
+static int		TestexprparserObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestexprstringCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestfileCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int		TestfilelinkCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int		TestfeventCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestgetassocdataCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestgetintCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestgetplatformCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestgetvarfullnameCmd(
 			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
-		            Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestlinkCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestinterpdeleteCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestlinkCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestlocaleCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestMathFunc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Obj *const objv[]);
+static int		TestMathFunc(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Value *resultPtr);
+static int		TestMathFunc2(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static Tcl_Channel	PretendTclpOpenFileChannel _ANSI_ARGS_((
-			    Tcl_Interp *interp, CONST char *fileName,
-			    CONST char *modeString, int permissions));
-static Tcl_Channel	TestOpenFileChannelProc1 _ANSI_ARGS_((
-			    Tcl_Interp *interp, CONST char *fileName,
-			    CONST char *modeString, int permissions));
-static Tcl_Channel	TestOpenFileChannelProc2 _ANSI_ARGS_((
-			    Tcl_Interp *interp, CONST char *fileName,
-			    CONST char *modeString, int permissions));
-static Tcl_Channel	TestOpenFileChannelProc3 _ANSI_ARGS_((
-			    Tcl_Interp *interp, CONST char *fileName,
-			    CONST char *modeString, int permissions));
-static int		TestpanicCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Value *resultPtr);
+static int		TestmainthreadCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestsetmainloopCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestexitmainloopCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestpanicCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestparserObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestparsevarObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static int		TestparsevarnameObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static int		TestregexpObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static int		TestreturnObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static void		TestregexpXflags _ANSI_ARGS_((char *string,
-			    int length, int *cflagsPtr, int *eflagsPtr));
-static int		TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Obj *const objv[]);
+static void		TestregexpXflags(char *string,
+			    int length, int *cflagsPtr, int *eflagsPtr);
+static int		TestsaveresultCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static void		TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
-static int		TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestsetCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestseterrorcodeCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestsetobjerrorcodeCmd _ANSI_ARGS_((
+			    Tcl_Obj *const objv[]);
+static void		TestsaveresultFree(char *blockPtr);
+static int		TestsetassocdataCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestsetCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		Testset2Cmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestseterrorcodeCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestsetobjerrorcodeCmd(
 			    ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		TestopenfilechannelprocCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp, int argc,
-			    CONST char **argv));
-static int		TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		PretendTclpStat _ANSI_ARGS_((CONST char *path,
-			    Tcl_StatBuf *buf));
-static int		TestStatProc1 _ANSI_ARGS_((CONST char *path,
-			    Tcl_StatBuf *buf));
-static int		TestStatProc2 _ANSI_ARGS_((CONST char *path,
-			    Tcl_StatBuf *buf));
-static int		TestStatProc3 _ANSI_ARGS_((CONST char *path,
-			    Tcl_StatBuf *buf));
-static int		TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestupvarCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int              TestWrongNumArgsObjCmd _ANSI_ARGS_((
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestsetplatformCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TeststaticpkgCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TesttranslatefilenameCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestupvarCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestWrongNumArgsObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int              TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestGetIndexFromObjStructObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
-static int		TestChannelCmd _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-static int		TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, int argc, CONST char **argv));
-/* Filesystem testing */
-
-static int		TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc, 
-			    Tcl_Obj *CONST objv[]));
-static int		TestSimpleFilesystemObjCmd _ANSI_ARGS_((
-			    ClientData dummy, Tcl_Interp *interp, int objc, 
-			    Tcl_Obj *CONST objv[]));
-
-static void             TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1, 
-			    Tcl_Obj* arg2));
-
-static Tcl_Obj*         TestReportGetNativePath _ANSI_ARGS_ ((
-			    Tcl_Obj* pathObjPtr));
-
-static int		TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path,
-			    Tcl_StatBuf *buf));
-static int		TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path,
-			    int mode));
-static Tcl_Channel	TestReportOpenFileChannel _ANSI_ARGS_ ((
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestChannelCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestChannelEventCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestFilesystemObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestSimpleFilesystemObjCmd(
+			    ClientData dummy, Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static void		TestReport(const char *cmd, Tcl_Obj *arg1,
+			    Tcl_Obj *arg2);
+static Tcl_Obj *	TestReportGetNativePath(Tcl_Obj *pathPtr);
+static int		TestReportStat(Tcl_Obj *path, Tcl_StatBuf *buf);
+static int		TestReportAccess(Tcl_Obj *path, int mode);
+static Tcl_Channel	TestReportOpenFileChannel(
 			    Tcl_Interp *interp, Tcl_Obj *fileName,
-			    int mode, int permissions));
-static int		TestReportMatchInDirectory _ANSI_ARGS_ ((
+			    int mode, int permissions);
+static int		TestReportMatchInDirectory(Tcl_Interp *interp,
+			    Tcl_Obj *resultPtr, Tcl_Obj *dirPtr,
+			    const char *pattern, Tcl_GlobTypeData *types);
+static int		TestReportChdir(Tcl_Obj *dirName);
+static int		TestReportLstat(Tcl_Obj *path, Tcl_StatBuf *buf);
+static int		TestReportCopyFile(Tcl_Obj *src, Tcl_Obj *dst);
+static int		TestReportDeleteFile(Tcl_Obj *path);
+static int		TestReportRenameFile(Tcl_Obj *src, Tcl_Obj *dst);
+static int		TestReportCreateDirectory(Tcl_Obj *path);
+static int		TestReportCopyDirectory(Tcl_Obj *src,
+			    Tcl_Obj *dst, Tcl_Obj **errorPtr);
+static int		TestReportRemoveDirectory(Tcl_Obj *path,
+			    int recursive, Tcl_Obj **errorPtr);
+static int		TestReportLoadFile(Tcl_Interp *interp,
+			    Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr,
+			    Tcl_FSUnloadFileProc **unloadProcPtr);
+static Tcl_Obj *	TestReportLink(Tcl_Obj *path,
+			    Tcl_Obj *to, int linkType);
+static const char **	TestReportFileAttrStrings(
+			    Tcl_Obj *fileName, Tcl_Obj **objPtrRef);
+static int		TestReportFileAttrsGet(Tcl_Interp *interp,
+			    int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef);
+static int		TestReportFileAttrsSet(Tcl_Interp *interp,
+			    int index, Tcl_Obj *fileName, Tcl_Obj *objPtr);
+static int		TestReportUtime(Tcl_Obj *fileName,
+			    struct utimbuf *tval);
+static int		TestReportNormalizePath(Tcl_Interp *interp,
+			    Tcl_Obj *pathPtr, int nextCheckpoint);
+static int		TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+static void		TestReportFreeInternalRep(ClientData clientData);
+static ClientData	TestReportDupInternalRep(ClientData clientData);
+
+static int		SimpleStat(Tcl_Obj *path, Tcl_StatBuf *buf);
+static int		SimpleAccess(Tcl_Obj *path, int mode);
+static Tcl_Channel	SimpleOpenFileChannel(Tcl_Interp *interp,
+			    Tcl_Obj *fileName, int mode, int permissions);
+static Tcl_Obj *	SimpleListVolumes(void);
+static int		SimplePathInFilesystem(
+			    Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+static Tcl_Obj *	SimpleRedirect(Tcl_Obj *pathPtr);
+static int		SimpleMatchInDirectory(
 			    Tcl_Interp *interp, Tcl_Obj *resultPtr,
-			    Tcl_Obj *dirPtr, CONST char *pattern,
-			    Tcl_GlobTypeData *types));
-static int		TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName));
-static int		TestReportLstat _ANSI_ARGS_ ((Tcl_Obj *path,
-			    Tcl_StatBuf *buf));
-static int		TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src,
-			    Tcl_Obj *dst));
-static int		TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path));
-static int		TestReportRenameFile _ANSI_ARGS_ ((Tcl_Obj *src,
-			    Tcl_Obj *dst));
-static int		TestReportCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *path));
-static int		TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src,
-			    Tcl_Obj *dst, Tcl_Obj **errorPtr));
-static int		TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path,
-			    int recursive, Tcl_Obj **errorPtr));
-static int		TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp,
-			    Tcl_Obj *fileName, 
-			    Tcl_LoadHandle *handlePtr,
-			    Tcl_FSUnloadFileProc **unloadProcPtr));
-static Tcl_Obj *	TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path,
-			    Tcl_Obj *to, int linkType));
-static CONST char**	TestReportFileAttrStrings _ANSI_ARGS_ ((
-			    Tcl_Obj *fileName, Tcl_Obj **objPtrRef));
-static int		TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp,
-			    int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef));
-static int		TestReportFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp,
-			    int index, Tcl_Obj *fileName, Tcl_Obj *objPtr));
-static int		TestReportUtime _ANSI_ARGS_ ((Tcl_Obj *fileName,
-			    struct utimbuf *tval));
-static int		TestReportNormalizePath _ANSI_ARGS_ ((
-			    Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    int nextCheckpoint));
-static int		TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *clientDataPtr));
-static void		TestReportFreeInternalRep _ANSI_ARGS_ ((ClientData clientData));
-static ClientData	TestReportDupInternalRep _ANSI_ARGS_ ((ClientData clientData));
-
-static int		SimpleStat _ANSI_ARGS_ ((Tcl_Obj *path,
-			    Tcl_StatBuf *buf));
-static int		SimpleAccess _ANSI_ARGS_ ((Tcl_Obj *path,
-			    int mode));
-static Tcl_Channel	SimpleOpenFileChannel _ANSI_ARGS_ ((
-			    Tcl_Interp *interp, Tcl_Obj *fileName,
-			    int mode, int permissions));
-static Tcl_Obj*         SimpleListVolumes _ANSI_ARGS_ ((void));
-static int              SimplePathInFilesystem _ANSI_ARGS_ ((
-			    Tcl_Obj *pathPtr, ClientData *clientDataPtr));
-static Tcl_Obj*         SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr));
-static int              TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
+			    Tcl_Obj *dirPtr, const char *pattern,
+			    Tcl_GlobTypeData *types);
+static int		TestNumUtfCharsCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestHashSystemHashCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 #if defined(HAVE_CPUID) || defined(__WIN32__)
-static int	TestcpuidCmd _ANSI_ARGS_(( ClientData dummy,
-					      Tcl_Interp* interp,
-					      int objc,
-					      Tcl_Obj *CONST objv[] ));
+static int		TestcpuidCmd (ClientData dummy,
+			    Tcl_Interp* interp, int objc,
+			    Tcl_Obj *CONST objv[]);
 #endif
 
 static Tcl_Filesystem testReportingFilesystem = {
@@ -462,11 +468,11 @@ static Tcl_Filesystem testReportingFilesystem = {
     &TestReportFileAttrsGet,
     &TestReportFileAttrsSet,
     &TestReportCreateDirectory,
-    &TestReportRemoveDirectory, 
+    &TestReportRemoveDirectory,
     &TestReportDeleteFile,
     &TestReportCopyFile,
     &TestReportRenameFile,
-    &TestReportCopyDirectory, 
+    &TestReportCopyDirectory,
     &TestReportLstat,
     (Tcl_FSLoadFileProc *) &TestReportLoadFile,
     NULL /* cwd */,
@@ -494,7 +500,7 @@ static Tcl_Filesystem simpleFilesystem = {
     &SimpleStat,
     &SimpleAccess,
     &SimpleOpenFileChannel,
-    NULL,
+    &SimpleMatchInDirectory,
     NULL,
     /* We choose not to support symbolic links inside our vfs's */
     NULL,
@@ -503,14 +509,14 @@ static Tcl_Filesystem simpleFilesystem = {
     NULL,
     NULL,
     NULL,
-    NULL, 
+    NULL,
     NULL,
     /* No copy file - fallback will occur at Tcl level */
     NULL,
     /* No rename file - fallback will occur at Tcl level */
     NULL,
     /* No copy directory - fallback will occur at Tcl level */
-    NULL, 
+    NULL,
     /* Use stat for lstat */
     NULL,
     /* No load - fallback on core implementation */
@@ -523,25 +529,25 @@ static Tcl_Filesystem simpleFilesystem = {
 
 /*
  * External (platform specific) initialization routine, these declarations
- * explicitly don't use EXTERN since this code does not get compiled
- * into the library:
+ * explicitly don't use EXTERN since this code does not get compiled into the
+ * library:
  */
 
-extern int		TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
-extern int		TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int		TclplatformtestInit(Tcl_Interp *interp);
+extern int		TclThread_Init(Tcl_Interp *interp);
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcltest_Init --
  *
- *	This procedure performs application-specific initialization.
- *	Most applications, especially those that incorporate additional
- *	packages, will have their own version of this procedure.
+ *	This procedure performs application-specific initialization. Most
+ *	applications, especially those that incorporate additional packages,
+ *	will have their own version of this procedure.
  *
  * Results:
- *	Returns a standard Tcl completion code, and leaves an error
- *	message in the interp's result if an error occurs.
+ *	Returns a standard Tcl completion code, and leaves an error message in
+ *	the interp's result if an error occurs.
  *
  * Side effects:
  *	Depends on the startup script.
@@ -550,162 +556,160 @@ extern int		TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
  */
 
 int
-Tcltest_Init(interp)
-    Tcl_Interp *interp;		/* Interpreter for application. */
+Tcltest_Init(
+    Tcl_Interp *interp)		/* Interpreter for application. */
 {
     Tcl_ValueType t3ArgTypes[2];
 
     Tcl_Obj *listPtr;
     Tcl_Obj **objv;
     int objc, index;
-    static CONST char *specialOptions[] = {
+    static const char *specialOptions[] = {
 	"-appinitprocerror", "-appinitprocdeleteinterp",
-	"-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
+	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
     };
 
-#ifndef TCL_TIP268
-    if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
-#else
     /* TIP #268: Full patchlevel instead of just major.minor */
+
     if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
-#endif
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Create additional commands and math functions for testing Tcl.
      */
 
-    Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, 
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, 
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
-			 TestGetIndexFromObjStructObjCmd, (ClientData) 0,
-			 (Tcl_CmdDeleteProc *) NULL);
+	    TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL);
+#ifdef USE_OBSOLETE_FS_HOOKS
     Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
+    Tcl_CreateCommand(interp, "testopenfilechannelproc",
+    	    TestopenfilechannelprocCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
+	    NULL);
+#endif
+    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
     Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
     Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
+			 NULL, NULL);
     Tcl_DStringInit(&dstring);
     Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
     Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
     Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand( interp, "testevent", TesteventObjCmd,
-			  (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd,
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
-            (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, 
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
+    Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testhashsystemhash",
+	    TestHashSystemHashCmd, (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testgetvarfullname",
-	    TestgetvarfullnameCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    TestgetvarfullnameCmd, (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testopenfilechannelproc",
-    	    TestopenfilechannelprocCmd, (ClientData) 0, 
-    	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0,
-            (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
+    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
-            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
-            (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
+    Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
+	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
     Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testsetobjerrorcode", 
-	    TestsetobjerrorcodeCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
+	    TestsetobjerrorcodeCmd, (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testnumutfchars",
-	    TestNumUtfCharsCmd, (ClientData) 0, 
-	    (Tcl_CmdDeleteProc *) NULL);
+	    TestNumUtfCharsCmd, (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testtranslatefilename",
-            TesttranslatefilenameCmd, (ClientData) 0,
-            (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc,
-	    (ClientData) 123);
-    Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc,
-	    (ClientData) 345);
-    Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    TesttranslatefilenameCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0, NULL);
+    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
+    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
     Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+	    NULL);
     Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
-	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) NULL, NULL);
     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
-	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) NULL, NULL);
 #if defined(HAVE_CPUID) || defined(__WIN32__)
     Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
-			 (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
+	    (ClientData) 0, NULL);
 #endif
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
@@ -724,40 +728,37 @@ Tcltest_Init(interp)
 
     listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
     if (listPtr != NULL) {
-        if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
 	    return TCL_ERROR;
-        }
-        if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
+	}
+	if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
 		TCL_EXACT, &index) == TCL_OK)) {
 	    switch (index) {
-	        case 0: {
-		    return TCL_ERROR;
-	        }
-	        case 1: {
-		    Tcl_DeleteInterp(interp);
-		    return TCL_ERROR;
-	        }
-	        case 2: {
-		    int mode;
-		    Tcl_UnregisterChannel(interp, 
-			    Tcl_GetChannel(interp, "stderr", &mode));
-		    return TCL_ERROR;
-	        }
-	        case 3: {
-		    if (objc-1) {
-		        Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL,
-			       objv[1], TCL_GLOBAL_ONLY);
-		    }
-		    return TCL_ERROR;
-	        }
+	    case 0:
+		return TCL_ERROR;
+	    case 1:
+		Tcl_DeleteInterp(interp);
+		return TCL_ERROR;
+	    case 2: {
+		int mode;
+		Tcl_UnregisterChannel(interp,
+			Tcl_GetChannel(interp, "stderr", &mode));
+		return TCL_ERROR;
 	    }
-        }
+	    case 3:
+		if (objc-1) {
+		    Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1],
+			    TCL_GLOBAL_ONLY);
+		}
+		return TCL_ERROR;
+	    }
+	}
     }
-	
+
     /*
      * And finally add any platform specific test commands.
      */
-    
+
     return TclplatformtestInit(interp);
 }
 
@@ -780,11 +781,11 @@ Tcltest_Init(interp)
 
 	/* ARGSUSED */
 static int
-TestasyncCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestasyncCmd(
+    ClientData dummy,			/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int argc,				/* Number of arguments. */
+    const char **argv)			/* Argument strings. */
 {
     TestAsyncHandler *asyncPtr, *prevPtr;
     int id, code;
@@ -801,21 +802,21 @@ TestasyncCmd(dummy, interp, argc, argv)
 	    goto wrongNumArgs;
 	}
 	asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
-	asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
+	asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
 	strcpy(asyncPtr->command, argv[2]);
-	Tcl_MutexLock(&asyncTestMutex);
+        Tcl_MutexLock(&asyncTestMutex);
 	asyncPtr->id = nextId;
 	nextId++;
 	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
-		(ClientData) asyncPtr->id);
+                                            INT2PTR(asyncPtr->id));
 	asyncPtr->nextPtr = firstHandler;
 	firstHandler = asyncPtr;
+        Tcl_MutexUnlock(&asyncTestMutex);
 	TclFormatInt(buf, asyncPtr->id);
-	Tcl_MutexUnlock(&asyncTestMutex);
 	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "delete") == 0) {
 	if (argc == 2) {
-	    Tcl_MutexLock(&asyncTestMutex);
+            Tcl_MutexLock(&asyncTestMutex);
 	    while (firstHandler != NULL) {
 		asyncPtr = firstHandler;
 		firstHandler = asyncPtr->nextPtr;
@@ -823,7 +824,7 @@ TestasyncCmd(dummy, interp, argc, argv)
 		ckfree(asyncPtr->command);
 		ckfree((char *) asyncPtr);
 	    }
-	    Tcl_MutexUnlock(&asyncTestMutex);
+            Tcl_MutexUnlock(&asyncTestMutex);
 	    return TCL_OK;
 	}
 	if (argc != 3) {
@@ -832,7 +833,7 @@ TestasyncCmd(dummy, interp, argc, argv)
 	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	Tcl_MutexLock(&asyncTestMutex);
+        Tcl_MutexLock(&asyncTestMutex);
 	for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL;
 		prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) {
 	    if (asyncPtr->id != id) {
@@ -848,7 +849,7 @@ TestasyncCmd(dummy, interp, argc, argv)
 	    ckfree((char *) asyncPtr);
 	    break;
 	}
-	Tcl_MutexUnlock(&asyncTestMutex);
+        Tcl_MutexUnlock(&asyncTestMutex);
     } else if (strcmp(argv[1], "mark") == 0) {
 	if (argc != 5) {
 	    goto wrongNumArgs;
@@ -857,7 +858,7 @@ TestasyncCmd(dummy, interp, argc, argv)
 		|| (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) {
 	    return TCL_ERROR;
 	}
-	Tcl_MutexLock(&asyncTestMutex);
+        Tcl_MutexLock(&asyncTestMutex);
 	for (asyncPtr = firstHandler; asyncPtr != NULL;
 		asyncPtr = asyncPtr->nextPtr) {
 	    if (asyncPtr->id == id) {
@@ -865,29 +866,58 @@ TestasyncCmd(dummy, interp, argc, argv)
 		break;
 	    }
 	}
-	Tcl_MutexUnlock(&asyncTestMutex);
+        Tcl_MutexUnlock(&asyncTestMutex);
 	Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
 	return code;
+#ifdef TCL_THREADS
+    } else if (strcmp(argv[1], "marklater") == 0) {
+	if (argc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+        Tcl_MutexLock(&asyncTestMutex);
+	for (asyncPtr = firstHandler; asyncPtr != NULL;
+		asyncPtr = asyncPtr->nextPtr) {
+	    if (asyncPtr->id == id) {
+		Tcl_ThreadId threadID;
+		if (Tcl_CreateThread(&threadID, AsyncThreadProc,
+			(ClientData) INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
+			TCL_THREAD_NOFLAGS) != TCL_OK) {
+		    Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
+		    Tcl_MutexUnlock(&asyncTestMutex);
+		    return TCL_ERROR;
+		}
+		break;
+	    }
+	}
+        Tcl_MutexUnlock(&asyncTestMutex);
+    } else {
+	Tcl_AppendResult(interp, "bad option \"", argv[1],
+		"\": must be create, delete, int, mark, or marklater", NULL);
+	return TCL_ERROR;
+#else /* !TCL_THREADS */
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, int, or mark",
-		(char *) NULL);
+		"\": must be create, delete, int, or mark", NULL);
 	return TCL_ERROR;
+#endif
     }
     return TCL_OK;
 }
 
 static int
-AsyncHandlerProc(clientData, interp, code)
-    ClientData clientData;	/* Id of TestAsyncHandler structure. 
+AsyncHandlerProc(
+    ClientData clientData,	/* If of TestAsyncHandler structure. 
                                  * in global list. */
-    Tcl_Interp *interp;		/* Interpreter in which command was
+    Tcl_Interp *interp,		/* Interpreter in which command was
 				 * executed, or NULL. */
-    int code;			/* Current return code from command. */
+    int code)			/* Current return code from command. */
 {
     TestAsyncHandler *asyncPtr;
-    int id = (int)clientData;
-    CONST char *listArgv[4], *cmd;
+    int id = PTR2INT(clientData);
+    const char *listArgv[4], *cmd;
     char string[TCL_INTEGER_SPACE];
 
     Tcl_MutexLock(&asyncTestMutex);
@@ -912,9 +942,8 @@ AsyncHandlerProc(clientData, interp, code)
 	code = Tcl_Eval(interp, cmd);
     } else {
 	/*
-	 * this should not happen, but by definition of how async
-	 * handlers are invoked, it's possible.  Better error
-	 * checking is needed here.
+	 * this should not happen, but by definition of how async handlers are
+	 * invoked, it's possible.  Better error checking is needed here.
 	 */
     }
     ckfree((char *)cmd);
@@ -924,11 +953,51 @@ AsyncHandlerProc(clientData, interp, code)
 /*
  *----------------------------------------------------------------------
  *
+ * AsyncThreadProc --
+ *
+ *	Delivers an asynchronous event to a handler in another thread.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Invokes Tcl_AsyncMark on the handler
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_THREADS
+static Tcl_ThreadCreateType
+AsyncThreadProc(
+    ClientData clientData)	/* Parameter is the id of a
+				 * TestAsyncHandler, defined above. */
+{
+    TestAsyncHandler *asyncPtr;
+    int id = PTR2INT(clientData);
+
+    Tcl_Sleep(1);
+    Tcl_MutexLock(&asyncTestMutex);
+    for (asyncPtr = firstHandler; asyncPtr != NULL;
+         asyncPtr = asyncPtr->nextPtr) {
+        if (asyncPtr->id == id) {
+            Tcl_AsyncMark(asyncPtr->handler);
+            break;
+        }
+    }
+    Tcl_MutexUnlock(&asyncTestMutex);
+    Tcl_ExitThread(TCL_OK);
+    TCL_THREAD_CREATE_RETURN;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestcmdinfoCmd --
  *
- *	This procedure implements the "testcmdinfo" command.  It is used
- *	to test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation
- *	and deletion.
+ *	This procedure implements the "testcmdinfo" command.  It is used to
+ *	test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
+ *	deletion.
  *
  * Results:
  *	A standard Tcl result.
@@ -941,17 +1010,17 @@ AsyncHandlerProc(clientData, interp, code)
 
 	/* ARGSUSED */
 static int
-TestcmdinfoCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestcmdinfoCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_CmdInfo info;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option cmdName\"", (char *) NULL);
+		" option cmdName\"", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
@@ -968,34 +1037,33 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
 	}
 	if (info.proc == CmdProc1) {
 	    Tcl_AppendResult(interp, "CmdProc1", " ",
-		    (char *) info.clientData, (char *) NULL);
+		    (char *) info.clientData, NULL);
 	} else if (info.proc == CmdProc2) {
 	    Tcl_AppendResult(interp, "CmdProc2", " ",
-		    (char *) info.clientData, (char *) NULL);
+		    (char *) info.clientData, NULL);
 	} else {
-	    Tcl_AppendResult(interp, "unknown", (char *) NULL);
+	    Tcl_AppendResult(interp, "unknown", NULL);
 	}
 	if (info.deleteProc == CmdDelProc1) {
 	    Tcl_AppendResult(interp, " CmdDelProc1", " ",
-		    (char *) info.deleteData, (char *) NULL);
+		    (char *) info.deleteData, NULL);
 	} else if (info.deleteProc == CmdDelProc2) {
 	    Tcl_AppendResult(interp, " CmdDelProc2", " ",
-		    (char *) info.deleteData, (char *) NULL);
+		    (char *) info.deleteData, NULL);
 	} else {
-	    Tcl_AppendResult(interp, " unknown", (char *) NULL);
+	    Tcl_AppendResult(interp, " unknown", NULL);
 	}
-	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName,
-	        (char *) NULL);
+	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
 	if (info.isNativeObjectProc) {
-	    Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL);
+	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
 	} else {
-	    Tcl_AppendResult(interp, " stringProc", (char *) NULL);
+	    Tcl_AppendResult(interp, " stringProc", NULL);
 	}
     } else if (strcmp(argv[1], "modify") == 0) {
 	info.proc = CmdProc2;
 	info.clientData = (ClientData) "new_command_data";
 	info.objProc = NULL;
-        info.objClientData = (ClientData) NULL;
+	info.objClientData = (ClientData) NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (ClientData) "new_delete_data";
 	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
@@ -1005,8 +1073,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
 	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, get, or modify",
-		(char *) NULL);
+		"\": must be create, delete, get, or modify", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1014,33 +1081,31 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
 
 	/*ARGSUSED*/
 static int
-CmdProc1(clientData, interp, argc, argv)
-    ClientData clientData;		/* String to return. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
-{
-    Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
-	    (char *) NULL);
+CmdProc1(
+    ClientData clientData,	/* String to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL);
     return TCL_OK;
 }
 
 	/*ARGSUSED*/
 static int
-CmdProc2(clientData, interp, argc, argv)
-    ClientData clientData;		/* String to return. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
-{
-    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
-	    (char *) NULL);
+CmdProc2(
+    ClientData clientData,	/* String to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
     return TCL_OK;
 }
 
 static void
-CmdDelProc1(clientData)
-    ClientData clientData;		/* String to save. */
+CmdDelProc1(
+    ClientData clientData)	/* String to save. */
 {
     Tcl_DStringInit(&delString);
     Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
@@ -1048,8 +1113,8 @@ CmdDelProc1(clientData)
 }
 
 static void
-CmdDelProc2(clientData)
-    ClientData clientData;		/* String to save. */
+CmdDelProc2(
+    ClientData clientData)	/* String to save. */
 {
     Tcl_DStringInit(&delString);
     Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
@@ -1061,9 +1126,8 @@ CmdDelProc2(clientData)
  *
  * TestcmdtokenCmd --
  *
- *	This procedure implements the "testcmdtoken" command. It is used
- *	to test Tcl_Command tokens and procedures such as
- *	Tcl_GetCommandFullName.
+ *	This procedure implements the "testcmdtoken" command. It is used to
+ *	test Tcl_Command tokens and procedures such as Tcl_GetCommandFullName.
  *
  * Results:
  *	A standard Tcl result.
@@ -1076,11 +1140,11 @@ CmdDelProc2(clientData)
 
 	/* ARGSUSED */
 static int
-TestcmdtokenCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestcmdtokenCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_Command token;
     int *l;
@@ -1088,20 +1152,20 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option arg\"", (char *) NULL);
+		" option arg\"", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
 	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
-		(ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
-	sprintf(buf, "%p", (VOID *)token);
+		(ClientData) "original", NULL);
+	sprintf(buf, "%p", (void *)token);
 	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "name") == 0) {
 	Tcl_Obj *objPtr;
 
 	if (sscanf(argv[2], "%p", &l) != 1) {
 	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
-		    "\"", (char *) NULL);
+		    "\"", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -1109,12 +1173,12 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
 	Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
 
 	Tcl_AppendElement(interp,
-	        Tcl_GetCommandName(interp, (Tcl_Command) l));
+		Tcl_GetCommandName(interp, (Tcl_Command) l));
 	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
 	Tcl_DecrRefCount(objPtr);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create or name", (char *) NULL);
+		"\": must be create or name", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1140,25 +1204,25 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestcmdtraceCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestcmdtraceCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_DString buffer;
     int result;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option script\"", (char *) NULL);
+		" option script\"", NULL);
 	return TCL_ERROR;
     }
 
     if (strcmp(argv[1], "tracetest") == 0) {
 	Tcl_DStringInit(&buffer);
 	cmdTrace = Tcl_CreateTrace(interp, 50000,
-	        (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
 	result = Tcl_Eval(interp, argv[2]);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -1169,13 +1233,13 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
     } else if (strcmp(argv[1], "deletetest") == 0) {
 	/*
 	 * Create a command trace then eval a script to check whether it is
-	 * called. Note that this trace procedure removes itself as a
-	 * further check of the robustness of the trace proc calling code in
+	 * called. Note that this trace procedure removes itself as a further
+	 * check of the robustness of the trace proc calling code in
 	 * TclExecuteByteCode.
 	 */
-	
+
 	cmdTrace = Tcl_CreateTrace(interp, 50000,
-	        (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
+		(Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
 	Tcl_Eval(interp, argv[2]);
     } else if (strcmp(argv[1], "leveltest") == 0) {
 	Interp *iPtr = (Interp *) interp;
@@ -1189,26 +1253,26 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
 	}
 	Tcl_DeleteTrace(interp, cmdTrace);
 	Tcl_DStringFree(&buffer);
-    } else if ( strcmp(argv[1], "resulttest" ) == 0 ) {
+    } else if (strcmp(argv[1], "resulttest") == 0) {
 	/* Create an object-based trace, then eval a script. This is used
 	 * to test return codes other than TCL_OK from the trace engine.
 	 */
+
 	static int deleteCalled;
+
 	deleteCalled = 0;
-	cmdTrace = Tcl_CreateObjTrace( interp, 50000,
-				       TCL_ALLOW_INLINE_COMPILATION,
-				       ObjTraceProc,
-				       (ClientData) &deleteCalled,
-				       ObjTraceDeleteProc );
-	result = Tcl_Eval( interp, argv[ 2 ] );
-	Tcl_DeleteTrace( interp, cmdTrace );
-	if ( !deleteCalled ) {
-	    Tcl_SetResult( interp, "Delete wasn't called", TCL_STATIC );
+	cmdTrace = Tcl_CreateObjTrace(interp, 50000,
+		TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
+		(ClientData) &deleteCalled, ObjTraceDeleteProc);
+	result = Tcl_Eval(interp, argv[2]);
+	Tcl_DeleteTrace(interp, cmdTrace);
+	if (!deleteCalled) {
+	    Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
 	    return TCL_ERROR;
 	} else {
 	    return result;
 	}
-    } else if ( strcmp(argv[1], "doubletest" ) == 0 ) {
+    } else if (strcmp(argv[1], "doubletest") == 0) {
 	Tcl_Trace t1, t2;
 
 	Tcl_DStringInit(&buffer);
@@ -1226,28 +1290,26 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
 	Tcl_DStringFree(&buffer);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-			 "\": must be tracetest, deletetest, doubletest or resulttest",
-			 (char *) NULL);
+		"\": must be tracetest, deletetest, doubletest or resulttest", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static void
-CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
-        argc, argv)
-    ClientData clientData;	/* Pointer to buffer in which the
+CmdTraceProc(
+    ClientData clientData,	/* Pointer to buffer in which the
 				 * command and arguments are appended.
 				 * Accumulates test result. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int level;			/* Current trace level. */
-    char *command;		/* The command being traced (after
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int level,			/* Current trace level. */
+    char *command,		/* The command being traced (after
 				 * substitutions). */
-    Tcl_CmdProc *cmdProc;	/* Points to command's command procedure. */
-    ClientData cmdClientData;	/* Client data associated with command
+    Tcl_CmdProc *cmdProc,	/* Points to command's command procedure. */
+    ClientData cmdClientData,	/* Client data associated with command
 				 * procedure. */
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Argument strings. */
+    int argc,			/* Number of arguments. */
+    char **argv)		/* Argument strings. */
 {
     Tcl_DString *bufPtr = (Tcl_DString *) clientData;
     int i;
@@ -1262,49 +1324,49 @@ CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
 }
 
 static void
-CmdTraceDeleteProc(clientData, interp, level, command, cmdProc,
-	cmdClientData, argc, argv)
-    ClientData clientData;	/* Unused. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int level;			/* Current trace level. */
-    char *command;		/* The command being traced (after
+CmdTraceDeleteProc(
+    ClientData clientData,	/* Unused. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int level,			/* Current trace level. */
+    char *command,		/* The command being traced (after
 				 * substitutions). */
-    Tcl_CmdProc *cmdProc;	/* Points to command's command procedure. */
-    ClientData cmdClientData;	/* Client data associated with command
+    Tcl_CmdProc *cmdProc,	/* Points to command's command procedure. */
+    ClientData cmdClientData,	/* Client data associated with command
 				 * procedure. */
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Argument strings. */
+    int argc,			/* Number of arguments. */
+    char **argv)		/* Argument strings. */
 {
     /*
-     * Remove ourselves to test whether calling Tcl_DeleteTrace within
-     * a trace callback causes the for loop in TclExecuteByteCode that
-     * calls traces to reference freed memory.
+     * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
+     * callback causes the for loop in TclExecuteByteCode that calls traces to
+     * reference freed memory.
      */
-    
+
     Tcl_DeleteTrace(interp, cmdTrace);
 }
 
 static int
-ObjTraceProc( clientData, interp, level, command, token, objc, objv )
-    ClientData clientData;	/* unused */
-    Tcl_Interp* interp;		/* Tcl interpreter */
-    int level;			/* Execution level */
-    CONST char* command;	/* Command being executed */
-    Tcl_Command token;		/* Command information */
-    int objc;			/* Parameter count */
-    Tcl_Obj *CONST objv[];	/* Parameter list */
-{
-    CONST char* word = Tcl_GetString( objv[ 0 ] );
-    if ( !strcmp( word, "Error" ) ) {
-	Tcl_SetObjResult( interp, Tcl_NewStringObj( command, -1 ) );
+ObjTraceProc(
+    ClientData clientData,	/* unused */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int level,			/* Execution level */
+    const char *command,	/* Command being executed */
+    Tcl_Command token,		/* Command information */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const objv[])	/* Parameter list */
+{
+    const char *word = Tcl_GetString(objv[0]);
+
+    if (!strcmp(word, "Error")) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
 	return TCL_ERROR;
-    } else if ( !strcmp( word, "Break" ) ) {
+    } else if (!strcmp(word, "Break")) {
 	return TCL_BREAK;
-    } else if ( !strcmp( word, "Continue" ) ) {
+    } else if (!strcmp(word, "Continue")) {
 	return TCL_CONTINUE;
-    } else if ( !strcmp( word, "Return" ) ) {
+    } else if (!strcmp(word, "Return")) {
 	return TCL_RETURN;
-    } else if ( !strcmp( word, "OtherStatus" ) ) {
+    } else if (!strcmp(word, "OtherStatus")) {
 	return 6;
     } else {
 	return TCL_OK;
@@ -1312,10 +1374,10 @@ ObjTraceProc( clientData, interp, level, command, token, objc, objv )
 }
 
 static void
-ObjTraceDeleteProc( clientData )
-    ClientData clientData;
+ObjTraceDeleteProc(
+    ClientData clientData)
 {
-    int * intPtr = (int *) clientData;
+    int *intPtr = (int *) clientData;
     *intPtr = 1;		/* Record that the trace was deleted */
 }
 
@@ -1324,11 +1386,11 @@ ObjTraceDeleteProc( clientData )
  *
  * TestcreatecommandCmd --
  *
- *	This procedure implements the "testcreatecommand" command. It is
- *	used to test that the Tcl_CreateCommand creates a new command in
- *	the namespace specified as part of its name, if any. It also
- *	checks that the namespace code ignore single ":"s in the middle
- *	or end of a command name.
+ *	This procedure implements the "testcreatecommand" command. It is used
+ *	to test that the Tcl_CreateCommand creates a new command in the
+ *	namespace specified as part of its name, if any. It also checks that
+ *	the namespace code ignore single ":"s in the middle or end of a
+ *	command name.
  *
  * Results:
  *	A standard Tcl result.
@@ -1341,44 +1403,41 @@ ObjTraceDeleteProc( clientData )
  */
 
 static int
-TestcreatecommandCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestcreatecommandCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     if (argc != 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option\"", (char *) NULL);
+		" option\"", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
 	Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
-		CreatedCommandProc, (ClientData) NULL,
-		(Tcl_CmdDeleteProc *) NULL);
+		CreatedCommandProc, (ClientData) NULL, NULL);
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
     } else if (strcmp(argv[1], "create2") == 0) {
 	Tcl_CreateCommand(interp, "value:at:",
-		CreatedCommandProc2, (ClientData) NULL,
-		(Tcl_CmdDeleteProc *) NULL);
+		CreatedCommandProc2, (ClientData) NULL, NULL);
     } else if (strcmp(argv[1], "delete2") == 0) {
 	Tcl_DeleteCommand(interp, "value:at:");
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, create2, or delete2",
-		(char *) NULL);
+		"\": must be create, delete, create2, or delete2", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static int
-CreatedCommandProc(clientData, interp, argc, argv)
-    ClientData clientData;		/* String to return. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+CreatedCommandProc(
+    ClientData clientData,	/* String to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_CmdInfo info;
     int found;
@@ -1387,20 +1446,20 @@ CreatedCommandProc(clientData, interp, argc, argv)
 	    &info);
     if (!found) {
 	Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
-	        (char *) NULL);
+		NULL);
 	return TCL_ERROR;
     }
     Tcl_AppendResult(interp, "CreatedCommandProc in ",
-	    info.namespacePtr->fullName, (char *) NULL);
+	    info.namespacePtr->fullName, NULL);
     return TCL_OK;
 }
 
 static int
-CreatedCommandProc2(clientData, interp, argc, argv)
-    ClientData clientData;		/* String to return. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+CreatedCommandProc2(
+    ClientData clientData,	/* String to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_CmdInfo info;
     int found;
@@ -1408,11 +1467,11 @@ CreatedCommandProc2(clientData, interp, argc, argv)
     found = Tcl_GetCommandInfo(interp, "value:at:", &info);
     if (!found) {
 	Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
-	        (char *) NULL);
+		NULL);
 	return TCL_ERROR;
     }
     Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
-	    info.namespacePtr->fullName, (char *) NULL);
+	    info.namespacePtr->fullName, NULL);
     return TCL_OK;
 }
 
@@ -1435,11 +1494,11 @@ CreatedCommandProc2(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestdcallCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestdcallCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     int i, id;
 
@@ -1451,10 +1510,10 @@ TestdcallCmd(dummy, interp, argc, argv)
 	}
 	if (id < 0) {
 	    Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
-		    (ClientData) (-id));
+		    (ClientData) INT2PTR(-id));
 	} else {
 	    Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
-		    (ClientData) id);
+		    (ClientData) INT2PTR(id));
 	}
     }
     Tcl_DeleteInterp(delInterp);
@@ -1467,12 +1526,11 @@ TestdcallCmd(dummy, interp, argc, argv)
  */
 
 static void
-DelCallbackProc(clientData, interp)
-    ClientData clientData;		/* Numerical value to append to
-					 * delString. */
-    Tcl_Interp *interp;			/* Interpreter being deleted. */
+DelCallbackProc(
+    ClientData clientData,	/* Numerical value to append to delString. */
+    Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
-    int id = (int) clientData;
+    int id = PTR2INT(clientData);
     char buffer[TCL_INTEGER_SPACE];
 
     TclFormatInt(buffer, id);
@@ -1501,11 +1559,11 @@ DelCallbackProc(clientData, interp)
 
 	/* ARGSUSED */
 static int
-TestdelCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestdelCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     DelCmd *dPtr;
     Tcl_Interp *slave;
@@ -1531,23 +1589,23 @@ TestdelCmd(dummy, interp, argc, argv)
 }
 
 static int
-DelCmdProc(clientData, interp, argc, argv)
-    ClientData clientData;		/* String result to return. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+DelCmdProc(
+    ClientData clientData,	/* String result to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     DelCmd *dPtr = (DelCmd *) clientData;
 
-    Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL);
+    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
     ckfree(dPtr->deleteCmd);
     ckfree((char *) dPtr);
     return TCL_OK;
 }
 
 static void
-DelDeleteProc(clientData)
-    ClientData clientData;		/* String command to evaluate. */
+DelDeleteProc(
+    ClientData clientData)	/* String command to evaluate. */
 {
     DelCmd *dPtr = (DelCmd *) clientData;
 
@@ -1576,22 +1634,118 @@ DelDeleteProc(clientData)
  */
 
 static int
-TestdelassocdataCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestdelassocdataCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     if (argc != 2) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " data_key\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" data_key\"", NULL);
+	return TCL_ERROR;
     }
     Tcl_DeleteAssocData(interp, argv[1]);
     return TCL_OK;
 }
 
 /*
+ *-----------------------------------------------------------------------------
+ *
+ * TestdoubledigitsCmd --
+ *
+ *	This procedure implements the 'testdoubledigits' command. It is
+ *	used to test the low-level floating-point formatting primitives
+ *	in Tcl.
+ *
+ * Usage:
+ *	testdoubledigits fpval ndigits type ?shorten"
+ *
+ * Parameters:
+ *	fpval - Floating-point value to format.
+ *	ndigits - Digit count to request from Tcl_DoubleDigits
+ *	type - One of 'shortest', 'Steele', 'e', 'f'
+ *	shorten - Indicates that the 'shorten' flag should be passed in.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestdoubledigitsObjCmd(ClientData unused,
+				/* NULL */
+		       Tcl_Interp* interp,
+				/* Tcl interpreter */
+		       int objc,
+				/* Parameter count */
+		       Tcl_Obj* const objv[])
+				/* Parameter vector */
+{
+    static const char* options[] = {
+	"shortest",
+	"Steele",
+	"e",
+	"f",
+	NULL
+    };
+    static const int types[] = {
+	TCL_DD_SHORTEST,
+	TCL_DD_STEELE,
+	TCL_DD_E_FORMAT,
+	TCL_DD_F_FORMAT
+    };
+
+    const Tcl_ObjType* doubleType;
+    double d;
+    int status;
+    int ndigits;
+    int type;
+    int decpt;
+    int signum;
+    char* str;
+    char* endPtr;
+    Tcl_Obj* strObj;
+    Tcl_Obj* retval;
+
+    if (objc < 4 || objc > 5) {
+	Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
+	return TCL_ERROR;
+    }
+    status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
+    if (status != TCL_OK) {
+	doubleType = Tcl_GetObjType("double");
+	if (objv[1]->typePtr == doubleType
+	    || TclIsNaN(objv[1]->internalRep.doubleValue)) {
+	    status = TCL_OK;
+	    memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
+	}
+    }
+    if (status != TCL_OK
+	|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
+	|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
+			       TCL_EXACT, &type) != TCL_OK) {
+	fprintf(stderr, "bad value? %g\n", d);
+	return TCL_ERROR;
+    }
+    type = types[type];
+    if (objc > 4) {
+	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
+	    return TCL_ERROR;
+	}
+	type |= TCL_DD_SHORTEN_FLAG;
+    }
+    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
+    strObj = Tcl_NewStringObj(str, endPtr-str);
+    ckfree(str);
+    retval = Tcl_NewListObj(1, &strObj);
+    Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
+    strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
+    Tcl_ListObjAppendElement(NULL, retval, strObj);
+    Tcl_SetObjResult(interp, retval);
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TestdstringCmd --
@@ -1610,11 +1764,11 @@ TestdelassocdataCmd(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestdstringCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestdstringCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     int count;
 
@@ -1670,13 +1824,13 @@ TestdstringCmd(dummy, interp, argc, argv)
 	} else {
 	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
 		    "\": must be staticsmall, staticlarge, free, or special",
-		    (char *) NULL);
+		    NULL);
 	    return TCL_ERROR;
 	}
 	Tcl_DStringGetResult(interp, &dstring);
     } else if (strcmp(argv[1], "length") == 0) {
 	char buf[TCL_INTEGER_SPACE];
-	
+
 	if (argc != 2) {
 	    goto wrongNumArgs;
 	}
@@ -1702,8 +1856,8 @@ TestdstringCmd(dummy, interp, argc, argv)
 	Tcl_DStringStartSublist(&dstring);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be append, element, end, free, get, length, ",
-		"result, trunc, or start", (char *) NULL);
+		"\": must be append, element, end, free, get, length, "
+		"result, trunc, or start", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1739,92 +1893,82 @@ static void SpecialFree(blockPtr)
 
 	/* ARGSUSED */
 static int
-TestencodingObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestencodingObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Encoding encoding;
     int index, length;
     char *string;
     TclEncoding *encodingPtr;
-    static CONST char *optionStrings[] = {
-	"create",	"delete",	"path",
-	NULL
+    static const char *optionStrings[] = {
+	"create",	"delete",	NULL
     };
     enum options {
-	ENC_CREATE,	ENC_DELETE,	ENC_PATH
+	ENC_CREATE,	ENC_DELETE
     };
-    
+
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 	    &index) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     switch ((enum options) index) {
-	case ENC_CREATE: {
-	    Tcl_EncodingType type;
+    case ENC_CREATE: {
+	Tcl_EncodingType type;
 
-	    if (objc != 5) {
-		return TCL_ERROR;
-	    }
-	    encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
-	    encodingPtr->interp = interp;
+	if (objc != 5) {
+	    return TCL_ERROR;
+	}
+	encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
+	encodingPtr->interp = interp;
 
-	    string = Tcl_GetStringFromObj(objv[3], &length);
-	    encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
-	    memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
+	string = Tcl_GetStringFromObj(objv[3], &length);
+	encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+	memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
 
-	    string = Tcl_GetStringFromObj(objv[4], &length);
-	    encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
-	    memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
+	string = Tcl_GetStringFromObj(objv[4], &length);
+	encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+	memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
 
-	    string = Tcl_GetStringFromObj(objv[2], &length);
+	string = Tcl_GetStringFromObj(objv[2], &length);
 
-	    type.encodingName = string;
-	    type.toUtfProc = EncodingToUtfProc;
-	    type.fromUtfProc = EncodingFromUtfProc;
-	    type.freeProc = EncodingFreeProc;
-	    type.clientData = (ClientData) encodingPtr;
-	    type.nullSize = 1;
+	type.encodingName = string;
+	type.toUtfProc = EncodingToUtfProc;
+	type.fromUtfProc = EncodingFromUtfProc;
+	type.freeProc = EncodingFreeProc;
+	type.clientData = (ClientData) encodingPtr;
+	type.nullSize = 1;
 
-	    Tcl_CreateEncoding(&type);
-	    break;
-	}
-	case ENC_DELETE: {
-	    if (objc != 3) {
-		return TCL_ERROR;
-	    }
-	    encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
-	    Tcl_FreeEncoding(encoding);
-	    Tcl_FreeEncoding(encoding);
-	    break;
-	}
-	case ENC_PATH: {
-	    if (objc == 2) {
-		Tcl_SetObjResult(interp, TclGetLibraryPath());
-	    } else {
-		TclSetLibraryPath(objv[2]);
-	    }
-	    break;
+	Tcl_CreateEncoding(&type);
+	break;
+    }
+    case ENC_DELETE:
+	if (objc != 3) {
+	    return TCL_ERROR;
 	}
+	encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
+	Tcl_FreeEncoding(encoding);
+	Tcl_FreeEncoding(encoding);
+	break;
     }
     return TCL_OK;
 }
-static int 
-EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* TclEncoding structure. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Current state. */
-    char *dst;			/* Output buffer. */
-    int dstLen;			/* The maximum length of output buffer. */
-    int *srcReadPtr;		/* Filled with number of bytes read. */
-    int *dstWrotePtr;		/* Filled with number of bytes stored. */
-    int *dstCharsPtr;		/* Filled with number of chars stored. */
+
+static int
+EncodingToUtfProc(
+    ClientData clientData,	/* TclEncoding structure. */
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Current state. */
+    char *dst,			/* Output buffer. */
+    int dstLen,			/* The maximum length of output buffer. */
+    int *srcReadPtr,		/* Filled with number of bytes read. */
+    int *dstWrotePtr,		/* Filled with number of bytes stored. */
+    int *dstCharsPtr)		/* Filled with number of chars stored. */
 {
     int len;
     TclEncoding *encodingPtr;
@@ -1844,19 +1988,19 @@ EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     *dstCharsPtr = len;
     return TCL_OK;
 }
-static int 
-EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	srcReadPtr, dstWrotePtr, dstCharsPtr)
-    ClientData clientData;	/* TclEncoding structure. */
-    CONST char *src;		/* Source string in specified encoding. */
-    int srcLen;			/* Source string length in bytes. */
-    int flags;			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr;/* Current state. */
-    char *dst;			/* Output buffer. */
-    int dstLen;			/* The maximum length of output buffer. */
-    int *srcReadPtr;		/* Filled with number of bytes read. */
-    int *dstWrotePtr;		/* Filled with number of bytes stored. */
-    int *dstCharsPtr;		/* Filled with number of chars stored. */
+
+static int
+EncodingFromUtfProc(
+    ClientData clientData,	/* TclEncoding structure. */
+    const char *src,		/* Source string in specified encoding. */
+    int srcLen,			/* Source string length in bytes. */
+    int flags,			/* Conversion control flags. */
+    Tcl_EncodingState *statePtr,/* Current state. */
+    char *dst,			/* Output buffer. */
+    int dstLen,			/* The maximum length of output buffer. */
+    int *srcReadPtr,		/* Filled with number of bytes read. */
+    int *dstWrotePtr,		/* Filled with number of bytes stored. */
+    int *dstCharsPtr)		/* Filled with number of chars stored. */
 {
     int len;
     TclEncoding *encodingPtr;
@@ -1876,9 +2020,10 @@ EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
     *dstCharsPtr = len;
     return TCL_OK;
 }
+
 static void
-EncodingFreeProc(clientData)
-    ClientData clientData;	/* ClientData associated with type. */
+EncodingFreeProc(
+    ClientData clientData)	/* ClientData associated with type. */
 {
     TclEncoding *encodingPtr;
 
@@ -1906,60 +2051,31 @@ EncodingFreeProc(clientData)
  */
 
 static int
-TestevalexObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+TestevalexObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    int code, oldFlags, length, flags;
-    char *string;
-
-    if (objc == 1) {
-	/*
-	 * The command was invoked with no arguments, so just toggle
-	 * the flag that determines whether we use Tcl_EvalEx.
-	 */
-
-	if (iPtr->flags & USE_EVAL_DIRECT) {
-	    iPtr->flags &= ~USE_EVAL_DIRECT;
-	    Tcl_SetResult(interp, "disabling direct evaluation", TCL_STATIC);
-	} else {
-	    iPtr->flags |= USE_EVAL_DIRECT;
-	    Tcl_SetResult(interp, "enabling direct evaluation", TCL_STATIC);
-	}
-	return TCL_OK;
-    }
+    int length, flags;
+    char *script;
 
     flags = 0;
     if (objc == 3) {
-	string = Tcl_GetStringFromObj(objv[2], &length);
-	if (strcmp(string, "global") != 0) {
-	    Tcl_AppendResult(interp, "bad value \"", string,
-		    "\": must be global", (char *) NULL);
+	char *global = Tcl_GetStringFromObj(objv[2], &length);
+	if (strcmp(global, "global") != 0) {
+	    Tcl_AppendResult(interp, "bad value \"", global,
+		    "\": must be global", NULL);
 	    return TCL_ERROR;
 	}
 	flags = TCL_EVAL_GLOBAL;
     } else if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, "xxx", TCL_STATIC);
 
-    /*
-     * Note, we have to set the USE_EVAL_DIRECT flag in the interpreter
-     * in addition to calling Tcl_EvalEx.  This is needed so that even nested
-     * commands are evaluated directly.
-     */
-
-    oldFlags = iPtr->flags;
-    iPtr->flags |= USE_EVAL_DIRECT;
-    string = Tcl_GetStringFromObj(objv[1], &length);
-    code = Tcl_EvalEx(interp, string, length, flags); 
-    iPtr->flags = (iPtr->flags & ~USE_EVAL_DIRECT)
-	    | (oldFlags & USE_EVAL_DIRECT);
-    return code;
+    script = Tcl_GetStringFromObj(objv[1], &length);
+    return Tcl_EvalEx(interp, script, length, flags);
 }
 
 /*
@@ -1980,17 +2096,17 @@ TestevalexObjCmd(dummy, interp, objc, objv)
  */
 
 static int
-TestevalobjvObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+TestevalobjvObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int evalGlobal;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) {
 	return TCL_ERROR;
@@ -2029,74 +2145,67 @@ TestevalobjvObjCmd(dummy, interp, objc, objv)
  */
 
 static int
-TesteventObjCmd( ClientData unused,      /* Not used */
-		 Tcl_Interp* interp,     /* Tcl interpreter */
-		 int objc,               /* Parameter count */
-		 Tcl_Obj *CONST objv[] ) /* Parameter vector */
-{
-    
-    static CONST char* subcommands[] = { /* Possible subcommands */
-	"queue",
-	"delete",
-	NULL
+TesteventObjCmd(
+    ClientData unused,		/* Not used */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const objv[])	/* Parameter vector */
+{
+    static const char *subcommands[] = { /* Possible subcommands */
+	"queue", "delete", NULL
     };
     int subCmdIndex;		/* Index of the chosen subcommand */
-    static CONST char* positions[] = { /* Possible queue positions */
-	"head",
-	"tail",
-	"mark",
-	NULL
+    static const char *positions[] = { /* Possible queue positions */
+	"head", "tail", "mark", NULL
     };
     int posIndex;		/* Index of the chosen position */
-    static CONST Tcl_QueuePosition posNum[] = { 
-	    			/* Interpretation of the chosen position */
+    static const Tcl_QueuePosition posNum[] = {
+				/* Interpretation of the chosen position */
 	TCL_QUEUE_HEAD,
 	TCL_QUEUE_TAIL,
 	TCL_QUEUE_MARK
     };
-    TestEvent* ev;		/* Event to be queued */
+    TestEvent *ev;		/* Event to be queued */
 
-    if ( objc < 2 ) {
-	Tcl_WrongNumArgs( interp, 1, objv, "subcommand ?args?" );
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
 	return TCL_ERROR;
     }
-    if ( Tcl_GetIndexFromObj( interp, objv[1], subcommands, "subcommand",
-			      TCL_EXACT, &subCmdIndex ) != TCL_OK ) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
+	    TCL_EXACT, &subCmdIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
-    switch ( subCmdIndex ) {
+    switch (subCmdIndex) {
     case 0:			/* queue */
-	if ( objc != 5 ) {
-	    Tcl_WrongNumArgs( interp, 2, objv, "name position script" );
+	if (objc != 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name position script");
 	    return TCL_ERROR;
 	}
-	if ( Tcl_GetIndexFromObj( interp, objv[3], positions,
-				  "position specifier", TCL_EXACT,
-				  &posIndex ) != TCL_OK ) {
+	if (Tcl_GetIndexFromObj(interp, objv[3], positions,
+		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	ev = (TestEvent*) ckalloc( sizeof( TestEvent ) );
+	ev = (TestEvent *) ckalloc(sizeof(TestEvent));
 	ev->header.proc = TesteventProc;
 	ev->header.nextPtr = NULL;
 	ev->interp = interp;
-	ev->command = objv[ 4 ];
-	Tcl_IncrRefCount( ev->command );
-	ev->tag = objv[ 2 ];
-	Tcl_IncrRefCount( ev->tag );
-	Tcl_QueueEvent( (Tcl_Event*) ev, posNum[ posIndex ] );
+	ev->command = objv[4];
+	Tcl_IncrRefCount(ev->command);
+	ev->tag = objv[2];
+	Tcl_IncrRefCount(ev->tag);
+	Tcl_QueueEvent((Tcl_Event *) ev, posNum[posIndex]);
 	break;
 
     case 1:			/* delete */
-	if ( objc != 3 ) {
-	    Tcl_WrongNumArgs( interp, 2, objv, "name" );
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name");
 	    return TCL_ERROR;
 	}
-	Tcl_DeleteEvents( TesteventDeleteProc, objv[ 2 ] );
+	Tcl_DeleteEvents(TesteventDeleteProc, objv[2]);
 	break;
     }
 
     return TCL_OK;
-
 }
 
 /*
@@ -2106,49 +2215,49 @@ TesteventObjCmd( ClientData unused,      /* Not used */
  *
  *	Delivers a test event to the Tcl interpreter as part of event
  *	queue testing.
- * 
+ *
  * Results:
  *	Returns 1 if the event has been serviced, 0 otherwise.
  *
  * Side effects:
- *	Evaluates the event's callback script, so has whatever
- *	side effects the callback has.  The return value of the
- *	callback script becomes the return value of this function.
- *	If the callback script reports an error, it is reported as
- *	a background error.
+ *	Evaluates the event's callback script, so has whatever side effects
+ *	the callback has.  The return value of the callback script becomes the
+ *	return value of this function.  If the callback script reports an
+ *	error, it is reported as a background error.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TesteventProc( Tcl_Event* event, /* Event to deliver */
-	       int flags )	/* Current flags for Tcl_ServiceEvent */
-{
-    TestEvent * ev = (TestEvent *) event;
-    Tcl_Interp* interp = ev->interp;
-    Tcl_Obj* command = ev->command;
-    int result = Tcl_EvalObjEx( interp, command,
-				TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT );
+TesteventProc(
+    Tcl_Event *event,		/* Event to deliver */
+    int flags)			/* Current flags for Tcl_ServiceEvent */
+{
+    TestEvent *ev = (TestEvent *) event;
+    Tcl_Interp *interp = ev->interp;
+    Tcl_Obj *command = ev->command;
+    int result = Tcl_EvalObjEx(interp, command,
+	    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
     int retval;
-    if ( result != TCL_OK ) {
-	Tcl_AddErrorInfo( interp,
-			  "    (command bound to \"testevent\" callback)" );
-	Tcl_BackgroundError( interp );
+
+    if (result != TCL_OK) {
+	Tcl_AddErrorInfo(interp,
+		"    (command bound to \"testevent\" callback)");
+	Tcl_BackgroundError(interp);
 	return 1;		/* Avoid looping on errors */
     }
-    if ( Tcl_GetBooleanFromObj( interp,
-				Tcl_GetObjResult( interp ),
-				&retval ) != TCL_OK ) {
-	Tcl_AddErrorInfo( interp, 
-			  "    (return value from \"testevent\" callback)" );
-	Tcl_BackgroundError( interp );
+    if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+	    &retval) != TCL_OK) {
+	Tcl_AddErrorInfo(interp,
+		"    (return value from \"testevent\" callback)");
+	Tcl_BackgroundError(interp);
 	return 1;
     }
-    if ( retval ) {
-	Tcl_DecrRefCount( ev->tag );
-	Tcl_DecrRefCount( ev->command );
+    if (retval) {
+	Tcl_DecrRefCount(ev->tag);
+	Tcl_DecrRefCount(ev->command);
     }
-	
+
     return retval;
 }
 
@@ -2171,25 +2280,26 @@ TesteventProc( Tcl_Event* event, /* Event to deliver */
  */
 
 static int
-TesteventDeleteProc( Tcl_Event* event, /* Event to examine */
-		     ClientData clientData ) /* Tcl_Obj containing the name
-					      * of the event(s) to remove */
+TesteventDeleteProc(
+    Tcl_Event *event,		/* Event to examine */
+    ClientData clientData)	/* Tcl_Obj containing the name of the event(s)
+				 * to remove */
 {
-    TestEvent* ev;		/* Event to examine */
-    char* evNameStr;
-    Tcl_Obj* targetName;	/* Name of the event(s) to delete */
-    char* targetNameStr;
+    TestEvent *ev;		/* Event to examine */
+    char *evNameStr;
+    Tcl_Obj *targetName;	/* Name of the event(s) to delete */
+    char *targetNameStr;
 
-    if ( event->proc != TesteventProc ) {
+    if (event->proc != TesteventProc) {
 	return 0;
     }
-    targetName = (Tcl_Obj*) clientData;
-    targetNameStr = (char*) Tcl_GetStringFromObj( targetName, NULL );
-    ev = (TestEvent*) event;
-    evNameStr = Tcl_GetStringFromObj( ev->tag, NULL );
-    if ( strcmp( evNameStr, targetNameStr ) == 0 ) {
-	Tcl_DecrRefCount( ev->tag );
-	Tcl_DecrRefCount( ev->command );
+    targetName = (Tcl_Obj *) clientData;
+    targetNameStr = (char *) Tcl_GetStringFromObj(targetName, NULL);
+    ev = (TestEvent *) event;
+    evNameStr = Tcl_GetStringFromObj(ev->tag, NULL);
+    if (strcmp(evNameStr, targetNameStr) == 0) {
+	Tcl_DecrRefCount(ev->tag);
+	Tcl_DecrRefCount(ev->command);
 	return 1;
     } else {
 	return 0;
@@ -2214,54 +2324,62 @@ TesteventDeleteProc( Tcl_Event* event, /* Event to examine */
  */
 
 static int
-TestexithandlerCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestexithandlerCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     int value;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " create|delete value\"", (char *) NULL);
-        return TCL_ERROR;
+		" create|delete value\"", NULL);
+	return TCL_ERROR;
     }
     if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
 	Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
-		(ClientData) value);
+		(ClientData) INT2PTR(value));
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
-		(ClientData) value);
+		(ClientData) INT2PTR(value));
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create or delete", (char *) NULL);
+		"\": must be create or delete", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static void
-ExitProcOdd(clientData)
-    ClientData clientData;		/* Integer value to print. */
+ExitProcOdd(
+    ClientData clientData)	/* Integer value to print. */
 {
     char buf[16 + TCL_INTEGER_SPACE];
+    size_t len;
 
-    sprintf(buf, "odd %d\n", (int) clientData);
-    write(1, buf, strlen(buf));
+    sprintf(buf, "odd %d\n", PTR2INT(clientData));
+    len = strlen(buf);
+    if (len != (size_t) write(1, buf, len)) {
+	Tcl_Panic("ExitProcOdd: unable to write to stdout");
+    }
 }
 
 static void
-ExitProcEven(clientData)
-    ClientData clientData;		/* Integer value to print. */
+ExitProcEven(
+    ClientData clientData)	/* Integer value to print. */
 {
     char buf[16 + TCL_INTEGER_SPACE];
+    size_t len;
 
-    sprintf(buf, "even %d\n", (int) clientData);
-    write(1, buf, strlen(buf));
+    sprintf(buf, "even %d\n", PTR2INT(clientData));
+    len = strlen(buf);
+    if (len != (size_t) write(1, buf, len)) {
+	Tcl_Panic("ExitProcEven: unable to write to stdout");
+    }
 }
 
 /*
@@ -2282,20 +2400,25 @@ ExitProcEven(clientData)
  */
 
 static int
-TestexprlongCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestexprlongCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     long exprResult;
     char buf[4 + TCL_INTEGER_SPACE];
     int result;
-    
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" expression\"", NULL);
+	return TCL_ERROR;
+    }
     Tcl_SetResult(interp, "This is a result", TCL_STATIC);
-    result = Tcl_ExprLong(interp, "4+1", &exprResult);
+    result = Tcl_ExprLong(interp, argv[1], &exprResult);
     if (result != TCL_OK) {
-        return result;
+	return result;
     }
     sprintf(buf, ": %ld", exprResult);
     Tcl_AppendResult(interp, buf, NULL);
@@ -2320,11 +2443,11 @@ TestexprlongCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestexprlongobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST *objv;		/* Argument objects. */
+TestexprlongobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Argument objects. */
 {
     long exprResult;
     char buf[4 + TCL_INTEGER_SPACE];
@@ -2337,7 +2460,7 @@ TestexprlongobjCmd(clientData, interp, objc, objv)
     Tcl_SetResult(interp, "This is a result", TCL_STATIC);
     result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
     if (result != TCL_OK) {
-        return result;
+	return result;
     }
     sprintf(buf, ": %ld", exprResult);
     Tcl_AppendResult(interp, buf, NULL);
@@ -2347,6 +2470,93 @@ TestexprlongobjCmd(clientData, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * TestexprdoubleCmd --
+ *
+ *	This procedure verifies that Tcl_ExprDouble does not modify the
+ *	interpreter result if there is no error.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprdoubleCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    double exprResult;
+    char buf[4 + TCL_DOUBLE_SPACE];
+    int result;
+
+    if (argc != 2) {
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" expression\"", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    result = Tcl_ExprDouble(interp, argv[1], &exprResult);
+    if (result != TCL_OK) {
+	return result;
+    }
+    strcpy(buf, ": ");
+    Tcl_PrintDouble(interp, exprResult, buf+2);
+    Tcl_AppendResult(interp, buf, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprdoubleobjCmd --
+ *
+ *	This procedure verifies that Tcl_ExprLongObj does not modify the
+ *	interpreter result if there is no error.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprdoubleobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Argument objects. */
+{
+    double exprResult;
+    char buf[4 + TCL_DOUBLE_SPACE];
+    int result;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "expression");
+	return TCL_ERROR;
+    }
+    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
+    if (result != TCL_OK) {
+	return result;
+    }
+    strcpy(buf, ": ");
+    Tcl_PrintDouble(interp, exprResult, buf+2);
+    Tcl_AppendResult(interp, buf, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestexprstringCmd --
  *
  *	This procedure tests the basic operation of Tcl_ExprString.
@@ -2361,16 +2571,16 @@ TestexprlongobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestexprstringCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestexprstringCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     if (argc != 2) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " expression\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" expression\"", NULL);
+	return TCL_ERROR;
     }
     return Tcl_ExprString(interp, argv[1]);
 }
@@ -2380,9 +2590,8 @@ TestexprstringCmd(clientData, interp, argc, argv)
  *
  * TestfilelinkCmd --
  *
- *	This procedure implements the "testfilelink" command.  It is used
- *	to test the effects of creating and manipulating filesystem links
- *	in Tcl.
+ *	This procedure implements the "testfilelink" command.  It is used to
+ *	test the effects of creating and manipulating filesystem links in Tcl.
  *
  * Results:
  *	A standard Tcl result.
@@ -2394,11 +2603,11 @@ TestexprstringCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestfilelinkCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestfilelinkCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     Tcl_Obj *contents;
 
@@ -2406,35 +2615,35 @@ TestfilelinkCmd(clientData, interp, objc, objv)
 	Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
 	return TCL_ERROR;
     }
-    
+
     if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
 	return TCL_ERROR;
     }
-    
+
     if (objc == 3) {
 	/* Create link from source to target */
-	contents = Tcl_FSLink(objv[1], objv[2], 
-			TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK);
+	contents = Tcl_FSLink(objv[1], objv[2],
+		TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK);
 	if (contents == NULL) {
-	    Tcl_AppendResult(interp, "could not create link from \"", 
-		    Tcl_GetString(objv[1]), "\" to \"", 
-		    Tcl_GetString(objv[2]), "\": ", 
-		    Tcl_PosixError(interp), (char *) NULL);
+	    Tcl_AppendResult(interp, "could not create link from \"",
+		    Tcl_GetString(objv[1]), "\" to \"",
+		    Tcl_GetString(objv[2]), "\": ",
+		    Tcl_PosixError(interp), NULL);
 	    return TCL_ERROR;
 	}
     } else {
 	/* Read link */
 	contents = Tcl_FSLink(objv[1], NULL, 0);
 	if (contents == NULL) {
-	    Tcl_AppendResult(interp, "could not read link \"", 
-		    Tcl_GetString(objv[1]), "\": ", 
-		    Tcl_PosixError(interp), (char *) NULL);
+	    Tcl_AppendResult(interp, "could not read link \"",
+		    Tcl_GetString(objv[1]), "\": ",
+		    Tcl_PosixError(interp), NULL);
 	    return TCL_ERROR;
 	}
     }
     Tcl_SetObjResult(interp, contents);
     if (objc == 2) {
-	/* 
+	/*
 	 * If we are creating a link, this will actually just
 	 * be objv[3], and we don't own it
 	 */
@@ -2461,22 +2670,22 @@ TestfilelinkCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestgetassocdataCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestgetassocdataCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     char *res;
-    
+
     if (argc != 2) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " data_key\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" data_key\"", NULL);
+	return TCL_ERROR;
     }
     res = (char *) Tcl_GetAssocData(interp, argv[1], NULL);
     if (res != NULL) {
-        Tcl_AppendResult(interp, res, NULL);
+	Tcl_AppendResult(interp, res, NULL);
     }
     return TCL_OK;
 }
@@ -2499,25 +2708,21 @@ TestgetassocdataCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestgetplatformCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestgetplatformCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
-    static CONST char *platformStrings[] = { "unix", "mac", "windows" };
+    static const char *platformStrings[] = { "unix", "mac", "windows" };
     TclPlatformType *platform;
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
-    platform = TclWinGetPlatform();
-#else
-    platform = &tclPlatform;
-#endif
-    
+    platform = TclGetPlatform();
+
     if (argc != 1) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		(char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		NULL);
+	return TCL_ERROR;
     }
 
     Tcl_AppendResult(interp, platformStrings[*platform], NULL);
@@ -2544,22 +2749,22 @@ TestgetplatformCmd(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestinterpdeleteCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestinterpdeleteCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_Interp *slaveToDelete;
 
     if (argc != 2) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " path\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" path\"", NULL);
+	return TCL_ERROR;
     }
     slaveToDelete = Tcl_GetSlave(interp, argv[1]);
-    if (slaveToDelete == (Tcl_Interp *) NULL) {
-        return TCL_ERROR;
+    if (slaveToDelete == NULL) {
+	return TCL_ERROR;
     }
     Tcl_DeleteInterp(slaveToDelete);
     return TCL_OK;
@@ -2585,17 +2790,26 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestlinkCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestlinkCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     static int intVar = 43;
     static int boolVar = 4;
     static double realVar = 1.23;
     static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
     static char *stringVar = NULL;
+    static char charVar = '@';
+    static unsigned char ucharVar = 130;
+    static short shortVar = 3000;
+    static unsigned short ushortVar = 60000;
+    static unsigned int uintVar = 0xbeeffeed;
+    static long longVar = 123456789L;
+    static unsigned long ulongVar = 3456789012UL;
+    static float floatVar = 4.5;
+    static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
     static int created = 0;
     char buffer[2*TCL_DOUBLE_SPACE];
     int writable, flag;
@@ -2603,14 +2817,16 @@ TestlinkCmd(dummy, interp, argc, argv)
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg arg arg arg?\"", (char *) NULL);
+		" option ?arg arg arg arg arg arg arg arg arg arg arg arg"
+		" arg arg?\"", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
-	if (argc != 7) {
+	if (argc != 16) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		argv[0], " ", argv[1],
-		" intRO realRO boolRO stringRO wideRO\"", (char *) NULL);
+		" intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO"
+		" ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL);
 	    return TCL_ERROR;
 	}
 	if (created) {
@@ -2619,6 +2835,15 @@ TestlinkCmd(dummy, interp, argc, argv)
 	    Tcl_UnlinkVar(interp, "bool");
 	    Tcl_UnlinkVar(interp, "string");
 	    Tcl_UnlinkVar(interp, "wide");
+	    Tcl_UnlinkVar(interp, "char");
+	    Tcl_UnlinkVar(interp, "uchar");
+	    Tcl_UnlinkVar(interp, "short");
+	    Tcl_UnlinkVar(interp, "ushort");
+	    Tcl_UnlinkVar(interp, "uint");
+	    Tcl_UnlinkVar(interp, "long");
+	    Tcl_UnlinkVar(interp, "ulong");
+	    Tcl_UnlinkVar(interp, "float");
+	    Tcl_UnlinkVar(interp, "uwide");
 	}
 	created = 1;
 	if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
@@ -2661,17 +2886,99 @@ TestlinkCmd(dummy, interp, argc, argv)
 			TCL_LINK_WIDE_INT | flag) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "char", (char *) &charVar,
+		TCL_LINK_CHAR | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[8], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "uchar", (char *) &ucharVar,
+		TCL_LINK_UCHAR | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[9], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "short", (char *) &shortVar,
+		TCL_LINK_SHORT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[10], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "ushort", (char *) &ushortVar,
+		TCL_LINK_USHORT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[11], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "uint", (char *) &uintVar,
+		TCL_LINK_UINT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[12], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "long", (char *) &longVar,
+		TCL_LINK_LONG | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[13], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "ulong", (char *) &ulongVar,
+		TCL_LINK_ULONG | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[14], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "float", (char *) &floatVar,
+		TCL_LINK_FLOAT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBoolean(interp, argv[15], &writable) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+	if (Tcl_LinkVar(interp, "uwide", (char *) &uwideVar,
+		TCL_LINK_WIDE_UINT | flag) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_UnlinkVar(interp, "int");
 	Tcl_UnlinkVar(interp, "real");
 	Tcl_UnlinkVar(interp, "bool");
 	Tcl_UnlinkVar(interp, "string");
 	Tcl_UnlinkVar(interp, "wide");
+	Tcl_UnlinkVar(interp, "char");
+	Tcl_UnlinkVar(interp, "uchar");
+	Tcl_UnlinkVar(interp, "short");
+	Tcl_UnlinkVar(interp, "ushort");
+	Tcl_UnlinkVar(interp, "uint");
+	Tcl_UnlinkVar(interp, "long");
+	Tcl_UnlinkVar(interp, "ulong");
+	Tcl_UnlinkVar(interp, "float");
+	Tcl_UnlinkVar(interp, "uwide");
 	created = 0;
     } else if (strcmp(argv[1], "get") == 0) {
 	TclFormatInt(buffer, intVar);
 	Tcl_AppendElement(interp, buffer);
-	Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
+	Tcl_PrintDouble(NULL, realVar, buffer);
 	Tcl_AppendElement(interp, buffer);
 	TclFormatInt(buffer, boolVar);
 	Tcl_AppendElement(interp, buffer);
@@ -2682,12 +2989,36 @@ TestlinkCmd(dummy, interp, argc, argv)
 	tmp = Tcl_NewWideIntObj(wideVar);
 	Tcl_AppendElement(interp, Tcl_GetString(tmp));
 	Tcl_DecrRefCount(tmp);
+	TclFormatInt(buffer, (int) charVar);
+	Tcl_AppendElement(interp, buffer);
+	TclFormatInt(buffer, (int) ucharVar);
+	Tcl_AppendElement(interp, buffer);
+	TclFormatInt(buffer, (int) shortVar);
+	Tcl_AppendElement(interp, buffer);
+	TclFormatInt(buffer, (int) ushortVar);
+	Tcl_AppendElement(interp, buffer);
+	TclFormatInt(buffer, (int) uintVar);
+	Tcl_AppendElement(interp, buffer);
+	tmp = Tcl_NewLongObj(longVar);
+	Tcl_AppendElement(interp, Tcl_GetString(tmp));
+	Tcl_DecrRefCount(tmp);
+	tmp = Tcl_NewLongObj((long)ulongVar);
+	Tcl_AppendElement(interp, Tcl_GetString(tmp));
+	Tcl_DecrRefCount(tmp);
+	Tcl_PrintDouble(NULL, (double)floatVar, buffer);
+	Tcl_AppendElement(interp, buffer);
+	tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar);
+	Tcl_AppendElement(interp, Tcl_GetString(tmp));
+	Tcl_DecrRefCount(tmp);
     } else if (strcmp(argv[1], "set") == 0) {
-	if (argc != 7) {
+	int v;
+
+	if (argc != 16) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		    argv[0], " ", argv[1],
-		    " intValue realValue boolValue stringValue wideValue\"",
-		    (char *) NULL);
+		    " intValue realValue boolValue stringValue wideValue"
+		    " charValue ucharValue shortValue ushortValue uintValue"
+		    " longValue ulongValue floatValue uwideValue\"", NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -2724,12 +3055,74 @@ TestlinkCmd(dummy, interp, argc, argv)
 	    }
 	    Tcl_DecrRefCount(tmp);
 	}
+	if (argv[7][0]) {
+	    if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    charVar = (char) v;
+	}
+	if (argv[8][0]) {
+	    if (Tcl_GetInt(interp, argv[8], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ucharVar = (unsigned char) v;
+	}
+	if (argv[9][0]) {
+	    if (Tcl_GetInt(interp, argv[9], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    shortVar = (short) v;
+	}
+	if (argv[10][0]) {
+	    if (Tcl_GetInt(interp, argv[10], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ushortVar = (unsigned short) v;
+	}
+	if (argv[11][0]) {
+	    if (Tcl_GetInt(interp, argv[11], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    uintVar = (unsigned int) v;
+	}
+	if (argv[12][0]) {
+	    if (Tcl_GetInt(interp, argv[12], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    longVar = (long) v;
+	}
+	if (argv[13][0]) {
+	    if (Tcl_GetInt(interp, argv[13], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ulongVar = (unsigned long) v;
+	}
+	if (argv[14][0]) {
+	    double d;
+	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    floatVar = (float) d;
+	}
+	if (argv[15][0]) {
+	    Tcl_WideInt w;
+	    tmp = Tcl_NewStringObj(argv[15], -1);
+	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
+		Tcl_DecrRefCount(tmp);
+		return TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(tmp);
+	    uwideVar = (Tcl_WideUInt) w;
+	}
     } else if (strcmp(argv[1], "update") == 0) {
-	if (argc != 7) {
+	int v;
+
+	if (argc != 16) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		    argv[0], " ", argv[1],
-		    "intValue realValue boolValue stringValue wideValue\"",
-		    (char *) NULL);
+		    " intValue realValue boolValue stringValue wideValue"
+		    " charValue ucharValue shortValue ushortValue uintValue"
+		    " longValue ulongValue floatValue uwideValue\"", NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -2771,10 +3164,77 @@ TestlinkCmd(dummy, interp, argc, argv)
 	    Tcl_DecrRefCount(tmp);
 	    Tcl_UpdateLinkedVar(interp, "wide");
 	}
+	if (argv[7][0]) {
+	    if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    charVar = (char) v;
+	    Tcl_UpdateLinkedVar(interp, "char");
+	}
+	if (argv[8][0]) {
+	    if (Tcl_GetInt(interp, argv[8], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ucharVar = (unsigned char) v;
+	    Tcl_UpdateLinkedVar(interp, "uchar");
+	}
+	if (argv[9][0]) {
+	    if (Tcl_GetInt(interp, argv[9], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    shortVar = (short) v;
+	    Tcl_UpdateLinkedVar(interp, "short");
+	}
+	if (argv[10][0]) {
+	    if (Tcl_GetInt(interp, argv[10], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ushortVar = (unsigned short) v;
+	    Tcl_UpdateLinkedVar(interp, "ushort");
+	}
+	if (argv[11][0]) {
+	    if (Tcl_GetInt(interp, argv[11], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    uintVar = (unsigned int) v;
+	    Tcl_UpdateLinkedVar(interp, "uint");
+	}
+	if (argv[12][0]) {
+	    if (Tcl_GetInt(interp, argv[12], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    longVar = (long) v;
+	    Tcl_UpdateLinkedVar(interp, "long");
+	}
+	if (argv[13][0]) {
+	    if (Tcl_GetInt(interp, argv[13], &v) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    ulongVar = (unsigned long) v;
+	    Tcl_UpdateLinkedVar(interp, "ulong");
+	}
+	if (argv[14][0]) {
+	    double d;
+	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    floatVar = (float) d;
+	    Tcl_UpdateLinkedVar(interp, "float");
+	}
+	if (argv[15][0]) {
+	    Tcl_WideInt w;
+	    tmp = Tcl_NewStringObj(argv[15], -1);
+	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
+		Tcl_DecrRefCount(tmp);
+		return TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(tmp);
+	    uwideVar = (Tcl_WideUInt) w;
+	    Tcl_UpdateLinkedVar(interp, "uwide");
+	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": should be create, delete, get, set, or update",
-		(char *) NULL);
+		"\": should be create, delete, get, set, or update", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2798,17 +3258,17 @@ TestlinkCmd(dummy, interp, argc, argv)
  */
 
 static int
-TestlocaleCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestlocaleCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     int index;
     char *locale;
 
-    static CONST char *optionStrings[] = {
-    	"ctype", "numeric", "time", "collate", "monetary", 
+    static const char *optionStrings[] = {
+    	"ctype", "numeric", "time", "collate", "monetary",
 	"all",	NULL
     };
     static CONST int lcTypes[] = {
@@ -2824,7 +3284,7 @@ TestlocaleCmd(clientData, interp, objc, objv)
 	Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
 	return TCL_ERROR;
     }
-    
+
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 	    &index) != TCL_OK) {
 	return TCL_ERROR;
@@ -2861,14 +3321,14 @@ TestlocaleCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 static int
-TestMathFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;		/* Integer value to return. */
-    Tcl_Interp *interp;			/* Not used. */
-    Tcl_Value *args;			/* Not used. */
-    Tcl_Value *resultPtr;		/* Where to store result. */
+TestMathFunc(
+    ClientData clientData,	/* Integer value to return. */
+    Tcl_Interp *interp,		/* Not used. */
+    Tcl_Value *args,		/* Not used. */
+    Tcl_Value *resultPtr)	/* Where to store result. */
 {
     resultPtr->type = TCL_INT;
-    resultPtr->intValue = (int) clientData;
+    resultPtr->intValue = PTR2INT(clientData);
     return TCL_OK;
 }
 
@@ -2891,26 +3351,25 @@ TestMathFunc(clientData, interp, args, resultPtr)
 
 	/* ARGSUSED */
 static int
-TestMathFunc2(clientData, interp, args, resultPtr)
-    ClientData clientData;		/* Integer value to return. */
-    Tcl_Interp *interp;			/* Used to report errors. */
-    Tcl_Value *args;			/* Points to an array of two
-					 * Tcl_Value structs for the 
-					 * two arguments. */
-    Tcl_Value *resultPtr;		/* Where to store the result. */
+TestMathFunc2(
+    ClientData clientData,	/* Integer value to return. */
+    Tcl_Interp *interp,		/* Used to report errors. */
+    Tcl_Value *args,		/* Points to an array of two Tcl_Value structs
+				 * for the two arguments. */
+    Tcl_Value *resultPtr)	/* Where to store the result. */
 {
     int result = TCL_OK;
-    
+
     /*
      * Return the maximum of the two arguments with the correct type.
      */
-    
+
     if (args[0].type == TCL_INT) {
 	int i0 = args[0].intValue;
-	
+
 	if (args[1].type == TCL_INT) {
 	    int i1 = args[1].intValue;
-	    
+
 	    resultPtr->type = TCL_INT;
 	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
 	} else if (args[1].type == TCL_DOUBLE) {
@@ -2931,10 +3390,10 @@ TestMathFunc2(clientData, interp, args, resultPtr)
 	}
     } else if (args[0].type == TCL_DOUBLE) {
 	double d0 = args[0].doubleValue;
-	
+
 	if (args[1].type == TCL_INT) {
 	    double d1 = args[1].intValue;
-	    
+
 	    resultPtr->type = TCL_DOUBLE;
 	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
 	} else if (args[1].type == TCL_DOUBLE) {
@@ -2953,10 +3412,10 @@ TestMathFunc2(clientData, interp, args, resultPtr)
 	}
     } else if (args[0].type == TCL_WIDE_INT) {
 	Tcl_WideInt w0 = args[0].wideValue;
-	
+
 	if (args[1].type == TCL_INT) {
 	    Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
-	    
+
 	    resultPtr->type = TCL_WIDE_INT;
 	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
 	} else if (args[1].type == TCL_DOUBLE) {
@@ -2999,9 +3458,9 @@ TestMathFunc2(clientData, interp, args, resultPtr)
  */
 	/* ARGSUSED */
 static void
-CleanupTestSetassocdataTests(clientData, interp)
-    ClientData clientData;		/* Data to be released. */
-    Tcl_Interp *interp;			/* Interpreter being deleted. */
+CleanupTestSetassocdataTests(
+    ClientData clientData,	/* Data to be released. */
+    Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
     ckfree((char *) clientData);
 }
@@ -3024,11 +3483,11 @@ CleanupTestSetassocdataTests(clientData, interp)
  */
 
 static int
-TestparserObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestparserObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     char *script;
     int length, dummy;
@@ -3080,11 +3539,11 @@ TestparserObjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestexprparserObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestexprparserObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     char *script;
     int length, dummy;
@@ -3101,6 +3560,10 @@ TestexprparserObjCmd(clientData, interp, objc, objv)
     if (length == 0) {
 	length = dummy;
     }
+    parse.commentStart = NULL;
+    parse.commentSize = 0;
+    parse.commandStart = NULL;
+    parse.commandSize = 0;
     if (Tcl_ParseExpr(interp, script, length, &parse) != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (remainder of expr: \"");
 	Tcl_AddErrorInfo(interp, parse.term);
@@ -3137,10 +3600,10 @@ TestexprparserObjCmd(clientData, interp, objc, objv)
  */
 
 static void
-PrintParse(interp, parsePtr)
-    Tcl_Interp *interp;		/* Interpreter whose result is to be set to
+PrintParse(
+    Tcl_Interp *interp,		/* Interpreter whose result is to be set to
 				 * the contents of a parse structure. */
-    Tcl_Parse *parsePtr;	/* Parse structure to print out. */
+    Tcl_Parse *parsePtr)	/* Parse structure to print out. */
 {
     Tcl_Obj *objPtr;
     char *typeString;
@@ -3149,56 +3612,58 @@ PrintParse(interp, parsePtr)
 
     objPtr = Tcl_GetObjResult(interp);
     if (parsePtr->commentSize > 0) {
-	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+	Tcl_ListObjAppendElement(NULL, objPtr,
 		Tcl_NewStringObj(parsePtr->commentStart,
 			parsePtr->commentSize));
     } else {
-	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
-		Tcl_NewStringObj("-", 1));
+	Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
     }
-    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+    Tcl_ListObjAppendElement(NULL, objPtr,
 	    Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
-    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+    Tcl_ListObjAppendElement(NULL, objPtr,
 	    Tcl_NewIntObj(parsePtr->numWords));
     for (i = 0; i < parsePtr->numTokens; i++) {
 	tokenPtr = &parsePtr->tokenPtr[i];
 	switch (tokenPtr->type) {
-	    case TCL_TOKEN_WORD:
-		typeString = "word";
-		break;
-	    case TCL_TOKEN_SIMPLE_WORD:
-		typeString = "simple";
-		break;
-	    case TCL_TOKEN_TEXT:
-		typeString = "text";
-		break;
-	    case TCL_TOKEN_BS:
-		typeString = "backslash";
-		break;
-	    case TCL_TOKEN_COMMAND:
-		typeString = "command";
-		break;
-	    case TCL_TOKEN_VARIABLE:
-		typeString = "variable";
-		break;
-	    case TCL_TOKEN_SUB_EXPR:
-		typeString = "subexpr";
-		break;
-	    case TCL_TOKEN_OPERATOR:
-		typeString = "operator";
-		break;
-	    default:
-		typeString = "??";
-		break;
+	case TCL_TOKEN_EXPAND_WORD:
+	    typeString = "expand";
+	    break;
+	case TCL_TOKEN_WORD:
+	    typeString = "word";
+	    break;
+	case TCL_TOKEN_SIMPLE_WORD:
+	    typeString = "simple";
+	    break;
+	case TCL_TOKEN_TEXT:
+	    typeString = "text";
+	    break;
+	case TCL_TOKEN_BS:
+	    typeString = "backslash";
+	    break;
+	case TCL_TOKEN_COMMAND:
+	    typeString = "command";
+	    break;
+	case TCL_TOKEN_VARIABLE:
+	    typeString = "variable";
+	    break;
+	case TCL_TOKEN_SUB_EXPR:
+	    typeString = "subexpr";
+	    break;
+	case TCL_TOKEN_OPERATOR:
+	    typeString = "operator";
+	    break;
+	default:
+	    typeString = "??";
+	    break;
 	}
-	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+	Tcl_ListObjAppendElement(NULL, objPtr,
 		Tcl_NewStringObj(typeString, -1));
-	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+	Tcl_ListObjAppendElement(NULL, objPtr,
 		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
-	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+	Tcl_ListObjAppendElement(NULL, objPtr,
 		Tcl_NewIntObj(tokenPtr->numComponents));
     }
-    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+    Tcl_ListObjAppendElement(NULL, objPtr,
 	    Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
 	    -1));
 }
@@ -3221,14 +3686,13 @@ PrintParse(interp, parsePtr)
  */
 
 static int
-TestparsevarObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestparsevarObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    CONST char *value;
-    CONST char *name, *termPtr;
+    const char *value, *name, *termPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "varName");
@@ -3263,11 +3727,11 @@ TestparsevarObjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestparsevarnameObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestparsevarnameObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     char *script;
     int append, length, dummy;
@@ -3312,10 +3776,10 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv)
  *
  * TestregexpObjCmd --
  *
- *	This procedure implements the "testregexp" command. It is
- *	used to give a direct interface for regexp flags.  It's identical
- *	to Tcl_RegexpObjCmd except for the -xflags option, and the
- *	consequences thereof (including the REG_EXPECT kludge).
+ *	This procedure implements the "testregexp" command. It is used to give
+ *	a direct interface for regexp flags. It's identical to
+ *	Tcl_RegexpObjCmd except for the -xflags option, and the consequences
+ *	thereof (including the REG_EXPECT kludge).
  *
  * Results:
  *	A standard Tcl result.
@@ -3328,11 +3792,11 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv)
 
 	/* ARGSUSED */
 static int
-TestregexpObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+TestregexpObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, ii, indices, stringLength, match, about;
     int hasxflags, cflags, eflags;
@@ -3340,11 +3804,11 @@ TestregexpObjCmd(dummy, interp, objc, objv)
     char *string;
     Tcl_Obj *objPtr;
     Tcl_RegExpInfo info;
-    static CONST char *options[] = {
+    static const char *options[] = {
 	"-indices",	"-nocase",	"-about",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",
 	"-xflags",
-	"--",		(char *) NULL
+	"--",		NULL
     };
     enum options {
 	REGEXP_INDICES, REGEXP_NOCASE,	REGEXP_ABOUT,	REGEXP_EXPANDED,
@@ -3358,7 +3822,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
     cflags = REG_ADVANCED;
     eflags = 0;
     hasxflags = 0;
-    
+
     for (i = 1; i < objc; i++) {
 	char *name;
 	int index;
@@ -3372,46 +3836,37 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	    return TCL_ERROR;
 	}
 	switch ((enum options) index) {
-	    case REGEXP_INDICES: {
-		indices = 1;
-		break;
-	    }
-	    case REGEXP_NOCASE: {
-		cflags |= REG_ICASE;
-		break;
-	    }
-	    case REGEXP_ABOUT: {
-		about = 1;
-		break;
-	    }
-	    case REGEXP_EXPANDED: {
-		cflags |= REG_EXPANDED;
-		break;
-	    }
-	    case REGEXP_MULTI: {
-		cflags |= REG_NEWLINE;
-		break;
-	    }
-	    case REGEXP_NOCROSS: {
-		cflags |= REG_NLSTOP;
-		break;
-	    }
-	    case REGEXP_NEWL: {
-		cflags |= REG_NLANCH;
-		break;
-	    }
-	    case REGEXP_XFLAGS: {
-		hasxflags = 1;
-		break;
-	    }
-	    case REGEXP_LAST: {
-		i++;
-		goto endOfForLoop;
-	    }
+	case REGEXP_INDICES:
+	    indices = 1;
+	    break;
+	case REGEXP_NOCASE:
+	    cflags |= REG_ICASE;
+	    break;
+	case REGEXP_ABOUT:
+	    about = 1;
+	    break;
+	case REGEXP_EXPANDED:
+	    cflags |= REG_EXPANDED;
+	    break;
+	case REGEXP_MULTI:
+	    cflags |= REG_NEWLINE;
+	    break;
+	case REGEXP_NOCROSS:
+	    cflags |= REG_NLSTOP;
+	    break;
+	case REGEXP_NEWL:
+	    cflags |= REG_NLANCH;
+	    break;
+	case REGEXP_XFLAGS:
+	    hasxflags = 1;
+	    break;
+	case REGEXP_LAST:
+	    i++;
+	    goto endOfForLoop;
 	}
     }
 
-    endOfForLoop:
+  endOfForLoop:
     if (objc - i < hasxflags + 2 - about) {
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
@@ -3431,7 +3886,6 @@ TestregexpObjCmd(dummy, interp, objc, objv)
     if (regExpr == NULL) {
 	return TCL_ERROR;
     }
-    objPtr = objv[1];
 
     if (about) {
 	if (TclRegAbout(interp, regExpr) < 0) {
@@ -3440,6 +3894,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	return TCL_OK;
     }
 
+    objPtr = objv[1];
     match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */,
 	    objc-2 /* nmatches */, eflags);
 
@@ -3449,13 +3904,13 @@ TestregexpObjCmd(dummy, interp, objc, objv)
     if (match == 0) {
 	/*
 	 * Set the interpreter's object result to an integer object w/
-	 * value 0. 
+	 * value 0.
 	 */
-	
+
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
 	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
 	    char *varName;
-	    CONST char *value;
+	    const char *value;
 	    int start, end;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
 
@@ -3465,12 +3920,12 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	    value = Tcl_SetVar(interp, varName, resinfo, 0);
 	    if (value == NULL) {
 		Tcl_AppendResult(interp, "couldn't set variable \"",
-			varName, "\"", (char *) NULL);
+			varName, "\"", NULL);
 		return TCL_ERROR;
 	    }
 	} else if (cflags & TCL_REG_CANMATCH) {
 	    char *varName;
-	    CONST char *value;
+	    const char *value;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
 
 	    Tcl_RegExpGetInfo(regExpr, &info);
@@ -3479,7 +3934,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	    value = Tcl_SetVar(interp, varName, resinfo, 0);
 	    if (value == NULL) {
 		Tcl_AppendResult(interp, "couldn't set variable \"",
-			varName, "\"", (char *) NULL);
+			varName, "\"", NULL);
 		return TCL_ERROR;
 	    }
 	}
@@ -3498,7 +3953,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
     for (i = 0; i < objc; i++) {
 	int start, end;
 	Tcl_Obj *newPtr, *varPtr, *valuePtr;
-	
+
 	varPtr = objv[i];
 	ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
 	if (indices) {
@@ -3515,10 +3970,10 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 	    }
 
 	    /*
-	     * Adjust index so it refers to the last character in the
-	     * match instead of the first character after the match.
+	     * Adjust index so it refers to the last character in the match
+	     * instead of the first character after the match.
 	     */
-	    
+
 	    if (end >= 0) {
 		end--;
 	    }
@@ -3538,20 +3993,18 @@ TestregexpObjCmd(dummy, interp, objc, objv)
 			info.matches[ii].end - 1);
 	    }
 	}
-	Tcl_IncrRefCount(newPtr);
 	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
-	Tcl_DecrRefCount(newPtr);
 	if (valuePtr == NULL) {
 	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    Tcl_GetString(varPtr), "\"", (char *) NULL);
+		    Tcl_GetString(varPtr), "\"", NULL);
 	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Set the interpreter's object result to an integer object w/ value 1. 
+     * Set the interpreter's object result to an integer object w/ value 1.
      */
-	
+
     Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
     return TCL_OK;
 }
@@ -3574,86 +4027,68 @@ TestregexpObjCmd(dummy, interp, objc, objv)
  */
 
 static void
-TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
-    char *string;		/* The string of flags. */
-    int length;			/* The length of the string in bytes. */
-    int *cflagsPtr;		/* compile flags word */
-    int *eflagsPtr;		/* exec flags word */
+TestregexpXflags(
+    char *string,		/* The string of flags. */
+    int length,			/* The length of the string in bytes. */
+    int *cflagsPtr,		/* compile flags word */
+    int *eflagsPtr)		/* exec flags word */
 {
-    int i;
-    int cflags;
-    int eflags;
+    int i, cflags, eflags;
 
     cflags = *cflagsPtr;
     eflags = *eflagsPtr;
     for (i = 0; i < length; i++) {
 	switch (string[i]) {
-	    case 'a': {
-		cflags |= REG_ADVF;
-		break;
-	    }
-	    case 'b': {
-		cflags &= ~REG_ADVANCED;
-		break;
-	    }
-	    case 'c': {
-		cflags |= TCL_REG_CANMATCH;
-		break;
-	    }
-	    case 'e': {
-		cflags &= ~REG_ADVANCED;
-		cflags |= REG_EXTENDED;
-		break;
-	    }
-	    case 'q': {
-		cflags &= ~REG_ADVANCED;
-		cflags |= REG_QUOTE;
-		break;
-	    }
-	    case 'o': {			/* o for opaque */
-		cflags |= REG_NOSUB;
-		break;
-	    }
-	    case 's': {			/* s for start */
-		cflags |= REG_BOSONLY;
-		break;
-	    }
-	    case '+': {
-		cflags |= REG_FAKE;
-		break;
-	    }
-	    case ',': {
-		cflags |= REG_PROGRESS;
-		break;
-	    }
-	    case '.': {
-		cflags |= REG_DUMP;
-		break;
-	    }
-	    case ':': {
-		eflags |= REG_MTRACE;
-		break;
-	    }
-	    case ';': {
-		eflags |= REG_FTRACE;
-		break;
-	    }
-	    case '^': {
-		eflags |= REG_NOTBOL;
-		break;
-	    }
-	    case '$': {
-		eflags |= REG_NOTEOL;
-		break;
-	    }
-	    case 't': {
-		cflags |= REG_EXPECT;
-		break;
-	    }
-	    case '%': {
-		eflags |= REG_SMALL;
-		break;
-	    }
+	case 'a':
+	    cflags |= REG_ADVF;
+	    break;
+	case 'b':
+	    cflags &= ~REG_ADVANCED;
+	    break;
+	case 'c':
+	    cflags |= TCL_REG_CANMATCH;
+	    break;
+	case 'e':
+	    cflags &= ~REG_ADVANCED;
+	    cflags |= REG_EXTENDED;
+	    break;
+	case 'q':
+	    cflags &= ~REG_ADVANCED;
+	    cflags |= REG_QUOTE;
+	    break;
+	case 'o':			/* o for opaque */
+	    cflags |= REG_NOSUB;
+	    break;
+	case 's':			/* s for start */
+	    cflags |= REG_BOSONLY;
+	    break;
+	case '+':
+	    cflags |= REG_FAKE;
+	    break;
+	case ',':
+	    cflags |= REG_PROGRESS;
+	    break;
+	case '.':
+	    cflags |= REG_DUMP;
+	    break;
+	case ':':
+	    eflags |= REG_MTRACE;
+	    break;
+	case ';':
+	    eflags |= REG_FTRACE;
+	    break;
+	case '^':
+	    eflags |= REG_NOTBOL;
+	    break;
+	case '$':
+	    eflags |= REG_NOTEOL;
+	    break;
+	case 't':
+	    cflags |= REG_EXPECT;
+	    break;
+	case '%':
+	    eflags |= REG_SMALL;
+	    break;
 	}
     }
 
@@ -3664,6 +4099,37 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TestreturnObjCmd --
+ *
+ *	This procedure implements the "testreturn" command. It is
+ *	used to verify that a
+ *		return TCL_RETURN;
+ *	has same behavior as
+ *		return Tcl_SetReturnOptions(interp, Tcl_NewObj());
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+TestreturnObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return TCL_RETURN;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestsetassocdataCmd --
  *
  *	This procedure implements the "testsetassocdata" command. It is used
@@ -3680,20 +4146,19 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
  */
 
 static int
-TestsetassocdataCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
-{
-    char *buf;
-    char *oldData;
+TestsetassocdataCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    char *buf, *oldData;
     Tcl_InterpDeleteProc *procPtr;
-    
+
     if (argc != 3) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " data_key data_item\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" data_key data_item\"", NULL);
+	return TCL_ERROR;
     }
 
     buf = ckalloc((unsigned) strlen(argv[2]) + 1);
@@ -3708,8 +4173,8 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
     if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
 	ckfree(oldData);
     }
-    
-    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, 
+
+    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
 	(ClientData) buf);
     return TCL_OK;
 }
@@ -3733,25 +4198,21 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestsetplatformCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestsetplatformCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     size_t length;
     TclPlatformType *platform;
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
-    platform = TclWinGetPlatform();
-#else
-    platform = &tclPlatform;
-#endif
-    
+    platform = TclGetPlatform();
+
     if (argc != 2) {
-        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-                " platform\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		" platform\"", NULL);
+	return TCL_ERROR;
     }
 
     length = strlen(argv[1]);
@@ -3760,8 +4221,8 @@ TestsetplatformCmd(clientData, interp, argc, argv)
     } else if (strncmp(argv[1], "windows", length) == 0) {
 	*platform = TCL_PLATFORM_WINDOWS;
     } else {
-        Tcl_AppendResult(interp, "unsupported platform: should be one of ",
-		"unix, mac, or windows", (char *) NULL);
+	Tcl_AppendResult(interp, "unsupported platform: should be one of "
+		"unix, or windows", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -3786,17 +4247,17 @@ TestsetplatformCmd(clientData, interp, argc, argv)
  */
 
 static int
-TeststaticpkgCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TeststaticpkgCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     int safe, loaded;
 
     if (argc != 4) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		argv[0], " pkgName safe loaded\"", (char *) NULL);
+		argv[0], " pkgName safe loaded\"", NULL);
 	return TCL_ERROR;
     }
     if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
@@ -3811,9 +4272,9 @@ TeststaticpkgCmd(dummy, interp, argc, argv)
 }
 
 static int
-StaticInitProc(interp)
-    Tcl_Interp *interp;			/* Interpreter in which package
-					 * is supposedly being loaded. */
+StaticInitProc(
+    Tcl_Interp *interp)		/* Interpreter in which package is supposedly
+				 * being loaded. */
 {
     Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
     return TCL_OK;
@@ -3837,18 +4298,18 @@ StaticInitProc(interp)
  */
 
 static int
-TesttranslatefilenameCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TesttranslatefilenameCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_DString buffer;
-    CONST char *result;
+    const char *result;
 
     if (argc != 2) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		argv[0], " path\"", (char *) NULL);
+		argv[0], " path\"", NULL);
 	return TCL_ERROR;
     }
     result = Tcl_TranslateFileName(interp, argv[1], &buffer);
@@ -3879,17 +4340,17 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestupvarCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestupvarCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     int flags = 0;
-    
+
     if ((argc != 5) && (argc != 6)) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		argv[0], " level name ?name2? dest global\"", (char *) NULL);
+		argv[0], " level name ?name2? dest global\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -3906,8 +4367,8 @@ TestupvarCmd(dummy, interp, argc, argv)
 	} else if (strcmp(argv[5], "namespace") == 0) {
 	    flags = TCL_NAMESPACE_ONLY;
 	}
-	return Tcl_UpVar2(interp, argv[1], argv[2], 
-		(argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4],
+	return Tcl_UpVar2(interp, argv[1], argv[2],
+		(argv[3][0] == 0) ? NULL : argv[3], argv[4],
 		flags);
     }
 }
@@ -3917,9 +4378,8 @@ TestupvarCmd(dummy, interp, argc, argv)
  *
  * TestseterrorcodeCmd --
  *
- *	This procedure implements the "testseterrorcodeCmd".
- *	This tests up to five elements passed to the
- *	Tcl_SetErrorCode command.
+ *	This procedure implements the "testseterrorcodeCmd".  This tests up to
+ *	five elements passed to the Tcl_SetErrorCode command.
  *
  * Results:
  *	A standard Tcl result. Always returns TCL_ERROR so that
@@ -3933,11 +4393,11 @@ TestupvarCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestseterrorcodeCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestseterrorcodeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     if (argc > 6) {
 	Tcl_SetResult(interp, "too many args", TCL_STATIC);
@@ -3968,22 +4428,13 @@ TestseterrorcodeCmd(dummy, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestsetobjerrorcodeCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestsetobjerrorcodeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    Tcl_Obj *listObjPtr;
-
-    if (objc > 1) {
-	listObjPtr = Tcl_ConcatObj(objc - 1, objv + 1);
-    } else {
-	listObjPtr = Tcl_NewObj();
-    }
-    Tcl_IncrRefCount(listObjPtr);
-    Tcl_SetObjErrorCode(interp, listObjPtr);
-    Tcl_DecrRefCount(listObjPtr);
+    Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
     return TCL_ERROR;
 }
 
@@ -4006,11 +4457,11 @@ TestsetobjerrorcodeCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 static int
-TestfeventCmd(clientData, interp, argc, argv)
-    ClientData clientData;		/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestfeventCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     static Tcl_Interp *interp2 = NULL;
     int code;
@@ -4018,46 +4469,46 @@ TestfeventCmd(clientData, interp, argc, argv)
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg ...?", (char *) NULL);
+		" option ?arg arg ...?", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "cmd") == 0) {
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " cmd script", (char *) NULL);
+		    " cmd script", NULL);
 	    return TCL_ERROR;
 	}
-        if (interp2 != (Tcl_Interp *) NULL) {
-            code = Tcl_GlobalEval(interp2, argv[2]);
+	if (interp2 != NULL) {
+	    code = Tcl_GlobalEval(interp2, argv[2]);
 	    Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
-            return code;
-        } else {
-            Tcl_AppendResult(interp,
-                    "called \"testfevent code\" before \"testfevent create\"",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
+	    return code;
+	} else {
+	    Tcl_AppendResult(interp,
+		    "called \"testfevent code\" before \"testfevent create\"",
+		    NULL);
+	    return TCL_ERROR;
+	}
     } else if (strcmp(argv[1], "create") == 0) {
 	if (interp2 != NULL) {
-            Tcl_DeleteInterp(interp2);
+	    Tcl_DeleteInterp(interp2);
 	}
-        interp2 = Tcl_CreateInterp();
+	interp2 = Tcl_CreateInterp();
 	return Tcl_Init(interp2);
     } else if (strcmp(argv[1], "delete") == 0) {
 	if (interp2 != NULL) {
-            Tcl_DeleteInterp(interp2);
+	    Tcl_DeleteInterp(interp2);
 	}
 	interp2 = NULL;
     } else if (strcmp(argv[1], "share") == 0) {
-        if (interp2 != NULL) {
-            chan = Tcl_GetChannel(interp, argv[2], NULL);
-            if (chan == (Tcl_Channel) NULL) {
-                return TCL_ERROR;
-            }
-            Tcl_RegisterChannel(interp2, chan);
-        }
+	if (interp2 != NULL) {
+	    chan = Tcl_GetChannel(interp, argv[2], NULL);
+	    if (chan == (Tcl_Channel) NULL) {
+		return TCL_ERROR;
+	    }
+	    Tcl_RegisterChannel(interp2, chan);
+	}
     }
-    
+
     return TCL_OK;
 }
 
@@ -4069,7 +4520,7 @@ TestfeventCmd(clientData, interp, argc, argv)
  *	Calls the panic routine.
  *
  * Results:
- *      Always returns TCL_OK. 
+ *	Always returns TCL_OK.
  *
  * Side effects:
  *	May exit application.
@@ -4078,37 +4529,37 @@ TestfeventCmd(clientData, interp, argc, argv)
  */
 
 static int
-TestpanicCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
-{
-    CONST char *argString;
-    
+TestpanicCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    const char *argString;
+
     /*
      *  Put the arguments into a var args structure
      *  Append all of the arguments together separated by spaces
      */
 
     argString = Tcl_Merge(argc-1, argv+1);
-    panic(argString);
+    Tcl_Panic("%s", argString);
     ckfree((char *)argString);
- 
+
     return TCL_OK;
 }
-
+
 static int
-TestfileCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;			/* Number of arguments. */
-    Tcl_Obj *CONST argv[];	/* The argument objects. */
+TestfileCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    Tcl_Obj *const argv[])	/* The argument objects. */
 {
     int force, i, j, result;
     Tcl_Obj *error = NULL;
     char *subcmd;
-    
+
     if (argc < 3) {
 	return TCL_ERROR;
     }
@@ -4116,7 +4567,7 @@ TestfileCmd(dummy, interp, argc, argv)
     force = 0;
     i = 2;
     if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
-        force = 1;
+	force = 1;
 	i = 3;
     }
 
@@ -4125,30 +4576,30 @@ TestfileCmd(dummy, interp, argc, argv)
     }
 
     for (j = i; j < argc; j++) {
-        if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) {
+	if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) {
 	    return TCL_ERROR;
 	}
     }
 
     subcmd = Tcl_GetString(argv[1]);
-    
+
     if (strcmp(subcmd, "mv") == 0) {
 	result = TclpObjRenameFile(argv[i], argv[i + 1]);
     } else if (strcmp(subcmd, "cp") == 0) {
-        result = TclpObjCopyFile(argv[i], argv[i + 1]);
+	result = TclpObjCopyFile(argv[i], argv[i + 1]);
     } else if (strcmp(subcmd, "rm") == 0) {
-        result = TclpObjDeleteFile(argv[i]);
+	result = TclpObjDeleteFile(argv[i]);
     } else if (strcmp(subcmd, "mkdir") == 0) {
-        result = TclpObjCreateDirectory(argv[i]);
+	result = TclpObjCreateDirectory(argv[i]);
     } else if (strcmp(subcmd, "cpdir") == 0) {
-        result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
+	result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
     } else if (strcmp(subcmd, "rmdir") == 0) {
-        result = TclpObjRemoveDirectory(argv[i], force, &error);
+	result = TclpObjRemoveDirectory(argv[i], force, &error);
     } else {
-        result = TCL_ERROR;
+	result = TCL_ERROR;
 	goto end;
     }
-	
+
     if (result != TCL_OK) {
 	if (error != NULL) {
 	    if (Tcl_GetString(error)[0] != '\0') {
@@ -4156,11 +4607,10 @@ TestfileCmd(dummy, interp, argc, argv)
 	    }
 	    Tcl_DecrRefCount(error);
 	}
-	Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
+	Tcl_AppendResult(interp, Tcl_ErrnoId(), NULL);
     }
 
-    end:
-
+  end:
     return result;
 }
 
@@ -4182,24 +4632,24 @@ TestfileCmd(dummy, interp, argc, argv)
  */
 
 static int
-TestgetvarfullnameCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestgetvarfullnameCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     char *name, *arg;
     int flags = 0;
     Tcl_Namespace *namespacePtr;
-    Tcl_CallFrame frame;
+    Tcl_CallFrame *framePtr;
     Tcl_Var variable;
     int result;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name scope");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
-    
+
     name = Tcl_GetString(objv[1]);
 
     arg = Tcl_GetString(objv[2]);
@@ -4210,30 +4660,29 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * This command, like any other created with Tcl_Create[Obj]Command,
-     * runs in the global namespace. As a "namespace-aware" command that
-     * needs to run in a particular namespace, it must activate that
-     * namespace itself.
+     * This command, like any other created with Tcl_Create[Obj]Command, runs
+     * in the global namespace. As a "namespace-aware" command that needs to
+     * run in a particular namespace, it must activate that namespace itself.
      */
 
     if (flags == TCL_NAMESPACE_ONLY) {
-	namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
-	        (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
+	namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", NULL,
+		TCL_LEAVE_ERR_MSG);
 	if (namespacePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
-                /*isProcCallFrame*/ 0);
+	result = TclPushStackFrame(interp, &framePtr, namespacePtr,
+		/*isProcCallFrame*/ 0);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
-    
-    variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
+
+    variable = Tcl_FindNamespaceVar(interp, name, NULL,
 	    (flags | TCL_LEAVE_ERR_MSG));
 
     if (flags == TCL_NAMESPACE_ONLY) {
-	Tcl_PopCallFrame(interp);
+	TclPopStackFrame(interp);
     }
     if (variable == (Tcl_Var) NULL) {
 	return TCL_ERROR;
@@ -4247,10 +4696,9 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
  *
  * GetTimesCmd --
  *
- *	This procedure implements the "gettimes" command.  It is
- *	used for computing the time needed for various basic operations
- *	such as reading variables, allocating memory, sprintf, converting
- *	variables, etc.
+ *	This procedure implements the "gettimes" command.  It is used for
+ *	computing the time needed for various basic operations such as reading
+ *	variables, allocating memory, sprintf, converting variables, etc.
  *
  * Results:
  *	A standard Tcl result.
@@ -4262,19 +4710,18 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
  */
 
 static int
-GetTimesCmd(unused, interp, argc, argv)
-    ClientData unused;		/* Unused. */
-    Tcl_Interp *interp;		/* The current interpreter. */
-    int argc;			/* The number of arguments. */
-    CONST char **argv;		/* The argument strings. */
+GetTimesCmd(
+    ClientData unused,		/* Unused. */
+    Tcl_Interp *interp,		/* The current interpreter. */
+    int argc,			/* The number of arguments. */
+    const char **argv)		/* The argument strings. */
 {
     Interp *iPtr = (Interp *) interp;
     int i, n;
     double timePer;
     Tcl_Time start, stop;
-    Tcl_Obj *objPtr;
-    Tcl_Obj **objv;
-    CONST char *s;
+    Tcl_Obj *objPtr, **objv;
+    const char *s;
     char newString[TCL_INTEGER_SPACE];
 
     /* alloc & free 100000 times */
@@ -4287,7 +4734,7 @@ GetTimesCmd(unused, interp, argc, argv)
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
     fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);
-    
+
     /* alloc 5000 times */
     fprintf(stderr, "alloc 5000 6 word items\n");
     objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
@@ -4298,7 +4745,7 @@ GetTimesCmd(unused, interp, argc, argv)
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
     fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);
-    
+
     /* free 5000 times */
     fprintf(stderr, "free 5000 6 word items\n");
     Tcl_GetTime(&start);
@@ -4318,7 +4765,7 @@ GetTimesCmd(unused, interp, argc, argv)
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
     fprintf(stderr, "   %.3f usec per Tcl_NewObj\n", timePer/5000);
-    
+
     /* Tcl_DecrRefCount 5000 times */
     fprintf(stderr, "Tcl_DecrRefCount 5000 times\n");
     Tcl_GetTime(&start);
@@ -4356,7 +4803,7 @@ GetTimesCmd(unused, interp, argc, argv)
     fprintf(stderr, "   %.3f usec per Tcl_GetIntFromObj of \"12345\"\n",
 	    timePer/100000);
     Tcl_DecrRefCount(objPtr);
-    
+
     /* Tcl_GetInt 100000 times */
     fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n");
     Tcl_GetTime(&start);
@@ -4419,7 +4866,7 @@ GetTimesCmd(unused, interp, argc, argv)
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
     fprintf(stderr, "   %.3f usec per Tcl_GetVar of a==\"12345\"\n",
 	    timePer/100000);
-    
+
     Tcl_ResetResult(interp);
     return TCL_OK;
 }
@@ -4442,11 +4889,11 @@ GetTimesCmd(unused, interp, argc, argv)
  */
 
 static int
-NoopCmd(unused, interp, argc, argv)
-    ClientData unused;		/* Unused. */
-    Tcl_Interp *interp;		/* The current interpreter. */
-    int argc;			/* The number of arguments. */
-    CONST char **argv;		/* The argument strings. */
+NoopCmd(
+    ClientData unused,		/* Unused. */
+    Tcl_Interp *interp,		/* The current interpreter. */
+    int argc,			/* The number of arguments. */
+    const char **argv)		/* The argument strings. */
 {
     return TCL_OK;
 }
@@ -4469,11 +4916,11 @@ NoopCmd(unused, interp, argc, argv)
  */
 
 static int
-NoopObjCmd(unused, interp, objc, objv)
-    ClientData unused;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+NoopObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     return TCL_OK;
 }
@@ -4497,34 +4944,66 @@ NoopObjCmd(unused, interp, objc, objv)
 
 	/* ARGSUSED */
 static int
-TestsetCmd(data, interp, argc, argv)
-    ClientData data;			/* Additional flags for Get/SetVar2. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestsetCmd(
+    ClientData data,		/* Additional flags for Get/SetVar2. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
-    int flags = (int) data;
-    CONST char *value;
+    int flags = PTR2INT(data);
+    const char *value;
 
     if (argc == 2) {
-        Tcl_SetResult(interp, "before get", TCL_STATIC);
-	value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags);
-        if (value == NULL) {
-            return TCL_ERROR;
-        }
+	Tcl_SetResult(interp, "before get", TCL_STATIC);
+	value = Tcl_GetVar2(interp, argv[1], NULL, flags);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
 	Tcl_AppendElement(interp, value);
-        return TCL_OK;
+	return TCL_OK;
     } else if (argc == 3) {
 	Tcl_SetResult(interp, "before set", TCL_STATIC);
-        value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags);
-        if (value == NULL) {
-            return TCL_ERROR;
-        }
+	value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
 	Tcl_AppendElement(interp, value);
 	return TCL_OK;
     } else {
 	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " varName ?newValue?\"", (char *) NULL);
+		argv[0], " varName ?newValue?\"", NULL);
+	return TCL_ERROR;
+    }
+}
+static int
+Testset2Cmd(
+    ClientData data,		/* Additional flags for Get/SetVar2. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    int flags = PTR2INT(data);
+    const char *value;
+
+    if (argc == 3) {
+	Tcl_SetResult(interp, "before get", TCL_STATIC);
+	value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_AppendElement(interp, value);
+	return TCL_OK;
+    } else if (argc == 4) {
+	Tcl_SetResult(interp, "before set", TCL_STATIC);
+	value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
+	if (value == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_AppendElement(interp, value);
+	return TCL_OK;
+    } else {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " varName elemName ?newValue?\"", NULL);
 	return TCL_ERROR;
     }
 }
@@ -4534,9 +5013,8 @@ TestsetCmd(data, interp, argc, argv)
  *
  * TestsaveresultCmd --
  *
- *	Implements the "testsaveresult" cmd that is used when testing
- *	the Tcl_SaveResult, Tcl_RestoreResult, and
- *	Tcl_DiscardResult interfaces.
+ *	Implements the "testsaveresult" cmd that is used when testing the
+ *	Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces.
  *
  * Results:
  *	A standard Tcl result.
@@ -4549,16 +5027,16 @@ TestsetCmd(data, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestsaveresultCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
+TestsaveresultCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
 {
     int discard, result, index;
     Tcl_SavedResult state;
     Tcl_Obj *objPtr;
-    static CONST char *optionStrings[] = {
+    static const char *optionStrings[] = {
 	"append", "dynamic", "free", "object", "small", NULL
     };
     enum options {
@@ -4571,7 +5049,7 @@ TestsaveresultCmd(dummy, interp, objc, objv)
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 	    &index) != TCL_OK) {
@@ -4583,25 +5061,26 @@ TestsaveresultCmd(dummy, interp, objc, objv)
 
     objPtr = NULL;		/* Lint. */
     switch ((enum options) index) {
-	case RESULT_SMALL:
-	    Tcl_SetResult(interp, "small result", TCL_VOLATILE);
-	    break;
-	case RESULT_APPEND:
-	    Tcl_AppendResult(interp, "append result", NULL);
-	    break;
-	case RESULT_FREE: {
-	    char *buf = ckalloc(200);
-	    strcpy(buf, "free result");
-	    Tcl_SetResult(interp, buf, TCL_DYNAMIC);
-	    break;
-	}
-	case RESULT_DYNAMIC:
-	    Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
-	    break;
-	case RESULT_OBJECT:
-	    objPtr = Tcl_NewStringObj("object result", -1);
-	    Tcl_SetObjResult(interp, objPtr);
-	    break;
+    case RESULT_SMALL:
+	Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+	break;
+    case RESULT_APPEND:
+	Tcl_AppendResult(interp, "append result", NULL);
+	break;
+    case RESULT_FREE: {
+	char *buf = ckalloc(200);
+
+	strcpy(buf, "free result");
+	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
+	break;
+    }
+    case RESULT_DYNAMIC:
+	Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
+	break;
+    case RESULT_OBJECT:
+	objPtr = Tcl_NewStringObj("object result", -1);
+	Tcl_SetObjResult(interp, objPtr);
+	break;
     }
 
     freeCount = 0;
@@ -4621,19 +5100,20 @@ TestsaveresultCmd(dummy, interp, objc, objv)
     }
 
     switch ((enum options) index) {
-	case RESULT_DYNAMIC: {
-	    int present = interp->freeProc == TestsaveresultFree;
-	    int called = freeCount;
-	    Tcl_AppendElement(interp, called ? "called" : "notCalled");
-	    Tcl_AppendElement(interp, present ? "present" : "missing");
-	    break;
-	}
-	case RESULT_OBJECT:
-	    Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
-		    ? "same" : "different");
-	    break;
-	default:
-	    break;
+    case RESULT_DYNAMIC: {
+	int present = interp->freeProc == TestsaveresultFree;
+	int called = freeCount;
+
+	Tcl_AppendElement(interp, called ? "called" : "notCalled");
+	Tcl_AppendElement(interp, present ? "present" : "missing");
+	break;
+    }
+    case RESULT_OBJECT:
+	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
+		? "same" : "different");
+	break;
+    default:
+	break;
     }
     return result;
 }
@@ -4655,11 +5135,12 @@ TestsaveresultCmd(dummy, interp, objc, objv)
  */
 
 static void
-TestsaveresultFree(blockPtr)
-    char *blockPtr;
+TestsaveresultFree(
+    char *blockPtr)
 {
     freeCount++;
 }
+#ifdef USE_OBSOLETE_FS_HOOKS
 
 /*
  *----------------------------------------------------------------------
@@ -4679,18 +5160,18 @@ TestsaveresultFree(blockPtr)
  */
 
 static int
-TeststatprocCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TeststatprocCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     TclStatProc_ *proc;
     int retVal;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option arg\"", (char *) NULL);
+		argv[0], " option arg\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -4703,41 +5184,40 @@ TeststatprocCmd (dummy, interp, argc, argv)
     } else if (strcmp(argv[2], "TestStatProc3") == 0) {
 	proc = TestStatProc3;
     } else {
-	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		"must be TclpStat, ",
-		"TestStatProc1, TestStatProc2, or TestStatProc3",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
+		"must be TclpStat, "
+		"TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
 	return TCL_ERROR;
     }
 
     if (strcmp(argv[1], "insert") == 0) {
 	if (proc == PretendTclpStat) {
-	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		   "must be ",
-		   "TestStatProc1, TestStatProc2, or TestStatProc3",
-		   (char *) NULL);
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
+		   "must be "
+		   "TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
 	    return TCL_ERROR;
 	}
 	retVal = TclStatInsertProc(proc);
     } else if (strcmp(argv[1], "delete") == 0) {
 	retVal = TclStatDeleteProc(proc);
     } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
-		"must be insert or delete", (char *) NULL);
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
+		"must be insert or delete", NULL);
 	return TCL_ERROR;
     }
 
     if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
-		"could not be ", argv[1], "ed", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", argv[2], "\": "
+		"could not be ", argv[1], "ed", NULL);
     }
 
     return retVal;
 }
 
-static int PretendTclpStat(path, buf)
-    CONST char *path;
-    Tcl_StatBuf *buf;
+static int
+PretendTclpStat(
+    const char *path,
+    struct stat *buf)
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
@@ -4775,8 +5255,8 @@ static int PretendTclpStat(path, buf)
 	 * Note that ino_t/ino64_t is unsigned...
 	 */
 
-        if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
-#   ifdef HAVE_ST_BLOCKS
+	if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
+#   ifdef HAVE_STRUCT_STAT_ST_BLOCKS
 		|| OUT_OF_RANGE(realBuf.st_blocks)
 #   endif
 	    ) {
@@ -4784,9 +5264,9 @@ static int PretendTclpStat(path, buf)
 	    errno = EOVERFLOW;
 #   else
 #       ifdef EFBIG
-            errno = EFBIG;
+	    errno = EFBIG;
 #       else
-#           error "what error should be returned for a value out of range?"
+#	    error "what error should be returned for a value out of range?"
 #       endif
 #   endif
 	    return -1;
@@ -4796,11 +5276,11 @@ static int PretendTclpStat(path, buf)
 #   undef OUT_OF_URANGE
 
 	/*
-	 * Copy across all supported fields, with possible type
-	 * coercions on those fields that change between the normal
-	 * and lf64 versions of the stat structure (on Solaris at
-	 * least.)  This is slow when the structure sizes coincide,
-	 * but that's what you get for mixing interfaces...
+	 * Copy across all supported fields, with possible type coercions on
+	 * those fields that change between the normal and lf64 versions of
+	 * the stat structure (on Solaris at least.) This is slow when the
+	 * structure sizes coincide, but that's what you get for mixing
+	 * interfaces...
 	 */
 
 	buf->st_mode    = realBuf.st_mode;
@@ -4814,8 +5294,10 @@ static int PretendTclpStat(path, buf)
 	buf->st_atime   = realBuf.st_atime;
 	buf->st_mtime   = realBuf.st_mtime;
 	buf->st_ctime   = realBuf.st_ctime;
-#   ifdef HAVE_ST_BLOCKS
+#   ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
 	buf->st_blksize = realBuf.st_blksize;
+#   endif
+#   ifdef HAVE_STRUCT_STAT_ST_BLOCKS
 	buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
 #   endif
     }
@@ -4824,36 +5306,35 @@ static int PretendTclpStat(path, buf)
 }
 
 static int
-TestStatProc1(path, buf)
-    CONST char *path;
-    Tcl_StatBuf *buf;
+TestStatProc1(
+    const char *path,
+    struct stat *buf)
 {
-    memset(buf, 0, sizeof(Tcl_StatBuf));
+    memset(buf, 0, sizeof(struct stat));
     buf->st_size = 1234;
     return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
 }
 
-
 static int
-TestStatProc2(path, buf)
-    CONST char *path;
-    Tcl_StatBuf *buf;
+TestStatProc2(
+    const char *path,
+    struct stat *buf)
 {
-    memset(buf, 0, sizeof(Tcl_StatBuf));
+    memset(buf, 0, sizeof(struct stat));
     buf->st_size = 2345;
     return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
 }
 
-
 static int
-TestStatProc3(path, buf)
-    CONST char *path;
-    Tcl_StatBuf *buf;
+TestStatProc3(
+    const char *path,
+    struct stat *buf)
 {
-    memset(buf, 0, sizeof(Tcl_StatBuf));
+    memset(buf, 0, sizeof(struct stat));
     buf->st_size = 3456;
     return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -4873,14 +5354,14 @@ TestStatProc3(path, buf)
  */
 
 static int
-TestmainthreadCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestmainthreadCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
   if (argc == 1) {
-      Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
+      Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
       Tcl_SetObjResult(interp, idObj);
       return TCL_OK;
   } else {
@@ -4933,11 +5414,11 @@ MainLoop(void)
  */
 
 static int
-TestsetmainloopCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestsetmainloopCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
   exitMainLoop = 0;
   Tcl_SetMainLoop(MainLoop);
@@ -4962,15 +5443,16 @@ TestsetmainloopCmd (dummy, interp, argc, argv)
  */
 
 static int
-TestexitmainloopCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestexitmainloopCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
   exitMainLoop = 1;
   return TCL_OK;
 }
+#ifdef USE_OBSOLETE_FS_HOOKS
 
 /*
  *----------------------------------------------------------------------
@@ -4990,18 +5472,18 @@ TestexitmainloopCmd (dummy, interp, argc, argv)
  */
 
 static int
-TestaccessprocCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestaccessprocCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     TclAccessProc_ *proc;
     int retVal;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option arg\"", (char *) NULL);
+		argv[0], " option arg\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -5014,41 +5496,40 @@ TestaccessprocCmd (dummy, interp, argc, argv)
     } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
 	proc = TestAccessProc3;
     } else {
-	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		"must be TclpAccess, ",
-		"TestAccessProc1, TestAccessProc2, or TestAccessProc3",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
+		"must be TclpAccess, "
+		"TestAccessProc1, TestAccessProc2, or TestAccessProc3", NULL);
 	return TCL_ERROR;
     }
 
     if (strcmp(argv[1], "insert") == 0) {
 	if (proc == PretendTclpAccess) {
-	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		   "must be ",
-		   "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
-		   (char *) NULL);
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": must be "
+		   "TestAccessProc1, TestAccessProc2, or TestAccessProc3"
+		   NULL);
 	    return TCL_ERROR;
 	}
 	retVal = TclAccessInsertProc(proc);
     } else if (strcmp(argv[1], "delete") == 0) {
 	retVal = TclAccessDeleteProc(proc);
     } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
-		"must be insert or delete", (char *) NULL);
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
+		"must be insert or delete", NULL);
 	return TCL_ERROR;
     }
 
     if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
-		"could not be ", argv[1], "ed", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", argv[2], "\": "
+		"could not be ", argv[1], "ed", NULL);
     }
 
     return retVal;
 }
 
-static int PretendTclpAccess(path, mode)
-    CONST char *path;
-    int mode;
+static int
+PretendTclpAccess(
+    const char *path,
+    int mode)
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
@@ -5059,27 +5540,25 @@ static int PretendTclpAccess(path, mode)
 }
 
 static int
-TestAccessProc1(path, mode)
-    CONST char *path;
-    int mode;
+TestAccessProc1(
+    const char *path,
+    int mode)
 {
     return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
 }
 
-
 static int
-TestAccessProc2(path, mode)
-    CONST char *path;
-    int mode;
+TestAccessProc2(
+    const char *path,
+    int mode)
 {
     return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
 }
 
-
 static int
-TestAccessProc3(path, mode)
-    CONST char *path;
-    int mode;
+TestAccessProc3(
+    const char *path,
+    int mode)
 {
     return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
 }
@@ -5089,8 +5568,9 @@ TestAccessProc3(path, mode)
  *
  * TestopenfilechannelprocCmd  --
  *
- *	Implements the "testTclOpenFileChannelProc" cmd that is used to test the
- *	'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C Apis.
+ *	Implements the "testTclOpenFileChannelProc" cmd that is used to test
+ *	the 'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C
+ *	Apis.
  *
  * Results:
  *	A standard Tcl result.
@@ -5102,18 +5582,18 @@ TestAccessProc3(path, mode)
  */
 
 static int
-TestopenfilechannelprocCmd (dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestopenfilechannelprocCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     TclOpenFileChannelProc_ *proc;
     int retVal;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option arg\"", (char *) NULL);
+		argv[0], " option arg\"", NULL);
 	return TCL_ERROR;
     }
 
@@ -5126,50 +5606,47 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
     } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
 	proc = TestOpenFileChannelProc3;
     } else {
-	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		"must be TclpOpenFileChannel, ",
-		"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
-		"TestOpenFileChannelProc3",
-		(char *) NULL);
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
+		"must be TclpOpenFileChannel, "
+		"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
+		"TestOpenFileChannelProc3", NULL);
 	return TCL_ERROR;
     }
 
     if (strcmp(argv[1], "insert") == 0) {
 	if (proc == PretendTclpOpenFileChannel) {
-	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
-		   "must be ",
-		   "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
-		   "TestOpenFileChannelProc3",
-		   (char *) NULL);
+	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
+		   "must be "
+		   "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
+		   "TestOpenFileChannelProc3", NULL);
 	    return TCL_ERROR;
 	}
 	retVal = TclOpenFileChannelInsertProc(proc);
     } else if (strcmp(argv[1], "delete") == 0) {
 	retVal = TclOpenFileChannelDeleteProc(proc);
     } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
-		"must be insert or delete", (char *) NULL);
+	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
+		"must be insert or delete", NULL);
 	return TCL_ERROR;
     }
 
     if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
-		"could not be ", argv[1], "ed", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", argv[2], "\": "
+		"could not be ", argv[1], "ed", NULL);
     }
 
     return retVal;
 }
 
 static Tcl_Channel
-PretendTclpOpenFileChannel(interp, fileName, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-					 * can be NULL. */
-    CONST char *fileName;               /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-					 * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-					 * file, with what modes to create
-					 * it? */
+PretendTclpOpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    const char *fileName,	/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or
+				 * a string such as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
 {
     Tcl_Channel ret;
     int mode, seekFlag;
@@ -5185,11 +5662,10 @@ PretendTclpOpenFileChannel(interp, fileName, modeString, permissions)
     if (ret != NULL) {
 	if (seekFlag) {
 	    if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) {
-		if (interp != (Tcl_Interp *) NULL) {
+		if (interp != NULL) {
 		    Tcl_AppendResult(interp,
-		      "could not seek to end of file while opening \"",
-		      fileName, "\": ", 
-		      Tcl_PosixError(interp), (char *) NULL);
+			    "could not seek to end of file while opening \"",
+			    fileName, "\": ", Tcl_PosixError(interp), NULL);
 		}
 		Tcl_Close(NULL, ret);
 		return NULL;
@@ -5200,53 +5676,52 @@ PretendTclpOpenFileChannel(interp, fileName, modeString, permissions)
 }
 
 static Tcl_Channel
-TestOpenFileChannelProc1(interp, fileName, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-                                         * can be NULL. */
-    CONST char *fileName;               /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-                                         * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-                                         * file, with what modes to create
-                                         * it? */
-{
-    CONST char *expectname="testOpenFileChannel1%.fil";
+TestOpenFileChannelProc1(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    const char *fileName,	/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or
+				 * a string such as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
+{
+    const char *expectname = "testOpenFileChannel1%.fil";
     Tcl_DString ds;
-    
+
     Tcl_DStringInit(&ds);
     Tcl_JoinPath(1, &expectname, &ds);
 
     if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
 	Tcl_DStringFree(&ds);
-	return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
+	return (PretendTclpOpenFileChannel(interp,
+		"__testOpenFileChannel1%__.fil",
 		modeString, permissions));
     } else {
 	Tcl_DStringFree(&ds);
-	return (NULL);
+	return NULL;
     }
 }
 
-
 static Tcl_Channel
-TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-                                         * can be NULL. */
-    CONST char *fileName;               /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-                                         * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-                                         * file, with what modes to create
-                                         * it? */
-{
-    CONST char *expectname="testOpenFileChannel2%.fil";
+TestOpenFileChannelProc2(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    const char *fileName,	/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or
+				 * a string such as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
+{
+    const char *expectname = "testOpenFileChannel2%.fil";
     Tcl_DString ds;
-    
+
     Tcl_DStringInit(&ds);
     Tcl_JoinPath(1, &expectname, &ds);
 
     if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
 	Tcl_DStringFree(&ds);
-	return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
+	return (PretendTclpOpenFileChannel(interp,
+		"__testOpenFileChannel2%__.fil",
 		modeString, permissions));
     } else {
 	Tcl_DStringFree(&ds);
@@ -5254,21 +5729,19 @@ TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
     }
 }
 
-
 static Tcl_Channel
-TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-                                         * can be NULL. */
-    CONST char *fileName;               /* Name of file to open. */
-    CONST char *modeString;             /* A list of POSIX open modes or
-                                         * a string such as "rw". */
-    int permissions;                    /* If the open involves creating a
-                                         * file, with what modes to create
-                                         * it? */
-{
-    CONST char *expectname="testOpenFileChannel3%.fil";
+TestOpenFileChannelProc3(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    const char *fileName,	/* Name of file to open. */
+    const char *modeString,	/* A list of POSIX open modes or a string such
+				 * as "rw". */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
+{
+    const char *expectname = "testOpenFileChannel3%.fil";
     Tcl_DString ds;
-    
+
     Tcl_DStringInit(&ds);
     Tcl_JoinPath(1, &expectname, &ds);
 
@@ -5281,6 +5754,7 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
 	return (NULL);
     }
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -5301,13 +5775,13 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
 
 	/* ARGSUSED */
 static int
-TestChannelCmd(clientData, interp, argc, argv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Interpreter for result. */
-    int argc;			/* Count of additional args. */
-    CONST char **argv;		/* Additional arg strings. */
+TestChannelCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Interpreter for result. */
+    int argc,			/* Count of additional args. */
+    const char **argv)		/* Additional arg strings. */
 {
-    CONST char *cmdName;	/* Sub command. */
+    const char *cmdName;	/* Sub command. */
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashSearch hSearch;	/* Search variable. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
@@ -5316,28 +5790,49 @@ TestChannelCmd(clientData, interp, argc, argv)
     Tcl_Channel chan;		/* The opaque type. */
     size_t len;			/* Length of subcommand string. */
     int IOQueued;		/* How much IO is queued inside channel? */
-    ChannelBuffer *bufPtr;	/* For iterating over queued IO. */
     char buf[TCL_INTEGER_SPACE];/* For sprintf. */
     int mode;			/* rw mode of the channel */
-    
+
     if (argc < 2) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " subcommand ?additional args..?\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" subcommand ?additional args..?\"", NULL);
+	return TCL_ERROR;
     }
     cmdName = argv[1];
     len = strlen(cmdName);
 
-    chanPtr = (Channel *) NULL;
+    chanPtr = NULL;
 
     if (argc > 2) {
-        chan = Tcl_GetChannel(interp, argv[2], &mode);
-        if (chan == (Tcl_Channel) NULL) {
-            return TCL_ERROR;
-        }
-        chanPtr		= (Channel *) chan;
+	if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
+	    /* For splice access the pool of detached channels.
+	     * Locate channel, remove from the list.
+	     */
+
+	    TestChannel **nextPtrPtr, *curPtr;
+
+	    chan = (Tcl_Channel) NULL;
+	    for (nextPtrPtr = &firstDetached, curPtr = firstDetached;
+		 curPtr != NULL;
+		 nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {
+
+		if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) {
+		    *nextPtrPtr = curPtr->nextPtr;
+		    curPtr->nextPtr = NULL;
+		    chan = curPtr->chan;
+		    ckfree((char *) curPtr);
+		    break;
+		}
+	    }
+	} else {
+	    chan = Tcl_GetChannel(interp, argv[2], &mode);
+	}
+	if (chan == (Tcl_Channel) NULL) {
+	    return TCL_ERROR;
+	}
+	chanPtr		= (Channel *) chan;
 	statePtr	= chanPtr->state;
-        chanPtr		= statePtr->topChanPtr;
+	chanPtr		= statePtr->topChanPtr;
 	chan		= (Tcl_Channel) chanPtr;
     } else {
 	/* lint */
@@ -5345,329 +5840,350 @@ TestChannelCmd(clientData, interp, argc, argv)
 	chan		= NULL;
     }
 
+    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {
+
+	Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
+
+	Tcl_IncrRefCount(msg);
+	Tcl_SetChannelError(chan, msg);
+	Tcl_DecrRefCount(msg);
+
+	Tcl_GetChannelError(chan, &msg);
+	Tcl_SetObjResult(interp, msg);
+	Tcl_DecrRefCount(msg);
+	return TCL_OK;
+    }
+    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {
+
+	Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
+
+	Tcl_IncrRefCount(msg);
+	Tcl_SetChannelErrorInterp(interp, msg);
+	Tcl_DecrRefCount(msg);
+
+	Tcl_GetChannelErrorInterp(interp, &msg);
+	Tcl_SetObjResult(interp, msg);
+	Tcl_DecrRefCount(msg);
+	return TCL_OK;
+    }
+
+    /*
+     * "cut" is actually more a simplified detach facility as provided by the
+     * Thread package. Without the safeguards of a regular command (no
+     * checking that the command is truly cut'able, no mutexes for
+     * thread-safety). Its complementary command is "splice", see below.
+     */
+
     if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " cut channelName\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        Tcl_CutChannel(chan);
-        return TCL_OK;
+	TestChannel *det;
+
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " cut channelName\"", NULL);
+	    return TCL_ERROR;
+	}
+
+	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
+	Tcl_UnregisterChannel(interp, chan);
+
+	Tcl_CutChannel(chan);
+
+	/* Remember the channel in the pool of detached channels */
+
+	det = (TestChannel *) ckalloc(sizeof(TestChannel));
+	det->chan     = chan;
+	det->nextPtr  = firstDetached;
+	firstDetached = det;
+
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'c') &&
 	    (strncmp(cmdName, "clearchannelhandlers", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " clearchannelhandlers channelName\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        Tcl_ClearChannelHandlers(chan);
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " clearchannelhandlers channelName\"", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_ClearChannelHandlers(chan);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " info channelName\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        Tcl_AppendElement(interp, argv[2]);
-        Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
-        if (statePtr->flags & TCL_READABLE) {
-            Tcl_AppendElement(interp, "read");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        if (statePtr->flags & TCL_WRITABLE) {
-            Tcl_AppendElement(interp, "write");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        if (statePtr->flags & CHANNEL_NONBLOCKING) {
-            Tcl_AppendElement(interp, "nonblocking");
-        } else {
-            Tcl_AppendElement(interp, "blocking");
-        }
-        if (statePtr->flags & CHANNEL_LINEBUFFERED) {
-            Tcl_AppendElement(interp, "line");
-        } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
-            Tcl_AppendElement(interp, "none");
-        } else {
-            Tcl_AppendElement(interp, "full");
-        }
-        if (statePtr->flags & BG_FLUSH_SCHEDULED) {
-            Tcl_AppendElement(interp, "async_flush");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        if (statePtr->flags & CHANNEL_EOF) {
-            Tcl_AppendElement(interp, "eof");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        if (statePtr->flags & CHANNEL_BLOCKED) {
-            Tcl_AppendElement(interp, "blocked");
-        } else {
-            Tcl_AppendElement(interp, "unblocked");
-        }
-        if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
-            Tcl_AppendElement(interp, "auto");
-            if (statePtr->flags & INPUT_SAW_CR) {
-                Tcl_AppendElement(interp, "saw_cr");
-            } else {
-                Tcl_AppendElement(interp, "");
-            }
-        } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
-            Tcl_AppendElement(interp, "lf");
-            Tcl_AppendElement(interp, "");
-        } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
-            Tcl_AppendElement(interp, "cr");
-            Tcl_AppendElement(interp, "");
-        } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
-            Tcl_AppendElement(interp, "crlf");
-            if (statePtr->flags & INPUT_SAW_CR) {
-                Tcl_AppendElement(interp, "queued_cr");
-            } else {
-                Tcl_AppendElement(interp, "");
-            }
-        }
-        if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
-            Tcl_AppendElement(interp, "auto");
-        } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
-            Tcl_AppendElement(interp, "lf");
-        } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
-            Tcl_AppendElement(interp, "cr");
-        } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
-            Tcl_AppendElement(interp, "crlf");
-        }
-        for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
-	     bufPtr != (ChannelBuffer *) NULL;
-	     bufPtr = bufPtr->nextPtr) {
-            IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
-        }
-        TclFormatInt(buf, IOQueued);
-        Tcl_AppendElement(interp, buf);
-        
-        IOQueued = 0;
-        if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
-            IOQueued = statePtr->curOutPtr->nextAdded -
-                statePtr->curOutPtr->nextRemoved;
-        }
-        for (bufPtr = statePtr->outQueueHead;
-	     bufPtr != (ChannelBuffer *) NULL;
-	     bufPtr = bufPtr->nextPtr) {
-            IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
-        }
-        TclFormatInt(buf, IOQueued);
-        Tcl_AppendElement(interp, buf);
-        
-        TclFormatInt(buf, (int)Tcl_Tell((Tcl_Channel) chanPtr));
-        Tcl_AppendElement(interp, buf);
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " info channelName\"", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_AppendElement(interp, argv[2]);
+	Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
+	if (statePtr->flags & TCL_READABLE) {
+	    Tcl_AppendElement(interp, "read");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	if (statePtr->flags & TCL_WRITABLE) {
+	    Tcl_AppendElement(interp, "write");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    Tcl_AppendElement(interp, "nonblocking");
+	} else {
+	    Tcl_AppendElement(interp, "blocking");
+	}
+	if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+	    Tcl_AppendElement(interp, "line");
+	} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+	    Tcl_AppendElement(interp, "none");
+	} else {
+	    Tcl_AppendElement(interp, "full");
+	}
+	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+	    Tcl_AppendElement(interp, "async_flush");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	if (statePtr->flags & CHANNEL_EOF) {
+	    Tcl_AppendElement(interp, "eof");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	if (statePtr->flags & CHANNEL_BLOCKED) {
+	    Tcl_AppendElement(interp, "blocked");
+	} else {
+	    Tcl_AppendElement(interp, "unblocked");
+	}
+	if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+	    Tcl_AppendElement(interp, "auto");
+	    if (statePtr->flags & INPUT_SAW_CR) {
+		Tcl_AppendElement(interp, "saw_cr");
+	    } else {
+		Tcl_AppendElement(interp, "");
+	    }
+	} else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
+	    Tcl_AppendElement(interp, "lf");
+	    Tcl_AppendElement(interp, "");
+	} else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+	    Tcl_AppendElement(interp, "cr");
+	    Tcl_AppendElement(interp, "");
+	} else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+	    Tcl_AppendElement(interp, "crlf");
+	    if (statePtr->flags & INPUT_SAW_CR) {
+		Tcl_AppendElement(interp, "queued_cr");
+	    } else {
+		Tcl_AppendElement(interp, "");
+	    }
+	}
+	if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+	    Tcl_AppendElement(interp, "auto");
+	} else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
+	    Tcl_AppendElement(interp, "lf");
+	} else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
+	    Tcl_AppendElement(interp, "cr");
+	} else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+	    Tcl_AppendElement(interp, "crlf");
+	}
+	IOQueued = Tcl_InputBuffered(chan);
+	TclFormatInt(buf, IOQueued);
+	Tcl_AppendElement(interp, buf);
 
-        TclFormatInt(buf, statePtr->refCount);
-        Tcl_AppendElement(interp, buf);
+	IOQueued = Tcl_OutputBuffered(chan);
+	TclFormatInt(buf, IOQueued);
+	Tcl_AppendElement(interp, buf);
 
-        return TCL_OK;
+	TclFormatInt(buf, (int)Tcl_Tell(chan));
+	Tcl_AppendElement(interp, buf);
+
+	TclFormatInt(buf, statePtr->refCount);
+	Tcl_AppendElement(interp, buf);
+
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'i') &&
-            (strncmp(cmdName, "inputbuffered", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-        
-        for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
-	     bufPtr != (ChannelBuffer *) NULL;
-	     bufPtr = bufPtr->nextPtr) {
-            IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
-        }
-        TclFormatInt(buf, IOQueued);
-        Tcl_AppendResult(interp, buf, (char *) NULL);
-        return TCL_OK;
+	    (strncmp(cmdName, "inputbuffered", len) == 0)) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+	IOQueued = Tcl_InputBuffered(chan);
+	TclFormatInt(buf, IOQueued);
+	Tcl_AppendResult(interp, buf, NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required", (char *) NULL);
-            return TCL_ERROR;
-        }
-        
-        TclFormatInt(buf, Tcl_IsChannelShared(chan));
-        Tcl_AppendResult(interp, buf, (char *) NULL);
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+
+	TclFormatInt(buf, Tcl_IsChannelShared(chan));
+	Tcl_AppendResult(interp, buf, NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
 	if (argc != 3) {
-	    Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+	    Tcl_AppendResult(interp, "channel name required", NULL);
 	    return TCL_ERROR;
 	}
-	
+
 	TclFormatInt(buf, Tcl_IsStandardChannel(chan));
-	Tcl_AppendResult(interp, buf, (char *) NULL);
+	Tcl_AppendResult(interp, buf, NULL);
 	return TCL_OK;
     }
 
     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-        
-        if (statePtr->flags & TCL_READABLE) {
-            Tcl_AppendElement(interp, "read");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        if (statePtr->flags & TCL_WRITABLE) {
-            Tcl_AppendElement(interp, "write");
-        } else {
-            Tcl_AppendElement(interp, "");
-        }
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+
+	if (statePtr->flags & TCL_READABLE) {
+	    Tcl_AppendElement(interp, "read");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	if (statePtr->flags & TCL_WRITABLE) {
+	    Tcl_AppendElement(interp, "write");
+	} else {
+	    Tcl_AppendElement(interp, "");
+	}
+	return TCL_OK;
     }
-    
+
     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
 
-        TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
-        Tcl_AppendResult(interp, buf, (char *) NULL);
-        return TCL_OK;
+	TclFormatInt(buf, (long)(size_t)Tcl_GetChannelThread(chan));
+	Tcl_AppendResult(interp, buf, NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-        Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL);
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_AppendResult(interp, statePtr->channelName, NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
-        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-        if (hTblPtr == (Tcl_HashTable *) NULL) {
-            return TCL_OK;
-        }
-        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != (Tcl_HashEntry *) NULL;
+	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+	if (hTblPtr == NULL) {
+	    return TCL_OK;
+	}
+	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+	     hPtr != NULL;
 	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-            Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
-        }
-        return TCL_OK;
+	    Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+	}
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'o') &&
-            (strncmp(cmdName, "outputbuffered", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
+	    (strncmp(cmdName, "outputbuffered", len) == 0)) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
 
-        IOQueued = 0;
-        if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
-            IOQueued = statePtr->curOutPtr->nextAdded -
-                statePtr->curOutPtr->nextRemoved;
-        }
-        for (bufPtr = statePtr->outQueueHead;
-	     bufPtr != (ChannelBuffer *) NULL;
-	     bufPtr = bufPtr->nextPtr) {
-            IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
-        }
-        TclFormatInt(buf, IOQueued);
-        Tcl_AppendResult(interp, buf, (char *) NULL);
-        return TCL_OK;
+	IOQueued = Tcl_OutputBuffered(chan);
+	TclFormatInt(buf, IOQueued);
+	Tcl_AppendResult(interp, buf, NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'q') &&
-            (strncmp(cmdName, "queuedcr", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
+	    (strncmp(cmdName, "queuedcr", len) == 0)) {
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
 
-        Tcl_AppendResult(interp,
-                (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
-                (char *) NULL);
-        return TCL_OK;
+	Tcl_AppendResult(interp,
+		(statePtr->flags & INPUT_SAW_CR) ? "1" : "0", NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
-        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-        if (hTblPtr == (Tcl_HashTable *) NULL) {
-            return TCL_OK;
-        }
-        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != (Tcl_HashEntry *) NULL;
+	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+	if (hTblPtr == NULL) {
+	    return TCL_OK;
+	}
+	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+	     hPtr != NULL;
 	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-            chanPtr  = (Channel *) Tcl_GetHashValue(hPtr);
+	    chanPtr  = (Channel *) Tcl_GetHashValue(hPtr);
 	    statePtr = chanPtr->state;
-            if (statePtr->flags & TCL_READABLE) {
-                Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
-            }
-        }
-        return TCL_OK;
+	    if (statePtr->flags & TCL_READABLE) {
+		Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+	    }
+	}
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-        
-        TclFormatInt(buf, statePtr->refCount);
-        Tcl_AppendResult(interp, buf, (char *) NULL);
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+
+	TclFormatInt(buf, statePtr->refCount);
+	Tcl_AppendResult(interp, buf, NULL);
+	return TCL_OK;
     }
 
+    /*
+     * "splice" is actually more a simplified attach facility as provided by
+     * the Thread package. Without the safeguards of a regular command (no
+     * checking that the command is truly cut'able, no mutexes for
+     * thread-safety). Its complementary command is "cut", see above.
+     */
+
     if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required", (char *) NULL);
-            return TCL_ERROR;
-        }
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
 
-        Tcl_SpliceChannel(chan);
-        return TCL_OK;
+	Tcl_SpliceChannel(chan);
+
+	Tcl_RegisterChannel(interp, chan);
+	Tcl_UnregisterChannel(NULL, chan);
+
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "channel name required",
-                    (char *) NULL);
-            return TCL_ERROR;
-        }
-        Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr),
-		(char *) NULL);
-        return TCL_OK;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), NULL);
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
-        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-        if (hTblPtr == (Tcl_HashTable *) NULL) {
-            return TCL_OK;
-        }
-        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != (Tcl_HashEntry *) NULL;
-	     hPtr = Tcl_NextHashEntry(&hSearch)) {
-            chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+	if (hTblPtr == NULL) {
+	    return TCL_OK;
+	}
+	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+	    chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
 	    statePtr = chanPtr->state;
-            if (statePtr->flags & TCL_WRITABLE) {
-                Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
-            }
-        }
-        return TCL_OK;
+	    if (statePtr->flags & TCL_WRITABLE) {
+		Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+	    }
+	}
+	return TCL_OK;
     }
 
     if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
@@ -5675,14 +6191,14 @@ TestChannelCmd(clientData, interp, argc, argv)
 	 * Syntax: transform channel -command command
 	 */
 
-        if (argc != 5) {
+	if (argc != 5) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " transform channelId -command cmd\"", (char *) NULL);
-            return TCL_ERROR;
-        }
+		    " transform channelId -command cmd\"", NULL);
+	    return TCL_ERROR;
+	}
 	if (strcmp(argv[3], "-command") != 0) {
 	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
-		    "\": should be \"-command\"", (char *) NULL);
+		    "\": should be \"-command\"", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -5695,18 +6211,17 @@ TestChannelCmd(clientData, interp, argc, argv)
 	 * Syntax: unstack channel
 	 */
 
-        if (argc != 3) {
+	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " unstack channel\"", (char *) NULL);
-            return TCL_ERROR;
-        }
+		    " unstack channel\"", NULL);
+	    return TCL_ERROR;
+	}
 	return Tcl_UnstackChannel(interp, chan);
     }
 
-    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
-            "cut, clearchannelhandlers, info, isshared, mode, open, "
-	    "readable, splice, writable, transform, unstack",
-            (char *) NULL);
+    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be "
+	    "cut, clearchannelhandlers, info, isshared, mode, open, "
+	    "readable, splice, writable, transform, unstack", NULL);
     return TCL_ERROR;
 }
 
@@ -5715,8 +6230,8 @@ TestChannelCmd(clientData, interp, argc, argv)
  *
  * TestChannelEventCmd --
  *
- *	This procedure implements the "testchannelevent" command. It is
- *	used to test the Tcl channel event mechanism.
+ *	This procedure implements the "testchannelevent" command. It is used
+ *	to test the Tcl channel event mechanism.
  *
  * Results:
  *	A standard Tcl result.
@@ -5729,198 +6244,198 @@ TestChannelCmd(clientData, interp, argc, argv)
 
 	/* ARGSUSED */
 static int
-TestChannelEventCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
+TestChannelEventCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
 {
     Tcl_Obj *resultListPtr;
     Channel *chanPtr;
     ChannelState *statePtr;	/* state info for channel */
     EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
-    CONST char *cmd;
+    const char *cmd;
     int index, i, mask, len;
 
     if ((argc < 3) || (argc > 5)) {
-        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" channelName cmd ?arg1? ?arg2?\"", NULL);
+	return TCL_ERROR;
     }
     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
-    if (chanPtr == (Channel *) NULL) {
-        return TCL_ERROR;
+    if (chanPtr == NULL) {
+	return TCL_ERROR;
     }
     statePtr = chanPtr->state;
 
     cmd = argv[2];
     len = strlen(cmd);
     if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
-        if (argc != 5) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " channelName add eventSpec script\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (strcmp(argv[3], "readable") == 0) {
-            mask = TCL_READABLE;
-        } else if (strcmp(argv[3], "writable") == 0) {
-            mask = TCL_WRITABLE;
-        } else if (strcmp(argv[3], "none") == 0) {
-            mask = 0;
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " channelName add eventSpec script\"", NULL);
+	    return TCL_ERROR;
+	}
+	if (strcmp(argv[3], "readable") == 0) {
+	    mask = TCL_READABLE;
+	} else if (strcmp(argv[3], "writable") == 0) {
+	    mask = TCL_WRITABLE;
+	} else if (strcmp(argv[3], "none") == 0) {
+	    mask = 0;
 	} else {
-            Tcl_AppendResult(interp, "bad event name \"", argv[3],
-                    "\": must be readable, writable, or none", (char *) NULL);
-            return TCL_ERROR;
-        }
+	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
+		    "\": must be readable, writable, or none", NULL);
+	    return TCL_ERROR;
+	}
+
+	esPtr = (EventScriptRecord *) ckalloc((unsigned)
+		sizeof(EventScriptRecord));
+	esPtr->nextPtr = statePtr->scriptRecordPtr;
+	statePtr->scriptRecordPtr = esPtr;
 
-        esPtr = (EventScriptRecord *) ckalloc((unsigned)
-                sizeof(EventScriptRecord));
-        esPtr->nextPtr = statePtr->scriptRecordPtr;
-        statePtr->scriptRecordPtr = esPtr;
-        
-        esPtr->chanPtr = chanPtr;
-        esPtr->interp = interp;
-        esPtr->mask = mask;
+	esPtr->chanPtr = chanPtr;
+	esPtr->interp = interp;
+	esPtr->mask = mask;
 	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
 	Tcl_IncrRefCount(esPtr->scriptPtr);
 
-        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
-                TclChannelEventScriptInvoker, (ClientData) esPtr);
-        
-        return TCL_OK;
+	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+		TclChannelEventScriptInvoker, (ClientData) esPtr);
+
+	return TCL_OK;
     }
 
     if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
-        if (argc != 4) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " channelName delete index\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
-            return TCL_ERROR;
-        }
-        if (index < 0) {
-            Tcl_AppendResult(interp, "bad event index: ", argv[3],
-                    ": must be nonnegative", (char *) NULL);
-            return TCL_ERROR;
-        }
-        for (i = 0, esPtr = statePtr->scriptRecordPtr;
-	     (i < index) && (esPtr != (EventScriptRecord *) NULL);
+	if (argc != 4) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " channelName delete index\"", NULL);
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (index < 0) {
+	    Tcl_AppendResult(interp, "bad event index: ", argv[3],
+		    ": must be nonnegative", NULL);
+	    return TCL_ERROR;
+	}
+	for (i = 0, esPtr = statePtr->scriptRecordPtr;
+	     (i < index) && (esPtr != NULL);
 	     i++, esPtr = esPtr->nextPtr) {
 	    /* Empty loop body. */
-        }
-        if (esPtr == (EventScriptRecord *) NULL) {
-            Tcl_AppendResult(interp, "bad event index ", argv[3],
-                    ": out of range", (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (esPtr == statePtr->scriptRecordPtr) {
-            statePtr->scriptRecordPtr = esPtr->nextPtr;
-        } else {
-            for (prevEsPtr = statePtr->scriptRecordPtr;
-		 (prevEsPtr != (EventScriptRecord *) NULL) &&
+	}
+	if (esPtr == NULL) {
+	    Tcl_AppendResult(interp, "bad event index ", argv[3],
+		    ": out of range", NULL);
+	    return TCL_ERROR;
+	}
+	if (esPtr == statePtr->scriptRecordPtr) {
+	    statePtr->scriptRecordPtr = esPtr->nextPtr;
+	} else {
+	    for (prevEsPtr = statePtr->scriptRecordPtr;
+		 (prevEsPtr != NULL) &&
 		     (prevEsPtr->nextPtr != esPtr);
 		 prevEsPtr = prevEsPtr->nextPtr) {
-                /* Empty loop body. */
-            }
-            if (prevEsPtr == (EventScriptRecord *) NULL) {
-                panic("TestChannelEventCmd: damaged event script list");
-            }
-            prevEsPtr->nextPtr = esPtr->nextPtr;
-        }
-        Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-                TclChannelEventScriptInvoker, (ClientData) esPtr);
+		/* Empty loop body. */
+	    }
+	    if (prevEsPtr == NULL) {
+		Tcl_Panic("TestChannelEventCmd: damaged event script list");
+	    }
+	    prevEsPtr->nextPtr = esPtr->nextPtr;
+	}
+	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+		TclChannelEventScriptInvoker, (ClientData) esPtr);
 	Tcl_DecrRefCount(esPtr->scriptPtr);
-        ckfree((char *) esPtr);
+	ckfree((char *) esPtr);
 
-        return TCL_OK;
+	return TCL_OK;
     }
 
     if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " channelName list\"", (char *) NULL);
-            return TCL_ERROR;
-        }
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " channelName list\"", NULL);
+	    return TCL_ERROR;
+	}
 	resultListPtr = Tcl_GetObjResult(interp);
-        for (esPtr = statePtr->scriptRecordPtr;
-	     esPtr != (EventScriptRecord *) NULL;
+	for (esPtr = statePtr->scriptRecordPtr;
+	     esPtr != NULL;
 	     esPtr = esPtr->nextPtr) {
 	    if (esPtr->mask) {
- 	        Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+		Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
 		    (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
- 	    } else {
- 	        Tcl_ListObjAppendElement(interp, resultListPtr, 
+	    } else {
+		Tcl_ListObjAppendElement(interp, resultListPtr,
 			Tcl_NewStringObj("none", -1));
 	    }
-  	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
-        }
+	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
+	}
 	Tcl_SetObjResult(interp, resultListPtr);
-        return TCL_OK;
+	return TCL_OK;
     }
 
     if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
-        if (argc != 3) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " channelName removeall\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        for (esPtr = statePtr->scriptRecordPtr;
-	     esPtr != (EventScriptRecord *) NULL;
+	if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " channelName removeall\"", NULL);
+	    return TCL_ERROR;
+	}
+	for (esPtr = statePtr->scriptRecordPtr;
+	     esPtr != NULL;
 	     esPtr = nextEsPtr) {
-            nextEsPtr = esPtr->nextPtr;
-            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-                    TclChannelEventScriptInvoker, (ClientData) esPtr);
+	    nextEsPtr = esPtr->nextPtr;
+	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+		    TclChannelEventScriptInvoker, (ClientData) esPtr);
 	    Tcl_DecrRefCount(esPtr->scriptPtr);
-            ckfree((char *) esPtr);
-        }
-        statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
-        return TCL_OK;
+	    ckfree((char *) esPtr);
+	}
+	statePtr->scriptRecordPtr = NULL;
+	return TCL_OK;
     }
 
-    if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
-        if (argc != 5) {
-            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-                    " channelName delete index event\"", (char *) NULL);
-            return TCL_ERROR;
-        }
-        if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
-            return TCL_ERROR;
-        }
-        if (index < 0) {
-            Tcl_AppendResult(interp, "bad event index: ", argv[3],
-                    ": must be nonnegative", (char *) NULL);
-            return TCL_ERROR;
-        }
-        for (i = 0, esPtr = statePtr->scriptRecordPtr;
-	     (i < index) && (esPtr != (EventScriptRecord *) NULL);
+    if	((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+	if (argc != 5) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		    " channelName delete index event\"", NULL);
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (index < 0) {
+	    Tcl_AppendResult(interp, "bad event index: ", argv[3],
+		    ": must be nonnegative", NULL);
+	    return TCL_ERROR;
+	}
+	for (i = 0, esPtr = statePtr->scriptRecordPtr;
+	     (i < index) && (esPtr != NULL);
 	     i++, esPtr = esPtr->nextPtr) {
 	    /* Empty loop body. */
-        }
-        if (esPtr == (EventScriptRecord *) NULL) {
-            Tcl_AppendResult(interp, "bad event index ", argv[3],
-                    ": out of range", (char *) NULL);
-            return TCL_ERROR;
-        }
+	}
+	if (esPtr == NULL) {
+	    Tcl_AppendResult(interp, "bad event index ", argv[3],
+		    ": out of range", NULL);
+	    return TCL_ERROR;
+	}
 
-        if (strcmp(argv[4], "readable") == 0) {
-            mask = TCL_READABLE;
-        } else if (strcmp(argv[4], "writable") == 0) {
-            mask = TCL_WRITABLE;
-        } else if (strcmp(argv[4], "none") == 0) {
-            mask = 0;
+	if (strcmp(argv[4], "readable") == 0) {
+	    mask = TCL_READABLE;
+	} else if (strcmp(argv[4], "writable") == 0) {
+	    mask = TCL_WRITABLE;
+	} else if (strcmp(argv[4], "none") == 0) {
+	    mask = 0;
 	} else {
-            Tcl_AppendResult(interp, "bad event name \"", argv[4],
-                    "\": must be readable, writable, or none", (char *) NULL);
-            return TCL_ERROR;
-        }
+	    Tcl_AppendResult(interp, "bad event name \"", argv[4],
+		    "\": must be readable, writable, or none", NULL);
+	    return TCL_ERROR;
+	}
 	esPtr->mask = mask;
-        Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
-                TclChannelEventScriptInvoker, (ClientData) esPtr);
+	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+		TclChannelEventScriptInvoker, (ClientData) esPtr);
 	return TCL_OK;
-    }    
-    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
-            "add, delete, list, set, or removeall", (char *) NULL);
+    }
+    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of "
+	    "add, delete, list, set, or removeall", NULL);
     return TCL_ERROR;
 }
 
@@ -5941,11 +6456,11 @@ TestChannelEventCmd(dummy, interp, argc, argv)
  */
 
 static int
-TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+TestWrongNumArgsObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, length;
     char *msg;
@@ -5958,7 +6473,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
 	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
 	return TCL_ERROR;
     }
-    
+
     if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -5967,7 +6482,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
     if (length == 0) {
 	msg = NULL;
     }
-    
+
     if (i > objc - 3) {
 	/*
 	 * Asked for more arguments than were given.
@@ -5997,14 +6512,14 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
  */
 
 static int
-TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+TestGetIndexFromObjStructObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     char *ary[] = {
-	"a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL
+	"a", "b", "c", "d", "e", "f", NULL, NULL
     };
     int idx,target;
 
@@ -6013,7 +6528,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
-				  "dummy", 0, &idx) != TCL_OK) {
+	    "dummy", 0, &idx) != TCL_OK) {
 	return TCL_ERROR;
     }
     if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
@@ -6023,7 +6538,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
 	char buffer[64];
 	sprintf(buffer, "%d", idx);
 	Tcl_AppendResult(interp, "index value comparison failed: got ",
-			 buffer, NULL);
+		buffer, NULL);
 	sprintf(buffer, "%d", target);
 	Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
 	return TCL_ERROR;
@@ -6037,9 +6552,9 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
  *
  * TestFilesystemObjCmd --
  *
- *	This procedure implements the "testfilesystem" command.  It is
- *	used to test Tcl_FSRegister, Tcl_FSUnregister, and can be used
- *	to test that the pluggable filesystem works.
+ *	This procedure implements the "testfilesystem" command. It is used to
+ *	test Tcl_FSRegister, Tcl_FSUnregister, and can be used to test that
+ *	the pluggable filesystem works.
  *
  * Results:
  *	A standard Tcl result.
@@ -6051,15 +6566,15 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
  */
 
 static int
-TestFilesystemObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;
-    Tcl_Interp *interp;
-    int		objc;
-    Tcl_Obj	*CONST objv[];
+TestFilesystemObjCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
     int res, boolVal;
     char *msg;
-    
+
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
 	return TCL_ERROR;
@@ -6078,78 +6593,90 @@ TestFilesystemObjCmd(dummy, interp, objc, objv)
     return res;
 }
 
-static int 
-TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
+static int
+TestReportInFilesystem(
+    Tcl_Obj *pathPtr,
+    ClientData *clientDataPtr)
 {
-    static Tcl_Obj* lastPathPtr = NULL;
-    
+    static Tcl_Obj *lastPathPtr = NULL;
+    Tcl_Obj *newPathPtr;
+
     if (pathPtr == lastPathPtr) {
 	/* Reject all files second time around */
-        return -1;
-    } else {
-	Tcl_Obj * newPathPtr;
-	/* Try to claim all files first time around */
-
-	newPathPtr = Tcl_DuplicateObj(pathPtr);
-	lastPathPtr = newPathPtr;
-	Tcl_IncrRefCount(newPathPtr);
-	if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
-	    /* Nothing claimed it.  Therefore we don't either */
-	    Tcl_DecrRefCount(newPathPtr);
-	    lastPathPtr = NULL;
-	    return -1;
-	} else {
-	    lastPathPtr = NULL;
-	    *clientDataPtr = (ClientData) newPathPtr;
-	    return TCL_OK;
-	}
+	return -1;
+    }
+
+    /* Try to claim all files first time around */
+
+    newPathPtr = Tcl_DuplicateObj(pathPtr);
+    lastPathPtr = newPathPtr;
+    Tcl_IncrRefCount(newPathPtr);
+    if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
+	/* Nothing claimed it. Therefore we don't either */
+	Tcl_DecrRefCount(newPathPtr);
+	lastPathPtr = NULL;
+	return -1;
     }
+    lastPathPtr = NULL;
+    *clientDataPtr = (ClientData) newPathPtr;
+    return TCL_OK;
 }
 
-/* 
- * Simple helper function to extract the native vfs representation of a
- * path object, or NULL if no such representation exists.
+/*
+ * Simple helper function to extract the native vfs representation of a path
+ * object, or NULL if no such representation exists.
  */
-static Tcl_Obj* 
-TestReportGetNativePath(Tcl_Obj* pathObjPtr) {
-    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem);
+
+static Tcl_Obj *
+TestReportGetNativePath(
+    Tcl_Obj *pathPtr)
+{
+    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem);
 }
 
-static void 
-TestReportFreeInternalRep(ClientData clientData) {
-    Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
+static void
+TestReportFreeInternalRep(
+    ClientData clientData)
+{
+    Tcl_Obj *nativeRep = (Tcl_Obj *) clientData;
+
     if (nativeRep != NULL) {
 	/* Free the path */
 	Tcl_DecrRefCount(nativeRep);
     }
 }
 
-static ClientData 
-TestReportDupInternalRep(ClientData clientData) {
-    Tcl_Obj *original = (Tcl_Obj*)clientData;
+static ClientData
+TestReportDupInternalRep(
+    ClientData clientData)
+{
+    Tcl_Obj *original = (Tcl_Obj *) clientData;
+
     Tcl_IncrRefCount(original);
     return clientData;
 }
 
 static void
-TestReport(cmd, path, arg2)
-    CONST char* cmd;
-    Tcl_Obj* path;
-    Tcl_Obj* arg2;
+TestReport(
+    const char *cmd,
+    Tcl_Obj *path,
+    Tcl_Obj *arg2)
 {
-    Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
+    Tcl_Interp *interp = (Tcl_Interp *) Tcl_FSData(&testReportingFilesystem);
+
     if (interp == NULL) {
 	/* This is bad, but not much we can do about it */
     } else {
-	/* 
-	 * No idea why I decided to program this up using the
-	 * old string-based API, but there you go.  We should
-	 * convert it to objects.
+	/*
+	 * No idea why I decided to program this up using the old string-based
+	 * API, but there you go. We should convert it to objects.
 	 */
+
 	Tcl_SavedResult savedResult;
 	Tcl_DString ds;
+
 	Tcl_DStringInit(&ds);
-	Tcl_DStringAppend(&ds, "lappend filesystemReport ",-1);
+	Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
 	Tcl_DStringStartSublist(&ds);
 	Tcl_DStringAppendElement(&ds, cmd);
 	if (path != NULL) {
@@ -6167,254 +6694,259 @@ TestReport(cmd, path, arg2)
 }
 
 static int
-TestReportStat(path, buf)
-    Tcl_Obj *path;		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
+TestReportStat(
+    Tcl_Obj *path,		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
-    TestReport("stat",path, NULL);
-    return Tcl_FSStat(TestReportGetNativePath(path),buf);
+    TestReport("stat", path, NULL);
+    return Tcl_FSStat(TestReportGetNativePath(path), buf);
 }
+
 static int
-TestReportLstat(path, buf)
-    Tcl_Obj *path;		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
+TestReportLstat(
+    Tcl_Obj *path,		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
-    TestReport("lstat",path, NULL);
-    return Tcl_FSLstat(TestReportGetNativePath(path),buf);
+    TestReport("lstat", path, NULL);
+    return Tcl_FSLstat(TestReportGetNativePath(path), buf);
 }
+
 static int
-TestReportAccess(path, mode)
-    Tcl_Obj *path;		/* Path of file to access (in current CP). */
-    int mode;                   /* Permission setting. */
+TestReportAccess(
+    Tcl_Obj *path,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
 {
-    TestReport("access",path,NULL);
-    return Tcl_FSAccess(TestReportGetNativePath(path),mode);
+    TestReport("access", path, NULL);
+    return Tcl_FSAccess(TestReportGetNativePath(path), mode);
 }
+
 static Tcl_Channel
-TestReportOpenFileChannel(interp, fileName, mode, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-					 * can be NULL. */
-    Tcl_Obj *fileName;                  /* Name of file to open. */
-    int mode;                           /* POSIX open mode. */
-    int permissions;                    /* If the open involves creating a
-					 * file, with what modes to create
-					 * it? */
-{
-    TestReport("open",fileName, NULL);
+TestReportOpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    Tcl_Obj *fileName,		/* Name of file to open. */
+    int mode,			/* POSIX open mode. */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
+{
+    TestReport("open", fileName, NULL);
     return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName),
-				 mode, permissions);
+	    mode, permissions);
 }
 
 static int
-TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
-    Tcl_Interp *interp;		/* Interpreter to receive results. */
-    Tcl_Obj *resultPtr;		/* Object to lappend results. */
-    Tcl_Obj *dirPtr;	        /* Contains path to directory to search. */
-    CONST char *pattern;	/* Pattern to match against. */
-    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
+TestReportMatchInDirectory(
+    Tcl_Interp *interp,		/* Interpreter for error messages. */
+    Tcl_Obj *resultPtr,		/* Object to lappend results. */
+    Tcl_Obj *dirPtr,		/* Contains path to directory to search. */
+    const char *pattern,	/* Pattern to match against. */
+    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
 				 * May be NULL. */
 {
     if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
-	TestReport("matchmounts",dirPtr, NULL);
+	TestReport("matchmounts", dirPtr, NULL);
 	return TCL_OK;
     } else {
-	TestReport("matchindirectory",dirPtr, NULL);
-	return Tcl_FSMatchInDirectory(interp, resultPtr, 
-				      TestReportGetNativePath(dirPtr), pattern, 
-				      types);
+	TestReport("matchindirectory", dirPtr, NULL);
+	return Tcl_FSMatchInDirectory(interp, resultPtr,
+		TestReportGetNativePath(dirPtr), pattern, types);
     }
 }
+
 static int
-TestReportChdir(dirName)
-    Tcl_Obj *dirName;
+TestReportChdir(
+    Tcl_Obj *dirName)
 {
-    TestReport("chdir",dirName,NULL);
+    TestReport("chdir", dirName, NULL);
     return Tcl_FSChdir(TestReportGetNativePath(dirName));
 }
+
 static int
-TestReportLoadFile(interp, fileName,  
-		   handlePtr, unloadProcPtr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    Tcl_Obj *fileName;		/* Name of the file containing the desired
+TestReportLoadFile(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Obj *fileName,		/* Name of the file containing the desired
 				 * code. */
-    Tcl_LoadHandle *handlePtr;	/* Filled with token for dynamically loaded
-				 * file which will be passed back to 
+    Tcl_LoadHandle *handlePtr,	/* Filled with token for dynamically loaded
+				 * file which will be passed back to
 				 * (*unloadProcPtr)() to unload the file. */
-    Tcl_FSUnloadFileProc **unloadProcPtr;	
+    Tcl_FSUnloadFileProc **unloadProcPtr)
 				/* Filled with address of Tcl_FSUnloadFileProc
 				 * function which should be used for
 				 * this file. */
 {
-    TestReport("loadfile",fileName,NULL);
-    return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL, NULL,
-			  NULL, NULL, handlePtr, unloadProcPtr);
+    TestReport("loadfile", fileName, NULL);
+    return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL,
+	    NULL, NULL, NULL, handlePtr, unloadProcPtr);
 }
+
 static Tcl_Obj *
-TestReportLink(path, to, linkType)
-    Tcl_Obj *path;		/* Path of file to readlink or link */
-    Tcl_Obj *to;		/* Path of file to link to, or NULL */
-    int linkType;
+TestReportLink(
+    Tcl_Obj *path,		/* Path of file to readlink or link */
+    Tcl_Obj *to,		/* Path of file to link to, or NULL */
+    int linkType)
 {
-    TestReport("link",path,to);
+    TestReport("link", path, to);
     return Tcl_FSLink(TestReportGetNativePath(path), to, linkType);
 }
+
 static int
-TestReportRenameFile(src, dst)
-    Tcl_Obj *src;		/* Pathname of file or dir to be renamed
+TestReportRenameFile(
+    Tcl_Obj *src,		/* Pathname of file or dir to be renamed
 				 * (UTF-8). */
-    Tcl_Obj *dst;		/* New pathname of file or directory
+    Tcl_Obj *dst)		/* New pathname of file or directory
 				 * (UTF-8). */
 {
-    TestReport("renamefile",src,dst);
-    return Tcl_FSRenameFile(TestReportGetNativePath(src), 
-			    TestReportGetNativePath(dst));
+    TestReport("renamefile", src, dst);
+    return Tcl_FSRenameFile(TestReportGetNativePath(src),
+	    TestReportGetNativePath(dst));
 }
-static int 
-TestReportCopyFile(src, dst)
-    Tcl_Obj *src;		/* Pathname of file to be copied (UTF-8). */
-    Tcl_Obj *dst;		/* Pathname of file to copy to (UTF-8). */
+
+static int
+TestReportCopyFile(
+    Tcl_Obj *src,		/* Pathname of file to be copied (UTF-8). */
+    Tcl_Obj *dst)		/* Pathname of file to copy to (UTF-8). */
 {
-    TestReport("copyfile",src,dst);
-    return Tcl_FSCopyFile(TestReportGetNativePath(src), 
-			    TestReportGetNativePath(dst));
+    TestReport("copyfile", src, dst);
+    return Tcl_FSCopyFile(TestReportGetNativePath(src),
+	    TestReportGetNativePath(dst));
 }
+
 static int
-TestReportDeleteFile(path)
-    Tcl_Obj *path;		/* Pathname of file to be removed (UTF-8). */
+TestReportDeleteFile(
+    Tcl_Obj *path)		/* Pathname of file to be removed (UTF-8). */
 {
-    TestReport("deletefile",path,NULL);
+    TestReport("deletefile", path, NULL);
     return Tcl_FSDeleteFile(TestReportGetNativePath(path));
 }
+
 static int
-TestReportCreateDirectory(path)
-    Tcl_Obj *path;		/* Pathname of directory to create (UTF-8). */
+TestReportCreateDirectory(
+    Tcl_Obj *path)		/* Pathname of directory to create (UTF-8). */
 {
-    TestReport("createdirectory",path,NULL);
+    TestReport("createdirectory", path, NULL);
     return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
 }
+
 static int
-TestReportCopyDirectory(src, dst, errorPtr)
-    Tcl_Obj *src;		/* Pathname of directory to be copied
+TestReportCopyDirectory(
+    Tcl_Obj *src,		/* Pathname of directory to be copied
 				 * (UTF-8). */
-    Tcl_Obj *dst;		/* Pathname of target directory (UTF-8). */
-    Tcl_Obj **errorPtr;	        /* If non-NULL, to be filled with UTF-8 name 
-                       	         * of file causing error. */
+    Tcl_Obj *dst,		/* Pathname of target directory (UTF-8). */
+    Tcl_Obj **errorPtr)		/* If non-NULL, to be filled with UTF-8 name
+				 * of file causing error. */
 {
-    TestReport("copydirectory",src,dst);
-    return Tcl_FSCopyDirectory(TestReportGetNativePath(src), 
-			    TestReportGetNativePath(dst), errorPtr);
+    TestReport("copydirectory", src, dst);
+    return Tcl_FSCopyDirectory(TestReportGetNativePath(src),
+	    TestReportGetNativePath(dst), errorPtr);
 }
+
 static int
-TestReportRemoveDirectory(path, recursive, errorPtr)
-    Tcl_Obj *path;		/* Pathname of directory to be removed
+TestReportRemoveDirectory(
+    Tcl_Obj *path,		/* Pathname of directory to be removed
 				 * (UTF-8). */
-    int recursive;		/* If non-zero, removes directories that
+    int recursive,		/* If non-zero, removes directories that
 				 * are nonempty.  Otherwise, will only remove
 				 * empty directories. */
-    Tcl_Obj **errorPtr;	        /* If non-NULL, to be filled with UTF-8 name 
-                       	         * of file causing error. */
+    Tcl_Obj **errorPtr)		/* If non-NULL, to be filled with UTF-8 name
+				 * of file causing error. */
 {
-    TestReport("removedirectory",path,NULL);
-    return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive, 
-				 errorPtr);
+    TestReport("removedirectory", path, NULL);
+    return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
+	    errorPtr);
 }
-static CONST char**
-TestReportFileAttrStrings(fileName, objPtrRef)
-    Tcl_Obj* fileName;
-    Tcl_Obj** objPtrRef;
+
+static const char **
+TestReportFileAttrStrings(
+    Tcl_Obj *fileName,
+    Tcl_Obj **objPtrRef)
 {
-    TestReport("fileattributestrings",fileName,NULL);
+    TestReport("fileattributestrings", fileName, NULL);
     return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
 }
+
 static int
-TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *fileName;		/* filename we are operating on. */
-    Tcl_Obj **objPtrRef;	/* for output. */
+TestReportFileAttrsGet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *fileName,		/* filename we are operating on. */
+    Tcl_Obj **objPtrRef)	/* for output. */
 {
-    TestReport("fileattributesget",fileName,NULL);
-    return Tcl_FSFileAttrsGet(interp, index, 
-			      TestReportGetNativePath(fileName), objPtrRef);
+    TestReport("fileattributesget", fileName, NULL);
+    return Tcl_FSFileAttrsGet(interp, index,
+	    TestReportGetNativePath(fileName), objPtrRef);
 }
+
 static int
-TestReportFileAttrsSet(interp, index, fileName, objPtr)
-    Tcl_Interp *interp;		/* The interpreter for error reporting. */
-    int index;			/* index of the attribute command. */
-    Tcl_Obj *fileName;		/* filename we are operating on. */
-    Tcl_Obj *objPtr;		/* for input. */
-{
-    TestReport("fileattributesset",fileName,objPtr);
-    return Tcl_FSFileAttrsSet(interp, index, 
-			      TestReportGetNativePath(fileName), objPtr);
-}
-static int 
-TestReportUtime (fileName, tval)
-    Tcl_Obj* fileName;
-    struct utimbuf *tval;
-{
-    TestReport("utime",fileName,NULL);
+TestReportFileAttrsSet(
+    Tcl_Interp *interp,		/* The interpreter for error reporting. */
+    int index,			/* index of the attribute command. */
+    Tcl_Obj *fileName,		/* filename we are operating on. */
+    Tcl_Obj *objPtr)		/* for input. */
+{
+    TestReport("fileattributesset", fileName, objPtr);
+    return Tcl_FSFileAttrsSet(interp, index,
+	    TestReportGetNativePath(fileName), objPtr);
+}
+
+static int
+TestReportUtime(
+    Tcl_Obj *fileName,
+    struct utimbuf *tval)
+{
+    TestReport("utime", fileName, NULL);
     return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
 }
+
 static int
-TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
-    Tcl_Interp *interp;
-    Tcl_Obj *pathPtr;
-    int nextCheckpoint;
+TestReportNormalizePath(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathPtr,
+    int nextCheckpoint)
 {
-    TestReport("normalizepath",pathPtr,NULL);
+    TestReport("normalizepath", pathPtr, NULL);
     return nextCheckpoint;
 }
 
-static int 
-SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
-    CONST char *str = Tcl_GetString(pathPtr);
-    if (strncmp(str,"simplefs:/",10)) {
+static int
+SimplePathInFilesystem(
+    Tcl_Obj *pathPtr,
+    ClientData *clientDataPtr)
+{
+    const char *str = Tcl_GetString(pathPtr);
+
+    if (strncmp(str, "simplefs:/", 10)) {
 	return -1;
     }
     return TCL_OK;
 }
 
-/* 
- * Since TclCopyChannel insists on an interpreter, we use this
- * to simplify our test scripts.  Would be better if it could
- * copy without an interp
- */
-static Tcl_Interp *simpleInterpPtr = NULL;
-/* We use this to ensure we clean up after ourselves */
-static Tcl_Obj *tempFile = NULL;
-
-/* 
- * This is a very 'hacky' filesystem which is used just to 
- * test two important features of the vfs code: (1) that
- * you can load a shared library from a vfs, (2) that when
- * copying files from one fs to another, the 'mtime' is
- * preserved.
- * 
- * It treats any file in 'simplefs:/' as a file, and
- * artificially creates a real file on the fly which it uses
- * to extract information from.  The real file it uses is
- * whatever follows the trailing '/' (e.g. 'foo' in 'simplefs:/foo'),
- * and that file is assumed to exist in the native pwd, and is
- * copied over to the native temporary directory where it is
- * accessed.
- * 
- * Please do not consider this filesystem a model of how
- * things are to be done.  It is quite the opposite!  But, it
- * does allow us to test two important features.
- * 
- * Finally: this fs can only be used from one interpreter.
+/*
+ * This is a slightly 'hacky' filesystem which is used just to test a few
+ * important features of the vfs code: (1) that you can load a shared library
+ * from a vfs, (2) that when copying files from one fs to another, the 'mtime'
+ * is preserved. (3) that recursive cross-filesystem directory copies have the
+ * correct behaviour with/without -force.
+ *
+ * It treats any file in 'simplefs:/' as a file, which it routes to the
+ * current directory. The real file it uses is whatever follows the trailing
+ * '/' (e.g. 'foo' in 'simplefs:/foo'), and that file exists or not according
+ * to what is in the native pwd.
+ *
+ * Please do not consider this filesystem a model of how things are to be
+ * done. It is quite the opposite!  But, it does allow us to test some
+ * important features.
  */
+
 static int
-TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;
-    Tcl_Interp *interp;
-    int		objc;
-    Tcl_Obj	*CONST objv[];
+TestSimpleFilesystemObjCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
     int res, boolVal;
     char *msg;
-    
+
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
 	return TCL_ERROR;
@@ -6425,129 +6957,138 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
     if (boolVal) {
 	res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
 	msg = (res == TCL_OK) ? "registered" : "failed";
-	simpleInterpPtr = interp;
     } else {
-	if (tempFile != NULL) {
-	    Tcl_FSDeleteFile(tempFile);
-	    Tcl_DecrRefCount(tempFile);
-	    tempFile = NULL;
-	}
 	res = Tcl_FSUnregister(&simpleFilesystem);
 	msg = (res == TCL_OK) ? "unregistered" : "failed";
-	simpleInterpPtr = NULL;
     }
     Tcl_SetResult(interp, msg, TCL_VOLATILE);
     return res;
 }
 
-/* 
- * Treats a file name 'simplefs:/foo' by copying the file 'foo'
- * in the current (native) directory to a temporary native file,
- * and then returns that native file.
+/*
+ * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
+ * (native) directory.
  */
-static Tcl_Obj*
-SimpleCopy(pathPtr)
-    Tcl_Obj *pathPtr;                   /* Name of file to copy. */
+
+static Tcl_Obj *
+SimpleRedirect(
+    Tcl_Obj *pathPtr)		/* Name of file to copy. */
 {
-    int res;
-    CONST char *str;
+    int len;
+    const char *str;
     Tcl_Obj *origPtr;
-    Tcl_Obj *tempPtr;
-
-    tempPtr = TclpTempFileName();
-    Tcl_IncrRefCount(tempPtr);
 
-    /* 
+    /*
      * We assume the same name in the current directory is ok.
      */
-    str = Tcl_GetString(pathPtr);
+
+    str = Tcl_GetStringFromObj(pathPtr, &len);
+    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
+	/* Probably shouldn't ever reach here */
+	Tcl_IncrRefCount(pathPtr);
+	return pathPtr;
+    }
     origPtr = Tcl_NewStringObj(str+10,-1);
     Tcl_IncrRefCount(origPtr);
+    return origPtr;
+}
 
-    res = TclCrossFilesystemCopy(simpleInterpPtr, origPtr, tempPtr);
-    Tcl_DecrRefCount(origPtr);
+static int
+SimpleMatchInDirectory(
+    Tcl_Interp *interp,		/* Interpreter for error
+				 * messages. */
+    Tcl_Obj *resultPtr,		/* Object to lappend results. */
+    Tcl_Obj *dirPtr,		/* Contains path to directory to search. */
+    const char *pattern,	/* Pattern to match against. */
+    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
+				 * May be NULL. */
+{
+    int res;
+    Tcl_Obj *origPtr;
+    Tcl_Obj *resPtr;
 
-    if (res != TCL_OK) {
-	Tcl_FSDeleteFile(tempPtr);
-	Tcl_DecrRefCount(tempPtr);
-	return NULL;
+    /* We only provide a new volume, therefore no mounts at all */
+    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+	return TCL_OK;
     }
-    return tempPtr;
+
+    /*
+     * We assume the same name in the current directory is ok.
+     */
+    resPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(resPtr);
+    origPtr = SimpleRedirect(dirPtr);
+    res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
+    if (res == TCL_OK) {
+	int gLength, j;
+	Tcl_ListObjLength(NULL, resPtr, &gLength);
+	for (j = 0; j < gLength; j++) {
+	    Tcl_Obj *gElt, *nElt;
+	    Tcl_ListObjIndex(NULL, resPtr, j, &gElt);
+	    nElt = Tcl_NewStringObj("simplefs:/",10);
+	    Tcl_AppendObjToObj(nElt, gElt);
+	    Tcl_ListObjAppendElement(NULL, resultPtr, nElt);
+	}
+    }
+    Tcl_DecrRefCount(origPtr);
+    Tcl_DecrRefCount(resPtr);
+    return res;
 }
 
 static Tcl_Channel
-SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
-    Tcl_Interp *interp;                 /* Interpreter for error reporting;
-					 * can be NULL. */
-    Tcl_Obj *pathPtr;                   /* Name of file to open. */
-    int mode;             		/* POSIX open mode. */
-    int permissions;                    /* If the open involves creating a
-					 * file, with what modes to create
-					 * it? */
+SimpleOpenFileChannel(
+    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
+				 * NULL. */
+    Tcl_Obj *pathPtr,		/* Name of file to open. */
+    int mode,			/* POSIX open mode. */
+    int permissions)		/* If the open involves creating a file, with
+				 * what modes to create it? */
 {
     Tcl_Obj *tempPtr;
     Tcl_Channel chan;
-    
+
     if ((mode != 0) && !(mode & O_RDONLY)) {
-	Tcl_AppendResult(interp, "read-only", 
-		(char *) NULL);
-	return NULL;
-    }
-    
-    tempPtr = SimpleCopy(pathPtr);
-    
-    if (tempPtr == NULL) {
+	Tcl_AppendResult(interp, "read-only", NULL);
 	return NULL;
     }
-    
-    chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
 
-    if (tempFile != NULL) {
-        Tcl_FSDeleteFile(tempFile);
-	Tcl_DecrRefCount(tempFile);
-	tempFile = NULL;
-    }
-    /* 
-     * Store file pointer in this global variable so we can delete
-     * it later 
-     */
-    tempFile = tempPtr;
+    tempPtr = SimpleRedirect(pathPtr);
+    chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
+    Tcl_DecrRefCount(tempPtr);
     return chan;
 }
 
 static int
-SimpleAccess(pathPtr, mode)
-    Tcl_Obj *pathPtr;		/* Path of file to access (in current CP). */
-    int mode;                   /* Permission setting. */
+SimpleAccess(
+    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
 {
-    /* All files exist */
-    return TCL_OK;
+    Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
+    int res = Tcl_FSAccess(tempPtr, mode);
+
+    Tcl_DecrRefCount(tempPtr);
+    return res;
 }
 
 static int
-SimpleStat(pathPtr, bufPtr)
-    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
+SimpleStat(
+    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
 {
-    Tcl_Obj *tempPtr = SimpleCopy(pathPtr);
-    if (tempPtr == NULL) {
-	/* We just pretend the file exists anyway */
-	return TCL_OK;
-    } else {
-	int res = Tcl_FSStat(tempPtr, bufPtr);
-	Tcl_FSDeleteFile(tempPtr);
-	Tcl_DecrRefCount(tempPtr);
-	return res;
-    }
+    Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
+    int res = Tcl_FSStat(tempPtr, bufPtr);
+
+    Tcl_DecrRefCount(tempPtr);
+    return res;
 }
 
-static Tcl_Obj*
+static Tcl_Obj *
 SimpleListVolumes(void)
 {
     /* Add one new volume */
     Tcl_Obj *retVal;
 
-    retVal = Tcl_NewStringObj("simplefs:/",-1);
+    retVal = Tcl_NewStringObj("simplefs:/", -1);
     Tcl_IncrRefCount(retVal);
     return retVal;
 }
@@ -6555,15 +7096,17 @@ SimpleListVolumes(void)
 /*
  * Used to check correct string-length determining in Tcl_NumUtfChars
  */
+
 static int
-TestNumUtfCharsCmd(clientData, interp, objc, objv)
-    ClientData clientData;
-    Tcl_Interp *interp;
-    int objc;
-    Tcl_Obj *CONST objv[];
+TestNumUtfCharsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
     if (objc > 1) {
 	int len = -1;
+
 	if (objc > 2) {
 	    (void) Tcl_GetStringFromObj(objv[1], &len);
 	}
@@ -6582,14 +7125,14 @@ TestNumUtfCharsCmd(clientData, interp, objc, objv)
  *	Retrieves CPU ID information.
  *
  * Usage:
- *	testcpuid <eax>
+ *	testwincpuid <eax>
  *
  * Parameters:
  *	eax - The value to pass in the EAX register to a CPUID instruction.
  *
  * Results:
- *	Returns a four-element list containing the values from the
- *	EAX, EBX, ECX and EDX registers returned from the CPUID instruction.
+ *	Returns a four-element list containing the values from the EAX, EBX,
+ *	ECX and EDX registers returned from the CPUID instruction.
  *
  * Side effects:
  *	None.
@@ -6598,35 +7141,453 @@ TestNumUtfCharsCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestcpuidCmd( ClientData dummy,
-		 Tcl_Interp* interp, /* Tcl interpreter */
-		 int objc,	/* Parameter count */
-		 Tcl_Obj *CONST * objv ) /* Parameter vector */
+TestcpuidCmd(
+    ClientData dummy,
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    int objc,			/* Parameter count */
+    Tcl_Obj *const * objv)	/* Parameter vector */
 {
-    int status;
-    int index;
+    int status, index, i;
     unsigned int regs[4];
-    Tcl_Obj * regsObjs[4];
-    int i;
+    Tcl_Obj *regsObjs[4];
 
-    if ( objc != 2 ) {
-	Tcl_WrongNumArgs( interp, 1, objv, "eax" );
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "eax");
 	return TCL_ERROR;
     }
-    if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
+    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
 	return TCL_ERROR;
     }
-    status = TclWinCPUID( (unsigned int) index, regs );
-    if ( status != TCL_OK ) {
-	Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available",
-						    -1 ) );
+    status = TclWinCPUID((unsigned) index, regs);
+    if (status != TCL_OK) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("operation not available", -1));
 	return status;
     }
-    for ( i = 0; i < 4; ++i ) {
-	regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
+    for (i=0 ; i<4 ; ++i) {
+	regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
     }
-    Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
+    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
     return TCL_OK;
-
 }
 #endif
+
+/*
+ * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
+ */
+
+static int
+TestHashSystemHashCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    static Tcl_HashKeyType hkType = {
+	TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
+	NULL, NULL, NULL, NULL
+    };
+    Tcl_HashTable hash;
+    Tcl_HashEntry *hPtr;
+    int i, isNew, limit = 100;
+
+    if (objc>1 && Tcl_GetIntFromObj(interp, objv[1], &limit)!=TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    Tcl_InitCustomHashTable(&hash, TCL_CUSTOM_TYPE_KEYS, &hkType);
+
+    if (hash.numEntries != 0) {
+	Tcl_AppendResult(interp, "non-zero initial size", NULL);
+	Tcl_DeleteHashTable(&hash);
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<limit ; i++) {
+	hPtr = Tcl_CreateHashEntry(&hash, (char *) INT2PTR(i), &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
+	    Tcl_DeleteHashTable(&hash);
+	    return TCL_ERROR;
+	}
+	Tcl_SetHashValue(hPtr, (ClientData) INT2PTR(i+42));
+    }
+
+    if (hash.numEntries != limit) {
+	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
+	Tcl_DeleteHashTable(&hash);
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<limit ; i++) {
+	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
+	if (hPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
+	    Tcl_DeleteHashTable(&hash);
+	    return TCL_ERROR;
+	}
+	if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
+	    Tcl_DeleteHashTable(&hash);
+	    return TCL_ERROR;
+	}
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    if (hash.numEntries != 0) {
+	Tcl_AppendResult(interp, "non-zero final size", NULL);
+	Tcl_DeleteHashTable(&hash);
+	return TCL_ERROR;
+    }
+
+    Tcl_DeleteHashTable(&hash);
+    Tcl_AppendResult(interp, "OK", NULL);
+    return TCL_OK;
+}
+
+/*
+ * Used for testing Tcl_GetInt which is no longer used directly by the
+ * core very much.
+ */
+static int
+TestgetintCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int argc,
+    const char **argv)
+{
+    if (argc < 2) {
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	return TCL_ERROR;
+    } else {
+	int val, i, total=0;
+	char buf[TCL_INTEGER_SPACE];
+
+	for (i=1 ; i<argc ; i++) {
+	    if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    total += val;
+	}
+	TclFormatInt(buf, total);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestconcatobjCmd --
+ *
+ *	This procedure implements the "testconcatobj" command. It is used
+ *	to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
+ *	cases and thet it never corrupts its arguments. In other words, that
+ *	[Bug 1447328] was fixed properly.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestconcatobjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int argc,			/* Number of arguments. */
+    const char **argv)		/* Argument strings. */
+{
+    Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
+    int result = TCL_OK, len;
+    Tcl_Obj *objv[3];
+
+    /*
+     * Set the start of the error message as obj result; it will be cleared at
+     * the end if no errors were found.
+     */
+
+    Tcl_SetObjResult(interp,
+	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));
+
+    emptyPtr = Tcl_NewObj();
+
+    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
+    Tcl_ListObjLength(NULL, list1Ptr, &len);
+    if (list1Ptr->bytes != NULL) {
+	ckfree((char *) list1Ptr->bytes);
+	list1Ptr->bytes = NULL;
+    }
+
+    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
+    Tcl_ListObjLength(NULL, list2Ptr, &len);
+    if (list2Ptr->bytes != NULL) {
+	ckfree((char *) list2Ptr->bytes);
+	list2Ptr->bytes = NULL;
+    }
+
+    /*
+     * Verify that concat'ing a list obj with one or more empty strings does
+     * return a fresh Tcl_Obj (see also [Bug 2055782]).
+     */
+
+    tmpPtr = Tcl_DuplicateObj(list1Ptr);
+
+    objv[0] = tmpPtr;
+    objv[1] = emptyPtr;
+    concatPtr = Tcl_ConcatObj(2, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (a) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ",
+		NULL);
+	switch (tmpPtr->refCount) {
+	case 0:
+	    Tcl_AppendResult(interp, "(no new refCount)", NULL);
+	    break;
+	case 1:
+	    Tcl_AppendResult(interp, "(refCount added)", NULL);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[0] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    Tcl_IncrRefCount(tmpPtr);
+    concatPtr = Tcl_ConcatObj(2, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (b) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ",
+		NULL);
+	switch (tmpPtr->refCount) {
+	case 0:
+	    Tcl_AppendResult(interp, "(refCount removed?)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	    break;
+	case 1:
+	    Tcl_AppendResult(interp, "(no new refCount)", NULL);
+	    break;
+	case 2:
+	    Tcl_AppendResult(interp, "(refCount added)", NULL);
+	    Tcl_DecrRefCount(tmpPtr);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[0] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    objv[0] = emptyPtr;
+    objv[1] = tmpPtr;
+    objv[2] = emptyPtr;
+    concatPtr = Tcl_ConcatObj(3, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (c) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ",
+		NULL);
+	switch (tmpPtr->refCount) {
+	case 0:
+	    Tcl_AppendResult(interp, "(no new refCount)", NULL);
+	    break;
+	case 1:
+	    Tcl_AppendResult(interp, "(refCount added)", NULL);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[1] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    Tcl_IncrRefCount(tmpPtr);
+    concatPtr = Tcl_ConcatObj(3, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (d) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ",
+		NULL);
+	switch (tmpPtr->refCount) {
+	case 0:
+	    Tcl_AppendResult(interp, "(refCount removed?)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	    break;
+	case 1:
+	    Tcl_AppendResult(interp, "(no new refCount)", NULL);
+	    break;
+	case 2:
+	    Tcl_AppendResult(interp, "(refCount added)", NULL);
+	    Tcl_DecrRefCount(tmpPtr);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(more than one refCount added!)", NULL);
+	    Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()");
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[1] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    /*
+     * Verify that an unshared list is not corrupted when concat'ing things to
+     * it.
+     */
+
+    objv[0] = tmpPtr;
+    objv[1] = list2Ptr;
+    concatPtr = Tcl_ConcatObj(2, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (e) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	int len;
+
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ",
+		NULL);
+
+	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
+	switch (tmpPtr->refCount) {
+	case 3:
+	    Tcl_AppendResult(interp, "(failed to concat)", NULL);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+	}
+	if (Tcl_IsShared(tmpPtr)) {
+	    Tcl_DecrRefCount(tmpPtr);
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[0] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    objv[0] = tmpPtr;
+    objv[1] = list2Ptr;
+    Tcl_IncrRefCount(tmpPtr);
+    concatPtr = Tcl_ConcatObj(2, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (f) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	int len;
+
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
+		NULL);
+
+	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
+	switch (tmpPtr->refCount) {
+	case 3:
+	    Tcl_AppendResult(interp, "(failed to concat)", NULL);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+	}
+	if (Tcl_IsShared(tmpPtr)) {
+	    Tcl_DecrRefCount(tmpPtr);
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[0] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    objv[0] = tmpPtr;
+    objv[1] = list2Ptr;
+    Tcl_IncrRefCount(tmpPtr);
+    Tcl_IncrRefCount(tmpPtr);
+    concatPtr = Tcl_ConcatObj(2, objv);
+    if (concatPtr->refCount != 0) {
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"\n\t* (g) concatObj does not have refCount 0", NULL);
+    }
+    if (concatPtr == tmpPtr) {
+	int len;
+
+	result = TCL_ERROR;
+	Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
+		NULL);
+
+	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
+	switch (tmpPtr->refCount) {
+	case 3:
+	    Tcl_AppendResult(interp, "(failed to concat)", NULL);
+	    break;
+	default:
+	    Tcl_AppendResult(interp, "(corrupted input!)", NULL);
+	}
+	Tcl_DecrRefCount(tmpPtr);
+	if (Tcl_IsShared(tmpPtr)) {
+	    Tcl_DecrRefCount(tmpPtr);
+	}
+	tmpPtr = Tcl_DuplicateObj(list1Ptr);
+	objv[0] = tmpPtr;
+    }
+    Tcl_DecrRefCount(concatPtr);
+
+    /*
+     * Clean everything up. Note that we don't actually know how many
+     * references there are to tmpPtr here; in the no-error case, it should be
+     * five... [Bug 2895367]
+     */
+
+    Tcl_DecrRefCount(list1Ptr);
+    Tcl_DecrRefCount(list2Ptr);
+    Tcl_DecrRefCount(emptyPtr);
+    while (tmpPtr->refCount > 1) {
+	Tcl_DecrRefCount(tmpPtr);
+    }
+    Tcl_DecrRefCount(tmpPtr);
+
+    if (result == TCL_OK) {
+	Tcl_ResetResult(interp);
+    }
+    return result;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
+ * End:
+ */
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 8e9dc93..f113cfe 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1,61 +1,57 @@
-/* 
+/*
  * tclTestObj.c --
  *
- *	This file contains C command procedures for the additional Tcl
- *	commands that are used for testing implementations of the Tcl object
- *	types. These commands are not normally included in Tcl
- *	applications; they're only used for testing.
+ *	This file contains C command functions for the additional Tcl commands
+ *	that are used for testing implementations of the Tcl object types.
+ *	These commands are not normally included in Tcl applications; they're
+ *	only used for testing.
  *
  * Copyright (c) 1995-1998 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
+ * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
+#include "tommath.h"
 
 /*
  * An array of Tcl_Obj pointers used in the commands that operate on or get
- * the values of Tcl object-valued variables. varPtr[i] is the i-th
- * variable's Tcl_Obj *.
+ * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
+ * Tcl_Obj *.
  */
 
 #define NUMBER_OF_OBJECT_VARS 20
 static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
 
 /*
- * Forward declarations for procedures defined later in this file:
+ * Forward declarations for functions defined later in this file:
  */
 
-static int		CheckIfVarUnset _ANSI_ARGS_((Tcl_Interp *interp,
-			    int varIndex));
-static int		GetVariableIndex _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, int *indexPtr));
-static void		SetVarToObj _ANSI_ARGS_((int varIndex,
-			    Tcl_Obj *objPtr));
-int			TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-static int		TestbooleanobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestconvertobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestdoubleobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestindexobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestintobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TestobjCmd _ANSI_ARGS_((ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
-static int		TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
+static int		CheckIfVarUnset(Tcl_Interp *interp, int varIndex);
+static int		GetVariableIndex(Tcl_Interp *interp,
+			    const char *string, int *indexPtr);
+static void		SetVarToObj(int varIndex, Tcl_Obj *objPtr);
+int			TclObjTest_Init(Tcl_Interp *interp);
+static int		TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestbooleanobjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]));
+			    Tcl_Obj *const objv[]);
+static int		TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int 		TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TestobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 
 typedef struct TestString {
     int numChars;
@@ -63,14 +59,13 @@ typedef struct TestString {
     size_t uallocated;
     Tcl_UniChar unicode[2];
 } TestString;
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclObjTest_Init --
  *
- *	This procedure creates additional commands that are used to test the
+ *	This function creates additional commands that are used to test the
  *	Tcl object support.
  *
  * Results:
@@ -84,154 +79,213 @@ typedef struct TestString {
  */
 
 int
-TclObjTest_Init(interp)
-    Tcl_Interp *interp;
+TclObjTest_Init(
+    Tcl_Interp *interp)
 {
     register int i;
-    
+
     for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
         varPtr[i] = NULL;
     }
-	
+
+    Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
+	    (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+	    (ClientData) 0, NULL);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TestbooleanobjCmd --
+ * TestbignumobjCmd --
  *
- *	This procedure implements the "testbooleanobj" command.  It is used
- *	to test the boolean Tcl object type implementation.
+ *	This function implmenets the "testbignumobj" command.  It is used
+ *	to exercise the bignum Tcl object type implementation.
  *
  * Results:
- *	A standard Tcl object result.
+ *	Returns a standard Tcl object result.
  *
  * Side effects:
- *	Creates and frees boolean objects, and also converts objects to
- *	have boolean type.
+ *	Creates and frees bignum objects; converts objects to have bignum
+ *	type.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TestbooleanobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestbignumobjCmd(
+    ClientData clientData,	/* unused */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Argument count */
+    Tcl_Obj *const objv[])	/* Argument vector */
 {
-    int varIndex, boolValue;
-    char *index, *subCmd;
+    const char * subcmds[] = {
+	"set",      "get",      "mult10",      "div10", NULL
+    };
+    enum options {
+	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
+    };
+
+    int index, varIndex;
+    char* string;
+    mp_int bignumValue, newValue;
 
     if (objc < 3) {
-	wrongNumArgs:
-	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?...");
 	return TCL_ERROR;
     }
-
-    index = Tcl_GetString(objv[2]);
-    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    string = Tcl_GetString(objv[2]);
+    if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    subCmd = Tcl_GetString(objv[1]);
-    if (strcmp(subCmd, "set") == 0) {
+    switch (index) {
+    case BIGNUM_SET:
 	if (objc != 4) {
-	    goto wrongNumArgs;
+	    Tcl_WrongNumArgs(interp, 2, objv, "var value");
+	    return TCL_ERROR;
 	}
-	if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
+	string = Tcl_GetString(objv[3]);
+	if (mp_init(&bignumValue) != MP_OKAY) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("error in mp_init", -1));
+	    return TCL_ERROR;
+	}
+	if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) {
+	    mp_clear(&bignumValue);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("error in mp_read_radix", -1));
 	    return TCL_ERROR;
 	}
 
 	/*
 	 * If the object currently bound to the variable with index varIndex
 	 * has ref count 1 (i.e. the object is unshared) we can modify that
-	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+	 * object directly.  Otherwise, if RC>1 (i.e. the object is shared),
 	 * we must create a new object to modify/set and decrement the old
 	 * formerly-shared object's ref count. This is "copy on write".
 	 */
 
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+	    SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
 	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else if (strcmp(subCmd, "get") == 0) {
+	break;
+
+    case BIGNUM_GET:
 	if (objc != 3) {
-	    goto wrongNumArgs;
+	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+	    return TCL_ERROR;
 	}
 	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else if (strcmp(subCmd, "not") == 0) {
+	break;
+
+    case BIGNUM_MULT10:
 	if (objc != 3) {
-	    goto wrongNumArgs;
+	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+	    return TCL_ERROR;
 	}
 	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
-				  &boolValue) != TCL_OK) {
+	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
+		&bignumValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	if (mp_init(&newValue) != MP_OKAY
+		|| (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
+	    mp_clear(&bignumValue);
+	    mp_clear(&newValue);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("error in mp_mul_d", -1));
+	    return TCL_ERROR;
+	}
+	mp_clear(&bignumValue);
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+	}
+	break;
+
+    case BIGNUM_DIV10:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+	    return TCL_ERROR;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
+		&bignumValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (mp_init(&newValue) != MP_OKAY
+		|| (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) {
+	    mp_clear(&bignumValue);
+	    mp_clear(&newValue);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("error in mp_div_d", -1));
+	    return TCL_ERROR;
+	}
+	mp_clear(&bignumValue);
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
 	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, or not", (char *) NULL);
-	return TCL_ERROR;
     }
+
+    Tcl_SetObjResult(interp, varPtr[varIndex]);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TestconvertobjCmd --
+ * TestbooleanobjCmd --
  *
- *	This procedure implements the "testconvertobj" command. It is used
- *	to test converting objects to new types.
+ *	This function implements the "testbooleanobj" command.  It is used to
+ *	test the boolean Tcl object type implementation.
  *
  * Results:
  *	A standard Tcl object result.
  *
  * Side effects:
- *	Converts objects to new types.
+ *	Creates and frees boolean objects, and also converts objects to
+ *	have boolean type.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TestconvertobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestbooleanobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *subCmd;
-    char buf[20];
+    int varIndex, boolValue;
+    char *index, *subCmd;
 
     if (objc < 3) {
 	wrongNumArgs:
@@ -239,22 +293,63 @@ TestconvertobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
+    index = Tcl_GetString(objv[2]);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
     subCmd = Tcl_GetString(objv[1]);
-    if (strcmp(subCmd, "double") == 0) {
-	double d;
+    if (strcmp(subCmd, "set") == 0) {
+	if (objc != 4) {
+	    goto wrongNumArgs;
+	}
+	if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If the object currently bound to the variable with index varIndex
+	 * has ref count 1 (i.e. the object is unshared) we can modify that
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
+	 * we must create a new object to modify/set and decrement the old
+	 * formerly-shared object's ref count. This is "copy on write".
+	 */
 
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	sprintf(buf, "%f", d);
-        Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "not") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
+				  &boolValue) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be double", (char *) NULL);
+		"\": must be set, get, or not", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -265,8 +360,8 @@ TestconvertobjCmd(clientData, interp, objc, objv)
  *
  * TestdoubleobjCmd --
  *
- *	This procedure implements the "testdoubleobj" command.  It is used
- *	to test the double-precision floating point Tcl object type
+ *	This function implements the "testdoubleobj" command.  It is used to
+ *	test the double-precision floating point Tcl object type
  *	implementation.
  *
  * Results:
@@ -280,16 +375,16 @@ TestconvertobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestdoubleobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestdoubleobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int varIndex;
     double doubleValue;
     char *index, *subCmd, *string;
-	
+
     if (objc < 3) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
@@ -314,8 +409,8 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
 	/*
 	 * If the object currently bound to the variable with index varIndex
 	 * has ref count 1 (i.e. the object is unshared) we can modify that
-	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
-	 * we must create a new object to modify/set and decrement the old
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
+	 * must create a new object to modify/set and decrement the old
 	 * formerly-shared object's ref count. This is "copy on write".
 	 */
 
@@ -370,7 +465,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, mult10, or div10", (char *) NULL);
+		"\": must be set, get, mult10, or div10", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -381,7 +476,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
  *
  * TestindexobjCmd --
  *
- *	This procedure implements the "testindexobj" command. It is used to
+ *	This function implements the "testindexobj" command. It is used to
  *	test the index Tcl object type implementation.
  *
  * Results:
@@ -395,15 +490,15 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestindexobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestindexobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int allowAbbrev, index, index2, setError, i, result;
-    CONST char **argv;
-    static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL};
+    const char **argv;
+    static const char *tablePtr[] = {"a", "b", "check", NULL};
     /*
      * Keep this structure declaration in sync with tclIndexObj.c
      */
@@ -417,20 +512,19 @@ TestindexobjCmd(clientData, interp, objc, objv)
     if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
 	    "check") == 0)) {
 	/*
-	 * This code checks to be sure that the results of
-	 * Tcl_GetIndexFromObj are properly cached in the object and
-	 * returned on subsequent lookups.
+	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
+	 * are properly cached in the object and returned on subsequent
+	 * lookups.
 	 */
 
 	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 
-	Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
-		"token", 0, &index);
-	indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
+	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
+	indexRep = (struct IndexRep *) objv[1]->internalRep.twoPtrValue.ptr1;
 	indexRep->index = index2;
-	result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
+	result = Tcl_GetIndexFromObj(NULL, objv[1],
 		tablePtr, "token", 0, &index);
 	if (result == TCL_OK) {
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -450,22 +544,22 @@ TestindexobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    argv = (CONST char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+    argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
     for (i = 4; i < objc; i++) {
 	argv[i-4] = Tcl_GetString(objv[i]);
     }
     argv[objc-4] = NULL;
-    
+
     /*
-     * Tcl_GetIndexFromObj assumes that the table is statically-allocated
-     * so that its address is different for each index object. If we
-     * accidently allocate a table at the same address as that cached in
-     * the index object, clear out the object's cached state.
+     * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
+     * that its address is different for each index object. If we accidently
+     * allocate a table at the same address as that cached in the index
+     * object, clear out the object's cached state.
      */
 
     if ( objv[3]->typePtr != NULL
 	 && !strcmp( "index", objv[3]->typePtr->name ) ) {
-	indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
+	indexRep = (struct IndexRep *) objv[3]->internalRep.twoPtrValue.ptr1;
 	if (indexRep->tablePtr == (VOID *) argv) {
 	    objv[3]->typePtr->freeIntRepProc(objv[3]);
 	    objv[3]->typePtr = NULL;
@@ -486,7 +580,7 @@ TestindexobjCmd(clientData, interp, objc, objv)
  *
  * TestintobjCmd --
  *
- *	This procedure implements the "testintobj" command. It is used to
+ *	This function implements the "testintobj" command. It is used to
  *	test the int Tcl object type implementation.
  *
  * Results:
@@ -500,16 +594,16 @@ TestindexobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestintobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestintobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int intValue, varIndex, i;
     long longValue;
     char *index, *subCmd, *string;
-	
+
     if (objc < 3) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
@@ -535,8 +629,8 @@ TestintobjCmd(clientData, interp, objc, objv)
 	/*
 	 * If the object currently bound to the variable with index varIndex
 	 * has ref count 1 (i.e. the object is unshared) we can modify that
-	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
-	 * we must create a new object to modify/set and decrement the old
+	 * object directly. Otherwise, if RC>1 (i.e. the object is shared), we
+	 * must create a new object to modify/set and decrement the old
 	 * formerly-shared object's ref count. This is "copy on write".
 	 */
 
@@ -616,18 +710,18 @@ TestintobjCmd(clientData, interp, objc, objv)
 	Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
     } else if (strcmp(subCmd, "inttoobigtest") == 0) {
 	/*
-	 * If long ints have more bits than ints on this platform, verify
-	 * that Tcl_GetIntFromObj returns an error if the long int held
-	 * in an integer object's internal representation is too large
-	 * to fit in an int.
+	 * If long ints have more bits than ints on this platform, verify that
+	 * Tcl_GetIntFromObj returns an error if the long int held in an
+	 * integer object's internal representation is too large to fit in an
+	 * int.
 	 */
-	
+
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
 #if (INT_MAX == LONG_MAX)   /* int is same size as long int */
 	Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
-#else 
+#else
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
 	} else {
@@ -677,19 +771,114 @@ TestintobjCmd(clientData, interp, objc, objv)
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, get2, mult10, or div10",
-		(char *) NULL);
+		"\": must be set, get, get2, mult10, or div10", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 /*
+ *-----------------------------------------------------------------------------
+ *
+ * TestlistobjCmd --
+ *
+ *	This function implements the 'testlistobj' command. It is used to
+ *	test a few possible corner cases in list object manipulation from
+ *	C code that cannot occur at the Tcl level.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	Creates, manipulates and frees list objects.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestlistobjCmd(
+    ClientData clientData,	/* Not used */
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int objc,			/* Number of arguments */
+    Tcl_Obj *const objv[])	/* Argument objects */
+{
+    /* Subcommands supported by this command */
+    const char* subcommands[] = {
+	"set",
+	"get",
+	"replace"
+    };
+    enum listobjCmdIndex {
+	LISTOBJ_SET,
+	LISTOBJ_GET,
+	LISTOBJ_REPLACE
+    };
+
+    const char* index;		/* Argument giving the variable number */
+    int varIndex;		/* Variable number converted to binary */
+    int cmdIndex;		/* Ordinal number of the subcommand */
+    int first;			/* First index in the list */
+    int count;			/* Count of elements in a list */
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
+	return TCL_ERROR;
+    }
+    index = Tcl_GetString(objv[2]);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
+			    0, &cmdIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch(cmdIndex) {
+    case LISTOBJ_SET:
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
+	} else {
+	    SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+	break;
+
+    case LISTOBJ_GET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+	    return TCL_ERROR;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+	break;
+
+    case LISTOBJ_REPLACE:
+	if (objc < 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+			     "varIndex start count ?element...?");
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_IsShared(varPtr[varIndex])) {
+	    SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	}
+	Tcl_ResetResult(interp);
+	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
+				  objc-5, objv+5);
+    }
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TestobjCmd --
  *
- *	This procedure implements the "testobj" command. It is used to test
+ *	This function implements the "testobj" command. It is used to test
  *	the type-independent portions of the Tcl object type implementation.
  *
  * Results:
@@ -702,16 +891,16 @@ TestintobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TestobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TestobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int varIndex, destIndex, i;
     char *index, *subCmd, *string;
     Tcl_ObjType *targetType;
-	
+
     if (objc < 2) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
@@ -762,7 +951,7 @@ TestobjCmd(clientData, interp, objc, objv)
         typeName = Tcl_GetString(objv[3]);
         if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "no type ", typeName, " found", (char *) NULL);
+		    "no type ", typeName, " found", NULL);
             return TCL_ERROR;
         }
         if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
@@ -821,13 +1010,13 @@ TestobjCmd(clientData, interp, objc, objv)
         SetVarToObj(varIndex, Tcl_NewObj());
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "objtype") == 0) {
-	char *typeName;
+	const char *typeName;
 
 	/*
 	 * return an object containing the name of the argument's type
 	 * of internal rep.  If none exists, return "none".
 	 */
-	
+
         if (objc != 3) {
             goto wrongNumArgs;
         }
@@ -879,11 +1068,9 @@ TestobjCmd(clientData, interp, objc, objv)
 	}
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"",
-		Tcl_GetString(objv[1]),
-		"\": must be assign, convert, duplicate, freeallvars, ",
-		"newobj, objcount, objtype, refcount, type, or types",
-		(char *) NULL);
+		"bad option \"", Tcl_GetString(objv[1]),
+		"\": must be assign, convert, duplicate, freeallvars, "
+		"newobj, objcount, objtype, refcount, type, or types", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -894,7 +1081,7 @@ TestobjCmd(clientData, interp, objc, objv)
  *
  * TeststringobjCmd --
  *
- *	This procedure implements the "teststringobj" command. It is used to
+ *	This function implements the "teststringobj" command. It is used to
  *	test the string Tcl object type implementation.
  *
  * Results:
@@ -908,21 +1095,21 @@ TestobjCmd(clientData, interp, objc, objv)
  */
 
 static int
-TeststringobjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+TeststringobjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int varIndex, option, i, length;
     Tcl_UniChar *unicode;
 #define MAX_STRINGS 11
     char *index, *string, *strings[MAX_STRINGS+1];
     TestString *strPtr;
-    static CONST char *options[] = {
+    static const char *options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "ualloc", "getunicode", 
-	"appendself", "appendself2", (char *) NULL
+	"set", "set2", "setlength", "ualloc", "getunicode",
+	"appendself", "appendself2", NULL
     };
 
     if (objc < 3) {
@@ -951,12 +1138,12 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    if (varPtr[varIndex] == NULL) {
 		SetVarToObj(varIndex, Tcl_NewObj());
 	    }
-	    
+
 	    /*
 	     * If the object bound to variable "varIndex" is shared, we must
-	     * "copy on write" and append to a copy of the object. 
+	     * "copy on write" and append to a copy of the object.
 	     */
-	    
+
 	    if (Tcl_IsShared(varPtr[varIndex])) {
 		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
@@ -974,7 +1161,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
 
 	    /*
 	     * If the object bound to variable "varIndex" is shared, we must
-	     * "copy on write" and append to a copy of the object. 
+	     * "copy on write" and append to a copy of the object.
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
@@ -1024,7 +1211,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    }
 	    if (varPtr[varIndex] != NULL) {
 		strPtr = (TestString *)
-		    (varPtr[varIndex])->internalRep.otherValuePtr;
+		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
 		length = (int) strPtr->allocated;
 	    } else {
 		length = -1;
@@ -1038,13 +1225,13 @@ TeststringobjCmd(clientData, interp, objc, objv)
 
 	    /*
 	     * If the object currently bound to the variable with index
-	     * varIndex has ref count 1 (i.e. the object is unshared) we
-	     * can modify that object directly. Otherwise, if RC>1 (i.e.
-	     * the object is shared), we must create a new object to
-	     * modify/set and decrement the old formerly-shared object's
-	     * ref count. This is "copy on write".
+	     * varIndex has ref count 1 (i.e. the object is unshared) we can
+	     * modify that object directly. Otherwise, if RC>1 (i.e. the
+	     * object is shared), we must create a new object to modify/set
+	     * and decrement the old formerly-shared object's ref count. This
+	     * is "copy on write".
 	     */
-    
+
 	    string = Tcl_GetStringFromObj(objv[3], &length);
 	    if ((varPtr[varIndex] != NULL)
 		    && !Tcl_IsShared(varPtr[varIndex])) {
@@ -1077,7 +1264,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    }
 	    if (varPtr[varIndex] != NULL) {
 		strPtr = (TestString *)
-		    (varPtr[varIndex])->internalRep.otherValuePtr;
+		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
 		length = (int) strPtr->uallocated;
 	    } else {
 		length = -1;
@@ -1169,17 +1356,17 @@ TeststringobjCmd(clientData, interp, objc, objv)
  *	None.
  *
  * Side effects:
- *	This routine handles ref counting details for assignment:
- *	i.e. the old value's ref count must be decremented (if not NULL) and
- *	the new one incremented (also if not NULL).
+ *	This routine handles ref counting details for assignment: i.e. the old
+ *	value's ref count must be decremented (if not NULL) and the new one
+ *	incremented (also if not NULL).
  *
  *----------------------------------------------------------------------
  */
 
 static void
-SetVarToObj(varIndex, objPtr)
-    int varIndex;		/* Designates the assignment variable. */
-    Tcl_Obj *objPtr;		/* Points to object to assign to var. */
+SetVarToObj(
+    int varIndex,		/* Designates the assignment variable. */
+    Tcl_Obj *objPtr)		/* Points to object to assign to var. */
 {
     if (varPtr[varIndex] != NULL) {
 	Tcl_DecrRefCount(varPtr[varIndex]);
@@ -1207,15 +1394,15 @@ SetVarToObj(varIndex, objPtr)
  */
 
 static int
-GetVariableIndex(interp, string, indexPtr)
-    Tcl_Interp *interp;         /* Interpreter for error reporting. */
-    char *string;               /* String containing a variable index
-				 * specified as a nonnegative number less
-				 * than NUMBER_OF_OBJECT_VARS. */
-    int *indexPtr;              /* Place to store converted result. */
+GetVariableIndex(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    const char *string,		/* String containing a variable index
+				 * specified as a nonnegative number less than
+				 * NUMBER_OF_OBJECT_VARS. */
+    int *indexPtr)		/* Place to store converted result. */
 {
     int index;
-    
+
     if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -1234,7 +1421,7 @@ GetVariableIndex(interp, string, indexPtr)
  *
  * CheckIfVarUnset --
  *
- *	Utility procedure that checks whether a test variable is readable:
+ *	Utility function that checks whether a test variable is readable:
  *	i.e., that varPtr[varIndex] is non-NULL.
  *
  * Results:
@@ -1248,13 +1435,13 @@ GetVariableIndex(interp, string, indexPtr)
  */
 
 static int
-CheckIfVarUnset(interp, varIndex)
-    Tcl_Interp *interp;		/* Interpreter for error reporting. */
-    int varIndex;		/* Index of the test variable to check. */
+CheckIfVarUnset(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    int varIndex)		/* Index of the test variable to check. */
 {
     if (varPtr[varIndex] == NULL) {
 	char buf[32 + TCL_INTEGER_SPACE];
-	
+
 	sprintf(buf, "variable %d is unset (NULL)", varIndex);
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
@@ -1262,3 +1449,11 @@ CheckIfVarUnset(interp, varIndex)
     }
     return 0;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index c85b303..644179b 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -1,14 +1,14 @@
-/* 
+/*
  * tclTestProcBodyObj.c --
  *
- *	Implements the "procbodytest" package, which contains commands
- *	to test creation of Tcl procedures whose body argument is a
- *	Tcl_Obj of type "procbody" rather than a string.
+ *	Implements the "procbodytest" package, which contains commands to test
+ *	creation of Tcl procedures whose body argument is a Tcl_Obj of type
+ *	"procbody" rather than a string.
  *
  * Copyright (c) 1998 by Scriptics Corporation.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -17,14 +17,14 @@
  * name and version of this package
  */
 
-static CONST char packageName[] = "procbodytest";
-static CONST char packageVersion[] = "1.0";
+static const char packageName[] = "procbodytest";
+static const char packageVersion[] = "1.0";
 
 /*
  * Name of the commands exported by this package
  */
 
-static CONST char procCommand[] = "proc";
+static const char procCommand[] = "proc";
 
 /*
  * this struct describes an entry in the table of command names and command
@@ -33,7 +33,7 @@ static CONST char procCommand[] = "proc";
 
 typedef struct CmdTable
 {
-    CONST char *cmdName;	/* command name */
+    const char *cmdName;	/* command name */
     Tcl_ObjCmdProc *proc;	/* command proc */
     int exportIt;		/* if 1, export the command */
 } CmdTable;
@@ -42,31 +42,26 @@ typedef struct CmdTable
  * Declarations for functions defined in this file.
  */
 
-static int	ProcBodyTestProcObjCmd _ANSI_ARGS_((ClientData dummy,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int	ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
-			int isSafe));
-static int	RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
-			CONST char *namespace, CONST CmdTable *cmdTablePtr));
-int             Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp));
-int             Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+static int	ProcBodyTestProcObjCmd(ClientData dummy,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+static int	ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
+static int	RegisterCommand(Tcl_Interp* interp,
+			const char *namespace, const CmdTable *cmdTablePtr);
+int             Procbodytest_Init(Tcl_Interp * interp);
+int             Procbodytest_SafeInit(Tcl_Interp * interp);
 
 /*
  * List of commands to create when the package is loaded; must go after the
  * declarations of the enable command procedure.
  */
 
-static CONST CmdTable commands[] =
-{
+static CONST CmdTable commands[] = {
     { procCommand,	ProcBodyTestProcObjCmd,	1 },
-
     { 0, 0, 0 }
 };
 
-static CONST CmdTable safeCommands[] =
-{
+static CONST CmdTable safeCommands[] = {
     { procCommand,	ProcBodyTestProcObjCmd,	1 },
-
     { 0, 0, 0 }
 };
 
@@ -75,7 +70,7 @@ static CONST CmdTable safeCommands[] =
  *
  * Procbodytest_Init --
  *
- *  This procedure initializes the "procbodytest" package.
+ *  This function initializes the "procbodytest" package.
  *
  * Results:
  *  A standard Tcl result.
@@ -87,8 +82,8 @@ static CONST CmdTable safeCommands[] =
  */
 
 int
-Procbodytest_Init(interp)
-    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+Procbodytest_Init(
+    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
                                  * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 0);
@@ -99,7 +94,7 @@ Procbodytest_Init(interp)
  *
  * Procbodytest_SafeInit --
  *
- *  This procedure initializes the "procbodytest" package.
+ *  This function initializes the "procbodytest" package.
  *
  * Results:
  *  A standard Tcl result.
@@ -111,8 +106,8 @@ Procbodytest_Init(interp)
  */
 
 int
-Procbodytest_SafeInit(interp)
-    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+Procbodytest_SafeInit(
+    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
                                  * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 1);
@@ -123,7 +118,7 @@ Procbodytest_SafeInit(interp)
  *
  * RegisterCommand --
  *
- *  This procedure registers a command in the context of the given namespace.
+ *  This function registers a command in the context of the given namespace.
  *
  * Results:
  *  A standard Tcl result.
@@ -135,11 +130,11 @@ Procbodytest_SafeInit(interp)
  */
 
 static int RegisterCommand(interp, namespace, cmdTablePtr)
-    Tcl_Interp* interp;			/* the Tcl interpreter for which the
-                                         * operation is performed */
-    CONST char *namespace;		/* the namespace in which the command
-                                         * is registered */
-    CONST CmdTable *cmdTablePtr;	/* the command to register */
+    Tcl_Interp* interp;		/* the Tcl interpreter for which the operation
+				 * is performed */
+    const char *namespace;		/* the namespace in which the command is
+				 * registered */
+    const CmdTable *cmdTablePtr;/* the command to register */
 {
     char buf[128];
 
@@ -149,7 +144,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
         if (Tcl_Eval(interp, buf) != TCL_OK)
             return TCL_ERROR;
     }
-    
+
     sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
     Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
 
@@ -161,7 +156,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
  *
  * ProcBodyTestInitInternal --
  *
- *  This procedure initializes the Loader package.
+ *  This function initializes the Loader package.
  *  The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
  *
  * Results:
@@ -174,10 +169,10 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
  */
 
 static int
-ProcBodyTestInitInternal(interp, isSafe)
-    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+ProcBodyTestInitInternal(
+    Tcl_Interp *interp,		/* the Tcl interpreter for which the package
                                  * is initialized */
-    int isSafe;			/* 1 if this is a safe interpreter */
+    int isSafe)			/* 1 if this is a safe interpreter */
 {
     CONST CmdTable *cmdTablePtr;
 
@@ -187,7 +182,7 @@ ProcBodyTestInitInternal(interp, isSafe)
             return TCL_ERROR;
         }
     }
-    
+
     return Tcl_PkgProvide(interp, packageName, packageVersion);
 }
 
@@ -225,20 +220,20 @@ ProcBodyTestInitInternal(interp, isSafe)
  */
 
 static int
-ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
-    ClientData dummy;		/* context; not used */
-    Tcl_Interp *interp;		/* the current interpreter */
-    int objc;			/* argument count */
-    Tcl_Obj *CONST objv[];	/* arguments */
+ProcBodyTestProcObjCmd(
+    ClientData dummy,		/* context; not used */
+    Tcl_Interp *interp,		/* the current interpreter */
+    int objc,			/* argument count */
+    Tcl_Obj *const objv[])	/* arguments */
 {
     char *fullName;
     Tcl_Command procCmd;
     Command *cmdPtr;
-    Proc *procPtr = (Proc *) NULL;
+    Proc *procPtr = NULL;
     Tcl_Obj *bodyObjPtr;
     Tcl_Obj *myobjv[5];
     int result;
-    
+
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
 	return TCL_ERROR;
@@ -247,10 +242,9 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
     /*
      * Find the Command pointer to this procedure
      */
-    
-    fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
-    procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
-            TCL_LEAVE_ERR_MSG);
+
+    fullName = Tcl_GetStringFromObj(objv[3], NULL);
+    procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
     if (procCmd == NULL) {
         return TCL_ERROR;
     }
@@ -259,38 +253,27 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
 
     /*
      * check that this is a procedure and not a builtin command:
-     * If a procedure, cmdPtr->objProc is either 0 or TclObjInterpProc,
-     * and cmdPtr->proc is either 0 or TclProcInterpProc.
-     * Also, the compile proc should be 0, but we don't check for that.
+     * If a procedure, cmdPtr->objProc is TclObjInterpProc.
      */
 
-    if (((cmdPtr->objProc != NULL)
-            && (cmdPtr->objProc != TclGetObjInterpProc()))
-            || ((cmdPtr->proc != NULL)
-                    && (cmdPtr->proc != TclGetInterpProc()))) {
+    if (cmdPtr->objProc != TclGetObjInterpProc()) {
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"command \"", fullName,
-		"\" is not a Tcl procedure", (char *) NULL);
+		"command \"", fullName, "\" is not a Tcl procedure", NULL);
         return TCL_ERROR;
     }
 
     /*
      * it is a Tcl procedure: the client data is the Proc structure
      */
-    
-    if (cmdPtr->objProc != NULL) {
-        procPtr = (Proc *) cmdPtr->objClientData;
-    } else if (cmdPtr->proc != NULL) {
-        procPtr = (Proc *) cmdPtr->clientData;
-    }
 
+    procPtr = (Proc *) cmdPtr->objClientData;
     if (procPtr == NULL) {
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"procedure \"", fullName,
-		"\" does not have a Proc struct!", (char *) NULL);
+		"\" does not have a Proc struct!", NULL);
         return TCL_ERROR;
     }
-        
+
     /*
      * create a new object, initialize our argument vector, call into Tcl
      */
@@ -299,7 +282,7 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
     if (bodyObjPtr == NULL) {
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"failed to create a procbody object for procedure \"",
-                fullName, "\"", (char *) NULL);
+                fullName, "\"", NULL);
         return TCL_ERROR;
     }
     Tcl_IncrRefCount(bodyObjPtr);
@@ -308,10 +291,18 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
     myobjv[1] = objv[1];
     myobjv[2] = objv[2];
     myobjv[3] = bodyObjPtr;
-    myobjv[4] = (Tcl_Obj *) NULL;
+    myobjv[4] = NULL;
 
     result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
     Tcl_DecrRefCount(bodyObjPtr);
 
     return result;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThread.c b/generic/tclThread.c
index c2f769d..8384107 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -1,22 +1,21 @@
-/* 
+/*
  * tclThread.c --
  *
- *	This file implements   Platform independent thread operations.
- *	Most of the real work is done in the platform dependent files.
+ *	This file implements Platform independent thread operations. Most of
+ *	the real work is done in the platform dependent files.
  *
  * Copyright (c) 1998 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
 /*
- * There are three classes of synchronization objects:
- * mutexes, thread data keys, and condition variables.
- * The following are used to record the memory used for these
- * objects so they can be finalized.
+ * There are three classes of synchronization objects: mutexes, thread data
+ * keys, and condition variables. The following are used to record the memory
+ * used for these objects so they can be finalized.
  *
  * These statics are guarded by the mutex in the caller of
  * TclRememberThreadData, e.g., TclpThreadDataKeyInit
@@ -33,19 +32,19 @@ static SyncObjRecord mutexRecord = {0, 0, NULL};
 static SyncObjRecord condRecord = {0, 0, NULL};
 
 /*
- * Prototypes of functions used only in this file
+ * Prototypes of functions used only in this file.
  */
- 
-static void		RememberSyncObject _ANSI_ARGS_((char *objPtr,
-			    SyncObjRecord *recPtr));
-static void		ForgetSyncObject _ANSI_ARGS_((char *objPtr,
-			    SyncObjRecord *recPtr));
 
-/* 
+static void		ForgetSyncObject(char *objPtr, SyncObjRecord *recPtr);
+static void		RememberSyncObject(char *objPtr,
+			    SyncObjRecord *recPtr);
+
+/*
  * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
- * specified.  Here we undo that so the procedures are defined in the
- * stubs table.
+ * specified. Here we undo that so the functions are defined in the stubs
+ * table.
  */
+
 #ifndef TCL_THREADS
 #undef Tcl_MutexLock
 #undef Tcl_MutexUnlock
@@ -54,61 +53,51 @@ static void		ForgetSyncObject _ANSI_ARGS_((char *objPtr,
 #undef Tcl_ConditionWait
 #undef Tcl_ConditionFinalize
 #endif
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_GetThreadData --
  *
- *	This procedure allocates and initializes a chunk of thread
- *	local storage.
+ *	This function allocates and initializes a chunk of thread local
+ *	storage.
  *
  * Results:
  *	A thread-specific pointer to the data structure.
  *
  * Side effects:
- *	Will allocate memory the first time this thread calls for
- *	this chunk of storage.
+ *	Will allocate memory the first time this thread calls for this chunk
+ *	of storage.
  *
  *----------------------------------------------------------------------
  */
 
-VOID *
-Tcl_GetThreadData(keyPtr, size)
-    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk */
-    int size;			/* Size of storage block */
+void *
+Tcl_GetThreadData(
+    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
+    int size)			/* Size of storage block */
 {
-    VOID *result;
+    void *result;
 #ifdef TCL_THREADS
-
-    /*
-     * See if this is the first thread to init this key.
-     */
-
-    if (*keyPtr == NULL) {
-	TclpThreadDataKeyInit(keyPtr);
-    }
-
     /*
      * Initialize the key for this thread.
      */
-
     result = TclpThreadDataKeyGet(keyPtr);
+
     if (result == NULL) {
-	result  = (VOID *)ckalloc((size_t)size);
-	memset(result, 0, (size_t)size);
+	result = ckalloc((size_t) size);
+	memset(result, 0, (size_t) size);
 	TclpThreadDataKeySet(keyPtr, result);
     }
-#else
+#else /* TCL_THREADS */
     if (*keyPtr == NULL) {
-	result = (VOID *)ckalloc((size_t)size);
-	memset((char *)result, 0, (size_t)size);
+	result = ckalloc((size_t) size);
+	memset(result, 0, (size_t) size);
 	*keyPtr = (Tcl_ThreadDataKey)result;
-	TclRememberDataKey(keyPtr);
+	RememberSyncObject((char *) keyPtr, &keyRecord);
     }
-    result = *(VOID **)keyPtr;
-#endif
+    result = * (void **) keyPtr;
+#endif /* TCL_THREADS */
     return result;
 }
 
@@ -117,11 +106,11 @@ Tcl_GetThreadData(keyPtr, size)
  *
  * TclThreadDataKeyGet --
  *
- *	This procedure returns a pointer to a block of thread local storage.
+ *	This function returns a pointer to a block of thread local storage.
  *
  * Results:
- *	A thread-specific pointer to the data structure, or NULL
- *	if the memory has not been assigned to this key for this thread.
+ *	A thread-specific pointer to the data structure, or NULL if the memory
+ *	has not been assigned to this key for this thread.
  *
  * Side effects:
  *	None.
@@ -129,61 +118,27 @@ Tcl_GetThreadData(keyPtr, size)
  *----------------------------------------------------------------------
  */
 
-VOID *
-TclThreadDataKeyGet(keyPtr)
-    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
-				 * really (pthread_key_t **) */
-{
-#ifdef TCL_THREADS
-    return (VOID *)TclpThreadDataKeyGet(keyPtr);
-#else
-    char *result = *(char **)keyPtr;
-    return (VOID *)result;
-#endif /* TCL_THREADS */
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadDataKeySet --
- *
- *	This procedure sets a thread local storage pointer.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The assigned value will be returned by TclpThreadDataKeyGet.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclThreadDataKeySet(keyPtr, data)
-    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
-				 * really (pthread_key_t **) */
-    VOID *data;			/* Thread local storage */
+void *
+TclThreadDataKeyGet(
+    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
+				 * (pthread_key_t **) */
 {
 #ifdef TCL_THREADS
-    if (*keyPtr == NULL) {
-	TclpThreadDataKeyInit(keyPtr);
-    }
-    TclpThreadDataKeySet(keyPtr, data);
-#else
-    *keyPtr = (Tcl_ThreadDataKey)data;
+    return TclpThreadDataKeyGet(keyPtr);
+#else /* TCL_THREADS */
+    char *result = *(char **) keyPtr;
+    return result;
 #endif /* TCL_THREADS */
 }
 
-
 
 /*
  *----------------------------------------------------------------------
  *
  * RememberSyncObject
  *
- *      Keep a list of (mutexes/condition variable/data key)
- *	used during finalization.
+ *	Keep a list of (mutexes/condition variable/data key) used during
+ *	finalization.
  *
  *	Assume master lock is held.
  *
@@ -197,22 +152,23 @@ TclThreadDataKeySet(keyPtr, data)
  */
 
 static void
-RememberSyncObject(objPtr, recPtr)
-    char *objPtr;		/* Pointer to sync object */
-    SyncObjRecord *recPtr;	/* Record of sync objects */
+RememberSyncObject(
+    char *objPtr,		/* Pointer to sync object */
+    SyncObjRecord *recPtr)	/* Record of sync objects */
 {
     char **newList;
     int i, j;
 
+
     /*
-     * Reuse any free slot in the list. 
+     * Reuse any free slot in the list.
      */
 
     for (i=0 ; i < recPtr->num ; ++i) {
 	if (recPtr->list[i] == NULL) {
 	    recPtr->list[i] = objPtr;
 	    return;
-	} 
+	}
     }
 
     /*
@@ -222,14 +178,14 @@ RememberSyncObject(objPtr, recPtr)
 
     if (recPtr->num >= recPtr->max) {
 	recPtr->max += 8;
-	newList = (char **)ckalloc(recPtr->max * sizeof(char *));
-	for (i=0, j=0 ; i < recPtr->num ; i++) {
-            if (recPtr->list[i] != NULL) {
+	newList = (char **) ckalloc(recPtr->max * sizeof(char *));
+	for (i=0,j=0 ; i<recPtr->num ; i++) {
+	    if (recPtr->list[i] != NULL) {
 		newList[j++] = recPtr->list[i];
-            }
+	    }
 	}
 	if (recPtr->list != NULL) {
-	    ckfree((char *)recPtr->list);
+	    ckfree((char *) recPtr->list);
 	}
 	recPtr->list = newList;
 	recPtr->num = j;
@@ -244,7 +200,7 @@ RememberSyncObject(objPtr, recPtr)
  *
  * ForgetSyncObject
  *
- *      Remove a single object from the list.
+ *	Remove a single object from the list.
  *	Assume master lock is held.
  *
  * Results:
@@ -257,9 +213,9 @@ RememberSyncObject(objPtr, recPtr)
  */
 
 static void
-ForgetSyncObject(objPtr, recPtr)
-    char *objPtr;		/* Pointer to sync object */
-    SyncObjRecord *recPtr;	/* Record of sync objects */
+ForgetSyncObject(
+    char *objPtr,		/* Pointer to sync object */
+    SyncObjRecord *recPtr)	/* Record of sync objects */
 {
     int i;
 
@@ -276,7 +232,7 @@ ForgetSyncObject(objPtr, recPtr)
  *
  * TclRememberMutex
  *
- *      Keep a list of mutexes used during finalization.
+ *	Keep a list of mutexes used during finalization.
  *	Assume master lock is held.
  *
  * Results:
@@ -289,8 +245,8 @@ ForgetSyncObject(objPtr, recPtr)
  */
 
 void
-TclRememberMutex(mutexPtr)
-    Tcl_Mutex *mutexPtr;
+TclRememberMutex(
+    Tcl_Mutex *mutexPtr)
 {
     RememberSyncObject((char *)mutexPtr, &mutexRecord);
 }
@@ -298,10 +254,10 @@ TclRememberMutex(mutexPtr)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_MutexFinalize
+ * Tcl_MutexFinalize --
  *
- *      Finalize a single mutex and remove it from the
- *	list of remembered objects.
+ *	Finalize a single mutex and remove it from the list of remembered
+ *	objects.
  *
  * Results:
  *	None.
@@ -313,47 +269,23 @@ TclRememberMutex(mutexPtr)
  */
 
 void
-Tcl_MutexFinalize(mutexPtr)
-    Tcl_Mutex *mutexPtr;
+Tcl_MutexFinalize(
+    Tcl_Mutex *mutexPtr)
 {
 #ifdef TCL_THREADS
     TclpFinalizeMutex(mutexPtr);
 #endif
     TclpMasterLock();
-    ForgetSyncObject((char *)mutexPtr, &mutexRecord);
+    ForgetSyncObject((char *) mutexPtr, &mutexRecord);
     TclpMasterUnlock();
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclRememberDataKey
- *
- *      Keep a list of thread data keys used during finalization.
- *	Assume master lock is held.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Add to the key list.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclRememberDataKey(keyPtr)
-    Tcl_ThreadDataKey *keyPtr;
-{
-    RememberSyncObject((char *)keyPtr, &keyRecord);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclRememberCondition
  *
- *      Keep a list of condition variables used during finalization.
+ *	Keep a list of condition variables used during finalization.
  *	Assume master lock is held.
  *
  * Results:
@@ -366,19 +298,19 @@ TclRememberDataKey(keyPtr)
  */
 
 void
-TclRememberCondition(condPtr)
-    Tcl_Condition *condPtr;
+TclRememberCondition(
+    Tcl_Condition *condPtr)
 {
-    RememberSyncObject((char *)condPtr, &condRecord);
+    RememberSyncObject((char *) condPtr, &condRecord);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ConditionFinalize
+ * Tcl_ConditionFinalize --
  *
- *      Finalize a single condition variable and remove it from the
- *	list of remembered objects.
+ *	Finalize a single condition variable and remove it from the list of
+ *	remembered objects.
  *
  * Results:
  *	None.
@@ -390,14 +322,14 @@ TclRememberCondition(condPtr)
  */
 
 void
-Tcl_ConditionFinalize(condPtr)
-    Tcl_Condition *condPtr;
+Tcl_ConditionFinalize(
+    Tcl_Condition *condPtr)
 {
 #ifdef TCL_THREADS
     TclpFinalizeCondition(condPtr);
 #endif
     TclpMasterLock();
-    ForgetSyncObject((char *)condPtr, &condRecord);
+    ForgetSyncObject((char *) condPtr, &condRecord);
     TclpMasterUnlock();
 }
 
@@ -406,8 +338,8 @@ Tcl_ConditionFinalize(condPtr)
  *
  * TclFinalizeThreadData --
  *
- *	This procedure cleans up the thread-local storage.  This is
- *	called once for each thread.
+ *	This function cleans up the thread-local storage. This is called once
+ *	for each thread.
  *
  * Results:
  *	None.
@@ -419,24 +351,9 @@ Tcl_ConditionFinalize(condPtr)
  */
 
 void
-TclFinalizeThreadData()
+TclFinalizeThreadData(void)
 {
-    int i;
-    Tcl_ThreadDataKey *keyPtr;
-
-    TclpMasterLock();
-    for (i=0 ; i<keyRecord.num ; i++) {
-	keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
-#ifdef TCL_THREADS
-	TclpFinalizeThreadData(keyPtr);
-#else
-	if (*keyPtr != NULL) {
-	    ckfree((char *)*keyPtr);
-	    *keyPtr = NULL;
-	}
-#endif
-    }
-    TclpMasterUnlock();
+    TclpFinalizeThreadDataThread();
 }
 
 /*
@@ -444,8 +361,8 @@ TclFinalizeThreadData()
  *
  * TclFinalizeSynchronization --
  *
- *      This procedure cleans up all synchronization objects:
- *      mutexes, condition variables, and thread-local storage.
+ *	This function cleans up all synchronization objects: mutexes,
+ *	condition variables, and thread-local storage.
  *
  * Results:
  *	None.
@@ -457,25 +374,41 @@ TclFinalizeThreadData()
  */
 
 void
-TclFinalizeSynchronization()
+TclFinalizeSynchronization(void)
 {
-#ifdef TCL_THREADS
+    int i;
+    void *blockPtr;
     Tcl_ThreadDataKey *keyPtr;
+#ifdef TCL_THREADS
     Tcl_Mutex *mutexPtr;
     Tcl_Condition *condPtr;
-    int i;
 
     TclpMasterLock();
-    for (i=0 ; i<keyRecord.num ; i++) {
-	keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
-	TclpFinalizeThreadDataKey(keyPtr);
-    }
+#endif
+
+    /*
+     * If we're running unthreaded, the TSD blocks are simply stored inside
+     * their thread data keys. Free them here.
+     */
+
     if (keyRecord.list != NULL) {
-	ckfree((char *)keyRecord.list);
+	for (i=0 ; i<keyRecord.num ; i++) {
+	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
+	    blockPtr = (void *) *keyPtr;
+	    ckfree(blockPtr);
+	}
+	ckfree((char *) keyRecord.list);
 	keyRecord.list = NULL;
     }
     keyRecord.max = 0;
     keyRecord.num = 0;
+    
+#ifdef TCL_THREADS
+    /*
+     * Call thread storage master cleanup.
+     */
+
+    TclFinalizeThreadStorage();
 
     for (i=0 ; i<mutexRecord.num ; i++) {
 	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
@@ -484,45 +417,37 @@ TclFinalizeSynchronization()
 	}
     }
     if (mutexRecord.list != NULL) {
-	ckfree((char *)mutexRecord.list);
+	ckfree((char *) mutexRecord.list);
 	mutexRecord.list = NULL;
     }
     mutexRecord.max = 0;
     mutexRecord.num = 0;
 
     for (i=0 ; i<condRecord.num ; i++) {
-	condPtr = (Tcl_Condition *)condRecord.list[i];
+	condPtr = (Tcl_Condition *) condRecord.list[i];
 	if (condPtr != NULL) {
 	    TclpFinalizeCondition(condPtr);
 	}
     }
     if (condRecord.list != NULL) {
-	ckfree((char *)condRecord.list);
+	ckfree((char *) condRecord.list);
 	condRecord.list = NULL;
     }
     condRecord.max = 0;
     condRecord.num = 0;
 
     TclpMasterUnlock();
-#else
-    if (keyRecord.list != NULL) {
-	ckfree((char *)keyRecord.list);
-	keyRecord.list = NULL;
-    }
-    keyRecord.max = 0;
-    keyRecord.num = 0;
-#endif
+#endif /* TCL_THREADS */
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ExitThread --
  *
- *	This procedure is called to terminate the current thread.
- *	This should be used by extensions that create threads with
- *	additional interpreters in them.
+ *	This function is called to terminate the current thread. This should
+ *	be used by extensions that create threads with additional interpreters
+ *	in them.
  *
  * Results:
  *	None.
@@ -534,8 +459,8 @@ TclFinalizeSynchronization()
  */
 
 void
-Tcl_ExitThread(status)
-    int status;
+Tcl_ExitThread(
+    int status)
 {
     Tcl_FinalizeThread();
 #ifdef TCL_THREADS
@@ -550,10 +475,9 @@ Tcl_ExitThread(status)
  *
  * Tcl_ConditionWait, et al. --
  *
- *	These noop procedures are provided so the stub table does
- *	not have to be conditionalized for threads.  The real
- *	implementations of these functions live in the platform
- *	specific files.
+ *	These noop functions are provided so the stub table does not have to
+ *	be conditionalized for threads. The real implementations of these
+ *	functions live in the platform specific files.
  *
  * Results:
  *	None.
@@ -566,31 +490,39 @@ Tcl_ExitThread(status)
 
 #undef Tcl_ConditionWait
 void
-Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
-    Tcl_Condition *condPtr;	/* Really (pthread_cond_t **) */
-    Tcl_Mutex *mutexPtr;	/* Really (pthread_mutex_t **) */
-    Tcl_Time *timePtr;		/* Timeout on waiting period */
+Tcl_ConditionWait(
+    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
+    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
+    Tcl_Time *timePtr)		/* Timeout on waiting period */
 {
 }
 
 #undef Tcl_ConditionNotify
 void
-Tcl_ConditionNotify(condPtr)
-    Tcl_Condition *condPtr;
+Tcl_ConditionNotify(
+    Tcl_Condition *condPtr)
 {
 }
 
 #undef Tcl_MutexLock
 void
-Tcl_MutexLock(mutexPtr)
-    Tcl_Mutex *mutexPtr;
+Tcl_MutexLock(
+    Tcl_Mutex *mutexPtr)
 {
 }
 
 #undef Tcl_MutexUnlock
 void
-Tcl_MutexUnlock(mutexPtr)
-    Tcl_Mutex *mutexPtr;
+Tcl_MutexUnlock(
+    Tcl_Mutex *mutexPtr)
 {
 }
-#endif
+#endif /* !TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index ad9f0a0..2e74fa7 100755..100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -2,31 +2,22 @@
  * tclThreadAlloc.c --
  *
  *	This is a very fast storage allocator for used with threads (designed
- *	avoid lock contention).  The basic strategy is to allocate memory in
- *  	fixed size blocks from block caches.
- * 
+ *	avoid lock contention). The basic strategy is to allocate memory in
+ *	fixed size blocks from block caches.
+ *
  * The Initial Developer of the Original Code is America Online, Inc.
  * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
-
-#ifdef WIN32
-#include "tclWinInt.h"
-#else
-extern Tcl_Mutex *TclpNewAllocMutex(void);
-extern void *TclpGetAllocCache(void);
-extern void TclpSetAllocCache(void *);
-#endif
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
 
 /*
- * If range checking is enabled, an additional byte will be allocated
- * to store the magic number at the end of the requested memory.
+ * If range checking is enabled, an additional byte will be allocated to store
+ * the magic number at the end of the requested memory.
  */
 
 #ifndef RCHECK
@@ -38,33 +29,21 @@ extern void TclpSetAllocCache(void *);
 #endif
 
 /*
- * The following define the number of Tcl_Obj's to allocate/move
- * at a time and the high water mark to prune a per-thread cache.
- * On a 32 bit system, sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
- *
+ * The following define the number of Tcl_Obj's to allocate/move at a time and
+ * the high water mark to prune a per-thread cache. On a 32 bit system,
+ * sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
  */
- 
-#define NOBJALLOC	 800
+
+#define NOBJALLOC	800
 #define NOBJHIGH	1200
 
 /*
- * Alignment for allocated memory.
+ * The following union stores accounting information for each block including
+ * two small magic numbers and a bucket number when in use or a next pointer
+ * when free. The original requested size (not including the Block overhead)
+ * is also maintained.
  */
 
-#if defined(__APPLE__)
-#define ALLOCALIGN	16
-#else
-#define ALLOCALIGN	8
-#endif
-
-/*
- * The following union stores accounting information for
- * each block including two small magic numbers and
- * a bucket number when in use or a next pointer when
- * free.  The original requested size (not including
- * the Block overhead) is also maintained.
- */
- 
 typedef union Block {
     struct {
 	union {
@@ -78,93 +57,95 @@ typedef union Block {
 	} u;
 	size_t reqSize;			/* Requested allocation size. */
     } b;
-    unsigned char padding[ALLOCALIGN];
+    unsigned char padding[TCL_ALLOCALIGN];
 } Block;
-#define b_next		b.u.next
-#define b_bucket	b.u.s.bucket
-#define b_magic1	b.u.s.magic1
-#define b_magic2	b.u.s.magic2
-#define MAGIC		0xef
-#define b_reqsize	b.reqSize
+#define nextBlock	b.u.next
+#define sourceBucket	b.u.s.bucket
+#define magicNum1	b.u.s.magic1
+#define magicNum2	b.u.s.magic2
+#define MAGIC		0xEF
+#define blockReqSize	b.reqSize
 
 /*
  * The following defines the minimum and and maximum block sizes and the number
  * of buckets in the bucket cache.
  */
 
-#define MINALLOC	((sizeof(Block) + 8 + (ALLOCALIGN-1)) & ~(ALLOCALIGN-1))
+#define MINALLOC	((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
 #define NBUCKETS	(11 - (MINALLOC >> 5))
 #define MAXALLOC	(MINALLOC << (NBUCKETS - 1))
 
 /*
- * The following structure defines a bucket of blocks with
- * various accounting and statistics information.
+ * The following structure defines a bucket of blocks with various accounting
+ * and statistics information.
  */
 
 typedef struct Bucket {
-    Block *firstPtr;
-    long nfree;
-    long nget;
-    long nput;
-    long nwait;
-    long nlock;
-    long nrequest;
+    Block *firstPtr;		/* First block available */
+    long numFree;		/* Number of blocks available */
+
+    /* All fields below for accounting only */
+
+    long numRemoves;		/* Number of removes from bucket */
+    long numInserts;		/* Number of inserts into bucket */
+    long numWaits;		/* Number of waits to acquire a lock */
+    long numLocks;		/* Number of locks acquired */
+    long totalAssigned;		/* Total space assigned to bucket */
 } Bucket;
 
 /*
- * The following structure defines a cache of buckets and objs.
+ * The following structure defines a cache of buckets and objs, of which there
+ * will be (at most) one per thread.
  */
 
 typedef struct Cache {
-    struct Cache  *nextPtr;
-    Tcl_ThreadId   owner;
-    Tcl_Obj       *firstObjPtr;
-    int            nobjs;
-    int	           nsysalloc;
-    Bucket         buckets[NBUCKETS];
+    struct Cache *nextPtr;	/* Linked list of cache entries */
+    Tcl_ThreadId owner;		/* Which thread's cache is this? */
+    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
+    int numObjects;		/* Number of objects for thread */
+    int totalAssigned;		/* Total space assigned to thread */
+    Bucket buckets[NBUCKETS];	/* The buckets for this thread */
 } Cache;
 
 /*
- * The following array specifies various per-bucket 
- * limits and locks.  The values are statically initialized
- * to avoid calculating them repeatedly.
+ * The following array specifies various per-bucket limits and locks. The
+ * values are statically initialized to avoid calculating them repeatedly.
  */
 
-struct binfo {
-    size_t blocksize;	/* Bucket blocksize. */
-    int maxblocks;	/* Max blocks before move to share. */
-    int nmove;		/* Num blocks to move to share. */
-    Tcl_Mutex *lockPtr; /* Share bucket lock. */
-} binfo[NBUCKETS];
+static struct {
+    size_t blockSize;		/* Bucket blocksize. */
+    int maxBlocks;		/* Max blocks before move to share. */
+    int numMove;		/* Num blocks to move to share. */
+    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
+} bucketInfo[NBUCKETS];
 
 /*
  * Static functions defined in this file.
  */
 
-static void LockBucket(Cache *cachePtr, int bucket);
-static void UnlockBucket(Cache *cachePtr, int bucket);
-static void PutBlocks(Cache *cachePtr, int bucket, int nmove);
-static int  GetBlocks(Cache *cachePtr, int bucket);
-static Block *Ptr2Block(char *ptr);
-static char *Block2Ptr(Block *blockPtr, int bucket, unsigned int reqsize);
-static void MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove);
+static Cache *	GetCache(void);
+static void	LockBucket(Cache *cachePtr, int bucket);
+static void	UnlockBucket(Cache *cachePtr, int bucket);
+static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
+static int	GetBlocks(Cache *cachePtr, int bucket);
+static Block *	Ptr2Block(char *ptr);
+static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
+static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
 
 /*
- * Local variables defined in this file and initialized at
- * startup.
+ * Local variables defined in this file and initialized at startup.
  */
 
 static Tcl_Mutex *listLockPtr;
 static Tcl_Mutex *objLockPtr;
-static Cache     sharedCache;
-static Cache    *sharedPtr = &sharedCache;
-static Cache    *firstCachePtr = &sharedCache;
-
+static Cache sharedCache;
+static Cache *sharedPtr = &sharedCache;
+static Cache *firstCachePtr = &sharedCache;
 
 /*
  *----------------------------------------------------------------------
  *
- *  GetCache ---
+ * GetCache ---
  *
  *	Gets per-thread memory cache, allocating it if necessary.
  *
@@ -172,7 +153,7 @@ static Cache    *firstCachePtr = &sharedCache;
  *	Pointer to cache.
  *
  * Side effects:
- *  	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -196,10 +177,11 @@ GetCache(void)
 	    listLockPtr = TclpNewAllocMutex();
 	    objLockPtr = TclpNewAllocMutex();
 	    for (i = 0; i < NBUCKETS; ++i) {
-		binfo[i].blocksize = MINALLOC << i;
-		binfo[i].maxblocks = 1 << (NBUCKETS - 1 - i);
-		binfo[i].nmove = i < NBUCKETS-1 ? 1 << (NBUCKETS - 2 - i) : 1;
-	        binfo[i].lockPtr = TclpNewAllocMutex();
+		bucketInfo[i].blockSize = MINALLOC << i;
+		bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
+		bucketInfo[i].numMove = i < NBUCKETS - 1 ?
+			1 << (NBUCKETS - 2 - i) : 1;
+		bucketInfo[i].lockPtr = TclpNewAllocMutex();
 	    }
 	}
 	Tcl_MutexUnlock(initLockPtr);
@@ -211,25 +193,24 @@ GetCache(void)
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
-    	cachePtr = calloc(1, sizeof(Cache));
-    	if (cachePtr == NULL) {
-	    panic("alloc: could not allocate new cache");
-    	}
-    	Tcl_MutexLock(listLockPtr);
-    	cachePtr->nextPtr = firstCachePtr;
-    	firstCachePtr = cachePtr;
-    	Tcl_MutexUnlock(listLockPtr);
-    	cachePtr->owner = Tcl_GetCurrentThread();
+	cachePtr = calloc(1, sizeof(Cache));
+	if (cachePtr == NULL) {
+	    Tcl_Panic("alloc: could not allocate new cache");
+	}
+	Tcl_MutexLock(listLockPtr);
+	cachePtr->nextPtr = firstCachePtr;
+	firstCachePtr = cachePtr;
+	Tcl_MutexUnlock(listLockPtr);
+	cachePtr->owner = Tcl_GetCurrentThread();
 	TclpSetAllocCache(cachePtr);
     }
     return cachePtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  TclFreeAllocCache --
+ * TclFreeAllocCache --
  *
  *	Flush and delete a cache, removing from list of caches.
  *
@@ -243,7 +224,8 @@ GetCache(void)
  */
 
 void
-TclFreeAllocCache(void *arg)
+TclFreeAllocCache(
+    void *arg)
 {
     Cache *cachePtr = arg;
     Cache **nextPtrPtr;
@@ -254,8 +236,8 @@ TclFreeAllocCache(void *arg)
      */
 
     for (bucket = 0; bucket < NBUCKETS; ++bucket) {
-	if (cachePtr->buckets[bucket].nfree > 0) {
-	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].nfree);
+	if (cachePtr->buckets[bucket].numFree > 0) {
+	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
 	}
     }
 
@@ -263,10 +245,10 @@ TclFreeAllocCache(void *arg)
      * Flush objs.
      */
 
-    if (cachePtr->nobjs > 0) {
-    	Tcl_MutexLock(objLockPtr);
-    	MoveObjs(cachePtr, sharedPtr, cachePtr->nobjs);
-    	Tcl_MutexUnlock(objLockPtr);
+    if (cachePtr->numObjects > 0) {
+	Tcl_MutexLock(objLockPtr);
+	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
+	Tcl_MutexUnlock(objLockPtr);
     }
 
     /*
@@ -283,12 +265,11 @@ TclFreeAllocCache(void *arg)
     Tcl_MutexUnlock(listLockPtr);
     free(cachePtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  TclpAlloc --
+ * TclpAlloc --
  *
  *	Allocate memory.
  *
@@ -302,72 +283,73 @@ TclFreeAllocCache(void *arg)
  */
 
 char *
-TclpAlloc(unsigned int reqsize)
+TclpAlloc(
+    unsigned int reqSize)
 {
-    Cache         *cachePtr;
-    Block         *blockPtr;
-    register int   bucket;
-    size_t  	   size;
+    Cache *cachePtr;
+    Block *blockPtr;
+    register int bucket;
+    size_t size;
 
+#ifndef __LP64__
     if (sizeof(int) >= sizeof(size_t)) {
 	/* An unsigned int overflow can also be a size_t overflow */
 	const size_t zero = 0;
 	const size_t max = ~zero;
 
-	if (((size_t) reqsize) > max - sizeof(Block) - RCHECK) {
+	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
 	    /* Requested allocation exceeds memory */
 	    return NULL;
 	}
     }
+#endif
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
 	cachePtr = GetCache();
     }
-    
+
     /*
-     * Increment the requested size to include room for 
-     * the Block structure.  Call malloc() directly if the
-     * required amount is greater than the largest block,
-     * otherwise pop the smallest block large enough,
+     * Increment the requested size to include room for the Block structure.
+     * Call malloc() directly if the required amount is greater than the
+     * largest block, otherwise pop the smallest block large enough,
      * allocating more blocks if necessary.
      */
 
-    blockPtr = NULL;     
-    size = reqsize + sizeof(Block);
+    blockPtr = NULL;
+    size = reqSize + sizeof(Block);
 #if RCHECK
     ++size;
 #endif
     if (size > MAXALLOC) {
 	bucket = NBUCKETS;
-    	blockPtr = malloc(size);
+	blockPtr = malloc(size);
 	if (blockPtr != NULL) {
-	    cachePtr->nsysalloc += reqsize;
+	    cachePtr->totalAssigned += reqSize;
 	}
     } else {
-    	bucket = 0;
-    	while (binfo[bucket].blocksize < size) {
-    	    ++bucket;
-    	}
-    	if (cachePtr->buckets[bucket].nfree || GetBlocks(cachePtr, bucket)) {
+	bucket = 0;
+	while (bucketInfo[bucket].blockSize < size) {
+	    ++bucket;
+	}
+	if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
 	    blockPtr = cachePtr->buckets[bucket].firstPtr;
-	    cachePtr->buckets[bucket].firstPtr = blockPtr->b_next;
-	    --cachePtr->buckets[bucket].nfree;
-    	    ++cachePtr->buckets[bucket].nget;
-	    cachePtr->buckets[bucket].nrequest += reqsize;
+	    cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
+	    --cachePtr->buckets[bucket].numFree;
+	    ++cachePtr->buckets[bucket].numRemoves;
+	    cachePtr->buckets[bucket].totalAssigned += reqSize;
 	}
     }
     if (blockPtr == NULL) {
-    	return NULL;
+	return NULL;
     }
-    return Block2Ptr(blockPtr, bucket, reqsize);
+    return Block2Ptr(blockPtr, bucket, reqSize);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  TclpFree --
+ * TclpFree --
  *
  *	Return blocks to the thread block cache.
  *
@@ -381,49 +363,52 @@ TclpAlloc(unsigned int reqsize)
  */
 
 void
-TclpFree(char *ptr)
+TclpFree(
+    char *ptr)
 {
-    if (ptr != NULL) {
-	Cache  *cachePtr = TclpGetAllocCache();
-	Block *blockPtr;
-	int bucket;
+    Cache *cachePtr;
+    Block *blockPtr;
+    int bucket;
 
-	if (cachePtr == NULL) {
-	    cachePtr = GetCache();
-	}
- 
-	/*
-	 * Get the block back from the user pointer and
-	 * call system free directly for large blocks.
-	 * Otherwise, push the block back on the bucket and
-	 * move blocks to the shared cache if there are now
-	 * too many free.
-	 */
+    if (ptr == NULL) {
+	return;
+    }
 
-	blockPtr = Ptr2Block(ptr);
-	bucket = blockPtr->b_bucket;
-	if (bucket == NBUCKETS) {
-	    cachePtr->nsysalloc -= blockPtr->b_reqsize;
-	    free(blockPtr);
-	} else {
-	    cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
-	    blockPtr->b_next = cachePtr->buckets[bucket].firstPtr;
-	    cachePtr->buckets[bucket].firstPtr = blockPtr;
-	    ++cachePtr->buckets[bucket].nfree;
-	    ++cachePtr->buckets[bucket].nput;
-	    if (cachePtr != sharedPtr &&
-		    cachePtr->buckets[bucket].nfree > binfo[bucket].maxblocks) {
-		PutBlocks(cachePtr, bucket, binfo[bucket].nmove);
-	    }
-	}
+    cachePtr = TclpGetAllocCache();
+    if (cachePtr == NULL) {
+	cachePtr = GetCache();
     }
-}
 
+    /*
+     * Get the block back from the user pointer and call system free directly
+     * for large blocks. Otherwise, push the block back on the bucket and move
+     * blocks to the shared cache if there are now too many free.
+     */
+
+    blockPtr = Ptr2Block(ptr);
+    bucket = blockPtr->sourceBucket;
+    if (bucket == NBUCKETS) {
+	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+	free(blockPtr);
+	return;
+    }
+
+    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
+    cachePtr->buckets[bucket].firstPtr = blockPtr;
+    ++cachePtr->buckets[bucket].numFree;
+    ++cachePtr->buckets[bucket].numInserts;
+
+    if (cachePtr != sharedPtr &&
+	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
+	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
  *
- *  TclpRealloc --
+ * TclpRealloc --
  *
  *	Re-allocate memory to a larger or smaller size.
  *
@@ -437,28 +422,32 @@ TclpFree(char *ptr)
  */
 
 char *
-TclpRealloc(char *ptr, unsigned int reqsize)
+TclpRealloc(
+    char *ptr,
+    unsigned int reqSize)
 {
     Cache *cachePtr;
     Block *blockPtr;
-    void *new;
+    void *newPtr;
     size_t size, min;
     int bucket;
 
     if (ptr == NULL) {
-	return TclpAlloc(reqsize);
+	return TclpAlloc(reqSize);
     }
 
+#ifndef __LP64__
     if (sizeof(int) >= sizeof(size_t)) {
 	/* An unsigned int overflow can also be a size_t overflow */
 	const size_t zero = 0;
 	const size_t max = ~zero;
 
-	if (((size_t) reqsize) > max - sizeof(Block) - RCHECK) {
+	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
 	    /* Requested allocation exceeds memory */
 	    return NULL;
 	}
     }
+#endif
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
@@ -466,54 +455,52 @@ TclpRealloc(char *ptr, unsigned int reqsize)
     }
 
     /*
-     * If the block is not a system block and fits in place,
-     * simply return the existing pointer.  Otherwise, if the block
-     * is a system block and the new size would also require a system
-     * block, call realloc() directly.
+     * If the block is not a system block and fits in place, simply return the
+     * existing pointer. Otherwise, if the block is a system block and the new
+     * size would also require a system block, call realloc() directly.
      */
 
     blockPtr = Ptr2Block(ptr);
-    size = reqsize + sizeof(Block);
+    size = reqSize + sizeof(Block);
 #if RCHECK
     ++size;
 #endif
-    bucket = blockPtr->b_bucket;
+    bucket = blockPtr->sourceBucket;
     if (bucket != NBUCKETS) {
 	if (bucket > 0) {
-	    min = binfo[bucket-1].blocksize;
+	    min = bucketInfo[bucket-1].blockSize;
 	} else {
 	    min = 0;
 	}
-	if (size > min && size <= binfo[bucket].blocksize) {
-	    cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
-	    cachePtr->buckets[bucket].nrequest += reqsize;
-	    return Block2Ptr(blockPtr, bucket, reqsize);
+	if (size > min && size <= bucketInfo[bucket].blockSize) {
+	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+	    cachePtr->buckets[bucket].totalAssigned += reqSize;
+	    return Block2Ptr(blockPtr, bucket, reqSize);
 	}
     } else if (size > MAXALLOC) {
-	cachePtr->nsysalloc -= blockPtr->b_reqsize;
-	cachePtr->nsysalloc += reqsize;
+	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+	cachePtr->totalAssigned += reqSize;
 	blockPtr = realloc(blockPtr, size);
 	if (blockPtr == NULL) {
 	    return NULL;
 	}
-	return Block2Ptr(blockPtr, NBUCKETS, reqsize);
+	return Block2Ptr(blockPtr, NBUCKETS, reqSize);
     }
 
     /*
      * Finally, perform an expensive malloc/copy/free.
      */
 
-    new = TclpAlloc(reqsize);
-    if (new != NULL) {
-	if (reqsize > blockPtr->b_reqsize) {
-	    reqsize = blockPtr->b_reqsize;
+    newPtr = TclpAlloc(reqSize);
+    if (newPtr != NULL) {
+	if (reqSize > blockPtr->blockReqSize) {
+	    reqSize = blockPtr->blockReqSize;
 	}
-    	memcpy(new, ptr, reqsize);
-    	TclpFree(ptr);
+	memcpy(newPtr, ptr, reqSize);
+	TclpFree(ptr);
     }
-    return new;
+    return newPtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -526,8 +513,8 @@ TclpRealloc(char *ptr, unsigned int reqsize)
  *	Pointer to uninitialized Tcl_Obj.
  *
  * Side effects:
- *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's
- *  	if list is empty.
+ *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
+ *	list is empty.
  *
  *----------------------------------------------------------------------
  */
@@ -536,38 +523,40 @@ Tcl_Obj *
 TclThreadAllocObj(void)
 {
     register Cache *cachePtr = TclpGetAllocCache();
-    register int nmove;
     register Tcl_Obj *objPtr;
-    Tcl_Obj *newObjsPtr;
 
     if (cachePtr == NULL) {
 	cachePtr = GetCache();
     }
 
     /*
-     * Get this thread's obj list structure and move
-     * or allocate new objs if necessary.
+     * Get this thread's obj list structure and move or allocate new objs if
+     * necessary.
      */
-     
-    if (cachePtr->nobjs == 0) {
-    	Tcl_MutexLock(objLockPtr);
-	nmove = sharedPtr->nobjs;
-	if (nmove > 0) {
-	    if (nmove > NOBJALLOC) {
-		nmove = NOBJALLOC;
+
+    if (cachePtr->numObjects == 0) {
+	register int numMove;
+
+	Tcl_MutexLock(objLockPtr);
+	numMove = sharedPtr->numObjects;
+	if (numMove > 0) {
+	    if (numMove > NOBJALLOC) {
+		numMove = NOBJALLOC;
 	    }
-	    MoveObjs(sharedPtr, cachePtr, nmove);
+	    MoveObjs(sharedPtr, cachePtr, numMove);
 	}
-    	Tcl_MutexUnlock(objLockPtr);
-	if (cachePtr->nobjs == 0) {
-	    cachePtr->nobjs = nmove = NOBJALLOC;
-	    newObjsPtr = malloc(sizeof(Tcl_Obj) * nmove);
+	Tcl_MutexUnlock(objLockPtr);
+	if (cachePtr->numObjects == 0) {
+	    Tcl_Obj *newObjsPtr;
+
+	    cachePtr->numObjects = numMove = NOBJALLOC;
+	    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
 	    if (newObjsPtr == NULL) {
-		panic("alloc: could not allocate %d new objects", nmove);
+		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
 	    }
-	    while (--nmove >= 0) {
-		objPtr = &newObjsPtr[nmove];
-		objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+	    while (--numMove >= 0) {
+		objPtr = &newObjsPtr[numMove];
+		objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
 		cachePtr->firstObjPtr = objPtr;
 	    }
 	}
@@ -578,11 +567,10 @@ TclThreadAllocObj(void)
      */
 
     objPtr = cachePtr->firstObjPtr;
-    cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
-    --cachePtr->nobjs;
+    cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    --cachePtr->numObjects;
     return objPtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -595,14 +583,14 @@ TclThreadAllocObj(void)
  *	None.
  *
  * Side effects:
- *	May move free Tcl_Obj's to shared list upon hitting high
- *  	water mark.
+ *	May move free Tcl_Obj's to shared list upon hitting high water mark.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclThreadFreeObj(Tcl_Obj *objPtr)
+TclThreadFreeObj(
+    Tcl_Obj *objPtr)
 {
     Cache *cachePtr = TclpGetAllocCache();
 
@@ -613,23 +601,22 @@ TclThreadFreeObj(Tcl_Obj *objPtr)
     /*
      * Get this thread's list and push on the free Tcl_Obj.
      */
-     
-    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+
+    objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr;
-    ++cachePtr->nobjs;
-    
+    ++cachePtr->numObjects;
+
     /*
-     * If the number of free objects has exceeded the high
-     * water mark, move some blocks to the shared list.
+     * If the number of free objects has exceeded the high water mark, move
+     * some blocks to the shared list.
      */
-     
-    if (cachePtr->nobjs > NOBJHIGH) {
+
+    if (cachePtr->numObjects > NOBJHIGH) {
 	Tcl_MutexLock(objLockPtr);
 	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
 	Tcl_MutexUnlock(objLockPtr);
     }
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -642,13 +629,14 @@ TclThreadFreeObj(Tcl_Obj *objPtr)
  *	None.
  *
  * Side effects:
- *  	List appended to given dstring.
+ *	List appended to given dstring.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
+Tcl_GetMemoryInfo(
+    Tcl_DString *dsPtr)
 {
     Cache *cachePtr;
     char buf[200];
@@ -659,28 +647,27 @@ Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
     while (cachePtr != NULL) {
 	Tcl_DStringStartSublist(dsPtr);
 	if (cachePtr == sharedPtr) {
-    	    Tcl_DStringAppendElement(dsPtr, "shared");
+	    Tcl_DStringAppendElement(dsPtr, "shared");
 	} else {
-	    sprintf(buf, "thread%d", (int) cachePtr->owner);
-    	    Tcl_DStringAppendElement(dsPtr, buf);
+	    sprintf(buf, "thread%p", cachePtr->owner);
+	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	for (n = 0; n < NBUCKETS; ++n) {
-    	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
-		(unsigned long) binfo[n].blocksize,
-		cachePtr->buckets[n].nfree,
-		cachePtr->buckets[n].nget,
-		cachePtr->buckets[n].nput,
-		cachePtr->buckets[n].nrequest,
-		cachePtr->buckets[n].nlock,
-		cachePtr->buckets[n].nwait);
+	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
+		    (unsigned long) bucketInfo[n].blockSize,
+		    cachePtr->buckets[n].numFree,
+		    cachePtr->buckets[n].numRemoves,
+		    cachePtr->buckets[n].numInserts,
+		    cachePtr->buckets[n].totalAssigned,
+		    cachePtr->buckets[n].numLocks,
+		    cachePtr->buckets[n].numWaits);
 	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	Tcl_DStringEndSublist(dsPtr);
-	    cachePtr = cachePtr->nextPtr;
+	cachePtr = cachePtr->nextPtr;
     }
     Tcl_MutexUnlock(listLockPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -693,45 +680,46 @@ Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
  *	None.
  *
  * Side effects:
- *  	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove)
+MoveObjs(
+    Cache *fromPtr,
+    Cache *toPtr,
+    int numMove)
 {
     register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
     Tcl_Obj *fromFirstObjPtr = objPtr;
 
-    toPtr->nobjs += nmove;
-    fromPtr->nobjs -= nmove;
+    toPtr->numObjects += numMove;
+    fromPtr->numObjects -= numMove;
 
     /*
-     * Find the last object to be moved; set the next one
-     * (the first one not to be moved) as the first object
-     * in the 'from' cache.
+     * Find the last object to be moved; set the next one (the first one not
+     * to be moved) as the first object in the 'from' cache.
      */
 
-    while (--nmove) {
-	objPtr = objPtr->internalRep.otherValuePtr;
+    while (--numMove) {
+	objPtr = objPtr->internalRep.twoPtrValue.ptr1;
     }
-    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;    
+    fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     /*
-     * Move all objects as a block - they are already linked to
-     * each other, we just have to update the first and last.
+     * Move all objects as a block - they are already linked to each other, we
+     * just have to update the first and last.
      */
 
-    objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
     toPtr->firstObjPtr = fromFirstObjPtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  Block2Ptr, Ptr2Block --
+ * Block2Ptr, Ptr2Block --
  *
  *	Convert between internal blocks and user pointers.
  *
@@ -745,84 +733,91 @@ MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove)
  */
 
 static char *
-Block2Ptr(Block *blockPtr, int bucket, unsigned int reqsize) 
+Block2Ptr(
+    Block *blockPtr,
+    int bucket,
+    unsigned int reqSize)
 {
     register void *ptr;
 
-    blockPtr->b_magic1 = blockPtr->b_magic2 = MAGIC;
-    blockPtr->b_bucket = bucket;
-    blockPtr->b_reqsize = reqsize;
+    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
+    blockPtr->sourceBucket = bucket;
+    blockPtr->blockReqSize = reqSize;
     ptr = ((void *) (blockPtr + 1));
 #if RCHECK
-    ((unsigned char *)(ptr))[reqsize] = MAGIC;
+    ((unsigned char *)(ptr))[reqSize] = MAGIC;
 #endif
     return (char *) ptr;
 }
 
 static Block *
-Ptr2Block(char *ptr)
+Ptr2Block(
+    char *ptr)
 {
     register Block *blockPtr;
 
     blockPtr = (((Block *) ptr) - 1);
-    if (blockPtr->b_magic1 != MAGIC
+    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
+	Tcl_Panic("alloc: invalid block: %p: %x %x",
+		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
+    }
 #if RCHECK
-	|| ((unsigned char *) ptr)[blockPtr->b_reqsize] != MAGIC
-#endif
-	|| blockPtr->b_magic2 != MAGIC) {
-	panic("alloc: invalid block: %p: %x %x %x\n",
-	    blockPtr, blockPtr->b_magic1, blockPtr->b_magic2,
-	    ((unsigned char *) ptr)[blockPtr->b_reqsize]);
+    if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) {
+	Tcl_Panic("alloc: invalid block: %p: %x %x %x",
+		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
+		((unsigned char *) ptr)[blockPtr->blockReqSize]);
     }
+#endif
     return blockPtr;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  LockBucket, UnlockBucket --
+ * LockBucket, UnlockBucket --
  *
  *	Set/unset the lock to access a bucket in the shared cache.
  *
  * Results:
- *  	None.
+ *	None.
  *
  * Side effects:
- *	Lock activity and contention are monitored globally and on
- *  	a per-cache basis.
+ *	Lock activity and contention are monitored globally and on a per-cache
+ *	basis.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-LockBucket(Cache *cachePtr, int bucket)
+LockBucket(
+    Cache *cachePtr,
+    int bucket)
 {
 #if 0
-    if (Tcl_MutexTryLock(binfo[bucket].lockPtr) != TCL_OK) {
-	Tcl_MutexLock(binfo[bucket].lockPtr);
-    	++cachePtr->buckets[bucket].nwait;
-    	++sharedPtr->buckets[bucket].nwait;
+    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
+	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
+	++cachePtr->buckets[bucket].numWaits;
+	++sharedPtr->buckets[bucket].numWaits;
     }
 #else
-    Tcl_MutexLock(binfo[bucket].lockPtr);
+    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
 #endif
-    ++cachePtr->buckets[bucket].nlock;
-    ++sharedPtr->buckets[bucket].nlock;
+    ++cachePtr->buckets[bucket].numLocks;
+    ++sharedPtr->buckets[bucket].numLocks;
 }
 
-
 static void
-UnlockBucket(Cache *cachePtr, int bucket)
+UnlockBucket(
+    Cache *cachePtr,
+    int bucket)
 {
-    Tcl_MutexUnlock(binfo[bucket].lockPtr);
+    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  PutBlocks --
+ * PutBlocks --
  *
  *	Return unused blocks to the shared cache.
  *
@@ -836,40 +831,42 @@ UnlockBucket(Cache *cachePtr, int bucket)
  */
 
 static void
-PutBlocks(Cache *cachePtr, int bucket, int nmove)
+PutBlocks(
+    Cache *cachePtr,
+    int bucket,
+    int numMove)
 {
     register Block *lastPtr, *firstPtr;
-    register int n = nmove;
+    register int n = numMove;
 
     /*
-     * Before acquiring the lock, walk the block list to find
-     * the last block to be moved.
+     * Before acquiring the lock, walk the block list to find the last block
+     * to be moved.
      */
 
     firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
     while (--n > 0) {
-	lastPtr = lastPtr->b_next;
+	lastPtr = lastPtr->nextBlock;
     }
-    cachePtr->buckets[bucket].firstPtr = lastPtr->b_next;
-    cachePtr->buckets[bucket].nfree -= nmove;
+    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
+    cachePtr->buckets[bucket].numFree -= numMove;
 
     /*
-     * Aquire the lock and place the list of blocks at the front
-     * of the shared cache bucket.
+     * Aquire the lock and place the list of blocks at the front of the shared
+     * cache bucket.
      */
 
     LockBucket(cachePtr, bucket);
-    lastPtr->b_next = sharedPtr->buckets[bucket].firstPtr;
+    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
     sharedPtr->buckets[bucket].firstPtr = firstPtr;
-    sharedPtr->buckets[bucket].nfree += nmove;
+    sharedPtr->buckets[bucket].numFree += numMove;
     UnlockBucket(cachePtr, bucket);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- *  GetBlocks --
+ * GetBlocks --
  *
  *	Get more blocks for a bucket.
  *
@@ -883,67 +880,69 @@ PutBlocks(Cache *cachePtr, int bucket, int nmove)
  */
 
 static int
-GetBlocks(Cache *cachePtr, int bucket)
+GetBlocks(
+    Cache *cachePtr,
+    int bucket)
 {
     register Block *blockPtr;
     register int n;
-    register size_t size;
 
     /*
-     * First, atttempt to move blocks from the shared cache.  Note
-     * the potentially dirty read of nfree before acquiring the lock
-     * which is a slight performance enhancement.  The value is
-     * verified after the lock is actually acquired.
+     * First, atttempt to move blocks from the shared cache. Note the
+     * potentially dirty read of numFree before acquiring the lock which is a
+     * slight performance enhancement. The value is verified after the lock is
+     * actually acquired.
      */
-     
-    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].nfree > 0) {
+
+    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
 	LockBucket(cachePtr, bucket);
-	if (sharedPtr->buckets[bucket].nfree > 0) {
+	if (sharedPtr->buckets[bucket].numFree > 0) {
 
 	    /*
-	     * Either move the entire list or walk the list to find
-	     * the last block to move.
+	     * Either move the entire list or walk the list to find the last
+	     * block to move.
 	     */
 
-	    n = binfo[bucket].nmove;
-	    if (n >= sharedPtr->buckets[bucket].nfree) {
+	    n = bucketInfo[bucket].numMove;
+	    if (n >= sharedPtr->buckets[bucket].numFree) {
 		cachePtr->buckets[bucket].firstPtr =
-		    sharedPtr->buckets[bucket].firstPtr;
-		cachePtr->buckets[bucket].nfree =
-		    sharedPtr->buckets[bucket].nfree;
+			sharedPtr->buckets[bucket].firstPtr;
+		cachePtr->buckets[bucket].numFree =
+			sharedPtr->buckets[bucket].numFree;
 		sharedPtr->buckets[bucket].firstPtr = NULL;
-		sharedPtr->buckets[bucket].nfree = 0;
+		sharedPtr->buckets[bucket].numFree = 0;
 	    } else {
 		blockPtr = sharedPtr->buckets[bucket].firstPtr;
 		cachePtr->buckets[bucket].firstPtr = blockPtr;
-		sharedPtr->buckets[bucket].nfree -= n;
-		cachePtr->buckets[bucket].nfree = n;
+		sharedPtr->buckets[bucket].numFree -= n;
+		cachePtr->buckets[bucket].numFree = n;
 		while (--n > 0) {
-    		    blockPtr = blockPtr->b_next;
+		    blockPtr = blockPtr->nextBlock;
 		}
-		sharedPtr->buckets[bucket].firstPtr = blockPtr->b_next;
-		blockPtr->b_next = NULL;
+		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
+		blockPtr->nextBlock = NULL;
 	    }
 	}
 	UnlockBucket(cachePtr, bucket);
     }
-    
-    if (cachePtr->buckets[bucket].nfree == 0) {
+
+    if (cachePtr->buckets[bucket].numFree == 0) {
+	register size_t size;
 
 	/*
-	 * If no blocks could be moved from shared, first look for a
-	 * larger block in this cache to split up.
+	 * If no blocks could be moved from shared, first look for a larger
+	 * block in this cache to split up.
 	 */
 
-    	blockPtr = NULL;
+	blockPtr = NULL;
 	n = NBUCKETS;
 	size = 0; /* lint */
 	while (--n > bucket) {
-    	    if (cachePtr->buckets[n].nfree > 0) {
-		size = binfo[n].blocksize;
+	    if (cachePtr->buckets[n].numFree > 0) {
+		size = bucketInfo[n].blockSize;
 		blockPtr = cachePtr->buckets[n].firstPtr;
-		cachePtr->buckets[n].firstPtr = blockPtr->b_next;
-		--cachePtr->buckets[n].nfree;
+		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
+		--cachePtr->buckets[n].numFree;
 		break;
 	    }
 	}
@@ -964,26 +963,26 @@ GetBlocks(Cache *cachePtr, int bucket)
 	 * Split the larger block into smaller blocks for this bucket.
 	 */
 
-	n = size / binfo[bucket].blocksize;
-	cachePtr->buckets[bucket].nfree = n;
+	n = size / bucketInfo[bucket].blockSize;
+	cachePtr->buckets[bucket].numFree = n;
 	cachePtr->buckets[bucket].firstPtr = blockPtr;
 	while (--n > 0) {
-	    blockPtr->b_next = (Block *) 
-		((char *) blockPtr + binfo[bucket].blocksize);
-	    blockPtr = blockPtr->b_next;
+	    blockPtr->nextBlock = (Block *)
+		((char *) blockPtr + bucketInfo[bucket].blockSize);
+	    blockPtr = blockPtr->nextBlock;
 	}
-	blockPtr->b_next = NULL;
+	blockPtr->nextBlock = NULL;
     }
     return 1;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * TclFinalizeThreadAlloc --
  *
- *	This procedure is used to destroy all private resources used in
- *	this file.
+ *	This procedure is used to destroy all private resources used in this
+ *	file.
  *
  * Results:
  *	None.
@@ -995,13 +994,13 @@ GetBlocks(Cache *cachePtr, int bucket)
  */
 
 void
-TclFinalizeThreadAlloc()
+TclFinalizeThreadAlloc(void)
 {
     unsigned int i;
 
     for (i = 0; i < NBUCKETS; ++i) {
-        TclpFreeAllocMutex(binfo[i].lockPtr); 
-        binfo[i].lockPtr = NULL;
+        TclpFreeAllocMutex(bucketInfo[i].lockPtr);
+        bucketInfo[i].lockPtr = NULL;
     }
 
     TclpFreeAllocMutex(objLockPtr);
@@ -1013,15 +1012,37 @@ TclFinalizeThreadAlloc()
     TclpFreeAllocCache(NULL);
 }
 
-#else /* ! defined(TCL_THREADS) && ! defined(USE_THREAD_ALLOC) */
+#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetMemoryInfo --
+ *
+ *	Return a list-of-lists of memory stats.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	List appended to given dstring.
+ *
+ *----------------------------------------------------------------------
+ */
 
+void
+Tcl_GetMemoryInfo(
+    Tcl_DString *dsPtr)
+{
+    Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
+}
+
 /*
  *----------------------------------------------------------------------
  *
  * TclFinalizeThreadAlloc --
  *
- *	This procedure is used to destroy all private resources used in
- *	this file.
+ *	This procedure is used to destroy all private resources used in this
+ *	file.
  *
  * Results:
  *	None.
@@ -1033,9 +1054,16 @@ TclFinalizeThreadAlloc()
  */
 
 void
-TclFinalizeThreadAlloc()
+TclFinalizeThreadAlloc(void)
 {
-    Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use.");
+    Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use");
 }
-
-#endif /* TCL_THREADS */
+#endif /* TCL_THREADS && USE_THREAD_ALLOC */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index f097924..3a905b5 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -1,69 +1,66 @@
-/* 
+/*
  * tclThreadJoin.c --
  *
- *	This file implements a platform independent emulation layer for
- *	the handling of joinable threads. The Mac and Windows platforms
- *	use this code to provide the functionality of joining threads.
- *	This code is currently not necessary on Unix.
+ *	This file implements a platform independent emulation layer for the
+ *	handling of joinable threads. The Windows platform uses this code to
+ *	provide the functionality of joining threads.  This code is currently
+ *	not necessary on Unix.
  *
  * Copyright (c) 2000 by Scriptics Corporation
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
-#if defined(WIN32)
+#ifdef WIN32
 
-/* The information about each joinable thread is remembered in a
- * structure as defined below.
+/*
+ * The information about each joinable thread is remembered in a structure as
+ * defined below.
  */
 
 typedef struct JoinableThread {
-  Tcl_ThreadId  id;                     /* The id of the joinable thread */
-  int           result;                 /* A place for the result after the
-					 * demise of the thread */
-  int           done;                   /* Boolean flag. Initialized to 0
-					 * and set to 1 after the exit of
-					 * the thread. This allows a thread
-					 * requesting a join to detect when
-					 * waiting is not necessary. */
-  int           waitedUpon;             /* Boolean flag. Initialized to 0
-					 * and set to 1 by the thread waiting
-					 * for this one via Tcl_JoinThread.
-					 * Used to lock any other thread
-					 * trying to wait on this one.
-					 */
-  Tcl_Mutex     threadMutex;            /* The mutex used to serialize access
-					 * to this structure. */
-  Tcl_Condition cond;                   /* This is the condition a thread has
-					 * to wait upon to get notified of the
-					 * end of the described thread. It is
-					 * signaled indirectly by
-					 * Tcl_ExitThread. */
-  struct JoinableThread* nextThreadPtr; /* Reference to the next thread in the
-					 * list of joinable threads */
+    Tcl_ThreadId  id;		/* The id of the joinable thread. */
+    int result;			/* A place for the result after the demise of
+				 * the thread. */
+    int done;			/* Boolean flag. Initialized to 0 and set to 1
+				 * after the exit of the thread. This allows a
+				 * thread requesting a join to detect when
+				 * waiting is not necessary. */
+    int waitedUpon;		/* Boolean flag. Initialized to 0 and set to 1
+				 * by the thread waiting for this one via
+				 * Tcl_JoinThread.  Used to lock any other
+				 * thread trying to wait on this one. */
+    Tcl_Mutex threadMutex;	/* The mutex used to serialize access to this
+				 * structure. */
+    Tcl_Condition cond;		/* This is the condition a thread has to wait
+				 * upon to get notified of the end of the
+				 * described thread. It is signaled indirectly
+				 * by Tcl_ExitThread. */
+    struct JoinableThread *nextThreadPtr;
+				/* Reference to the next thread in the list of
+				 * joinable threads. */
 } JoinableThread;
 
-/* The following variable is used to maintain the global list of all
- * joinable threads. Usage by a thread is allowed only if the
- * thread acquired the 'joinMutex'.
+/*
+ * The following variable is used to maintain the global list of all joinable
+ * threads. Usage by a thread is allowed only if the thread acquired the
+ * 'joinMutex'.
  */
 
 TCL_DECLARE_MUTEX(joinMutex)
 
 static JoinableThread* firstThreadPtr;
-
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclJoinThread --
  *
- *	This procedure waits for the exit of the thread with the specified
- *	id and returns its result.
+ *	This procedure waits for the exit of the thread with the specified id
+ *	and returns its result.
  *
  * Results:
  *	A standard tcl result signaling the overall success/failure of the
@@ -72,135 +69,139 @@ static JoinableThread* firstThreadPtr;
  *
  * Side effects:
  *	Deallocates the memory allocated by TclRememberJoinableThread.
- *	Removes the data associated to the thread waited upon from the
- *	list of joinable threads.
+ *	Removes the data associated to the thread waited upon from the list of
+ *	joinable threads.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclJoinThread(id, result)
-    Tcl_ThreadId id;     /* The id of the thread to wait upon. */
-    int*         result; /* Reference to a location for the result
-			  * of the thread we are waiting upon. */
+TclJoinThread(
+    Tcl_ThreadId id,		/* The id of the thread to wait upon. */
+    int *result)		/* Reference to a location for the result of
+				 * the thread we are waiting upon. */
 {
-    /* Steps done here:
+    JoinableThread *threadPtr;
+
+    /*
+     * Steps done here:
      * i.    Acquire the joinMutex and search for the thread.
      * ii.   Error out if it could not be found.
      * iii.  If found, switch from exclusive access to the list to exclusive
-     *       access to the thread structure.
+     *	     access to the thread structure.
      * iv.   Error out if some other is already waiting.
      * v.    Skip the waiting part of the thread is already done.
      * vi.   Wait for the thread to exit, mark it as waited upon too.
-     * vii.  Get the result form the structure, 
+     * vii.  Get the result form the structure,
      * viii. switch to exclusive access of the list,
      * ix.   remove the structure from the list,
      * x.    then switch back to exclusive access to the structure
      * xi.   and delete it.
      */
 
-    JoinableThread* threadPtr;
+    Tcl_MutexLock(&joinMutex);
 
-    Tcl_MutexLock (&joinMutex);
-
-    for (threadPtr = firstThreadPtr;
-	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
-	 threadPtr = threadPtr->nextThreadPtr)
-        /* empty body */
-      ;
+    threadPtr = firstThreadPtr;
+    while (threadPtr!=NULL && threadPtr->id!=id) {
+	threadPtr = threadPtr->nextThreadPtr;
+    }
 
-    if (threadPtr == (JoinableThread*) NULL) {
-        /* Thread not found. Either not joinable, or already waited
-	 * upon and exited. Whatever, an error is in order.
+    if (threadPtr == NULL) {
+	/*
+	 * Thread not found. Either not joinable, or already waited upon and
+	 * exited. Whatever, an error is in order.
 	 */
 
-      Tcl_MutexUnlock (&joinMutex);
-      return TCL_ERROR;
+	Tcl_MutexUnlock(&joinMutex);
+	return TCL_ERROR;
     }
 
-    /* [1] If we don't lock the structure before giving up exclusive access
-     * to the list some other thread just completing its wait on the same
-     * thread can delete the structure from under us, leaving us with a
-     * dangling pointer.
+    /*
+     * [1] If we don't lock the structure before giving up exclusive access to
+     * the list some other thread just completing its wait on the same thread
+     * can delete the structure from under us, leaving us with a dangling
+     * pointer.
      */
 
-    Tcl_MutexLock   (&threadPtr->threadMutex);
-    Tcl_MutexUnlock (&joinMutex);
+    Tcl_MutexLock(&threadPtr->threadMutex);
+    Tcl_MutexUnlock(&joinMutex);
 
-    /* [2] Now that we have the structure mutex any other thread that just
-     * tries to delete structure will wait at location [3] until we are
-     * done with the structure. And in that case we are done with it
-     * rather quickly as 'waitedUpon' will be set and we will have to
-     * error out.
+    /*
+     * [2] Now that we have the structure mutex any other thread that just
+     * tries to delete structure will wait at location [3] until we are done
+     * with the structure. And in that case we are done with it rather quickly
+     * as 'waitedUpon' will be set and we will have to error out.
      */
 
     if (threadPtr->waitedUpon) {
-        Tcl_MutexUnlock (&threadPtr->threadMutex);
+	Tcl_MutexUnlock(&threadPtr->threadMutex);
 	return TCL_ERROR;
     }
 
-    /* We are waiting now, let other threads recognize this
+    /*
+     * We are waiting now, let other threads recognize this.
      */
 
     threadPtr->waitedUpon = 1;
 
     while (!threadPtr->done) {
-      Tcl_ConditionWait (&threadPtr->cond, &threadPtr->threadMutex, NULL);
+	Tcl_ConditionWait(&threadPtr->cond, &threadPtr->threadMutex, NULL);
     }
 
-    /* We have to release the structure before trying to access the list
-     * again or we can run into deadlock with a thread at [1] (see above)
-     * because of us holding the structure and the other holding the list.
-     * There is no problem with dangling pointers here as 'waitedUpon == 1'
-     * is still valid and any other thread will error out and not come to
-     * this place. IOW, the fact that we are here also means that no other
-     * thread came here before us and is able to delete the structure.
+    /*
+     * We have to release the structure before trying to access the list again
+     * or we can run into deadlock with a thread at [1] (see above) because of
+     * us holding the structure and the other holding the list.  There is no
+     * problem with dangling pointers here as 'waitedUpon == 1' is still valid
+     * and any other thread will error out and not come to this place. IOW,
+     * the fact that we are here also means that no other thread came here
+     * before us and is able to delete the structure.
      */
 
-    Tcl_MutexUnlock (&threadPtr->threadMutex);
-    Tcl_MutexLock   (&joinMutex);
+    Tcl_MutexUnlock(&threadPtr->threadMutex);
+    Tcl_MutexLock(&joinMutex);
 
-    /* We have to search the list again as its structure may (may, almost
+    /*
+     * We have to search the list again as its structure may (may, almost
      * certainly) have changed while we were waiting. Especially now is the
-     * time to compute the predecessor in the list. Any earlier result can
-     * be dangling by now.
+     * time to compute the predecessor in the list. Any earlier result can be
+     * dangling by now.
      */
 
     if (firstThreadPtr == threadPtr) {
-        firstThreadPtr = threadPtr->nextThreadPtr;
+	firstThreadPtr = threadPtr->nextThreadPtr;
     } else {
-        JoinableThread* prevThreadPtr;
-
-	for (prevThreadPtr = firstThreadPtr;
-	     prevThreadPtr->nextThreadPtr != threadPtr;
-	     prevThreadPtr = prevThreadPtr->nextThreadPtr)
-	    /* empty body */
-	  ;
+	JoinableThread *prevThreadPtr = firstThreadPtr;
 
+	while (prevThreadPtr->nextThreadPtr != threadPtr) {
+	    prevThreadPtr = prevThreadPtr->nextThreadPtr;
+	}
 	prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
     }
 
-    Tcl_MutexUnlock (&joinMutex);
+    Tcl_MutexUnlock(&joinMutex);
 
-    /* [3] Now that the structure is not part of the list anymore no other
+    /*
+     * [3] Now that the structure is not part of the list anymore no other
      * thread can acquire its mutex from now on. But it is possible that
-     * another thread is still holding the mutex though, see location [2].
-     * So we have to acquire the mutex one more time to wait for that thread
-     * to finish. We can (and have to) release the mutex immediately.
+     * another thread is still holding the mutex though, see location [2].  So
+     * we have to acquire the mutex one more time to wait for that thread to
+     * finish. We can (and have to) release the mutex immediately.
      */
 
-    Tcl_MutexLock   (&threadPtr->threadMutex);
-    Tcl_MutexUnlock (&threadPtr->threadMutex);
+    Tcl_MutexLock(&threadPtr->threadMutex);
+    Tcl_MutexUnlock(&threadPtr->threadMutex);
 
-    /* Copy the result to us, finalize the synchronisation objects, then
-     * free the structure and return.
+    /*
+     * Copy the result to us, finalize the synchronisation objects, then free
+     * the structure and return.
      */
 
     *result = threadPtr->result;
 
-    Tcl_ConditionFinalize (&threadPtr->cond);
-    Tcl_MutexFinalize (&threadPtr->threadMutex);
-    ckfree ((VOID*) threadPtr);
+    Tcl_ConditionFinalize(&threadPtr->cond);
+    Tcl_MutexFinalize(&threadPtr->threadMutex);
+    ckfree((char *) threadPtr);
 
     return TCL_OK;
 }
@@ -211,39 +212,37 @@ TclJoinThread(id, result)
  * TclRememberJoinableThread --
  *
  *	This procedure remebers a thread as joinable. Only a call to
- *	TclJoinThread will remove the structre created (and initialized)
- *	here. IOW, not waiting upon a joinable thread will cause memory
- *	leaks.
+ *	TclJoinThread will remove the structre created (and initialized) here.
+ *	IOW, not waiting upon a joinable thread will cause memory leaks.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Allocates memory, adds it to the global list of all joinable
- *	threads.
+ *	Allocates memory, adds it to the global list of all joinable threads.
  *
  *----------------------------------------------------------------------
  */
 
-VOID
-TclRememberJoinableThread(id)
-    Tcl_ThreadId id; /* The thread to remember as joinable */
+void
+TclRememberJoinableThread(
+    Tcl_ThreadId id)		/* The thread to remember as joinable */
 {
-    JoinableThread* threadPtr;
+    JoinableThread *threadPtr;
 
-    threadPtr = (JoinableThread*) ckalloc (sizeof (JoinableThread));
-    threadPtr->id          = id;
-    threadPtr->done        = 0;
-    threadPtr->waitedUpon  = 0;
+    threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
+    threadPtr->id = id;
+    threadPtr->done = 0;
+    threadPtr->waitedUpon = 0;
     threadPtr->threadMutex = (Tcl_Mutex) NULL;
-    threadPtr->cond        = (Tcl_Condition) NULL;
+    threadPtr->cond = (Tcl_Condition) NULL;
 
-    Tcl_MutexLock (&joinMutex);
+    Tcl_MutexLock(&joinMutex);
 
     threadPtr->nextThreadPtr = firstThreadPtr;
-    firstThreadPtr           = threadPtr;
+    firstThreadPtr = threadPtr;
 
-    Tcl_MutexUnlock (&joinMutex);
+    Tcl_MutexUnlock(&joinMutex);
 }
 
 /*
@@ -251,9 +250,9 @@ TclRememberJoinableThread(id)
  *
  * TclSignalExitThread --
  *
- *	This procedure signals that the specified thread is done with
- *	its work. If the thread is joinable this signal is propagated
- *	to the thread waiting upon it.
+ *	This procedure signals that the specified thread is done with its
+ *	work. If the thread is joinable this signal is propagated to the
+ *	thread waiting upon it.
  *
  * Results:
  *	None.
@@ -264,46 +263,54 @@ TclRememberJoinableThread(id)
  *----------------------------------------------------------------------
  */
 
-VOID
-TclSignalExitThread(id,result)
-    Tcl_ThreadId id;     /* Id of the thread signaling its exit */
-    int          result; /* The result from the thread */
+void
+TclSignalExitThread(
+    Tcl_ThreadId id,		/* Id of the thread signaling its exit. */
+    int result)			/* The result from the thread. */
 {
-    JoinableThread* threadPtr;
+    JoinableThread *threadPtr;
 
-    Tcl_MutexLock (&joinMutex);
+    Tcl_MutexLock(&joinMutex);
 
-    for (threadPtr = firstThreadPtr;
-	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
-	 threadPtr = threadPtr->nextThreadPtr)
-        /* empty body */
-      ;
+    threadPtr = firstThreadPtr;
+    while ((threadPtr != NULL) && (threadPtr->id != id)) {
+	threadPtr = threadPtr->nextThreadPtr;
+    }
 
-    if (threadPtr == (JoinableThread*) NULL) {
-        /* Thread not found. Not joinable. No problem, nothing to do.
+    if (threadPtr == NULL) {
+	/*
+	 * Thread not found. Not joinable. No problem, nothing to do.
 	 */
 
-        Tcl_MutexUnlock (&joinMutex);
+	Tcl_MutexUnlock(&joinMutex);
 	return;
     }
 
-    /* Switch over the exclusive access from the list to the structure,
-     * then store the result, set the flag and notify the waiting thread,
-     * provided that it exists. The order of lock/unlock ensures that a
-     * thread entering 'TclJoinThread' will not interfere with us.
+    /*
+     * Switch over the exclusive access from the list to the structure, then
+     * store the result, set the flag and notify the waiting thread, provided
+     * that it exists. The order of lock/unlock ensures that a thread entering
+     * 'TclJoinThread' will not interfere with us.
      */
 
-    Tcl_MutexLock   (&threadPtr->threadMutex);
-    Tcl_MutexUnlock (&joinMutex);
+    Tcl_MutexLock(&threadPtr->threadMutex);
+    Tcl_MutexUnlock(&joinMutex);
 
-    threadPtr->done   = 1;
+    threadPtr->done = 1;
     threadPtr->result = result;
 
     if (threadPtr->waitedUpon) {
-      Tcl_ConditionNotify (&threadPtr->cond);
+	Tcl_ConditionNotify(&threadPtr->cond);
     }
 
-    Tcl_MutexUnlock (&threadPtr->threadMutex);
+    Tcl_MutexUnlock(&threadPtr->threadMutex);
 }
-
 #endif /* WIN32 */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
new file mode 100644
index 0000000..f1df888
--- /dev/null
+++ b/generic/tclThreadStorage.c
@@ -0,0 +1,597 @@
+/*
+ * tclThreadStorage.c --
+ *
+ *	This file implements platform independent thread storage operations.
+ *
+ * Copyright (c) 2003-2004 by Joe Mistachkin
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+#if defined(TCL_THREADS)
+
+/*
+ * This is the thread storage cache array and it's accompanying mutex. The
+ * elements are pairs of thread Id and an associated hash table pointer; the
+ * hash table being pointed to contains the thread storage for it's associated
+ * thread. The purpose of this cache is to minimize the number of hash table
+ * lookups in the master thread storage hash table.
+ */
+
+static Tcl_Mutex threadStorageLock;
+
+/*
+ * This is the struct used for a thread storage cache slot. It contains the
+ * owning thread Id and the associated hash table pointer.
+ */
+
+typedef struct ThreadStorage {
+    Tcl_ThreadId id;		/* the owning thread id */
+    Tcl_HashTable *hashTablePtr;/* the hash table for the thread */
+} ThreadStorage;
+
+/*
+ * These are the prototypes for the custom hash table allocation functions
+ * used by the thread storage subsystem.
+ */
+
+static Tcl_HashEntry *	AllocThreadStorageEntry(Tcl_HashTable *tablePtr,
+			    void *keyPtr);
+static void		FreeThreadStorageEntry(Tcl_HashEntry *hPtr);
+static Tcl_HashTable *	ThreadStorageGetHashTable(Tcl_ThreadId id);
+
+/*
+ * This is the hash key type for thread storage. We MUST use this in
+ * combination with the new hash key type flag TCL_HASH_KEY_SYSTEM_HASH
+ * because these hash tables MAY be used by the threaded memory allocator.
+ */
+
+static Tcl_HashKeyType tclThreadStorageHashKeyType = {
+    TCL_HASH_KEY_TYPE_VERSION,		/* version */
+    TCL_HASH_KEY_SYSTEM_HASH | TCL_HASH_KEY_RANDOMIZE_HASH,
+				        /* flags */
+    NULL,				/* hashKeyProc */
+    NULL,				/* compareKeysProc */
+    AllocThreadStorageEntry,		/* allocEntryProc */
+    FreeThreadStorageEntry		/* freeEntryProc */
+};
+
+/*
+ * This is an invalid thread value.
+ */
+
+#define STORAGE_INVALID_THREAD  (Tcl_ThreadId)0
+
+/*
+ * This is the value for an invalid thread storage key.
+ */
+
+#define STORAGE_INVALID_KEY	0
+
+/*
+ * This is the first valid key for use by external callers. All the values
+ * below this are RESERVED for future use.
+ */
+
+#define STORAGE_FIRST_KEY	1
+
+/*
+ * This is the default number of thread storage cache slots. This define may
+ * need to be fine tuned for maximum performance.
+ */
+
+#define STORAGE_CACHE_SLOTS	97
+
+/*
+ * This is the master thread storage hash table. It is keyed on thread Id and
+ * contains values that are hash tables for each thread. The thread specific
+ * hash tables contain the actual thread storage.
+ */
+
+static Tcl_HashTable threadStorageHashTable;
+
+/*
+ * This is the next thread data key value to use. We increment this everytime
+ * we "allocate" one. It is initially set to 1 in TclInitThreadStorage.
+ */
+
+static int nextThreadStorageKey = STORAGE_INVALID_KEY;
+
+/*
+ * This is the master thread storage cache. Per Kevin Kenny's idea, this
+ * prevents unnecessary lookups for threads that use a lot of thread storage.
+ */
+
+static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocThreadStorageEntry --
+ *
+ *	Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
+ *	We do this because the threaded memory allocator MAY use the thread
+ *	storage hash tables.
+ *
+ * Results:
+ *	The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocThreadStorageEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    void *keyPtr)		/* Key to store in the hash table entry. */
+{
+    Tcl_HashEntry *hPtr;
+
+    hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
+    hPtr->key.oneWordValue = keyPtr;
+    hPtr->clientData = NULL;
+    
+    return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeThreadStorageEntry --
+ *
+ *	Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree). We do
+ *	this because the threaded memory allocator MAY use the thread storage
+ *	hash tables.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeThreadStorageEntry(
+    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
+{
+    TclpSysFree((char *) hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ThreadStorageGetHashTable --
+ *
+ *	This procedure returns a hash table pointer to be used for thread
+ *	storage for the specified thread. 
+ *
+ * Results:
+ *	A hash table pointer for the specified thread, or NULL if the hash
+ *	table has not been created yet.
+ *
+ * Side effects:
+ *	May change an entry in the master thread storage cache to point to the
+ *	specified thread and it's associated hash table.
+ *
+ * Thread safety:
+ *	This function assumes that integer operations are safe (atomic)
+ *	on all (currently) supported Tcl platforms.  Hence there are 
+ * 	places where shared integer arithmetic is done w/o protective locks.    
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashTable *
+ThreadStorageGetHashTable(
+    Tcl_ThreadId id)		/* Id of thread to get hash table for */
+{
+    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+    Tcl_HashTable *hashTablePtr;
+
+    /*
+     * It's important that we pick up the hash table pointer BEFORE comparing
+     * thread Id in case another thread is in the critical region changing
+     * things out from under you.
+     *
+     * Thread safety: threadStorageCache is accessed w/o locks in order to
+     * avoid serialization of all threads at this hot-spot. It is safe to
+     * do this here because (threadStorageCache[index].id != id) test below
+     * should be atomic on all (currently) supported platforms and there 
+     * are no devastatig side effects of the test.
+     *
+     * Note Valgrind users: this place will show up as a race-condition in
+     * helgrind-tool output. To silence this warnings, define VALGRIND
+     * symbol at compilation time. 
+     */
+
+#if !defined(VALGRIND)
+    hashTablePtr = threadStorageCache[index].hashTablePtr;
+    if (threadStorageCache[index].id != id) {
+	Tcl_MutexLock(&threadStorageLock);
+#else
+    Tcl_MutexLock(&threadStorageLock);
+    hashTablePtr = threadStorageCache[index].hashTablePtr;
+    if (threadStorageCache[index].id != id) {
+#endif
+
+	/*
+	 * It's not in the cache, so we look it up...
+	 */
+
+	hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *) id);
+
+	if (hPtr != NULL) {
+	    /*
+	     * We found it, extract the hash table pointer.
+	     */
+
+	    hashTablePtr = Tcl_GetHashValue(hPtr);
+	} else {
+	    /*
+	     * The thread specific hash table is not found.
+	     */
+
+	    hashTablePtr = NULL;
+	}
+
+	if (hashTablePtr == NULL) {
+	    hashTablePtr = (Tcl_HashTable *)
+		    TclpSysAlloc(sizeof(Tcl_HashTable), 0);
+
+	    if (hashTablePtr == NULL) {
+		Tcl_Panic("could not allocate thread specific hash table, "
+			"TclpSysAlloc failed from ThreadStorageGetHashTable!");
+	    }
+	    Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
+		    &tclThreadStorageHashKeyType);
+
+	    /*
+	     * Add new thread storage hash table to the master hash table.
+	     */
+
+	    hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id,
+		    &isNew);
+
+	    if (hPtr == NULL) {
+		Tcl_Panic("Tcl_CreateHashEntry failed from "
+			"ThreadStorageGetHashTable!");
+	    }
+	    Tcl_SetHashValue(hPtr, hashTablePtr);
+	}
+
+	/*
+	 * Now, we put it in the cache since it is highly likely it will be
+	 * needed again shortly.
+	 */
+
+	threadStorageCache[index].id = id;
+	threadStorageCache[index].hashTablePtr = hashTablePtr;
+#if !defined(VALGRIND)
+	Tcl_MutexUnlock(&threadStorageLock);
+    }
+#else
+    }
+    Tcl_MutexUnlock(&threadStorageLock);
+#endif
+
+    return hashTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitThreadStorage --
+ *
+ *	Initializes the thread storage allocator.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This procedure initializes the master hash table that maps thread ID
+ *	onto the individual index tables that map thread data key to thread
+ *	data. It also creates a cache that enables fast lookup of the thread
+ *	data block array for a recently executing thread without using
+ *	spinlocks.
+ *
+ * This procedure is called from an extremely early point in Tcl's
+ * initialization. In particular, it may not use ckalloc/ckfree because they
+ * may depend on thread-local storage (it uses TclpSysAlloc and TclpSysFree
+ * instead). It may not depend on synchronization primitives - but no threads
+ * other than the master thread have yet been launched.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitThreadStorage(void)
+{
+    Tcl_InitCustomHashTable(&threadStorageHashTable, TCL_CUSTOM_TYPE_KEYS,
+	    &tclThreadStorageHashKeyType);
+
+    /*
+     * We also initialize the cache.
+     */
+
+    memset((void*) &threadStorageCache, 0,
+	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
+
+    /*
+     * Now, we set the first value to be used for a thread data key.
+     */
+
+    nextThreadStorageKey = STORAGE_FIRST_KEY;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyGet --
+ *
+ *	This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ *	A thread-specific pointer to the data structure, or NULL if the memory
+ *	has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void *
+TclpThreadDataKeyGet(
+    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
+				 * (int**) */
+{
+    Tcl_HashTable *hashTablePtr =
+	    ThreadStorageGetHashTable(Tcl_GetCurrentThread());
+    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(hashTablePtr, (char *) keyPtr);
+
+    if (hPtr == NULL) {
+	return NULL;
+    }
+    return Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeySet --
+ *
+ *	This procedure sets the pointer to a block of thread local storage.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets up the thread so future calls to TclpThreadDataKeyGet with this
+ *	key will return the data pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeySet(
+    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk, really
+				 * (pthread_key_t **) */
+    void *data)			/* Thread local storage */
+{
+    Tcl_HashTable *hashTablePtr;
+    Tcl_HashEntry *hPtr;
+    int dummy;
+
+    hashTablePtr = ThreadStorageGetHashTable(Tcl_GetCurrentThread());
+    hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)keyPtr, &dummy);
+
+    Tcl_SetHashValue(hPtr, data);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadDataThread --
+ *
+ *	This procedure cleans up the thread storage hash table for the
+ *	current thread.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees all associated thread storage, all hash table entries for
+ *	the thread's thread storage, and the hash table itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadDataThread(void)
+{
+    Tcl_ThreadId id = Tcl_GetCurrentThread();
+				/* Id of the thread to finalize. */
+    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
+    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
+				 * table. */
+    Tcl_HashTable* hashTablePtr;/* Pointer to the hash table holding TSD
+				 * blocks for the current thread*/
+    Tcl_HashSearch search;	/* Search object to walk the TSD blocks in the
+				 * designated thread */
+    Tcl_HashEntry *hPtr2;	/* Hash entry for a TSD block in the
+				 * designated thread. */
+
+    Tcl_MutexLock(&threadStorageLock);
+    hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char*)id);
+    if (hPtr == NULL) {
+	hashTablePtr = NULL;
+    } else {
+	/*
+	 * We found it, extract the hash table pointer.
+	 */
+
+	hashTablePtr = Tcl_GetHashValue(hPtr);
+	Tcl_DeleteHashEntry(hPtr);
+
+	/*
+	 * Make sure cache entry for this thread is NULL.
+	 */
+
+	if (threadStorageCache[index].id == id) {
+	    /*
+	     * We do not step on another thread's cache entry. This is
+	     * especially important if we are creating and exiting a lot of
+	     * threads.
+	     */
+
+	    threadStorageCache[index].id = STORAGE_INVALID_THREAD;
+	    threadStorageCache[index].hashTablePtr = NULL;
+	}
+    }
+    Tcl_MutexUnlock(&threadStorageLock);
+
+    /*
+     * The thread's hash table has been extracted and removed from the master
+     * hash table. Now clean up the thread.
+     */
+
+    if (hashTablePtr != NULL) {
+	/*
+	 * Free all TSD
+	 */
+
+	for (hPtr2 = Tcl_FirstHashEntry(hashTablePtr, &search); hPtr2 != NULL;
+		hPtr2 = Tcl_NextHashEntry(&search)) {
+	    void *blockPtr = Tcl_GetHashValue(hPtr2);
+
+	    if (blockPtr != NULL) {
+		/*
+		 * The block itself was allocated in Tcl_GetThreadData using
+		 * ckalloc; use ckfree to dispose of it.
+		 */
+
+		ckfree(blockPtr);
+	    }
+	}
+
+	/*
+	 * Delete thread specific hash table and free the struct.
+	 */
+
+	Tcl_DeleteHashTable(hashTablePtr);
+	TclpSysFree((char *) hashTablePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadStorage --
+ *
+ *	This procedure cleans up the master thread storage hash table, all
+ *	thread specific hash tables, and the thread storage cache.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The master thread storage hash table and thread storage cache are
+ *	reset to their initial (empty) state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadStorage(void)
+{
+    Tcl_HashSearch search;	/* We need to hit every thread with this
+				 * search. */
+    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
+				 * table. */
+    Tcl_MutexLock(&threadStorageLock);
+
+    /*
+     * We are going to delete the hash table for every thread now. This hash
+     * table should be empty at this point, except for one entry for the
+     * current thread.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);
+
+	if (hashTablePtr != NULL) {
+	    /*
+	     * Delete thread specific hash table for the thread in question
+	     * and free the struct.
+	     */
+
+	    Tcl_DeleteHashTable(hashTablePtr);
+	    TclpSysFree((char *)hashTablePtr);
+	}
+
+	/*
+	 * Delete thread specific entry from master hash table.
+	 */
+
+	Tcl_SetHashValue(hPtr, NULL);
+    }
+
+    Tcl_DeleteHashTable(&threadStorageHashTable);
+
+    /*
+     * Clear out the thread storage cache as well.
+     */
+
+    memset((void*) &threadStorageCache, 0,
+	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
+
+    /*
+     * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
+     * storage subsystem gets reinitialized
+     */
+
+    nextThreadStorageKey = STORAGE_INVALID_KEY;
+
+    Tcl_MutexUnlock(&threadStorageLock);
+}
+
+#else /* !defined(TCL_THREADS) */
+
+/*
+ * Stub functions for non-threaded builds
+ */
+
+void
+TclInitThreadStorage(void)
+{
+}
+
+void
+TclpFinalizeThreadDataThread(void)
+{
+}
+
+void
+TclFinalizeThreadStorage(void)
+{
+}
+
+#endif /* defined(TCL_THREADS) && defined(USE_THREAD_STORAGE) */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 9d17f56..d032cc6 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -1,29 +1,31 @@
-/* 
+/*
  * tclThreadTest.c --
  *
- *	This file implements the testthread command.  Eventually this
- *	should be tclThreadCmd.c
+ *	This file implements the testthread command. Eventually this should be
+ *	tclThreadCmd.c
  *	Some of this code is based on work done by Richard Hipp on behalf of
  *	Conservation Through Innovation, Limited, with their permission.
  *
  * Copyright (c) 1998 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
 
+extern int	Tcltest_Init(Tcl_Interp *interp);
+
 #ifdef TCL_THREADS
 /*
- * Each thread has an single instance of the following structure.  There
- * is one instance of this structure per thread even if that thread contains
- * multiple interpreters.  The interpreter identified by this structure is
- * the main interpreter for the thread.  
- *
- * The main interpreter is the one that will process any messages 
- * received by a thread.  Any thread can send messages but only the
- * main interpreter can receive them.
+ * Each thread has an single instance of the following structure. There is one
+ * instance of this structure per thread even if that thread contains multiple
+ * interpreters. The interpreter identified by this structure is the main
+ * interpreter for the thread.
+ *
+ * The main interpreter is the one that will process any messages received by
+ * a thread. Any thread can send messages but only the main interpreter can
+ * receive them.
  */
 
 typedef struct ThreadSpecificData {
@@ -36,8 +38,8 @@ typedef struct ThreadSpecificData {
 static Tcl_ThreadDataKey dataKey;
 
 /*
- * This list is used to list all threads that have interpreters.
- * This is protected by threadMutex.
+ * This list is used to list all threads that have interpreters. This is
+ * protected by threadMutex.
  */
 
 static struct ThreadSpecificData *threadList;
@@ -55,16 +57,18 @@ static struct ThreadSpecificData *threadList;
  */
 
 typedef struct ThreadCtrl {
-    char *script;    /* The TCL command this thread should execute */
-    int flags;        /* Initial value of the "flags" field in the 
-                       * ThreadSpecificData structure for the new thread.
-                       * Might contain TP_Detached or TP_TclThread. */
-    Tcl_Condition condWait;
-    /* This condition variable is used to synchronize
-     * the parent and child threads.  The child won't run
-     * until it acquires threadMutex, and the parent function
-     * won't complete until signaled on this condition
-     * variable. */
+    const char *script;	/* The Tcl command this thread should
+				 * execute */
+    int flags;			/* Initial value of the "flags" field in the
+				 * ThreadSpecificData structure for the new
+				 * thread. Might contain TP_Detached or
+				 * TP_TclThread. */
+    Tcl_Condition condWait;	/* This condition variable is used to
+				 * synchronize the parent and child threads.
+				 * The child won't run until it acquires
+				 * threadMutex, and the parent function won't
+				 * complete until signaled on this condition
+				 * variable. */
 } ThreadCtrl;
 
 /*
@@ -75,8 +79,8 @@ typedef struct ThreadEvent {
     Tcl_Event event;		/* Must be first */
     char *script;		/* The script to execute. */
     struct ThreadEventResult *resultPtr;
-				/* To communicate the result.  This is
-				 * NULL if we don't care about it. */
+				/* To communicate the result. This is NULL if
+				 * we don't care about it. */
 } ThreadEvent;
 
 typedef struct ThreadEventResult {
@@ -102,9 +106,9 @@ static ThreadEventResult *resultList;
 static Tcl_ThreadId errorThreadId;
 static char *errorProcString;
 
-/* 
- * Access to the list of threads and to the thread send results is
- * guarded by this mutex. 
+/*
+ * Access to the list of threads and to the thread send results is guarded by
+ * this mutex.
  */
 
 TCL_DECLARE_MUTEX(threadMutex)
@@ -112,28 +116,28 @@ TCL_DECLARE_MUTEX(threadMutex)
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLEXPORT
 
-EXTERN int	TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int	Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData,
-	Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int	TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
-	char *script, int joinable));
-EXTERN int	TclThreadList _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int	TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
-	char *script, int wait));
+EXTERN int		TclThread_Init(Tcl_Interp *interp);
+EXTERN int		Tcl_ThreadObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+EXTERN int		TclCreateThread(Tcl_Interp *interp, const char *script,
+			    int joinable);
+EXTERN int		TclThreadList(Tcl_Interp *interp);
+EXTERN int		TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
+			    const char *script, int wait);
 
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
 
-Tcl_ThreadCreateType	NewTestThread _ANSI_ARGS_((ClientData clientData));
-static void	ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
-static void	ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
-static int	ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask));
-static void	ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp));
-static void	ThreadFreeProc _ANSI_ARGS_((ClientData clientData));
-static int	ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr,
-	ClientData clientData));
-static void	ThreadExitProc _ANSI_ARGS_((ClientData clientData));
-
+Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
+static void		ListRemove(ThreadSpecificData *tsdPtr);
+static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
+static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
+static void		ThreadErrorProc(Tcl_Interp *interp);
+static void		ThreadFreeProc(ClientData clientData);
+static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
+			    ClientData clientData);
+static void		ThreadExitProc(ClientData clientData);
 
 /*
  *----------------------------------------------------------------------
@@ -152,15 +156,12 @@ static void	ThreadExitProc _ANSI_ARGS_((ClientData clientData));
  */
 
 int
-TclThread_Init(interp)
-    Tcl_Interp *interp; /* The current Tcl interpreter */
+TclThread_Init(
+    Tcl_Interp *interp)		/* The current Tcl interpreter */
 {
-    
-    Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, 
-	    (ClientData)NULL ,NULL);
-    if (Tcl_PkgProvide(interp, "Thread", "1.0" ) != TCL_OK) {
-	return TCL_ERROR;
-    }
+
+    Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd,
+	    (ClientData) NULL, NULL);
     return TCL_OK;
 }
 
@@ -170,8 +171,8 @@ TclThread_Init(interp)
  *
  * Tcl_ThreadObjCmd --
  *
- *	This procedure is invoked to process the "testthread" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This procedure is invoked to process the "testthread" Tcl command. See
+ *	the user documentation for details on what it does.
  *
  *	thread create ?-joinable? ?script?
  *	thread send id ?-async? script
@@ -193,30 +194,33 @@ TclThread_Init(interp)
 
 	/* ARGSUSED */
 int
-Tcl_ThreadObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_ThreadObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     int option;
-    static CONST char *threadOptions[] = {"create", "exit", "id", "join", "names",
-				    "send", "wait", "errorproc",
-				    (char *) NULL};
-    enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN,
-		  THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
+    static const char *threadOptions[] = {
+	"create", "exit", "id", "join", "names",
+	"send", "wait", "errorproc", NULL
+    };
+    enum options {
+	THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
+	THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
+    };
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
 	return TCL_ERROR;
     }
-    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions,
-	    "option", 0, &option) != TCL_OK) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
+	    &option) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    /* 
+    /*
      * Make sure the initial thread is on the list before doing anything.
      */
 
@@ -229,158 +233,158 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
     }
 
     switch ((enum options)option) {
-	case THREAD_CREATE: {
-	    char *script;
-	    int   joinable, len;
-
-	    if (objc == 2) {
-	        /* Neither joinable nor special script
-		 */
+    case THREAD_CREATE: {
+	const char *script;
+	int joinable, len;
 
-	        joinable = 0;
-		script   = "testthread wait";	/* Just enter the event loop */
+	if (objc == 2) {
+	    /*
+	     * Neither joinable nor special script
+	     */
 
-	    } else if (objc == 3) {
-	        /* Possibly -joinable, then no special script,
-		 * no joinable, then its a script.
-		 */
+	    joinable = 0;
+	    script = "testthread wait";		/* Just enter event loop */
+	} else if (objc == 3) {
+	    /*
+	     * Possibly -joinable, then no special script, no joinable, then
+	     * its a script.
+	     */
 
-	        script = Tcl_GetString(objv[2]);
-		len    = strlen (script);
+	    script = Tcl_GetStringFromObj(objv[2], &len);
 
-		if ((len > 1) &&
+	    if ((len > 1) &&
 		    (script [0] == '-') && (script [1] == 'j') &&
 		    (0 == strncmp (script, "-joinable", (size_t) len))) {
-		    joinable = 1;
-		    script   = "testthread wait"; /* Just enter the event loop
-						   */
-		} else {
-		    /* Remember the script */
-		    joinable = 0;
-		}
-	    } else if (objc == 4) {
-	        /* Definitely a script available, but is the flag
-		 * -joinable ?
+		joinable = 1;
+		script = "testthread wait";	/* Just enter event loop */
+	    } else {
+		/*
+		 * Remember the script
 		 */
 
-	        script = Tcl_GetString(objv[2]);
-		len    = strlen (script);
+		joinable = 0;
+	    }
+	} else if (objc == 4) {
+	    /*
+	     * Definitely a script available, but is the flag -joinable?
+	     */
 
-		joinable = ((len > 1) &&
-			    (script [0] == '-') && (script [1] == 'j') &&
-			    (0 == strncmp (script, "-joinable", (size_t) len)));
+	    script = Tcl_GetStringFromObj(objv[2], &len);
 
-		script = Tcl_GetString(objv[3]);
-	    } else {
-		Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
-		return TCL_ERROR;
-	    }
-	    return TclCreateThread(interp, script, joinable);
+	    joinable = ((len > 1) &&
+		    (script [0] == '-') && (script [1] == 'j') &&
+		    (0 == strncmp(script, "-joinable", (size_t) len)));
+
+	    script = Tcl_GetString(objv[3]);
+	} else {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
+	    return TCL_ERROR;
 	}
-	case THREAD_EXIT: {
-	    if (objc > 2) {
-		Tcl_WrongNumArgs(interp, 1, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    ListRemove(NULL);
-	    Tcl_ExitThread(0);
-	    return TCL_OK;
+	return TclCreateThread(interp, script, joinable);
+    }
+    case THREAD_EXIT:
+	if (objc > 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
 	}
-	case THREAD_ID:
-	    if (objc == 2) {
-		Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
-		Tcl_SetObjResult(interp, idObj);
-		return TCL_OK;
-	    } else {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-        case THREAD_JOIN: {
-	    long id;
-	    int result, status;
+	ListRemove(NULL);
+	Tcl_ExitThread(0);
+	return TCL_OK;
+    case THREAD_ID:
+	if (objc == 2) {
+	    Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
 
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 1, objv, "join id");
-		return TCL_ERROR;
-	    }
-	    if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
-		return TCL_ERROR;
-	    }
+	    Tcl_SetObjResult(interp, idObj);
+	    return TCL_OK;
+	} else {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+    case THREAD_JOIN: {
+	long id;
+	int result, status;
 
-	    result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
-	    if (result == TCL_OK) {
-	        Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
-	    } else {
-	        char buf [20];
-		sprintf (buf, "%ld", id);
-		Tcl_AppendResult (interp, "cannot join thread ", buf, NULL);
-	    }
-	    return result;
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "id");
+	    return TCL_ERROR;
 	}
-	case THREAD_NAMES: {
-	    if (objc > 2) {
-		Tcl_WrongNumArgs(interp, 2, objv, NULL);
-		return TCL_ERROR;
-	    }
-	    return TclThreadList(interp);
+	if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	case THREAD_SEND: {
-	    long id;
-	    char *script;
-	    int wait, arg;
 
-	    if ((objc != 4) && (objc != 5)) {
-		Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
-		return TCL_ERROR;
-	    }
-	    if (objc == 5) {
-		if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
-		    Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
-		    return TCL_ERROR;
-		}
-		wait = 0;
-		arg = 3;
-	    } else {
-		wait = 1;
-		arg = 2;
-	    }
-	    if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+	result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
+	if (result == TCL_OK) {
+	    Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
+	} else {
+	    char buf [20];
+
+	    sprintf(buf, "%ld", id);
+	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
+	}
+	return result;
+    }
+    case THREAD_NAMES:
+	if (objc > 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	    return TCL_ERROR;
+	}
+	return TclThreadList(interp);
+    case THREAD_SEND: {
+	long id;
+	const char *script;
+	int wait, arg;
+
+	if ((objc != 4) && (objc != 5)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
+	    return TCL_ERROR;
+	}
+	if (objc == 5) {
+	    if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
 		return TCL_ERROR;
 	    }
-	    arg++;
-	    script = Tcl_GetString(objv[arg]);
-	    return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+	    wait = 0;
+	    arg = 3;
+	} else {
+	    wait = 1;
+	    arg = 2;
 	}
-	case THREAD_WAIT: {
-	    while (1) {
-		(void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
-	    }
+	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+	    return TCL_ERROR;
 	}
-	case THREAD_ERRORPROC: {
-	    /*
-	     * Arrange for this proc to handle thread death errors.
-	     */
+	arg++;
+	script = Tcl_GetString(objv[arg]);
+	return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+    }
+    case THREAD_ERRORPROC: {
+	/*
+	 * Arrange for this proc to handle thread death errors.
+	 */
 
-	    char *proc;
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc");
-		return TCL_ERROR;
-	    }
-	    Tcl_MutexLock(&threadMutex);
-	    errorThreadId = Tcl_GetCurrentThread();
-	    if (errorProcString) {
-		ckfree(errorProcString);
-	    }
-	    proc = Tcl_GetString(objv[2]);
-	    errorProcString = ckalloc(strlen(proc)+1);
-	    strcpy(errorProcString, proc);
-	    Tcl_MutexUnlock(&threadMutex);
-	    return TCL_OK;
+	char *proc;
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
+	    return TCL_ERROR;
+	}
+	Tcl_MutexLock(&threadMutex);
+	errorThreadId = Tcl_GetCurrentThread();
+	if (errorProcString) {
+	    ckfree(errorProcString);
+	}
+	proc = Tcl_GetString(objv[2]);
+	errorProcString = ckalloc(strlen(proc)+1);
+	strcpy(errorProcString, proc);
+	Tcl_MutexUnlock(&threadMutex);
+	return TCL_OK;
+    }
+    case THREAD_WAIT:
+	while (1) {
+	    (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
 	}
     }
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -388,7 +392,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
  * TclCreateThread --
  *
  *	This procedure is invoked to create a thread containing an interp to
- *	run a script.  This returns after the thread has started executing.
+ *	run a script. This returns after the thread has started executing.
  *
  * Results:
  *	A standard Tcl result, which is the thread ID.
@@ -401,10 +405,10 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-TclCreateThread(interp, script, joinable)
-    Tcl_Interp *interp;			/* Current interpreter. */
-    char *script;			/* Script to execute */
-    int         joinable;		/* Flag, joinable thread or not */
+TclCreateThread(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    const char *script,		/* Script to execute */
+    int joinable)		/* Flag, joinable thread or not */
 {
     ThreadCtrl ctrl;
     Tcl_ThreadId id;
@@ -417,9 +421,9 @@ TclCreateThread(interp, script, joinable)
 
     Tcl_MutexLock(&threadMutex);
     if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
-		 TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
+	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
 	Tcl_MutexUnlock(&threadMutex);
-        Tcl_AppendResult(interp,"can't create a new thread",NULL);
+        Tcl_AppendResult(interp, "can't create a new thread", NULL);
 	return TCL_ERROR;
     }
 
@@ -439,32 +443,32 @@ TclCreateThread(interp, script, joinable)
  *
  * NewTestThread --
  *
- *    This routine is the "main()" for a new thread whose task is to
- *    execute a single TCL script.  The argument to this function is
- *    a pointer to a structure that contains the text of the TCL script
- *    to be executed.
- *
- *    Space to hold the script field of the ThreadControl structure passed 
- *    in as the only argument was obtained from malloc() and must be freed 
- *    by this function before it exits.  Space to hold the ThreadControl
- *    structure itself is released by the calling function, and the
- *    two condition variables in the ThreadControl structure are destroyed
- *    by the calling function.  The calling function will destroy the
- *    ThreadControl structure and the condition variable as soon as
- *    ctrlPtr->condWait is signaled, so this routine must make copies of
- *    any data it might need after that point.
+ *	This routine is the "main()" for a new thread whose task is to execute
+ *	a single Tcl script. The argument to this function is a pointer to a
+ *	structure that contains the text of the TCL script to be executed.
+ *
+ *	Space to hold the script field of the ThreadControl structure passed
+ *	in as the only argument was obtained from malloc() and must be freed
+ *	by this function before it exits. Space to hold the ThreadControl
+ *	structure itself is released by the calling function, and the two
+ *	condition variables in the ThreadControl structure are destroyed by
+ *	the calling function. The calling function will destroy the
+ *	ThreadControl structure and the condition variable as soon as
+ *	ctrlPtr->condWait is signaled, so this routine must make copies of any
+ *	data it might need after that point.
  *
  * Results:
- *    none
+ *	None
  *
  * Side effects:
- *    A TCL script is executed in a new thread.
+ *	A Tcl script is executed in a new thread.
  *
  *------------------------------------------------------------------------
  */
+
 Tcl_ThreadCreateType
-NewTestThread(clientData)
-    ClientData clientData;
+NewTestThread(
+    ClientData clientData)
 {
     ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -480,16 +484,25 @@ NewTestThread(clientData)
     result = TclThread_Init(tsdPtr->interp);
 
     /*
+     * This is part of the test facility. Initialize _ALL_ test commands for
+     * use by the new thread.
+     */
+
+    result = Tcltest_Init(tsdPtr->interp);
+
+    /*
      * Update the list of threads.
      */
 
     Tcl_MutexLock(&threadMutex);
     ListUpdateInner(tsdPtr);
+
     /*
-     * We need to keep a pointer to the alloc'ed mem of the script
-     * we are eval'ing, for the case that we exit during evaluation
+     * We need to keep a pointer to the alloc'ed mem of the script we are
+     * eval'ing, for the case that we exit during evaluation
      */
-    threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+
+    threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
     strcpy(threadEvalScript, ctrlPtr->script);
 
     Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
@@ -528,22 +541,23 @@ NewTestThread(clientData)
  *
  * ThreadErrorProc --
  *
- *    Send a message to the thread willing to hear about errors.
+ *	Send a message to the thread willing to hear about errors.
  *
  * Results:
- *    none
+ *	None
  *
  * Side effects:
- *    Send an event.
+ *	Send an event.
  *
  *------------------------------------------------------------------------
  */
+
 static void
-ThreadErrorProc(interp)
-    Tcl_Interp *interp;		/* Interp that failed */
+ThreadErrorProc(
+    Tcl_Interp *interp)		/* Interp that failed */
 {
     Tcl_Channel errChannel;
-    CONST char *errorInfo, *argv[3];
+    const char *errorInfo, *argv[3];
     char *script;
     char buf[TCL_DOUBLE_SPACE+1];
     sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
@@ -572,20 +586,21 @@ ThreadErrorProc(interp)
  *
  * ListUpdateInner --
  *
- *    Add the thread local storage to the list.  This assumes
- *	the caller has obtained the mutex.
+ *	Add the thread local storage to the list. This assumes the caller has
+ *	obtained the mutex.
  *
  * Results:
- *    none
+ *	None
  *
  * Side effects:
- *    Add the thread local storage to its list.
+ *	Add the thread local storage to its list.
  *
  *------------------------------------------------------------------------
  */
+
 static void
-ListUpdateInner(tsdPtr)
-    ThreadSpecificData *tsdPtr;
+ListUpdateInner(
+    ThreadSpecificData *tsdPtr)
 {
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -604,20 +619,21 @@ ListUpdateInner(tsdPtr)
  *
  * ListRemove --
  *
- *    Remove the thread local storage from its list.  This grabs the
- *	mutex to protect the list.
+ *	Remove the thread local storage from its list. This grabs the mutex to
+ *	protect the list.
  *
  * Results:
- *    none
+ *	None
  *
  * Side effects:
- *    Remove the thread local storage from its list.
+ *	Remove the thread local storage from its list.
  *
  *------------------------------------------------------------------------
  */
+
 static void
-ListRemove(tsdPtr)
-    ThreadSpecificData *tsdPtr;
+ListRemove(
+    ThreadSpecificData *tsdPtr)
 {
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -634,7 +650,6 @@ ListRemove(tsdPtr)
     tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
     Tcl_MutexUnlock(&threadMutex);
 }
-
 
 /*
  *------------------------------------------------------------------------
@@ -652,8 +667,8 @@ ListRemove(tsdPtr)
  *------------------------------------------------------------------------
  */
 int
-TclThreadList(interp)
-    Tcl_Interp *interp;
+TclThreadList(
+    Tcl_Interp *interp)
 {
     ThreadSpecificData *tsdPtr;
     Tcl_Obj *listPtr;
@@ -662,13 +677,12 @@ TclThreadList(interp)
     Tcl_MutexLock(&threadMutex);
     for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
 	Tcl_ListObjAppendElement(interp, listPtr,
-		Tcl_NewLongObj((long)tsdPtr->threadId));
+		Tcl_NewLongObj((long) tsdPtr->threadId));
     }
     Tcl_MutexUnlock(&threadMutex);
     Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
-
 
 /*
  *------------------------------------------------------------------------
@@ -685,12 +699,13 @@ TclThreadList(interp)
  *
  *------------------------------------------------------------------------
  */
+
 int
-TclThreadSend(interp, id, script, wait)
-    Tcl_Interp *interp;		/* The current interpreter. */
-    Tcl_ThreadId id;		/* Thread Id of other interpreter. */
-    char *script;		/* The script to evaluate. */
-    int wait;			/* If 1, we block for the result. */
+TclThreadSend(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    Tcl_ThreadId id,		/* Thread Id of other interpreter. */
+    const char *script,		/* The script to evaluate. */
+    int wait)			/* If 1, we block for the result. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ThreadEvent *threadEventPtr;
@@ -698,7 +713,7 @@ TclThreadSend(interp, id, script, wait)
     int found, code;
     Tcl_ThreadId threadId = (Tcl_ThreadId) id;
 
-    /* 
+    /*
      * Verify the thread exists.
      */
 
@@ -717,8 +732,8 @@ TclThreadSend(interp, id, script, wait)
     }
 
     /*
-     * Short circut sends to ourself.  Ought to do something with -async,
-     * like run in an idle handler.
+     * Short circut sends to ourself. Ought to do something with -async, like
+     * run in an idle handler.
      */
 
     if (threadId == Tcl_GetCurrentThread()) {
@@ -726,7 +741,7 @@ TclThreadSend(interp, id, script, wait)
 	return Tcl_GlobalEval(interp, script);
     }
 
-    /* 
+    /*
      * Create the event for its event queue.
      */
 
@@ -749,7 +764,7 @@ TclThreadSend(interp, id, script, wait)
 	resultPtr->errorInfo = NULL;
 	resultPtr->errorCode = NULL;
 
-	/* 
+	/*
 	 * Maintain the cleanup list.
 	 */
 
@@ -769,7 +784,7 @@ TclThreadSend(interp, id, script, wait)
      */
 
     threadEventPtr->event.proc = ThreadEventProc;
-    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, 
+    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
 	    TCL_QUEUE_TAIL);
     Tcl_ThreadAlert(threadId);
 
@@ -778,7 +793,7 @@ TclThreadSend(interp, id, script, wait)
 	return TCL_OK;
     }
 
-    /* 
+    /*
      * Block on the results and then get them.
      */
 
@@ -823,7 +838,6 @@ TclThreadSend(interp, id, script, wait)
 
     return code;
 }
-
 
 /*
  *------------------------------------------------------------------------
@@ -840,17 +854,18 @@ TclThreadSend(interp, id, script, wait)
  *
  *------------------------------------------------------------------------
  */
+
 static int
-ThreadEventProc(evPtr, mask)
-    Tcl_Event *evPtr;		/* Really ThreadEvent */
-    int mask;
+ThreadEventProc(
+    Tcl_Event *evPtr,		/* Really ThreadEvent */
+    int mask)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
     ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
     Tcl_Interp *interp = tsdPtr->interp;
     int code;
-    CONST char *result, *errorCode, *errorInfo;
+    const char *result, *errorCode, *errorInfo;
 
     if (interp == NULL) {
 	code = TCL_ERROR;
@@ -912,10 +927,11 @@ ThreadEventProc(evPtr, mask)
  *
  *------------------------------------------------------------------------
  */
+
      /* ARGSUSED */
 static void
-ThreadFreeProc(clientData)
-    ClientData clientData;
+ThreadFreeProc(
+    ClientData clientData)
 {
     if (clientData) {
 	ckfree((char *) clientData);
@@ -938,20 +954,23 @@ ThreadFreeProc(clientData)
  *
  *------------------------------------------------------------------------
  */
+
      /* ARGSUSED */
 static int
-ThreadDeleteEvent(eventPtr, clientData)
-    Tcl_Event *eventPtr;		/* Really ThreadEvent */
-    ClientData clientData;		/* dummy */
+ThreadDeleteEvent(
+    Tcl_Event *eventPtr,	/* Really ThreadEvent */
+    ClientData clientData)	/* dummy */
 {
     if (eventPtr->proc == ThreadEventProc) {
 	ckfree((char *) ((ThreadEvent *) eventPtr)->script);
 	return 1;
     }
+
     /*
-     * If it was NULL, we were in the middle of servicing the event
-     * and it should be removed
+     * If it was NULL, we were in the middle of servicing the event and it
+     * should be removed
      */
+
     return (eventPtr->proc == NULL);
 }
 
@@ -960,21 +979,22 @@ ThreadDeleteEvent(eventPtr, clientData)
  *
  * ThreadExitProc --
  *
- *    This is called when the thread exits.  
+ *    This is called when the thread exits.
  *
  * Results:
  *    None.
  *
  * Side effects:
- *	It unblocks anyone that is waiting on a send to this thread.
- *	It cleans up any events in the event queue for this thread.
+ *	It unblocks anyone that is waiting on a send to this thread. It cleans
+ *	up any events in the event queue for this thread.
  *
  *------------------------------------------------------------------------
  */
+
      /* ARGSUSED */
 static void
-ThreadExitProc(clientData)
-    ClientData clientData;
+ThreadExitProc(
+    ClientData clientData)
 {
     char *threadEvalScript = (char *) clientData;
     ThreadEventResult *resultPtr, *nextPtr;
@@ -992,9 +1012,10 @@ ThreadExitProc(clientData)
 	nextPtr = resultPtr->nextPtr;
 	if (resultPtr->srcThreadId == self) {
 	    /*
-	     * We are going away.  By freeing up the result we signal
-	     * to the other thread we don't care about the result.
+	     * We are going away. By freeing up the result we signal to the
+	     * other thread we don't care about the result.
 	     */
+
 	    if (resultPtr->prevPtr) {
 		resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
 	    } else {
@@ -1005,15 +1026,16 @@ ThreadExitProc(clientData)
 	    }
 	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
 	    resultPtr->eventPtr->resultPtr = NULL;
-	    ckfree((char *)resultPtr);
+	    ckfree((char *) resultPtr);
 	} else if (resultPtr->dstThreadId == self) {
 	    /*
-	     * Dang.  The target is going away.  Unblock the caller.
-	     * The result string must be dynamically allocated because
-	     * the main thread is going to call free on it.
+	     * Dang. The target is going away. Unblock the caller. The result
+	     * string must be dynamically allocated because the main thread is
+	     * going to call free on it.
 	     */
 
-	    char *msg = "target thread died";
+	    const char *msg = "target thread died";
+
 	    resultPtr->result = ckalloc(strlen(msg)+1);
 	    strcpy(resultPtr->result, msg);
 	    resultPtr->code = TCL_ERROR;
@@ -1022,5 +1044,12 @@ ThreadExitProc(clientData)
     }
     Tcl_MutexUnlock(&threadMutex);
 }
-
 #endif /* TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index d472b17..33838ec 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -1,4 +1,4 @@
-/* 
+/*
  * tclTimer.c --
  *
  *	This file provides timer event management facilities for Tcl,
@@ -6,75 +6,73 @@
  *
  * Copyright (c) 1997 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
 /*
  * For each timer callback that's pending there is one record of the following
- * type.  The normal handlers (created by Tcl_CreateTimerHandler) are chained
+ * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
  * together in a list sorted by time (earliest event first).
  */
 
 typedef struct TimerHandler {
-    Tcl_Time time;			/* When timer is to fire. */
-    Tcl_TimerProc *proc;		/* Procedure to call. */
-    ClientData clientData;		/* Argument to pass to proc. */
-    Tcl_TimerToken token;		/* Identifies handler so it can be
-					 * deleted. */
-    struct TimerHandler *nextPtr;	/* Next event in queue, or NULL for
-					 * end of queue. */
+    Tcl_Time time;		/* When timer is to fire. */
+    Tcl_TimerProc *proc;	/* Function to call. */
+    ClientData clientData;	/* Argument to pass to proc. */
+    Tcl_TimerToken token;	/* Identifies handler so it can be deleted. */
+    struct TimerHandler *nextPtr;
+				/* Next event in queue, or NULL for end of
+				 * queue. */
 } TimerHandler;
 
 /*
- * The data structure below is used by the "after" command to remember
- * the command to be executed later.  All of the pending "after" commands
- * for an interpreter are linked together in a list.
+ * The data structure below is used by the "after" command to remember the
+ * command to be executed later. All of the pending "after" commands for an
+ * interpreter are linked together in a list.
  */
 
 typedef struct AfterInfo {
     struct AfterAssocData *assocPtr;
-				/* Pointer to the "tclAfter" assocData for
-				 * the interp in which command will be
+				/* Pointer to the "tclAfter" assocData for the
+				 * interp in which command will be
 				 * executed. */
     Tcl_Obj *commandPtr;	/* Command to execute. */
-    int id;			/* Integer identifier for command;  used to
+    int id;			/* Integer identifier for command; used to
 				 * cancel it. */
-    Tcl_TimerToken token;	/* Used to cancel the "after" command.  NULL
-				 * means that the command is run as an
-				 * idle handler rather than as a timer
-				 * handler.  NULL means this is an "after
-				 * idle" handler rather than a
-                                 * timer handler. */
+    Tcl_TimerToken token;	/* Used to cancel the "after" command. NULL
+				 * means that the command is run as an idle
+				 * handler rather than as a timer handler.
+				 * NULL means this is an "after idle" handler
+				 * rather than a timer handler. */
     struct AfterInfo *nextPtr;	/* Next in list of all "after" commands for
 				 * this interpreter. */
 } AfterInfo;
 
 /*
- * One of the following structures is associated with each interpreter
- * for which an "after" command has ever been invoked.  A pointer to
- * this structure is stored in the AssocData for the "tclAfter" key.
+ * One of the following structures is associated with each interpreter for
+ * which an "after" command has ever been invoked. A pointer to this structure
+ * is stored in the AssocData for the "tclAfter" key.
  */
 
 typedef struct AfterAssocData {
     Tcl_Interp *interp;		/* The interpreter for which this data is
 				 * registered. */
-    AfterInfo *firstAfterPtr;	/* First in list of all "after" commands
-				 * still pending for this interpreter, or
-				 * NULL if none. */
+    AfterInfo *firstAfterPtr;	/* First in list of all "after" commands still
+				 * pending for this interpreter, or NULL if
+				 * none. */
 } AfterAssocData;
 
 /*
- * There is one of the following structures for each of the
- * handlers declared in a call to Tcl_DoWhenIdle.  All of the
- * currently-active handlers are linked together into a list.
+ * There is one of the following structures for each of the handlers declared
+ * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
+ * linked together into a list.
  */
 
 typedef struct IdleHandler {
-    Tcl_IdleProc (*proc);	/* Procedure to call. */
+    Tcl_IdleProc (*proc);	/* Function to call. */
     ClientData clientData;	/* Value to pass to proc. */
     int generation;		/* Used to distinguish older handlers from
 				 * recently-created ones. */
@@ -82,53 +80,69 @@ typedef struct IdleHandler {
 } IdleHandler;
 
 /*
- * The timer and idle queues are per-thread because they are associated
- * with the notifier, which is also per-thread.
+ * The timer and idle queues are per-thread because they are associated with
+ * the notifier, which is also per-thread.
  *
- * All static variables used in this file are collected into a single
- * instance of the following structure.  For multi-threaded implementations,
- * there is one instance of this structure for each thread.
+ * All static variables used in this file are collected into a single instance
+ * of the following structure. For multi-threaded implementations, there is
+ * one instance of this structure for each thread.
  *
- * Notice that different structures with the same name appear in other
- * files.  The structure defined below is used in this file only.
+ * Notice that different structures with the same name appear in other files.
+ * The structure defined below is used in this file only.
  */
 
 typedef struct ThreadSpecificData {
     TimerHandler *firstTimerHandlerPtr;	/* First event in queue. */
-    int lastTimerId;		/* Timer identifier of most recently
-				 * created timer. */
+    int lastTimerId;		/* Timer identifier of most recently created
+				 * timer. */
     int timerPending;		/* 1 if a timer event is in the queue. */
     IdleHandler *idleList;	/* First in list of all idle handlers. */
     IdleHandler *lastIdlePtr;	/* Last in list (or NULL for empty list). */
-    int idleGeneration;		/* Used to fill in the "generation" fields
-				 * of IdleHandler structures.  Increments
-				 * each time Tcl_DoOneEvent starts calling
-				 * idle handlers, so that all old handlers
-				 * can be called without calling any of the
-				 * new ones created by old ones. */
+    int idleGeneration;		/* Used to fill in the "generation" fields of
+				 * IdleHandler structures. Increments each
+				 * time Tcl_DoOneEvent starts calling idle
+				 * handlers, so that all old handlers can be
+				 * called without calling any of the new ones
+				 * created by old ones. */
     int afterId;		/* For unique identifiers of after events. */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
 
 /*
- * Prototypes for procedures referenced only in this file:
+ * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write
+ * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes
+ * the number of milliseconds difference between two times. Both macros use
+ * both of their arguments multiple times, so make sure they are cheap and
+ * side-effect free. The "prototypes" for these macros are:
+ *
+ * static int	TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2);
+ * static long	TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
+ */
+
+#define TCL_TIME_BEFORE(t1, t2) \
+    (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
+
+#define TCL_TIME_DIFF_MS(t1, t2) \
+    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
+	    ((long)(t1).usec - (long)(t2).usec)/1000)
+
+/*
+ * Prototypes for functions referenced only in this file:
  */
 
-static void		AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp));
-static void		AfterProc _ANSI_ARGS_((ClientData clientData));
-static void		FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
-static AfterInfo *	GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
-			    Tcl_Obj *commandPtr));
-static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
-static void		TimerExitProc _ANSI_ARGS_((ClientData clientData));
-static int		TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
-			    int flags));
-static void		TimerCheckProc _ANSI_ARGS_((ClientData clientData,
-			    int flags));
-static void		TimerSetupProc _ANSI_ARGS_((ClientData clientData,
-			    int flags));
+static void		AfterCleanupProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
+static void		AfterProc(ClientData clientData);
+static void		FreeAfterPtr(AfterInfo *afterPtr);
+static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr,
+			    Tcl_Obj *commandPtr);
+static ThreadSpecificData *InitTimer(void);
+static void		TimerExitProc(ClientData clientData);
+static int		TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
+static void		TimerCheckProc(ClientData clientData, int flags);
+static void		TimerSetupProc(ClientData clientData, int flags);
 
 /*
  *----------------------------------------------------------------------
@@ -147,10 +161,10 @@ static void		TimerSetupProc _ANSI_ARGS_((ClientData clientData,
  */
 
 static ThreadSpecificData *
-InitTimer()
+InitTimer(void)
 {
-    ThreadSpecificData *tsdPtr = 
-	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -165,8 +179,8 @@ InitTimer()
  *
  * TimerExitProc --
  *
- *	This function is call at exit or unload time to remove the
- *	timer and idle event sources.
+ *	This function is call at exit or unload time to remove the timer and
+ *	idle event sources.
  *
  * Results:
  *	None.
@@ -178,15 +192,16 @@ InitTimer()
  */
 
 static void
-TimerExitProc(clientData)
-    ClientData clientData;	/* Not used. */
+TimerExitProc(
+    ClientData clientData)	/* Not used. */
 {
-    ThreadSpecificData *tsdPtr =
-	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    TclThreadDataKeyGet(&dataKey);
 
     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
     if (tsdPtr != NULL) {
 	register TimerHandler *timerHandlerPtr;
+
 	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	while (timerHandlerPtr != NULL) {
 	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
@@ -201,55 +216,82 @@ TimerExitProc(clientData)
  *
  * Tcl_CreateTimerHandler --
  *
- *	Arrange for a given procedure to be invoked at a particular
- *	time in the future.
+ *	Arrange for a given function to be invoked at a particular time in the
+ *	future.
  *
  * Results:
- *	The return value is a token for the timer event, which
- *	may be used to delete the event before it fires.
+ *	The return value is a token for the timer event, which may be used to
+ *	delete the event before it fires.
  *
  * Side effects:
- *	When milliseconds have elapsed, proc will be invoked
- *	exactly once.
+ *	When milliseconds have elapsed, proc will be invoked exactly once.
  *
  *--------------------------------------------------------------
  */
 
 Tcl_TimerToken
-Tcl_CreateTimerHandler(milliseconds, proc, clientData)
-    int milliseconds;		/* How many milliseconds to wait
-				 * before invoking proc. */
-    Tcl_TimerProc *proc;	/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary data to pass to proc. */
+Tcl_CreateTimerHandler(
+    int milliseconds,		/* How many milliseconds to wait before
+				 * invoking proc. */
+    Tcl_TimerProc *proc,	/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary data to pass to proc. */
 {
-    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
     Tcl_Time time;
-    ThreadSpecificData *tsdPtr;
-
-    tsdPtr = InitTimer();
-
-    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
 
     /*
      * Compute when the event should fire.
      */
 
     Tcl_GetTime(&time);
-    timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
-    timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
-    if (timerHandlerPtr->time.usec >= 1000000) {
-	timerHandlerPtr->time.usec -= 1000000;
-	timerHandlerPtr->time.sec += 1;
+    time.sec += milliseconds/1000;
+    time.usec += (milliseconds%1000)*1000;
+    if (time.usec >= 1000000) {
+	time.usec -= 1000000;
+	time.sec += 1;
     }
+    return TclCreateAbsoluteTimerHandler(&time, proc, clientData);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclCreateAbsoluteTimerHandler --
+ *
+ *	Arrange for a given function to be invoked at a particular time in the
+ *	future.
+ *
+ * Results:
+ *	The return value is a token for the timer event, which may be used to
+ *	delete the event before it fires.
+ *
+ * Side effects:
+ *	When the time in timePtr has been reached, proc will be invoked
+ *	exactly once.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tcl_TimerToken
+TclCreateAbsoluteTimerHandler(
+    Tcl_Time *timePtr,
+    Tcl_TimerProc *proc,
+    ClientData clientData)
+{
+    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
+    ThreadSpecificData *tsdPtr;
+
+    tsdPtr = InitTimer();
+    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
 
     /*
-     * Fill in other fields for the event.
+     * Fill in fields for the event.
      */
 
+    memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
     timerHandlerPtr->proc = proc;
     timerHandlerPtr->clientData = clientData;
     tsdPtr->lastTimerId++;
-    timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
+    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
 
     /*
      * Add the event to the queue in the correct position
@@ -258,9 +300,7 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
 
     for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
 	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
-	if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
-		|| ((tPtr2->time.sec == timerHandlerPtr->time.sec)
-		&& (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
+	if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) {
 	    break;
 	}
     }
@@ -287,17 +327,16 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
  *	None.
  *
  * Side effects:
- *	Destroy the timer callback identified by TimerToken,
- *	so that its associated procedure will not be called.
- *	If the callback has already fired, or if the given
- *	token doesn't exist, then nothing happens.
+ *	Destroy the timer callback identified by TimerToken, so that its
+ *	associated function will not be called. If the callback has already
+ *	fired, or if the given token doesn't exist, then nothing happens.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_DeleteTimerHandler(token)
-    Tcl_TimerToken token;	/* Result previously returned by
+Tcl_DeleteTimerHandler(
+    Tcl_TimerToken token)	/* Result previously returned by
 				 * Tcl_DeleteTimerHandler. */
 {
     register TimerHandler *timerHandlerPtr, *prevPtr;
@@ -328,9 +367,9 @@ Tcl_DeleteTimerHandler(token)
  *
  * TimerSetupProc --
  *
- *	This function is called by Tcl_DoOneEvent to setup the timer
- *	event source for before blocking.  This routine checks both the
- *	idle and after timer lists.
+ *	This function is called by Tcl_DoOneEvent to setup the timer event
+ *	source for before blocking. This routine checks both the idle and
+ *	after timer lists.
  *
  * Results:
  *	None.
@@ -342,9 +381,9 @@ Tcl_DeleteTimerHandler(token)
  */
 
 static void
-TimerSetupProc(data, flags)
-    ClientData data;		/* Not used. */
-    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
@@ -378,7 +417,7 @@ TimerSetupProc(data, flags)
     } else {
 	return;
     }
-	
+
     Tcl_SetMaxBlockTime(&blockTime);
 }
 
@@ -387,9 +426,9 @@ TimerSetupProc(data, flags)
  *
  * TimerCheckProc --
  *
- *	This function is called by Tcl_DoOneEvent to check the timer
- *	event source for events.  This routine checks both the
- *	idle and after timer lists.
+ *	This function is called by Tcl_DoOneEvent to check the timer event
+ *	source for events. This routine checks both the idle and after timer
+ *	lists.
  *
  * Results:
  *	None.
@@ -401,9 +440,9 @@ TimerSetupProc(data, flags)
  */
 
 static void
-TimerCheckProc(data, flags)
-    ClientData data;		/* Not used. */
-    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Event *timerEvPtr;
     Tcl_Time blockTime;
@@ -446,28 +485,27 @@ TimerCheckProc(data, flags)
  *
  * TimerHandlerEventProc --
  *
- *	This procedure is called by Tcl_ServiceEvent when a timer event
- *	reaches the front of the event queue.  This procedure handles
- *	the event by invoking the callbacks for all timers that are
- *	ready.
+ *	This function is called by Tcl_ServiceEvent when a timer event reaches
+ *	the front of the event queue. This function handles the event by
+ *	invoking the callbacks for all timers that are ready.
  *
  * Results:
- *	Returns 1 if the event was handled, meaning it should be removed
- *	from the queue.  Returns 0 if the event was not handled, meaning
- *	it should stay on the queue.  The only time the event isn't
- *	handled is if the TCL_TIMER_EVENTS flag bit isn't set.
+ *	Returns 1 if the event was handled, meaning it should be removed from
+ *	the queue. Returns 0 if the event was not handled, meaning it should
+ *	stay on the queue. The only time the event isn't handled is if the
+ *	TCL_TIMER_EVENTS flag bit isn't set.
  *
  * Side effects:
- *	Whatever the timer handler callback procedures do.
+ *	Whatever the timer handler callback functions do.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TimerHandlerEventProc(evPtr, flags)
-    Tcl_Event *evPtr;		/* Event to service. */
-    int flags;			/* Flags that indicate what events to
-				 * handle, such as TCL_FILE_EVENTS. */
+TimerHandlerEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to handle,
+				 * such as TCL_FILE_EVENTS. */
 {
     TimerHandler *timerHandlerPtr, **nextPtrPtr;
     Tcl_Time time;
@@ -475,9 +513,9 @@ TimerHandlerEventProc(evPtr, flags)
     ThreadSpecificData *tsdPtr = InitTimer();
 
     /*
-     * Do nothing if timers aren't enabled.  This leaves the event on the
-     * queue, so we will get to it as soon as ServiceEvents() is called
-     * with timers enabled.
+     * Do nothing if timers aren't enabled. This leaves the event on the
+     * queue, so we will get to it as soon as ServiceEvents() is called with
+     * timers enabled.
      */
 
     if (!(flags & TCL_TIMER_EVENTS)) {
@@ -485,30 +523,28 @@ TimerHandlerEventProc(evPtr, flags)
     }
 
     /*
-     * The code below is trickier than it may look, for the following
-     * reasons:
+     * The code below is trickier than it may look, for the following reasons:
      *
-     * 1. New handlers can get added to the list while the current
-     *    one is being processed.  If new ones get added, we don't
-     *    want to process them during this pass through the list to avoid
-     *	  starving other event sources.  This is implemented using the
-     *	  token number in the handler:  new handlers will have a
-     *    newer token than any of the ones currently on the list.
-     * 2. The handler can call Tcl_DoOneEvent, so we have to remove
-     *    the handler from the list before calling it. Otherwise an
-     *    infinite loop could result.
-     * 3. Tcl_DeleteTimerHandler can be called to remove an element from
-     *    the list while a handler is executing, so the list could
-     *    change structure during the call.
-     * 4. Because we only fetch the current time before entering the loop,
-     *    the only way a new timer will even be considered runnable is if
-     *	  its expiration time is within the same millisecond as the
-     *	  current time.  This is fairly likely on Windows, since it has
-     *	  a course granularity clock.  Since timers are placed
-     *	  on the queue in time order with the most recently created
-     *    handler appearing after earlier ones with the same expiration
-     *	  time, we don't have to worry about newer generation timers
-     *	  appearing before later ones.
+     * 1. New handlers can get added to the list while the current one is
+     *	  being processed. If new ones get added, we don't want to process
+     *	  them during this pass through the list to avoid starving other event
+     *	  sources. This is implemented using the token number in the handler:
+     *	  new handlers will have a newer token than any of the ones currently
+     *	  on the list.
+     * 2. The handler can call Tcl_DoOneEvent, so we have to remove the
+     *	  handler from the list before calling it. Otherwise an infinite loop
+     *	  could result.
+     * 3. Tcl_DeleteTimerHandler can be called to remove an element from the
+     *	  list while a handler is executing, so the list could change
+     *	  structure during the call.
+     * 4. Because we only fetch the current time before entering the loop, the
+     *	  only way a new timer will even be considered runnable is if its
+     *	  expiration time is within the same millisecond as the current time.
+     *	  This is fairly likely on Windows, since it has a course granularity
+     *	  clock. Since timers are placed on the queue in time order with the
+     *	  most recently created handler appearing after earlier ones with the
+     *	  same expiration time, we don't have to worry about newer generation
+     *	  timers appearing before later ones.
      */
 
     tsdPtr->timerPending = 0;
@@ -520,10 +556,8 @@ TimerHandlerEventProc(evPtr, flags)
 	if (timerHandlerPtr == NULL) {
 	    break;
 	}
-	    
-	if ((timerHandlerPtr->time.sec > time.sec)
-		|| ((timerHandlerPtr->time.sec == time.sec)
-			&& (timerHandlerPtr->time.usec > time.usec))) {
+
+	if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) {
 	    break;
 	}
 
@@ -531,13 +565,13 @@ TimerHandlerEventProc(evPtr, flags)
 	 * Bail out if the next timer is of a newer generation.
 	 */
 
-	if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
+	if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
 	    break;
 	}
 
 	/*
-	 * Remove the handler from the queue before invoking it,
-	 * to avoid potential reentrancy problems.
+	 * Remove the handler from the queue before invoking it, to avoid
+	 * potential reentrancy problems.
 	 */
 
 	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
@@ -553,24 +587,24 @@ TimerHandlerEventProc(evPtr, flags)
  *
  * Tcl_DoWhenIdle --
  *
- *	Arrange for proc to be invoked the next time the system is
- *	idle (i.e., just before the next time that Tcl_DoOneEvent
- *	would have to wait for something to happen).
+ *	Arrange for proc to be invoked the next time the system is idle (i.e.,
+ *	just before the next time that Tcl_DoOneEvent would have to wait for
+ *	something to happen).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Proc will eventually be called, with clientData as argument.
- *	See the manual entry for details.
+ *	Proc will eventually be called, with clientData as argument. See the
+ *	manual entry for details.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_DoWhenIdle(proc, clientData)
-    Tcl_IdleProc *proc;		/* Procedure to invoke. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_DoWhenIdle(
+    Tcl_IdleProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr;
     Tcl_Time blockTime;
@@ -598,23 +632,23 @@ Tcl_DoWhenIdle(proc, clientData)
  *
  * Tcl_CancelIdleCall --
  *
- *	If there are any when-idle calls requested to a given procedure
- *	with given clientData, cancel all of them.
+ *	If there are any when-idle calls requested to a given function with
+ *	given clientData, cancel all of them.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If the proc/clientData combination were on the when-idle list,
- *	they are removed so that they will never be called.
+ *	If the proc/clientData combination were on the when-idle list, they
+ *	are removed so that they will never be called.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_CancelIdleCall(proc, clientData)
-    Tcl_IdleProc *proc;		/* Procedure that was previously registered. */
-    ClientData clientData;	/* Arbitrary value to pass to proc. */
+Tcl_CancelIdleCall(
+    Tcl_IdleProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr, *prevPtr;
     IdleHandler *nextPtr;
@@ -645,14 +679,13 @@ Tcl_CancelIdleCall(proc, clientData)
  *
  * TclServiceIdle --
  *
- *	This procedure is invoked by the notifier when it becomes
- *	idle.  It will invoke all idle handlers that are present at
- *	the time the call is invoked, but not those added during idle
- *	processing.
+ *	This function is invoked by the notifier when it becomes idle. It will
+ *	invoke all idle handlers that are present at the time the call is
+ *	invoked, but not those added during idle processing.
  *
  * Results:
- *	The return value is 1 if TclServiceIdle found something to
- *	do, otherwise return value is 0.
+ *	The return value is 1 if TclServiceIdle found something to do,
+ *	otherwise return value is 0.
  *
  * Side effects:
  *	Invokes all pending idle handlers.
@@ -661,7 +694,7 @@ Tcl_CancelIdleCall(proc, clientData)
  */
 
 int
-TclServiceIdle()
+TclServiceIdle(void)
 {
     IdleHandler *idlePtr;
     int oldGeneration;
@@ -676,22 +709,20 @@ TclServiceIdle()
     tsdPtr->idleGeneration++;
 
     /*
-     * The code below is trickier than it may look, for the following
-     * reasons:
+     * The code below is trickier than it may look, for the following reasons:
      *
-     * 1. New handlers can get added to the list while the current
-     *    one is being processed.  If new ones get added, we don't
-     *    want to process them during this pass through the list (want
-     *    to check for other work to do first).  This is implemented
-     *    using the generation number in the handler:  new handlers
-     *    will have a different generation than any of the ones currently
-     *    on the list.
-     * 2. The handler can call Tcl_DoOneEvent, so we have to remove
-     *    the handler from the list before calling it. Otherwise an
-     *    infinite loop could result.
-     * 3. Tcl_CancelIdleCall can be called to remove an element from
-     *    the list while a handler is executing, so the list could
-     *    change structure during the call.
+     * 1. New handlers can get added to the list while the current one is
+     *	  being processed. If new ones get added, we don't want to process
+     *	  them during this pass through the list (want to check for other work
+     *	  to do first). This is implemented using the generation number in the
+     *	  handler: new handlers will have a different generation than any of
+     *	  the ones currently on the list.
+     * 2. The handler can call Tcl_DoOneEvent, so we have to remove the
+     *	  handler from the list before calling it. Otherwise an infinite loop
+     *	  could result.
+     * 3. Tcl_CancelIdleCall can be called to remove an element from the list
+     *	  while a handler is executing, so the list could change structure
+     *	  during the call.
      */
 
     for (idlePtr = tsdPtr->idleList;
@@ -718,8 +749,8 @@ TclServiceIdle()
  *
  * Tcl_AfterObjCmd --
  *
- *	This procedure is invoked to process the "after" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "after" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -732,21 +763,21 @@ TclServiceIdle()
 
 	/* ARGSUSED */
 int
-Tcl_AfterObjCmd(clientData, interp, objc, objv)
-    ClientData clientData;	/* Unused */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_AfterObjCmd(
+    ClientData clientData,	/* Unused */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    int ms;
+    Tcl_WideInt ms;		/* Number of milliseconds to wait */
+    Tcl_Time wakeup;
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
-    char *argString;
     int index;
     char buf[16 + TCL_INTEGER_SPACE];
     static CONST char *afterSubCmds[] = {
-	"cancel", "idle", "info", (char *) NULL
+	"cancel", "idle", "info", NULL
     };
     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
     ThreadSpecificData *tsdPtr = InitTimer();
@@ -757,11 +788,11 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
     }
 
     /*
-     * Create the "after" information associated for this interpreter,
-     * if it doesn't already exist.  
+     * Create the "after" information associated for this interpreter, if it
+     * doesn't already exist.
      */
 
-    assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL );
+    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
     if (assocPtr == NULL) {
 	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
 	assocPtr->interp = interp;
@@ -774,23 +805,35 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
      * First lets see if the command was passed a number as the first argument.
      */
 
-    if (objv[1]->typePtr == &tclIntType) {
-	ms = (int) objv[1]->internalRep.longValue;
-	goto processInteger;
-    }
-    argString = Tcl_GetStringFromObj(objv[1], &length);
-    if (argString[0] == '+' || argString[0] == '-'
-	|| isdigit(UCHAR(argString[0]))) {	/* INTL: digit */
-	if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
+    if (objv[1]->typePtr == &tclIntType
+#ifndef NO_WIDE_TYPE
+	|| objv[1]->typePtr == &tclWideIntType
+#endif
+	|| objv[1]->typePtr == &tclBignumType
+	|| ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, 
+				 &index) != TCL_OK )) {
+	index = -1;
+	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+	    Tcl_AppendResult(interp, "bad argument \"",
+			     Tcl_GetString(objv[1]),
+			     "\": must be cancel, idle, info, or an integer",
+			     NULL);
 	    return TCL_ERROR;
 	}
-processInteger:
+    }
+
+    /* 
+     * At this point, either index = -1 and ms contains the number of ms
+     * to wait, or else index is the index of a subcommand.
+     */
+
+    switch (index) {
+    case -1: {
 	if (ms < 0) {
 	    ms = 0;
 	}
 	if (objc == 2) {
-	    Tcl_Sleep(ms);
-	    return TCL_OK;
+	    return AfterDelay(interp, ms);
 	}
 	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
 	afterPtr->assocPtr = assocPtr;
@@ -800,135 +843,202 @@ processInteger:
  	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
 	}
 	Tcl_IncrRefCount(afterPtr->commandPtr);
+
 	/*
-	 * The variable below is used to generate unique identifiers for
-	 * after commands.  This id can wrap around, which can potentially
-	 * cause problems.  However, there are not likely to be problems
-	 * in practice, because after commands can only be requested to
-	 * about a month in the future, and wrap-around is unlikely to
-	 * occur in less than about 1-10 years.  Thus it's unlikely that
-	 * any old ids will still be around when wrap-around occurs.
+	 * The variable below is used to generate unique identifiers for after
+	 * commands. This id can wrap around, which can potentially cause
+	 * problems. However, there are not likely to be problems in practice,
+	 * because after commands can only be requested to about a month in
+	 * the future, and wrap-around is unlikely to occur in less than about
+	 * 1-10 years. Thus it's unlikely that any old ids will still be
+	 * around when wrap-around occurs.
 	 */
+
 	afterPtr->id = tsdPtr->afterId;
 	tsdPtr->afterId += 1;
-	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
-		(ClientData) afterPtr);
+	Tcl_GetTime(&wakeup);
+	wakeup.sec += (long)(ms / 1000);
+	wakeup.usec += ((long)(ms % 1000)) * 1000;
+	if (wakeup.usec > 1000000) {
+	    wakeup.sec++;
+	    wakeup.usec -= 1000000;
+	}
+	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc,
+							(ClientData) afterPtr);
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
-	sprintf(buf, "after#%d", afterPtr->id);
-	Tcl_AppendResult(interp, buf, (char *) NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
 	return TCL_OK;
     }
+    case AFTER_CANCEL: {
+	Tcl_Obj *commandPtr;
+	char *command, *tempCommand;
+	int tempLength;
 
-    /*
-     * If it's not a number it must be a subcommand.
-     */
-
-    if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",
-            0, &index) != TCL_OK) {
-	Tcl_AppendResult(interp, "bad argument \"", argString,
-		"\": must be cancel, idle, info, or a number",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-    switch ((enum afterSubCmds) index) {
-        case AFTER_CANCEL: {
-	    Tcl_Obj *commandPtr;
-	    char *command, *tempCommand;
-	    int tempLength;
-
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "id|command");
-		return TCL_ERROR;
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
+	    return TCL_ERROR;
+	}
+	if (objc == 3) {
+	    commandPtr = objv[2];
+	} else {
+	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
+	}
+	command = Tcl_GetStringFromObj(commandPtr, &length);
+	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
+		afterPtr = afterPtr->nextPtr) {
+	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
+		    &tempLength);
+	    if ((length == tempLength)
+		    && (memcmp((void*) command, (void*) tempCommand,
+			    (unsigned) length) == 0)) {
+		break;
 	    }
-	    if (objc == 3) {
-		commandPtr = objv[2];
+	}
+	if (afterPtr == NULL) {
+	    afterPtr = GetAfterEvent(assocPtr, commandPtr);
+	}
+	if (objc != 3) {
+	    Tcl_DecrRefCount(commandPtr);
+	}
+	if (afterPtr != NULL) {
+	    if (afterPtr->token != NULL) {
+		Tcl_DeleteTimerHandler(afterPtr->token);
 	    } else {
-		commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
+		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
 	    }
-	    command = Tcl_GetStringFromObj(commandPtr, &length);
-	    for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
+	    FreeAfterPtr(afterPtr);
+	}
+	break;
+    }
+    case AFTER_IDLE:
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+	    return TCL_ERROR;
+	}
+	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr->assocPtr = assocPtr;
+	if (objc == 3) {
+	    afterPtr->commandPtr = objv[2];
+	} else {
+	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
+	}
+	Tcl_IncrRefCount(afterPtr->commandPtr);
+	afterPtr->id = tsdPtr->afterId;
+	tsdPtr->afterId += 1;
+	afterPtr->token = NULL;
+	afterPtr->nextPtr = assocPtr->firstAfterPtr;
+	assocPtr->firstAfterPtr = afterPtr;
+	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
+	break;
+    case AFTER_INFO: {
+	Tcl_Obj *resultListPtr;
+
+	if (objc == 2) {
+	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
 		    afterPtr = afterPtr->nextPtr) {
-		tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
-			&tempLength);
-		if ((length == tempLength)
-		        && (memcmp((void*) command, (void*) tempCommand,
-			        (unsigned) length) == 0)) {
-		    break;
-		}
-	    }
-	    if (afterPtr == NULL) {
-		afterPtr = GetAfterEvent(assocPtr, commandPtr);
-	    }
-	    if (objc != 3) {
-		Tcl_DecrRefCount(commandPtr);
-	    }
-	    if (afterPtr != NULL) {
-		if (afterPtr->token != NULL) {
-		    Tcl_DeleteTimerHandler(afterPtr->token);
-		} else {
-		    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+		if (assocPtr->interp == interp) {
+		    sprintf(buf, "after#%d", afterPtr->id);
+		    Tcl_AppendElement(interp, buf);
 		}
-		FreeAfterPtr(afterPtr);
 	    }
-	    break;
+	    return TCL_OK;
+	}
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
+	    return TCL_ERROR;
+	}
+	afterPtr = GetAfterEvent(assocPtr, objv[2]);
+	if (afterPtr == NULL) {
+	    Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]),
+		    "\" doesn't exist", NULL);
+	    return TCL_ERROR;
 	}
-	case AFTER_IDLE:
-	    if (objc < 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+	resultListPtr = Tcl_NewObj();
+	Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
+	Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ 		(afterPtr->token == NULL) ? "idle" : "timer", -1));
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
+    default:
+	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AfterDelay --
+ *
+ *	Implements the blocking delay behaviour of [after $time]. Tricky
+ *	because it has to take into account any time limit that has been set.
+ *
+ * Results:
+ *	Standard Tcl result code (with error set if an error occurred due to a
+ *	time limit being exceeded).
+ *
+ * Side effects:
+ *	May adjust the time limit granularity marker.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AfterDelay(
+    Tcl_Interp *interp,
+    Tcl_WideInt ms)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    Tcl_Time endTime, now;
+    Tcl_WideInt diff;
+
+    Tcl_GetTime(&endTime);
+    endTime.sec += (long)(ms/1000);
+    endTime.usec += ((int)(ms%1000))*1000;
+    if (endTime.usec >= 1000000) {
+	endTime.sec++;
+	endTime.usec -= 1000000;
+    }
+
+    do {
+	Tcl_GetTime(&now);
+	if (iPtr->limit.timeEvent != NULL
+	    && TCL_TIME_BEFORE(iPtr->limit.time, now)) {
+	    iPtr->limit.granularityTicker = 0;
+	    if (Tcl_LimitCheck(interp) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
-	    afterPtr->assocPtr = assocPtr;
-	    if (objc == 3) {
- 		afterPtr->commandPtr = objv[2];
-	    } else {
-		afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
+	}
+	if (iPtr->limit.timeEvent == NULL
+	    || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
+	    diff = TCL_TIME_DIFF_MS(endTime, now);
+#ifndef TCL_WIDE_INT_IS_LONG
+	    if (diff > LONG_MAX) {
+		diff = LONG_MAX;
 	    }
-	    Tcl_IncrRefCount(afterPtr->commandPtr);
-	    afterPtr->id = tsdPtr->afterId;
-	    tsdPtr->afterId += 1;
-	    afterPtr->token = NULL;
-	    afterPtr->nextPtr = assocPtr->firstAfterPtr;
-	    assocPtr->firstAfterPtr = afterPtr;
-	    Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
-	    sprintf(buf, "after#%d", afterPtr->id);
-	    Tcl_AppendResult(interp, buf, (char *) NULL);
-	    break;
-	case AFTER_INFO: {
-	    Tcl_Obj *resultListPtr;
-
-	    if (objc == 2) {
-		for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
-		     afterPtr = afterPtr->nextPtr) {
-		    if (assocPtr->interp == interp) {
-			sprintf(buf, "after#%d", afterPtr->id);
-			Tcl_AppendElement(interp, buf);
-		    }
-		}
-		return TCL_OK;
+#endif
+	    if (diff > 0) {
+		Tcl_Sleep((long)diff);
 	    }
-	    if (objc != 3) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?id?");
-		return TCL_ERROR;
+	} else {
+	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
+#ifndef TCL_WIDE_INT_IS_LONG
+	    if (diff > LONG_MAX) {
+		diff = LONG_MAX;
 	    }
-	    afterPtr = GetAfterEvent(assocPtr, objv[2]);
-	    if (afterPtr == NULL) {
-		Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
-			"\" doesn't exist", (char *) NULL);
+#endif
+	    if (diff > 0) {
+		Tcl_Sleep((long)diff);
+	    }
+	    if (Tcl_LimitCheck(interp) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    resultListPtr = Tcl_GetObjResult(interp);
- 	    Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
- 	    Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- 		(afterPtr->token == NULL) ? "idle" : "timer", -1));
-	    Tcl_SetObjResult(interp, resultListPtr);
-	    break;
-	}
-	default: {
-	    panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
 	}
-    }
+    } while (TCL_TIME_BEFORE(now, endTime));
     return TCL_OK;
 }
 
@@ -937,13 +1047,13 @@ processInteger:
  *
  * GetAfterEvent --
  *
- *	This procedure parses an "after" id such as "after#4" and
- *	returns a pointer to the AfterInfo structure.
+ *	This function parses an "after" id such as "after#4" and returns a
+ *	pointer to the AfterInfo structure.
  *
  * Results:
- *	The return value is either a pointer to an AfterInfo structure,
- *	if one is found that corresponds to "cmdString" and is for interp,
- *	or NULL if no corresponding after event can be found.
+ *	The return value is either a pointer to an AfterInfo structure, if one
+ *	is found that corresponds to "cmdString" and is for interp, or NULL if
+ *	no corresponding after event can be found.
  *
  * Side effects:
  *	None.
@@ -952,18 +1062,18 @@ processInteger:
  */
 
 static AfterInfo *
-GetAfterEvent(assocPtr, commandPtr)
-    AfterAssocData *assocPtr;	/* Points to "after"-related information for
+GetAfterEvent(
+    AfterAssocData *assocPtr,	/* Points to "after"-related information for
 				 * this interpreter. */
-    Tcl_Obj *commandPtr;
+    Tcl_Obj *commandPtr)
 {
-    char *cmdString;		/* Textual identifier for after event, such
-				 * as "after#6". */
+    char *cmdString;		/* Textual identifier for after event, such as
+				 * "after#6". */
     AfterInfo *afterPtr;
     int id;
     char *end;
 
-    cmdString = Tcl_GetString(commandPtr);
+    cmdString = TclGetString(commandPtr);
     if (strncmp(cmdString, "after#", 6) != 0) {
 	return NULL;
     }
@@ -986,37 +1096,34 @@ GetAfterEvent(assocPtr, commandPtr)
  *
  * AfterProc --
  *
- *	Timer callback to execute commands registered with the
- *	"after" command.
+ *	Timer callback to execute commands registered with the "after"
+ *	command.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Executes whatever command was specified.  If the command
- *	returns an error, then the command "bgerror" is invoked
- *	to process the error;  if bgerror fails then information
- *	about the error is output on stderr.
+ *	Executes whatever command was specified. If the command returns an
+ *	error, then the command "bgerror" is invoked to process the error; if
+ *	bgerror fails then information about the error is output on stderr.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-AfterProc(clientData)
-    ClientData clientData;	/* Describes command to execute. */
+AfterProc(
+    ClientData clientData)	/* Describes command to execute. */
 {
     AfterInfo *afterPtr = (AfterInfo *) clientData;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
     AfterInfo *prevPtr;
     int result;
     Tcl_Interp *interp;
-    char *script;
-    int numBytes;
 
     /*
-     * First remove the callback from our list of callbacks;  otherwise
-     * someone could delete the callback while it's being executed, which
-     * could cause a core dump.
+     * First remove the callback from our list of callbacks; otherwise someone
+     * could delete the callback while it's being executed, which could cause
+     * a core dump.
      */
 
     if (assocPtr->firstAfterPtr == afterPtr) {
@@ -1035,14 +1142,13 @@ AfterProc(clientData)
 
     interp = assocPtr->interp;
     Tcl_Preserve((ClientData) interp);
-    script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
-    result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
+    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	Tcl_BackgroundError(interp);
+	TclBackgroundException(interp, result);
     }
     Tcl_Release((ClientData) interp);
-    
+
     /*
      * Free the memory for the callback.
      */
@@ -1056,10 +1162,9 @@ AfterProc(clientData)
  *
  * FreeAfterPtr --
  *
- *	This procedure removes an "after" command from the list of
- *	those that are pending and frees its resources.  This procedure
- *	does *not* cancel the timer handler;  if that's needed, the
- *	caller must do it.
+ *	This function removes an "after" command from the list of those that
+ *	are pending and frees its resources. This function does *not* cancel
+ *	the timer handler; if that's needed, the caller must do it.
  *
  * Results:
  *	None.
@@ -1071,8 +1176,8 @@ AfterProc(clientData)
  */
 
 static void
-FreeAfterPtr(afterPtr)
-    AfterInfo *afterPtr;		/* Command to be deleted. */
+FreeAfterPtr(
+    AfterInfo *afterPtr)		/* Command to be deleted. */
 {
     AfterInfo *prevPtr;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
@@ -1095,7 +1200,7 @@ FreeAfterPtr(afterPtr)
  *
  * AfterCleanupProc --
  *
- *	This procedure is invoked whenever an interpreter is deleted
+ *	This function is invoked whenever an interpreter is deleted
  *	to cleanup the AssocData for "tclAfter".
  *
  * Results:
@@ -1109,10 +1214,10 @@ FreeAfterPtr(afterPtr)
 
 	/* ARGSUSED */
 static void
-AfterCleanupProc(clientData, interp)
-    ClientData clientData;	/* Points to AfterAssocData for the
+AfterCleanupProc(
+    ClientData clientData,	/* Points to AfterAssocData for the
 				 * interpreter. */
-    Tcl_Interp *interp;		/* Interpreter that is being deleted. */
+    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
 {
     AfterAssocData *assocPtr = (AfterAssocData *) clientData;
     AfterInfo *afterPtr;
@@ -1130,3 +1235,11 @@ AfterCleanupProc(clientData, interp)
     }
     ckfree((char *) assocPtr);
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
new file mode 100644
index 0000000..1bfc443
--- /dev/null
+++ b/generic/tclTomMath.decls
@@ -0,0 +1,222 @@
+# tclTomMath.decls --
+#
+#	This file contains the declarations for the functions in
+#	'libtommath' that are contained within the Tcl library.
+#	This file is used to generate the 'tclTomMathDecls.h' and
+#	'tclTomMathStub.c' files.
+#
+# If you edit this file, advance the revision number (and the epoch
+# if the new stubs are not backward compatible) in tclTomMathDecls.h
+#
+# Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+library tcl
+
+# Define the unsupported generic interfaces.
+
+interface tclTomMath
+# hooks {tclTomMathInt}
+
+# Declare each of the functions in the Tcl tommath interface
+
+declare 0 generic {
+    int TclBN_epoch(void)
+}
+declare 1 generic {
+    int TclBN_revision(void)
+}
+
+declare 2 generic {
+    int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 3 generic {
+    int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 4 generic {
+    int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 5 generic {
+    void TclBN_mp_clamp(mp_int *a)
+}
+declare 6 generic {
+    void TclBN_mp_clear(mp_int *a)
+}
+declare 7 generic {
+    void TclBN_mp_clear_multi(mp_int *a, ...)
+}
+declare 8 generic {
+    int TclBN_mp_cmp(mp_int *a, mp_int *b)
+}
+declare 9 generic {
+    int TclBN_mp_cmp_d(mp_int *a, mp_digit b)
+}
+declare 10 generic {
+    int TclBN_mp_cmp_mag(mp_int *a, mp_int *b)
+}
+declare 11 generic {
+    int TclBN_mp_copy(mp_int *a, mp_int *b)
+}
+declare 12 generic {
+    int TclBN_mp_count_bits(mp_int *a)
+}
+declare 13 generic {
+    int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
+}
+declare 14 generic {
+    int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
+}
+declare 15 generic {
+    int TclBN_mp_div_2(mp_int *a, mp_int *q)
+}
+declare 16 generic {
+    int TclBN_mp_div_2d(mp_int *a, int b, mp_int *q, mp_int *r)
+}
+declare 17 generic {
+    int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
+}
+declare 18 generic {
+    void TclBN_mp_exch(mp_int *a, mp_int *b)
+}
+declare 19 generic {
+    int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 20 generic {
+    int TclBN_mp_grow(mp_int *a, int size)
+}
+declare 21 generic {
+    int TclBN_mp_init(mp_int *a)
+}
+declare 22 generic {
+    int TclBN_mp_init_copy(mp_int *a, mp_int *b)
+}
+declare 23 generic {
+    int TclBN_mp_init_multi(mp_int *a, ...)
+}
+declare 24 generic {
+    int TclBN_mp_init_set(mp_int *a, mp_digit b)
+}
+declare 25 generic {
+    int TclBN_mp_init_size(mp_int *a, int size)
+}
+declare 26 generic {
+    int TclBN_mp_lshd(mp_int *a, int shift)
+}
+declare 27 generic {
+    int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
+}
+declare 28 generic {
+    int TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r)
+}
+declare 29 generic {
+    int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
+}
+declare 30 generic {
+    int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
+}
+declare 31 generic {
+    int TclBN_mp_mul_2(mp_int *a, mp_int *p)
+}
+declare 32 generic {
+    int TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p)
+}
+declare 33 generic {
+    int TclBN_mp_neg(mp_int *a, mp_int *b)
+}
+declare 34 generic {
+    int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 35 generic {
+    int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
+}
+declare 36 generic {
+    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
+}
+declare 37 generic {
+    void TclBN_mp_rshd(mp_int *a, int shift)
+}
+declare 38 generic {
+    int TclBN_mp_shrink(mp_int *a)
+}
+declare 39 generic {
+    void TclBN_mp_set(mp_int *a, mp_digit b)
+}
+declare 40 generic {
+    int TclBN_mp_sqr(mp_int *a, mp_int *b)
+}
+declare 41 generic {
+    int TclBN_mp_sqrt(mp_int *a, mp_int *b)
+}
+declare 42 generic {
+    int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 43 generic {
+    int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
+}
+declare 44 generic {
+    int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
+}
+declare 45 generic {
+    int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
+	    unsigned long *outlen)
+}
+declare 46 generic {
+    int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
+}
+declare 47 generic {
+    int TclBN_mp_unsigned_bin_size(mp_int *a)
+}
+declare 48 generic {
+    int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 49 generic {
+    void TclBN_mp_zero(mp_int *a)
+}
+
+# internal routines to libtommath - should not be called but must be
+# exported to accommodate the "tommath" extension
+
+declare 50 generic {
+    void TclBN_reverse(unsigned char *s, int len)
+}
+declare 51 generic {
+    int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
+}
+declare 52 generic {
+    int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
+}
+declare 53 generic {
+    int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 54 generic {
+    int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
+}
+declare 55 generic {
+    int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 56 generic {
+    int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
+}
+declare 57 generic {
+    int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 58 generic {
+    int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
+}
+declare 59 generic {
+    int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
+}
+declare 60 generic {
+    int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
+}
+declare 61 {
+    int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
+}
+declare 62 {
+    int TclBN_mp_set_int(mp_int *a, unsigned long i)
+}
+declare 63 {
+    int TclBN_mp_cnt_lsb(mp_int *a)
+}
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
new file mode 100644
index 0000000..550dafa
--- /dev/null
+++ b/generic/tclTomMath.h
@@ -0,0 +1,836 @@
+/* LibTomMath, multiple-precision integer library -- Tom St Denis
+ *
+ * LibTomMath is a library that provides multiple-precision
+ * integer arithmetic as well as number theoretic functionality.
+ *
+ * The library was designed directly after the MPI library by
+ * Michael Fromberger but has been written from scratch with
+ * additional optimizations in place.
+ *
+ * The library is free for all purposes without any express
+ * guarantee it works.
+ *
+ * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
+ */
+#ifndef BN_H_
+#define BN_H_
+
+#include <tclTomMathDecls.h>
+#ifndef MODULE_SCOPE
+#define MODULE_SCOPE extern
+#endif
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <limits.h>
+
+#ifndef MIN
+   #define MIN(x,y) ((x)<(y)?(x):(y))
+#endif
+
+#ifndef MAX
+   #define MAX(x,y) ((x)>(y)?(x):(y))
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+
+/* C++ compilers don't like assigning void * to mp_digit * */
+#define  OPT_CAST(x)  (x *)
+
+#else
+
+/* C on the other hand doesn't care */
+#define  OPT_CAST(x)
+
+#endif
+
+
+/* detect 64-bit mode if possible */
+#if defined(NEVER)  /* 128-bit ints fail in too many places */
+   #if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
+      #define MP_64BIT
+   #endif
+#endif
+
+/* some default configurations.
+ *
+ * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
+ * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
+ *
+ * At the very least a mp_digit must be able to hold 7 bits
+ * [any size beyond that is ok provided it doesn't overflow the data type]
+ */
+#ifdef MP_8BIT
+#ifndef MP_DIGIT_DECLARED
+   typedef unsigned char      mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+   typedef unsigned short     mp_word;
+#elif defined(MP_16BIT)
+#ifndef MP_DIGIT_DECLARED
+   typedef unsigned short     mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+   typedef unsigned long      mp_word;
+#elif defined(MP_64BIT)
+   /* for GCC only on supported platforms */
+#ifndef CRYPT
+   typedef unsigned long long ulong64;
+   typedef signed long long   long64;
+#endif
+
+#ifndef MP_DIGIT_DECLARED
+   typedef unsigned long      mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+   typedef unsigned long      mp_word __attribute__ ((mode(TI)));
+
+   #define DIGIT_BIT          60
+#else
+   /* this is the default case, 28-bit digits */
+   
+   /* this is to make porting into LibTomCrypt easier :-) */
+#ifndef CRYPT
+   #if defined(_MSC_VER) || defined(__BORLANDC__) 
+      typedef unsigned __int64   ulong64;
+      typedef signed __int64     long64;
+   #else
+      typedef unsigned long long ulong64;
+      typedef signed long long   long64;
+   #endif
+#endif
+
+#ifndef MP_DIGIT_DECLARED
+   typedef unsigned int      mp_digit;
+#define MP_DIGIT_DECLARED
+#endif
+   typedef ulong64            mp_word;
+
+#ifdef MP_31BIT   
+   /* this is an extension that uses 31-bit digits */
+   #define DIGIT_BIT          31
+#else
+   /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
+   #define DIGIT_BIT          28
+   #define MP_28BIT
+#endif   
+#endif
+
+/* define heap macros */
+#if 0 /* these are macros in tclTomMathDecls.h */
+#ifndef CRYPT
+   /* default to libc stuff */
+   #ifndef XMALLOC 
+       #define XMALLOC  malloc
+       #define XFREE    free
+       #define XREALLOC realloc
+       #define XCALLOC  calloc
+   #else
+      /* prototypes for our heap functions */
+      extern void *XMALLOC(size_t n);
+      extern void *XREALLOC(void *p, size_t n);
+      extern void *XCALLOC(size_t n, size_t s);
+      extern void XFREE(void *p);
+   #endif
+#endif
+#endif
+
+
+/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
+#ifndef DIGIT_BIT
+   #define DIGIT_BIT     ((int)((CHAR_BIT * sizeof(mp_digit) - 1)))  /* bits per digit */
+#endif
+
+#define MP_DIGIT_BIT     DIGIT_BIT
+#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
+#define MP_DIGIT_MAX     MP_MASK
+
+/* equalities */
+#define MP_LT        -1   /* less than */
+#define MP_EQ         0   /* equal to */
+#define MP_GT         1   /* greater than */
+
+#define MP_ZPOS       0   /* positive integer */
+#define MP_NEG        1   /* negative */
+
+#define MP_OKAY       0   /* ok result */
+#define MP_MEM        -2  /* out of mem */
+#define MP_VAL        -3  /* invalid input */
+#define MP_RANGE      MP_VAL
+
+#define MP_YES        1   /* yes response */
+#define MP_NO         0   /* no response */
+
+/* Primality generation flags */
+#define LTM_PRIME_BBS      0x0001 /* BBS style prime */
+#define LTM_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
+#define LTM_PRIME_2MSB_ON  0x0008 /* force 2nd MSB to 1 */
+
+typedef int           mp_err;
+
+/* you'll have to tune these... */
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
+           KARATSUBA_SQR_CUTOFF,
+           TOOM_MUL_CUTOFF,
+           TOOM_SQR_CUTOFF;
+#endif
+
+/* define this to use lower memory usage routines (exptmods mostly) */
+/* #define MP_LOW_MEM */
+
+/* default precision */
+#ifndef MP_PREC
+   #ifndef MP_LOW_MEM
+      #define MP_PREC                 32     /* default digits of precision */
+   #else
+      #define MP_PREC                 8      /* default digits of precision */
+   #endif   
+#endif
+
+/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
+#define MP_WARRAY               (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
+
+/* the infamous mp_int structure */
+#ifndef MP_INT_DECLARED
+#define MP_INT_DECLARED
+typedef struct mp_int mp_int;
+#endif
+struct mp_int {
+    int used, alloc, sign;
+    mp_digit *dp;
+};
+
+/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
+typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
+
+
+#define USED(m)    ((m)->used)
+#define DIGIT(m,k) ((m)->dp[(k)])
+#define SIGN(m)    ((m)->sign)
+
+/* error code to char* string */
+/*
+char *mp_error_to_string(int code);
+*/
+
+/* ---> init and deinit bignum functions <--- */
+/* init a bignum */
+/*
+int mp_init(mp_int *a);
+*/
+
+/* free a bignum */
+/*
+void mp_clear(mp_int *a);
+*/
+
+/* init a null terminated series of arguments */
+/*
+int mp_init_multi(mp_int *mp, ...);
+*/
+
+/* clear a null terminated series of arguments */
+/*
+void mp_clear_multi(mp_int *mp, ...);
+*/
+
+/* exchange two ints */
+/*
+void mp_exch(mp_int *a, mp_int *b);
+*/
+
+/* shrink ram required for a bignum */
+/*
+int mp_shrink(mp_int *a);
+*/
+
+/* grow an int to a given size */
+/*
+int mp_grow(mp_int *a, int size);
+*/
+
+/* init to a given number of digits */
+/*
+int mp_init_size(mp_int *a, int size);
+*/
+
+/* ---> Basic Manipulations <--- */
+#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
+#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
+#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
+
+/* set to zero */
+/*
+void mp_zero(mp_int *a);
+*/
+
+/* set to a digit */
+/*
+void mp_set(mp_int *a, mp_digit b);
+*/
+
+/* set a 32-bit const */
+/*
+int mp_set_int(mp_int *a, unsigned long b);
+*/
+
+/* get a 32-bit value */
+unsigned long mp_get_int(mp_int * a);
+
+/* initialize and set a digit */
+/*
+int mp_init_set (mp_int * a, mp_digit b);
+*/
+
+/* initialize and set 32-bit value */
+/*
+int mp_init_set_int (mp_int * a, unsigned long b);
+*/
+
+/* copy, b = a */
+/*
+int mp_copy(mp_int *a, mp_int *b);
+*/
+
+/* inits and copies, a = b */
+/*
+int mp_init_copy(mp_int *a, mp_int *b);
+*/
+
+/* trim unused digits */
+/*
+void mp_clamp(mp_int *a);
+*/
+
+/* ---> digit manipulation <--- */
+
+/* right shift by "b" digits */
+/*
+void mp_rshd(mp_int *a, int b);
+*/
+
+/* left shift by "b" digits */
+/*
+int mp_lshd(mp_int *a, int b);
+*/
+
+/* c = a / 2**b */
+/*
+int mp_div_2d(mp_int *a, int b, mp_int *c, mp_int *d);
+*/
+
+/* b = a/2 */
+/*
+int mp_div_2(mp_int *a, mp_int *b);
+*/
+
+/* c = a * 2**b */
+/*
+int mp_mul_2d(mp_int *a, int b, mp_int *c);
+*/
+
+/* b = a*2 */
+/*
+int mp_mul_2(mp_int *a, mp_int *b);
+*/
+
+/* c = a mod 2**d */
+/*
+int mp_mod_2d(mp_int *a, int b, mp_int *c);
+*/
+
+/* computes a = 2**b */
+/*
+int mp_2expt(mp_int *a, int b);
+*/
+
+/* Counts the number of lsbs which are zero before the first zero bit */
+/*
+int mp_cnt_lsb(mp_int *a);
+*/
+
+/* I Love Earth! */
+
+/* makes a pseudo-random int of a given size */
+/*
+int mp_rand(mp_int *a, int digits);
+*/
+
+/* ---> binary operations <--- */
+/* c = a XOR b  */
+/*
+int mp_xor(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a OR b */
+/*
+int mp_or(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a AND b */
+/*
+int mp_and(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* ---> Basic arithmetic <--- */
+
+/* b = -a */
+/*
+int mp_neg(mp_int *a, mp_int *b);
+*/
+
+/* b = |a| */
+/*
+int mp_abs(mp_int *a, mp_int *b);
+*/
+
+/* compare a to b */
+/*
+int mp_cmp(mp_int *a, mp_int *b);
+*/
+
+/* compare |a| to |b| */
+/*
+int mp_cmp_mag(mp_int *a, mp_int *b);
+*/
+
+/* c = a + b */
+/*
+int mp_add(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a - b */
+/*
+int mp_sub(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = a * b */
+/*
+int mp_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* b = a*a  */
+/*
+int mp_sqr(mp_int *a, mp_int *b);
+*/
+
+/* a/b => cb + d == a */
+/*
+int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* c = a mod b, 0 <= c < b  */
+/*
+int mp_mod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* ---> single digit functions <--- */
+
+/* compare against a single digit */
+/*
+int mp_cmp_d(mp_int *a, mp_digit b);
+*/
+
+/* c = a + b */
+/*
+int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a - b */
+/*
+int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a * b */
+/*
+int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* a/b => cb + d == a */
+/*
+int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
+*/
+
+/* a/3 => 3c + d == a */
+/*
+int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
+*/
+
+/* c = a**b */
+/*
+int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* c = a mod b, 0 <= c < b  */
+/*
+int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
+*/
+
+/* ---> number theory <--- */
+
+/* d = a + b (mod c) */
+/*
+int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* d = a - b (mod c) */
+/*
+int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* d = a * b (mod c) */
+/*
+int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* c = a * a (mod b) */
+/*
+int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = 1/a (mod b) */
+/*
+int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* c = (a, b) */
+/*
+int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* produces value such that U1*a + U2*b = U3 */
+/*
+int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
+*/
+
+/* c = [a, b] or (a*b)/(a, b) */
+/*
+int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* finds one of the b'th root of a, such that |c|**b <= |a|
+ *
+ * returns error if a < 0 and b is even
+ */
+/*
+int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
+*/
+
+/* special sqrt algo */
+/*
+int mp_sqrt(mp_int *arg, mp_int *ret);
+*/
+
+/* is number a square? */
+/*
+int mp_is_square(mp_int *arg, int *ret);
+*/
+
+/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
+/*
+int mp_jacobi(mp_int *a, mp_int *n, int *c);
+*/
+
+/* used to setup the Barrett reduction for a given modulus b */
+/*
+int mp_reduce_setup(mp_int *a, mp_int *b);
+*/
+
+/* Barrett Reduction, computes a (mod b) with a precomputed value c
+ *
+ * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
+ * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
+ */
+/*
+int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
+*/
+
+/* setups the montgomery reduction */
+/*
+int mp_montgomery_setup(mp_int *a, mp_digit *mp);
+*/
+
+/* computes a = B**n mod b without division or multiplication useful for
+ * normalizing numbers in a Montgomery system.
+ */
+/*
+int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
+*/
+
+/* computes x/R == x (mod N) via Montgomery Reduction */
+/*
+int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
+*/
+
+/* returns 1 if a is a valid DR modulus */
+/*
+int mp_dr_is_modulus(mp_int *a);
+*/
+
+/* sets the value of "d" required for mp_dr_reduce */
+/*
+void mp_dr_setup(mp_int *a, mp_digit *d);
+*/
+
+/* reduces a modulo b using the Diminished Radix method */
+/*
+int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
+*/
+
+/* returns true if a can be reduced with mp_reduce_2k */
+/*
+int mp_reduce_is_2k(mp_int *a);
+*/
+
+/* determines k value for 2k reduction */
+/*
+int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
+*/
+
+/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
+/*
+int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
+*/
+
+/* returns true if a can be reduced with mp_reduce_2k_l */
+/*
+int mp_reduce_is_2k_l(mp_int *a);
+*/
+
+/* determines k value for 2k reduction */
+/*
+int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
+*/
+
+/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
+/*
+int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
+*/
+
+/* d = a**b (mod c) */
+/*
+int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
+*/
+
+/* ---> Primes <--- */
+
+/* number of primes */
+#ifdef MP_8BIT
+   #define PRIME_SIZE      31
+#else
+   #define PRIME_SIZE      256
+#endif
+
+/* table of first PRIME_SIZE primes */
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE const mp_digit ltm_prime_tab[];
+#endif
+
+/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
+/*
+int mp_prime_is_divisible(mp_int *a, int *result);
+*/
+
+/* performs one Fermat test of "a" using base "b".
+ * Sets result to 0 if composite or 1 if probable prime
+ */
+/*
+int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
+*/
+
+/* performs one Miller-Rabin test of "a" using base "b".
+ * Sets result to 0 if composite or 1 if probable prime
+ */
+/*
+int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
+*/
+
+/* This gives [for a given bit size] the number of trials required
+ * such that Miller-Rabin gives a prob of failure lower than 2^-96 
+ */
+/*
+int mp_prime_rabin_miller_trials(int size);
+*/
+
+/* performs t rounds of Miller-Rabin on "a" using the first
+ * t prime bases.  Also performs an initial sieve of trial
+ * division.  Determines if "a" is prime with probability
+ * of error no more than (1/4)**t.
+ *
+ * Sets result to 1 if probably prime, 0 otherwise
+ */
+/*
+int mp_prime_is_prime(mp_int *a, int t, int *result);
+*/
+
+/* finds the next prime after the number "a" using "t" trials
+ * of Miller-Rabin.
+ *
+ * bbs_style = 1 means the prime must be congruent to 3 mod 4
+ */
+/*
+int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
+*/
+
+/* makes a truly random prime of a given size (bytes),
+ * call with bbs = 1 if you want it to be congruent to 3 mod 4 
+ *
+ * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
+ * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
+ * so it can be NULL
+ *
+ * The prime generated will be larger than 2^(8*size).
+ */
+#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)
+
+/* makes a truly random prime of a given size (bits),
+ *
+ * Flags are as follows:
+ * 
+ *   LTM_PRIME_BBS      - make prime congruent to 3 mod 4
+ *   LTM_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
+ *   LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
+ *   LTM_PRIME_2MSB_ON  - make the 2nd highest bit one
+ *
+ * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
+ * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
+ * so it can be NULL
+ *
+ */
+/*
+int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
+*/
+
+/* ---> radix conversion <--- */
+/*
+int mp_count_bits(mp_int *a);
+*/
+
+/*
+int mp_unsigned_bin_size(mp_int *a);
+*/
+/*
+int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
+*/
+/*
+int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
+*/
+/*
+int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
+*/
+
+/*
+int mp_signed_bin_size(mp_int *a);
+*/
+/*
+int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
+*/
+/*
+int mp_to_signed_bin(mp_int *a,  unsigned char *b);
+*/
+/*
+int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
+*/
+
+/*
+int mp_read_radix(mp_int *a, const char *str, int radix);
+*/
+/*
+int mp_toradix(mp_int *a, char *str, int radix);
+*/
+/*
+int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
+*/
+/*
+int mp_radix_size(mp_int *a, int radix, int *size);
+*/
+
+/*
+int mp_fread(mp_int *a, int radix, FILE *stream);
+*/
+/*
+int mp_fwrite(mp_int *a, int radix, FILE *stream);
+*/
+
+#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
+#define mp_raw_size(mp)           mp_signed_bin_size(mp)
+#define mp_toraw(mp, str)         mp_to_signed_bin((mp), (str))
+#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
+#define mp_mag_size(mp)           mp_unsigned_bin_size(mp)
+#define mp_tomag(mp, str)         mp_to_unsigned_bin((mp), (str))
+
+#define mp_tobinary(M, S)  mp_toradix((M), (S), 2)
+#define mp_tooctal(M, S)   mp_toradix((M), (S), 8)
+#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
+#define mp_tohex(M, S)     mp_toradix((M), (S), 16)
+
+/* lowlevel functions, do not call! */
+/*
+int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+*/
+#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
+/*
+int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
+*/
+/*
+int fast_s_mp_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int s_mp_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_karatsuba_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int mp_toom_sqr(mp_int *a, mp_int *b);
+*/
+/*
+int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
+*/
+/*
+int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
+*/
+/*
+int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
+*/
+/*
+int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
+*/
+/*
+int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
+*/
+/*
+void bn_reverse(unsigned char *s, int len);
+*/
+
+#if defined(BUILD_tcl) || !defined(_WIN32)
+MODULE_SCOPE const char *mp_s_rmap;
+#endif
+
+#ifdef __cplusplus
+   }
+#endif
+
+#endif
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
new file mode 100644
index 0000000..04a23f3
--- /dev/null
+++ b/generic/tclTomMathDecls.h
@@ -0,0 +1,819 @@
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclTomMathDecls.h --
+ *
+ *	This file contains the declarations for the 'libtommath'
+ *	functions that are exported by the Tcl library.
+ *
+ * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLTOMMATHDECLS
+#define _TCLTOMMATHDECLS
+
+#include "tcl.h"
+
+/*
+ * Define the version of the Stubs table that's exported for tommath
+ */
+
+#define TCLTOMMATH_EPOCH 0
+#define TCLTOMMATH_REVISION 0
+
+#define Tcl_TomMath_InitStubs(interp,version) \
+    (TclTomMathInitializeStubs((interp),(version),\
+                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))
+
+/* Define custom memory allocation for libtommath */
+
+/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
+#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
+/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
+#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
+/* MODULE_SCOPE void  TclBNFree( void* ); */
+#define TclBNFree(x) (ckfree((char*)(x)))
+/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
+/* unused - no macro */
+
+#define XMALLOC(x) TclBNAlloc(x)
+#define XFREE(x) TclBNFree(x)
+#define XREALLOC(x,n) TclBNRealloc(x,n)
+#define XCALLOC(n,x) TclBNCalloc(n,x)
+
+/* Rename the global symbols in libtommath to avoid linkage conflicts */
+
+#define KARATSUBA_MUL_CUTOFF TclBNKaratsubaMulCutoff
+#define KARATSUBA_SQR_CUTOFF TclBNKaratsubaSqrCutoff
+#define TOOM_MUL_CUTOFF TclBNToomMulCutoff
+#define TOOM_SQR_CUTOFF TclBNToomSqrCutoff
+
+#define bn_reverse TclBN_reverse
+#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
+#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
+#define mp_add TclBN_mp_add
+#define mp_add_d TclBN_mp_add_d
+#define mp_and TclBN_mp_and
+#define mp_clamp TclBN_mp_clamp
+#define mp_clear TclBN_mp_clear
+#define mp_clear_multi TclBN_mp_clear_multi
+#define mp_cmp TclBN_mp_cmp
+#define mp_cmp_d TclBN_mp_cmp_d
+#define mp_cmp_mag TclBN_mp_cmp_mag
+#define mp_cnt_lsb TclBN_mp_cnt_lsb
+#define mp_copy TclBN_mp_copy
+#define mp_count_bits TclBN_mp_count_bits
+#define mp_div TclBN_mp_div
+#define mp_div_2 TclBN_mp_div_2
+#define mp_div_2d TclBN_mp_div_2d
+#define mp_div_3 TclBN_mp_div_3
+#define mp_div_d TclBN_mp_div_d
+#define mp_exch TclBN_mp_exch
+#define mp_expt_d TclBN_mp_expt_d
+#define mp_grow TclBN_mp_grow
+#define mp_init TclBN_mp_init
+#define mp_init_copy TclBN_mp_init_copy
+#define mp_init_multi TclBN_mp_init_multi
+#define mp_init_set TclBN_mp_init_set
+#define mp_init_set_int TclBN_mp_init_set_int
+#define mp_init_size TclBN_mp_init_size
+#define mp_karatsuba_mul TclBN_mp_karatsuba_mul
+#define mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
+#define mp_lshd TclBN_mp_lshd
+#define mp_mod TclBN_mp_mod
+#define mp_mod_2d TclBN_mp_mod_2d
+#define mp_mul TclBN_mp_mul
+#define mp_mul_2 TclBN_mp_mul_2
+#define mp_mul_2d TclBN_mp_mul_2d
+#define mp_mul_d TclBN_mp_mul_d
+#define mp_neg TclBN_mp_neg
+#define mp_or TclBN_mp_or
+#define mp_radix_size TclBN_mp_radix_size
+#define mp_read_radix TclBN_mp_read_radix
+#define mp_rshd TclBN_mp_rshd
+#define mp_s_rmap TclBNMpSRmap
+#define mp_set TclBN_mp_set
+#define mp_set_int TclBN_mp_set_int
+#define mp_shrink TclBN_mp_shrink
+#define mp_sqr TclBN_mp_sqr
+#define mp_sqrt TclBN_mp_sqrt
+#define mp_sub TclBN_mp_sub
+#define mp_sub_d TclBN_mp_sub_d
+#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
+#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
+#define mp_toom_mul TclBN_mp_toom_mul
+#define mp_toom_sqr TclBN_mp_toom_sqr
+#define mp_toradix_n TclBN_mp_toradix_n
+#define mp_unsigned_bin_size TclBN_mp_unsigned_bin_size
+#define mp_xor TclBN_mp_xor
+#define mp_zero TclBN_mp_zero
+#define s_mp_add TclBN_s_mp_add
+#define s_mp_mul_digs TclBN_s_mp_mul_digs
+#define s_mp_sqr TclBN_s_mp_sqr
+#define s_mp_sub TclBN_s_mp_sub
+
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script.  Any modifications to the function declarations below should be made
+ * in the generic/tclInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#ifndef TclBN_epoch_TCL_DECLARED
+#define TclBN_epoch_TCL_DECLARED
+/* 0 */
+EXTERN int		TclBN_epoch(void);
+#endif
+#ifndef TclBN_revision_TCL_DECLARED
+#define TclBN_revision_TCL_DECLARED
+/* 1 */
+EXTERN int		TclBN_revision(void);
+#endif
+#ifndef TclBN_mp_add_TCL_DECLARED
+#define TclBN_mp_add_TCL_DECLARED
+/* 2 */
+EXTERN int		TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_add_d_TCL_DECLARED
+#define TclBN_mp_add_d_TCL_DECLARED
+/* 3 */
+EXTERN int		TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
+#endif
+#ifndef TclBN_mp_and_TCL_DECLARED
+#define TclBN_mp_and_TCL_DECLARED
+/* 4 */
+EXTERN int		TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_clamp_TCL_DECLARED
+#define TclBN_mp_clamp_TCL_DECLARED
+/* 5 */
+EXTERN void		TclBN_mp_clamp(mp_int *a);
+#endif
+#ifndef TclBN_mp_clear_TCL_DECLARED
+#define TclBN_mp_clear_TCL_DECLARED
+/* 6 */
+EXTERN void		TclBN_mp_clear(mp_int *a);
+#endif
+#ifndef TclBN_mp_clear_multi_TCL_DECLARED
+#define TclBN_mp_clear_multi_TCL_DECLARED
+/* 7 */
+EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
+#endif
+#ifndef TclBN_mp_cmp_TCL_DECLARED
+#define TclBN_mp_cmp_TCL_DECLARED
+/* 8 */
+EXTERN int		TclBN_mp_cmp(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_cmp_d_TCL_DECLARED
+#define TclBN_mp_cmp_d_TCL_DECLARED
+/* 9 */
+EXTERN int		TclBN_mp_cmp_d(mp_int *a, mp_digit b);
+#endif
+#ifndef TclBN_mp_cmp_mag_TCL_DECLARED
+#define TclBN_mp_cmp_mag_TCL_DECLARED
+/* 10 */
+EXTERN int		TclBN_mp_cmp_mag(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_copy_TCL_DECLARED
+#define TclBN_mp_copy_TCL_DECLARED
+/* 11 */
+EXTERN int		TclBN_mp_copy(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_count_bits_TCL_DECLARED
+#define TclBN_mp_count_bits_TCL_DECLARED
+/* 12 */
+EXTERN int		TclBN_mp_count_bits(mp_int *a);
+#endif
+#ifndef TclBN_mp_div_TCL_DECLARED
+#define TclBN_mp_div_TCL_DECLARED
+/* 13 */
+EXTERN int		TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
+				mp_int *r);
+#endif
+#ifndef TclBN_mp_div_d_TCL_DECLARED
+#define TclBN_mp_div_d_TCL_DECLARED
+/* 14 */
+EXTERN int		TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
+				mp_digit *r);
+#endif
+#ifndef TclBN_mp_div_2_TCL_DECLARED
+#define TclBN_mp_div_2_TCL_DECLARED
+/* 15 */
+EXTERN int		TclBN_mp_div_2(mp_int *a, mp_int *q);
+#endif
+#ifndef TclBN_mp_div_2d_TCL_DECLARED
+#define TclBN_mp_div_2d_TCL_DECLARED
+/* 16 */
+EXTERN int		TclBN_mp_div_2d(mp_int *a, int b, mp_int *q,
+				mp_int *r);
+#endif
+#ifndef TclBN_mp_div_3_TCL_DECLARED
+#define TclBN_mp_div_3_TCL_DECLARED
+/* 17 */
+EXTERN int		TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
+#endif
+#ifndef TclBN_mp_exch_TCL_DECLARED
+#define TclBN_mp_exch_TCL_DECLARED
+/* 18 */
+EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_expt_d_TCL_DECLARED
+#define TclBN_mp_expt_d_TCL_DECLARED
+/* 19 */
+EXTERN int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
+#endif
+#ifndef TclBN_mp_grow_TCL_DECLARED
+#define TclBN_mp_grow_TCL_DECLARED
+/* 20 */
+EXTERN int		TclBN_mp_grow(mp_int *a, int size);
+#endif
+#ifndef TclBN_mp_init_TCL_DECLARED
+#define TclBN_mp_init_TCL_DECLARED
+/* 21 */
+EXTERN int		TclBN_mp_init(mp_int *a);
+#endif
+#ifndef TclBN_mp_init_copy_TCL_DECLARED
+#define TclBN_mp_init_copy_TCL_DECLARED
+/* 22 */
+EXTERN int		TclBN_mp_init_copy(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_init_multi_TCL_DECLARED
+#define TclBN_mp_init_multi_TCL_DECLARED
+/* 23 */
+EXTERN int		TclBN_mp_init_multi(mp_int *a, ...);
+#endif
+#ifndef TclBN_mp_init_set_TCL_DECLARED
+#define TclBN_mp_init_set_TCL_DECLARED
+/* 24 */
+EXTERN int		TclBN_mp_init_set(mp_int *a, mp_digit b);
+#endif
+#ifndef TclBN_mp_init_size_TCL_DECLARED
+#define TclBN_mp_init_size_TCL_DECLARED
+/* 25 */
+EXTERN int		TclBN_mp_init_size(mp_int *a, int size);
+#endif
+#ifndef TclBN_mp_lshd_TCL_DECLARED
+#define TclBN_mp_lshd_TCL_DECLARED
+/* 26 */
+EXTERN int		TclBN_mp_lshd(mp_int *a, int shift);
+#endif
+#ifndef TclBN_mp_mod_TCL_DECLARED
+#define TclBN_mp_mod_TCL_DECLARED
+/* 27 */
+EXTERN int		TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
+#endif
+#ifndef TclBN_mp_mod_2d_TCL_DECLARED
+#define TclBN_mp_mod_2d_TCL_DECLARED
+/* 28 */
+EXTERN int		TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r);
+#endif
+#ifndef TclBN_mp_mul_TCL_DECLARED
+#define TclBN_mp_mul_TCL_DECLARED
+/* 29 */
+EXTERN int		TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
+#endif
+#ifndef TclBN_mp_mul_d_TCL_DECLARED
+#define TclBN_mp_mul_d_TCL_DECLARED
+/* 30 */
+EXTERN int		TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
+#endif
+#ifndef TclBN_mp_mul_2_TCL_DECLARED
+#define TclBN_mp_mul_2_TCL_DECLARED
+/* 31 */
+EXTERN int		TclBN_mp_mul_2(mp_int *a, mp_int *p);
+#endif
+#ifndef TclBN_mp_mul_2d_TCL_DECLARED
+#define TclBN_mp_mul_2d_TCL_DECLARED
+/* 32 */
+EXTERN int		TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p);
+#endif
+#ifndef TclBN_mp_neg_TCL_DECLARED
+#define TclBN_mp_neg_TCL_DECLARED
+/* 33 */
+EXTERN int		TclBN_mp_neg(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_or_TCL_DECLARED
+#define TclBN_mp_or_TCL_DECLARED
+/* 34 */
+EXTERN int		TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_radix_size_TCL_DECLARED
+#define TclBN_mp_radix_size_TCL_DECLARED
+/* 35 */
+EXTERN int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);
+#endif
+#ifndef TclBN_mp_read_radix_TCL_DECLARED
+#define TclBN_mp_read_radix_TCL_DECLARED
+/* 36 */
+EXTERN int		TclBN_mp_read_radix(mp_int *a, CONST char *str,
+				int radix);
+#endif
+#ifndef TclBN_mp_rshd_TCL_DECLARED
+#define TclBN_mp_rshd_TCL_DECLARED
+/* 37 */
+EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
+#endif
+#ifndef TclBN_mp_shrink_TCL_DECLARED
+#define TclBN_mp_shrink_TCL_DECLARED
+/* 38 */
+EXTERN int		TclBN_mp_shrink(mp_int *a);
+#endif
+#ifndef TclBN_mp_set_TCL_DECLARED
+#define TclBN_mp_set_TCL_DECLARED
+/* 39 */
+EXTERN void		TclBN_mp_set(mp_int *a, mp_digit b);
+#endif
+#ifndef TclBN_mp_sqr_TCL_DECLARED
+#define TclBN_mp_sqr_TCL_DECLARED
+/* 40 */
+EXTERN int		TclBN_mp_sqr(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_sqrt_TCL_DECLARED
+#define TclBN_mp_sqrt_TCL_DECLARED
+/* 41 */
+EXTERN int		TclBN_mp_sqrt(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_sub_TCL_DECLARED
+#define TclBN_mp_sub_TCL_DECLARED
+/* 42 */
+EXTERN int		TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_sub_d_TCL_DECLARED
+#define TclBN_mp_sub_d_TCL_DECLARED
+/* 43 */
+EXTERN int		TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
+#endif
+#ifndef TclBN_mp_to_unsigned_bin_TCL_DECLARED
+#define TclBN_mp_to_unsigned_bin_TCL_DECLARED
+/* 44 */
+EXTERN int		TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
+#endif
+#ifndef TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
+#define TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
+/* 45 */
+EXTERN int		TclBN_mp_to_unsigned_bin_n(mp_int *a,
+				unsigned char *b, unsigned long *outlen);
+#endif
+#ifndef TclBN_mp_toradix_n_TCL_DECLARED
+#define TclBN_mp_toradix_n_TCL_DECLARED
+/* 46 */
+EXTERN int		TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
+				int maxlen);
+#endif
+#ifndef TclBN_mp_unsigned_bin_size_TCL_DECLARED
+#define TclBN_mp_unsigned_bin_size_TCL_DECLARED
+/* 47 */
+EXTERN int		TclBN_mp_unsigned_bin_size(mp_int *a);
+#endif
+#ifndef TclBN_mp_xor_TCL_DECLARED
+#define TclBN_mp_xor_TCL_DECLARED
+/* 48 */
+EXTERN int		TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_zero_TCL_DECLARED
+#define TclBN_mp_zero_TCL_DECLARED
+/* 49 */
+EXTERN void		TclBN_mp_zero(mp_int *a);
+#endif
+#ifndef TclBN_reverse_TCL_DECLARED
+#define TclBN_reverse_TCL_DECLARED
+/* 50 */
+EXTERN void		TclBN_reverse(unsigned char *s, int len);
+#endif
+#ifndef TclBN_fast_s_mp_mul_digs_TCL_DECLARED
+#define TclBN_fast_s_mp_mul_digs_TCL_DECLARED
+/* 51 */
+EXTERN int		TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
+				mp_int *c, int digs);
+#endif
+#ifndef TclBN_fast_s_mp_sqr_TCL_DECLARED
+#define TclBN_fast_s_mp_sqr_TCL_DECLARED
+/* 52 */
+EXTERN int		TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_karatsuba_mul_TCL_DECLARED
+#define TclBN_mp_karatsuba_mul_TCL_DECLARED
+/* 53 */
+EXTERN int		TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
+				mp_int *c);
+#endif
+#ifndef TclBN_mp_karatsuba_sqr_TCL_DECLARED
+#define TclBN_mp_karatsuba_sqr_TCL_DECLARED
+/* 54 */
+EXTERN int		TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_mp_toom_mul_TCL_DECLARED
+#define TclBN_mp_toom_mul_TCL_DECLARED
+/* 55 */
+EXTERN int		TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_toom_sqr_TCL_DECLARED
+#define TclBN_mp_toom_sqr_TCL_DECLARED
+/* 56 */
+EXTERN int		TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_s_mp_add_TCL_DECLARED
+#define TclBN_s_mp_add_TCL_DECLARED
+/* 57 */
+EXTERN int		TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_s_mp_mul_digs_TCL_DECLARED
+#define TclBN_s_mp_mul_digs_TCL_DECLARED
+/* 58 */
+EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
+				int digs);
+#endif
+#ifndef TclBN_s_mp_sqr_TCL_DECLARED
+#define TclBN_s_mp_sqr_TCL_DECLARED
+/* 59 */
+EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
+#endif
+#ifndef TclBN_s_mp_sub_TCL_DECLARED
+#define TclBN_s_mp_sub_TCL_DECLARED
+/* 60 */
+EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
+#endif
+#ifndef TclBN_mp_init_set_int_TCL_DECLARED
+#define TclBN_mp_init_set_int_TCL_DECLARED
+/* 61 */
+EXTERN int		TclBN_mp_init_set_int(mp_int *a, unsigned long i);
+#endif
+#ifndef TclBN_mp_set_int_TCL_DECLARED
+#define TclBN_mp_set_int_TCL_DECLARED
+/* 62 */
+EXTERN int		TclBN_mp_set_int(mp_int *a, unsigned long i);
+#endif
+#ifndef TclBN_mp_cnt_lsb_TCL_DECLARED
+#define TclBN_mp_cnt_lsb_TCL_DECLARED
+/* 63 */
+EXTERN int		TclBN_mp_cnt_lsb(mp_int *a);
+#endif
+
+typedef struct TclTomMathStubs {
+    int magic;
+    struct TclTomMathStubHooks *hooks;
+
+    int (*tclBN_epoch) (void); /* 0 */
+    int (*tclBN_revision) (void); /* 1 */
+    int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
+    int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
+    int (*tclBN_mp_and) (mp_int *a, mp_int *b, mp_int *c); /* 4 */
+    void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
+    void (*tclBN_mp_clear) (mp_int *a); /* 6 */
+    void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
+    int (*tclBN_mp_cmp) (mp_int *a, mp_int *b); /* 8 */
+    int (*tclBN_mp_cmp_d) (mp_int *a, mp_digit b); /* 9 */
+    int (*tclBN_mp_cmp_mag) (mp_int *a, mp_int *b); /* 10 */
+    int (*tclBN_mp_copy) (mp_int *a, mp_int *b); /* 11 */
+    int (*tclBN_mp_count_bits) (mp_int *a); /* 12 */
+    int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
+    int (*tclBN_mp_div_d) (mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
+    int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
+    int (*tclBN_mp_div_2d) (mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
+    int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
+    void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
+    int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
+    int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
+    int (*tclBN_mp_init) (mp_int *a); /* 21 */
+    int (*tclBN_mp_init_copy) (mp_int *a, mp_int *b); /* 22 */
+    int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
+    int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
+    int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
+    int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
+    int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
+    int (*tclBN_mp_mod_2d) (mp_int *a, int b, mp_int *r); /* 28 */
+    int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
+    int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
+    int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
+    int (*tclBN_mp_mul_2d) (mp_int *a, int d, mp_int *p); /* 32 */
+    int (*tclBN_mp_neg) (mp_int *a, mp_int *b); /* 33 */
+    int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
+    int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
+    int (*tclBN_mp_read_radix) (mp_int *a, CONST char *str, int radix); /* 36 */
+    void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
+    int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
+    void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
+    int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
+    int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
+    int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
+    int (*tclBN_mp_sub_d) (mp_int *a, mp_digit b, mp_int *c); /* 43 */
+    int (*tclBN_mp_to_unsigned_bin) (mp_int *a, unsigned char *b); /* 44 */
+    int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
+    int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
+    int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
+    int (*tclBN_mp_xor) (mp_int *a, mp_int *b, mp_int *c); /* 48 */
+    void (*tclBN_mp_zero) (mp_int *a); /* 49 */
+    void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
+    int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
+    int (*tclBN_fast_s_mp_sqr) (mp_int *a, mp_int *b); /* 52 */
+    int (*tclBN_mp_karatsuba_mul) (mp_int *a, mp_int *b, mp_int *c); /* 53 */
+    int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
+    int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
+    int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
+    int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
+    int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
+    int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
+    int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
+    int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
+    int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
+    int (*tclBN_mp_cnt_lsb) (mp_int *a); /* 63 */
+} TclTomMathStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TclTomMathStubs *tclTomMathStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef TclBN_epoch
+#define TclBN_epoch \
+	(tclTomMathStubsPtr->tclBN_epoch) /* 0 */
+#endif
+#ifndef TclBN_revision
+#define TclBN_revision \
+	(tclTomMathStubsPtr->tclBN_revision) /* 1 */
+#endif
+#ifndef TclBN_mp_add
+#define TclBN_mp_add \
+	(tclTomMathStubsPtr->tclBN_mp_add) /* 2 */
+#endif
+#ifndef TclBN_mp_add_d
+#define TclBN_mp_add_d \
+	(tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */
+#endif
+#ifndef TclBN_mp_and
+#define TclBN_mp_and \
+	(tclTomMathStubsPtr->tclBN_mp_and) /* 4 */
+#endif
+#ifndef TclBN_mp_clamp
+#define TclBN_mp_clamp \
+	(tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */
+#endif
+#ifndef TclBN_mp_clear
+#define TclBN_mp_clear \
+	(tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */
+#endif
+#ifndef TclBN_mp_clear_multi
+#define TclBN_mp_clear_multi \
+	(tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */
+#endif
+#ifndef TclBN_mp_cmp
+#define TclBN_mp_cmp \
+	(tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */
+#endif
+#ifndef TclBN_mp_cmp_d
+#define TclBN_mp_cmp_d \
+	(tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */
+#endif
+#ifndef TclBN_mp_cmp_mag
+#define TclBN_mp_cmp_mag \
+	(tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */
+#endif
+#ifndef TclBN_mp_copy
+#define TclBN_mp_copy \
+	(tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */
+#endif
+#ifndef TclBN_mp_count_bits
+#define TclBN_mp_count_bits \
+	(tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */
+#endif
+#ifndef TclBN_mp_div
+#define TclBN_mp_div \
+	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
+#endif
+#ifndef TclBN_mp_div_d
+#define TclBN_mp_div_d \
+	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
+#endif
+#ifndef TclBN_mp_div_2
+#define TclBN_mp_div_2 \
+	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
+#endif
+#ifndef TclBN_mp_div_2d
+#define TclBN_mp_div_2d \
+	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
+#endif
+#ifndef TclBN_mp_div_3
+#define TclBN_mp_div_3 \
+	(tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
+#endif
+#ifndef TclBN_mp_exch
+#define TclBN_mp_exch \
+	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
+#endif
+#ifndef TclBN_mp_expt_d
+#define TclBN_mp_expt_d \
+	(tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */
+#endif
+#ifndef TclBN_mp_grow
+#define TclBN_mp_grow \
+	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
+#endif
+#ifndef TclBN_mp_init
+#define TclBN_mp_init \
+	(tclTomMathStubsPtr->tclBN_mp_init) /* 21 */
+#endif
+#ifndef TclBN_mp_init_copy
+#define TclBN_mp_init_copy \
+	(tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */
+#endif
+#ifndef TclBN_mp_init_multi
+#define TclBN_mp_init_multi \
+	(tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */
+#endif
+#ifndef TclBN_mp_init_set
+#define TclBN_mp_init_set \
+	(tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */
+#endif
+#ifndef TclBN_mp_init_size
+#define TclBN_mp_init_size \
+	(tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */
+#endif
+#ifndef TclBN_mp_lshd
+#define TclBN_mp_lshd \
+	(tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */
+#endif
+#ifndef TclBN_mp_mod
+#define TclBN_mp_mod \
+	(tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */
+#endif
+#ifndef TclBN_mp_mod_2d
+#define TclBN_mp_mod_2d \
+	(tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */
+#endif
+#ifndef TclBN_mp_mul
+#define TclBN_mp_mul \
+	(tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */
+#endif
+#ifndef TclBN_mp_mul_d
+#define TclBN_mp_mul_d \
+	(tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */
+#endif
+#ifndef TclBN_mp_mul_2
+#define TclBN_mp_mul_2 \
+	(tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */
+#endif
+#ifndef TclBN_mp_mul_2d
+#define TclBN_mp_mul_2d \
+	(tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */
+#endif
+#ifndef TclBN_mp_neg
+#define TclBN_mp_neg \
+	(tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */
+#endif
+#ifndef TclBN_mp_or
+#define TclBN_mp_or \
+	(tclTomMathStubsPtr->tclBN_mp_or) /* 34 */
+#endif
+#ifndef TclBN_mp_radix_size
+#define TclBN_mp_radix_size \
+	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
+#endif
+#ifndef TclBN_mp_read_radix
+#define TclBN_mp_read_radix \
+	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
+#endif
+#ifndef TclBN_mp_rshd
+#define TclBN_mp_rshd \
+	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
+#endif
+#ifndef TclBN_mp_shrink
+#define TclBN_mp_shrink \
+	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
+#endif
+#ifndef TclBN_mp_set
+#define TclBN_mp_set \
+	(tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
+#endif
+#ifndef TclBN_mp_sqr
+#define TclBN_mp_sqr \
+	(tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
+#endif
+#ifndef TclBN_mp_sqrt
+#define TclBN_mp_sqrt \
+	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
+#endif
+#ifndef TclBN_mp_sub
+#define TclBN_mp_sub \
+	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
+#endif
+#ifndef TclBN_mp_sub_d
+#define TclBN_mp_sub_d \
+	(tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
+#endif
+#ifndef TclBN_mp_to_unsigned_bin
+#define TclBN_mp_to_unsigned_bin \
+	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
+#endif
+#ifndef TclBN_mp_to_unsigned_bin_n
+#define TclBN_mp_to_unsigned_bin_n \
+	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
+#endif
+#ifndef TclBN_mp_toradix_n
+#define TclBN_mp_toradix_n \
+	(tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
+#endif
+#ifndef TclBN_mp_unsigned_bin_size
+#define TclBN_mp_unsigned_bin_size \
+	(tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */
+#endif
+#ifndef TclBN_mp_xor
+#define TclBN_mp_xor \
+	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
+#endif
+#ifndef TclBN_mp_zero
+#define TclBN_mp_zero \
+	(tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */
+#endif
+#ifndef TclBN_reverse
+#define TclBN_reverse \
+	(tclTomMathStubsPtr->tclBN_reverse) /* 50 */
+#endif
+#ifndef TclBN_fast_s_mp_mul_digs
+#define TclBN_fast_s_mp_mul_digs \
+	(tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */
+#endif
+#ifndef TclBN_fast_s_mp_sqr
+#define TclBN_fast_s_mp_sqr \
+	(tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */
+#endif
+#ifndef TclBN_mp_karatsuba_mul
+#define TclBN_mp_karatsuba_mul \
+	(tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
+#endif
+#ifndef TclBN_mp_karatsuba_sqr
+#define TclBN_mp_karatsuba_sqr \
+	(tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
+#endif
+#ifndef TclBN_mp_toom_mul
+#define TclBN_mp_toom_mul \
+	(tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
+#endif
+#ifndef TclBN_mp_toom_sqr
+#define TclBN_mp_toom_sqr \
+	(tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
+#endif
+#ifndef TclBN_s_mp_add
+#define TclBN_s_mp_add \
+	(tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
+#endif
+#ifndef TclBN_s_mp_mul_digs
+#define TclBN_s_mp_mul_digs \
+	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
+#endif
+#ifndef TclBN_s_mp_sqr
+#define TclBN_s_mp_sqr \
+	(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
+#endif
+#ifndef TclBN_s_mp_sub
+#define TclBN_s_mp_sub \
+	(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
+#endif
+#ifndef TclBN_mp_init_set_int
+#define TclBN_mp_init_set_int \
+	(tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */
+#endif
+#ifndef TclBN_mp_set_int
+#define TclBN_mp_set_int \
+	(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
+#endif
+#ifndef TclBN_mp_cnt_lsb
+#define TclBN_mp_cnt_lsb \
+	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
+#endif
+
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TCLINTDECLS */
diff --git a/generic/tclTomMathInt.h b/generic/tclTomMathInt.h
new file mode 100644
index 0000000..1b9eb64
--- /dev/null
+++ b/generic/tclTomMathInt.h
@@ -0,0 +1,2 @@
+#include "tclTomMath.h"
+#include "tommath_class.h"
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
new file mode 100644
index 0000000..89c1132
--- /dev/null
+++ b/generic/tclTomMathInterface.c
@@ -0,0 +1,311 @@
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclTomMathInterface.c --
+ *
+ *	This file contains procedures that are used as a 'glue' layer between
+ *	Tcl and libtommath.
+ *
+ * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tommath.h"
+#include <limits.h>
+
+extern TclTomMathStubs tclTomMathStubs;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTommath_Init --
+ *
+ *	Initializes the TclTomMath 'package', which exists as a
+ *	placeholder so that the package data can be used to hold
+ *	a stub table pointer.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Installs the stub table for tommath.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTommath_Init(
+    Tcl_Interp* interp		/* Tcl interpreter */
+) {
+    /* TIP #268: Full patchlevel instead of just major.minor */
+
+    if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
+			 (ClientData)&tclTomMathStubs) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_epoch --
+ *
+ *	Return the epoch number of the TclTomMath stubs table
+ *
+ * Results:
+ *	Returns an arbitrary integer that does not decrease with
+ *	release.  Stubs tables with different epochs are incompatible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_epoch(void)
+{
+    return TCLTOMMATH_EPOCH;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_revision --
+ *
+ *	Returns the revision level of the TclTomMath stubs table
+ *
+ * Results:
+ *	Returns an arbitrary integer that increases with revisions.
+ *	If a client requires a given epoch and revision, any Stubs table
+ *	with the same epoch and an equal or higher revision satisfies
+ *	the request.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_revision(void)
+{
+    return TCLTOMMATH_REVISION;
+}
+#if 0
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNAlloc --
+ *
+ *	Allocate memory for libtommath.
+ *
+ * Results:
+ *	Returns a pointer to the allocated block.
+ *
+ * This procedure is a wrapper around Tcl_Alloc, needed because of a
+ * mismatched type signature between Tcl_Alloc and malloc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void *
+TclBNAlloc(
+    size_t x)
+{
+    return (void *) ckalloc((unsigned int) x);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNRealloc --
+ *
+ *	Change the size of an allocated block of memory in libtommath
+ *
+ * Results:
+ *	Returns a pointer to the allocated block.
+ *
+ * This procedure is a wrapper around Tcl_Realloc, needed because of a
+ * mismatched type signature between Tcl_Realloc and realloc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void *
+TclBNRealloc(
+    void *p,
+    size_t s)
+{
+    return (void *) ckrealloc((char *) p, (unsigned int) s);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNFree --
+ *
+ *	Free allocated memory in libtommath.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory is freed.
+ *
+ * This function is simply a wrapper around Tcl_Free, needed in libtommath
+ * because of a type mismatch between free and Tcl_Free.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNFree(
+    void *p)
+{
+    ckfree((char *) p);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromLong --
+ *
+ *	Allocate and initialize a 'bignum' from a native 'long'.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromLong(
+    mp_int *a,
+    long initVal)
+{
+    int status;
+    unsigned long v;
+    mp_digit* p;
+
+    /*
+     * Allocate enough memory to hold the largest possible long
+     */
+
+    status = mp_init_size(a,
+	    (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
+    if (status != MP_OKAY) {
+	Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
+    }
+
+    /*
+     * Convert arg to sign and magnitude.
+     */
+
+    if (initVal < 0) {
+	a->sign = MP_NEG;
+	v = -initVal;
+    } else {
+	a->sign = MP_ZPOS;
+	v = initVal;
+    }
+
+    /*
+     * Store the magnitude in the bignum.
+     */
+
+    p = a->dp;
+    while (v) {
+	*p++ = (mp_digit) (v & MP_MASK);
+	v >>= MP_DIGIT_BIT;
+    }
+    a->used = p - a->dp;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideInt --
+ *
+ *	Allocate and initialize a 'bignum' from a Tcl_WideInt
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideInt(
+    mp_int *a,			/* Bignum to initialize */
+    Tcl_WideInt v)		/* Initial value */
+{
+    if (v < (Tcl_WideInt)0) {
+	TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
+	mp_neg(a, a);
+    } else {
+	TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideUInt --
+ *
+ *	Allocate and initialize a 'bignum' from a Tcl_WideUInt
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideUInt(
+    mp_int *a,			/* Bignum to initialize */
+    Tcl_WideUInt v)		/* Initial value */
+{
+    int status;
+    mp_digit *p;
+
+    /*
+     * Allocate enough memory to hold the largest possible Tcl_WideUInt.
+     */
+
+    status = mp_init_size(a,
+	    (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
+    if (status != MP_OKAY) {
+	Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
+    }
+
+    a->sign = MP_ZPOS;
+
+    /*
+     * Store the magnitude in the bignum.
+     */
+
+    p = a->dp;
+    while (v) {
+	*p++ = (mp_digit) (v & MP_MASK);
+	v >>= MP_DIGIT_BIT;
+    }
+    a->used = p - a->dp;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
new file mode 100644
index 0000000..fa29160
--- /dev/null
+++ b/generic/tclTrace.c
@@ -0,0 +1,3249 @@
+/*
+ * tclTrace.c --
+ *
+ *	This file contains code to handle most trace management.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ * Structures used to hold information about variable traces:
+ */
+
+typedef struct {
+    int flags;			/* Operations for which Tcl command is to be
+				 * invoked. */
+    size_t length;		/* Number of non-NUL chars. in command. */
+    char command[4];		/* Space for Tcl command to invoke. Actual
+				 * size will be as large as necessary to hold
+				 * command. This field must be the last in the
+				 * structure, so that it can be larger than 4
+				 * bytes. */
+} TraceVarInfo;
+
+typedef struct {
+    VarTrace traceInfo;
+    TraceVarInfo traceCmdInfo;
+} CombinedTraceVarInfo;
+
+/*
+ * Structure used to hold information about command traces:
+ */
+
+typedef struct {
+    int flags;			/* Operations for which Tcl command is to be
+				 * invoked. */
+    size_t length;		/* Number of non-NUL chars. in command. */
+    Tcl_Trace stepTrace;	/* Used for execution traces, when tracing
+				 * inside the given command */
+    int startLevel;		/* Used for bookkeeping with step execution
+				 * traces, store the level at which the step
+				 * trace was invoked */
+    char *startCmd;		/* Used for bookkeeping with step execution
+				 * traces, store the command name which
+				 * invoked step trace */
+    int curFlags;		/* Trace flags for the current command */
+    int curCode;		/* Return code for the current command */
+    int refCount;		/* Used to ensure this structure is not
+				 * deleted too early. Keeps track of how many
+				 * pieces of code have a pointer to this
+				 * structure. */
+    char command[4];		/* Space for Tcl command to invoke. Actual
+				 * size will be as large as necessary to hold
+				 * command. This field must be the last in the
+				 * structure, so that it can be larger than 4
+				 * bytes. */
+} TraceCommandInfo;
+
+/*
+ * Used by command execution traces. Note that we assume in the code that
+ * TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that
+ * TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
+ *
+ * TCL_TRACE_ENTER_DURING_EXEC  - Trace each command inside the command
+ *				  currently being traced, before execution.
+ * TCL_TRACE_LEAVE_DURING_EXEC  - Trace each command inside the command
+ *				  currently being traced, after execution.
+ * TCL_TRACE_ANY_EXEC		- OR'd combination of all EXEC flags.
+ * TCL_TRACE_EXEC_IN_PROGRESS   - The callback function on this trace is
+ *				  currently executing. Therefore we don't let
+ *				  further traces execute.
+ * TCL_TRACE_EXEC_DIRECT	- This execution trace is triggered directly
+ *				  by the command being traced, not because of
+ *				  an internal trace.
+ * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used
+ * in command execution traces.
+ */
+
+#define TCL_TRACE_ENTER_DURING_EXEC	4
+#define TCL_TRACE_LEAVE_DURING_EXEC	8
+#define TCL_TRACE_ANY_EXEC		15
+#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
+#define TCL_TRACE_EXEC_DIRECT		0x20
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
+	int objc, Tcl_Obj *const objv[]);
+
+static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
+static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
+static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;
+
+/*
+ * Each subcommand has a number of 'types' to which it can apply. Currently
+ * 'execution', 'command' and 'variable' are the only types supported. These
+ * three arrays MUST be kept in sync! In the future we may provide an API to
+ * add to the list of supported trace types.
+ */
+
+static const char *traceTypeOptions[] = {
+    "execution", "command", "variable", NULL
+};
+static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
+    TraceExecutionObjCmd,
+    TraceCommandObjCmd,
+    TraceVariableObjCmd
+};
+
+/*
+ * Declarations for local functions to this file:
+ */
+
+static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
+			    Command *cmdPtr, const char *command, int numChars,
+			    int objc, Tcl_Obj *const objv[]);
+static char *		TraceVarProc(ClientData clientData, Tcl_Interp *interp,
+			    const char *name1, const char *name2, int flags);
+static void		TraceCommandProc(ClientData clientData,
+			    Tcl_Interp *interp, const char *oldName,
+			    const char *newName, int flags);
+static Tcl_CmdObjTraceProc TraceExecutionProc;
+static int		StringTraceProc(ClientData clientData,
+			    Tcl_Interp *interp, int level,
+			    const char *command, Tcl_Command commandInfo,
+			    int objc, Tcl_Obj *const objv[]);
+static void		StringTraceDeleteProc(ClientData clientData);
+static void		DisposeTraceResult(int flags, char *result);
+static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
+			    const char *part2, register VarTrace *tracePtr);
+
+/*
+ * The following structure holds the client data for string-based
+ * trace procs
+ */
+
+typedef struct StringTraceData {
+    ClientData clientData;	/* Client data from Tcl_CreateTrace */
+    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
+} StringTraceData;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceObjCmd --
+ *
+ *	This function is invoked to process the "trace" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ *	Standard syntax as of Tcl 8.4 is:
+ *	    trace {add|info|remove} {command|variable} name ops cmd
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_TraceObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int optionIndex;
+    char *name, *flagOps, *p;
+    /* Main sub commands to 'trace' */
+    static const char *traceOptions[] = {
+	"add", "info", "remove",
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	"variable", "vdelete", "vinfo",
+#endif
+	NULL
+    };
+    /* 'OLD' options are pre-Tcl-8.4 style */
+    enum traceOptions {
+	TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
+#endif
+    };
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
+		"option", 0, &optionIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch ((enum traceOptions) optionIndex) {
+    case TRACE_ADD:
+    case TRACE_REMOVE: {
+	/*
+	 * All sub commands of trace add/remove must take at least one more
+	 * argument. Beyond that we let the subcommand itself control the
+	 * argument structure.
+	 */
+
+	int typeIndex;
+
+	if (objc < 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
+		0, &typeIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+    }
+    case TRACE_INFO: {
+	/*
+	 * All sub commands of trace info must take exactly two more arguments
+	 * which name the type of thing being traced and the name of the thing
+	 * being traced.
+	 */
+
+	int typeIndex;
+	if (objc < 3) {
+	    /*
+	     * Delegate other complaints to the type-specific code which can
+	     * give a better error message.
+	     */
+
+	    Tcl_WrongNumArgs(interp, 2, objv, "type name");
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
+		0, &typeIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+	break;
+    }
+
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+    case TRACE_OLD_VARIABLE:
+    case TRACE_OLD_VDELETE: {
+	Tcl_Obj *copyObjv[6];
+	Tcl_Obj *opsList;
+	int code, numFlags;
+
+	if (objc != 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+	    return TCL_ERROR;
+	}
+
+	opsList = Tcl_NewObj();
+	Tcl_IncrRefCount(opsList);
+	flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
+	if (numFlags == 0) {
+	    Tcl_DecrRefCount(opsList);
+	    goto badVarOps;
+	}
+	for (p = flagOps; *p != 0; p++) {
+	    Tcl_Obj *opObj;
+
+	    if (*p == 'r') {
+		TclNewLiteralStringObj(opObj, "read");
+	    } else if (*p == 'w') {
+		TclNewLiteralStringObj(opObj, "write");
+	    } else if (*p == 'u') {
+		TclNewLiteralStringObj(opObj, "unset");
+	    } else if (*p == 'a') {
+		TclNewLiteralStringObj(opObj, "array");
+	    } else {
+		Tcl_DecrRefCount(opsList);
+		goto badVarOps;
+	    }
+	    Tcl_ListObjAppendElement(NULL, opsList, opObj);
+	}
+	copyObjv[0] = NULL;
+	memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
+	copyObjv[4] = opsList;
+	if (optionIndex == TRACE_OLD_VARIABLE) {
+	    code = (traceSubCmds[2])(interp, TRACE_ADD, objc+1, copyObjv);
+	} else {
+	    code = (traceSubCmds[2])(interp, TRACE_REMOVE, objc+1, copyObjv);
+	}
+	Tcl_DecrRefCount(opsList);
+	return code;
+    }
+    case TRACE_OLD_VINFO: {
+	ClientData clientData;
+	char ops[5];
+	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "name");
+	    return TCL_ERROR;
+	}
+	resultListPtr = Tcl_NewObj();
+	clientData = 0;
+	name = Tcl_GetString(objv[2]);
+	while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		TraceVarProc, clientData)) != 0) {
+
+	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+	    pairObjPtr = Tcl_NewListObj(0, NULL);
+	    p = ops;
+	    if (tvarPtr->flags & TCL_TRACE_READS) {
+		*p = 'r';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		*p = 'w';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		*p = 'u';
+		p++;
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+		*p = 'a';
+		p++;
+	    }
+	    *p = '\0';
+
+	    /*
+	     * Build a pair (2-item list) with the ops string as the first obj
+	     * element and the tvarPtr->command string as the second obj
+	     * element. Append the pair (as an element) to the end of the
+	     * result object list.
+	     */
+
+	    elemObjPtr = Tcl_NewStringObj(ops, -1);
+	    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+	    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+	    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+	    Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
+	}
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
+#endif /* TCL_REMOVE_OBSOLETE_TRACES */
+    }
+    return TCL_OK;
+
+  badVarOps:
+    Tcl_AppendResult(interp, "bad operations \"", flagOps,
+	    "\": should be one or more of rwua", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceExecutionObjCmd --
+ *
+ *	Helper function for Tcl_TraceObjCmd; implements the [trace
+ *	{add|remove|info} execution ...] subcommands. See the user
+ *	documentation for details on what these do.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the operation (add, remove, or info) being performed; may
+ *	add or remove command traces on a command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceExecutionObjCmd(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int optionIndex,		/* Add, info or remove */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int commandLength, index;
+    char *name, *command;
+    size_t length;
+    enum traceOptions {
+	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
+    };
+    static const char *opStrings[] = {
+	"enter", "leave", "enterstep", "leavestep", NULL
+    };
+    enum operations {
+	TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
+	TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP
+    };
+
+    switch ((enum traceOptions) optionIndex) {
+    case TRACE_ADD:
+    case TRACE_REMOVE: {
+	int flags = 0;
+	int i, listLen, result;
+	Tcl_Obj **elemPtrs;
+
+	if (objc != 6) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Make sure the ops argument is a list object; get its length and a
+	 * pointer to its array of element pointers.
+	 */
+
+	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (listLen == 0) {
+	    Tcl_SetResult(interp, "bad operation list \"\": must be "
+		    "one or more of enter, leave, enterstep, or leavestep",
+		    TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	for (i = 0; i < listLen; i++) {
+	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+		    "operation", TCL_EXACT, &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum operations) index) {
+	    case TRACE_EXEC_ENTER:
+		flags |= TCL_TRACE_ENTER_EXEC;
+		break;
+	    case TRACE_EXEC_LEAVE:
+		flags |= TCL_TRACE_LEAVE_EXEC;
+		break;
+	    case TRACE_EXEC_ENTER_STEP:
+		flags |= TCL_TRACE_ENTER_DURING_EXEC;
+		break;
+	    case TRACE_EXEC_LEAVE_STEP:
+		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
+		break;
+	    }
+	}
+	command = Tcl_GetStringFromObj(objv[5], &commandLength);
+	length = (size_t) commandLength;
+	if ((enum traceOptions) optionIndex == TRACE_ADD) {
+	    TraceCommandInfo *tcmdPtr;
+
+	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+			    + length + 1));
+	    tcmdPtr->flags = flags;
+	    tcmdPtr->stepTrace = NULL;
+	    tcmdPtr->startLevel = 0;
+	    tcmdPtr->startCmd = NULL;
+	    tcmdPtr->length = length;
+	    tcmdPtr->refCount = 1;
+	    flags |= TCL_TRACE_DELETE;
+	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
+		    TCL_TRACE_LEAVE_DURING_EXEC)) {
+		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+	    }
+	    memcpy(tcmdPtr->command, command, length+1);
+	    name = Tcl_GetString(objv[3]);
+	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+		    (ClientData) tcmdPtr) != TCL_OK) {
+		ckfree((char *) tcmdPtr);
+		return TCL_ERROR;
+	    }
+	} else {
+	    /*
+	     * Search through all of our traces on this command to see if
+	     * there's one with the given command. If so, then delete the
+	     * first one that matches.
+	     */
+
+	    TraceCommandInfo *tcmdPtr;
+	    ClientData clientData = NULL;
+	    name = Tcl_GetString(objv[3]);
+
+	    /*
+	     * First ensure the name given is valid.
+	     */
+
+	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
+		return TCL_ERROR;
+	    }
+
+	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+		    TraceCommandProc, clientData)) != NULL) {
+		tcmdPtr = (TraceCommandInfo *) clientData;
+
+		/*
+		 * In checking the 'flags' field we must remove any extraneous
+		 * flags which may have been temporarily added by various
+		 * pieces of the trace mechanism.
+		 */
+
+		if ((tcmdPtr->length == length)
+			&& ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC |
+				TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags)
+			&& (strncmp(command, tcmdPtr->command,
+				(size_t) length) == 0)) {
+		    flags |= TCL_TRACE_DELETE;
+		    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
+			    TCL_TRACE_LEAVE_DURING_EXEC)) {
+			flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+		    }
+		    Tcl_UntraceCommand(interp, name, flags,
+			    TraceCommandProc, clientData);
+		    if (tcmdPtr->stepTrace != NULL) {
+			/*
+			 * We need to remove the interpreter-wide trace which
+			 * we created to allow 'step' traces.
+			 */
+
+			Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+			tcmdPtr->stepTrace = NULL;
+			if (tcmdPtr->startCmd != NULL) {
+			    ckfree((char *) tcmdPtr->startCmd);
+			}
+		    }
+		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+			/*
+			 * Postpone deletion.
+			 */
+
+			tcmdPtr->flags = 0;
+		    }
+		    if ((--tcmdPtr->refCount) <= 0) {
+			ckfree((char *) tcmdPtr);
+		    }
+		    break;
+		}
+	    }
+	}
+	break;
+    }
+    case TRACE_INFO: {
+	ClientData clientData;
+	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name");
+	    return TCL_ERROR;
+	}
+
+	clientData = NULL;
+	name = Tcl_GetString(objv[3]);
+
+	/*
+	 * First ensure the name given is valid.
+	 */
+
+	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
+	    return TCL_ERROR;
+	}
+
+	resultListPtr = Tcl_NewListObj(0, NULL);
+	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+		TraceCommandProc, clientData)) != NULL) {
+	    int numOps = 0;
+	    Tcl_Obj *opObj;
+	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+	    /*
+	     * Build a list with the ops list as the first obj element and the
+	     * tcmdPtr->command string as the second obj element. Append this
+	     * list (as an element) to the end of the result object list.
+	     */
+
+	    elemObjPtr = Tcl_NewListObj(0, NULL);
+	    Tcl_IncrRefCount(elemObjPtr);
+	    if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
+		TclNewLiteralStringObj(opObj, "enter");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
+		TclNewLiteralStringObj(opObj, "leave");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
+		TclNewLiteralStringObj(opObj, "enterstep");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
+		TclNewLiteralStringObj(opObj, "leavestep");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
+	    if (0 == numOps) {
+		Tcl_DecrRefCount(elemObjPtr);
+		continue;
+	    }
+	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+	    Tcl_DecrRefCount(elemObjPtr);
+	    elemObjPtr = NULL;
+
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
+		    Tcl_NewStringObj(tcmdPtr->command, -1));
+	    Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
+	}
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceCommandObjCmd --
+ *
+ *	Helper function for Tcl_TraceObjCmd; implements the [trace
+ *	{add|info|remove} command ...] subcommands. See the user documentation
+ *	for details on what these do.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the operation (add, remove, or info) being performed; may
+ *	add or remove command traces on a command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceCommandObjCmd(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int optionIndex,		/* Add, info or remove */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int commandLength, index;
+    char *name, *command;
+    size_t length;
+    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
+    static const char *opStrings[] = { "delete", "rename", NULL };
+    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
+
+    switch ((enum traceOptions) optionIndex) {
+    case TRACE_ADD:
+    case TRACE_REMOVE: {
+	int flags = 0;
+	int i, listLen, result;
+	Tcl_Obj **elemPtrs;
+
+	if (objc != 6) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Make sure the ops argument is a list object; get its length and a
+	 * pointer to its array of element pointers.
+	 */
+
+	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (listLen == 0) {
+	    Tcl_SetResult(interp, "bad operation list \"\": must be "
+		    "one or more of delete or rename", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+
+	for (i = 0; i < listLen; i++) {
+	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+		    "operation", TCL_EXACT, &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum operations) index) {
+	    case TRACE_CMD_RENAME:
+		flags |= TCL_TRACE_RENAME;
+		break;
+	    case TRACE_CMD_DELETE:
+		flags |= TCL_TRACE_DELETE;
+		break;
+	    }
+	}
+
+	command = Tcl_GetStringFromObj(objv[5], &commandLength);
+	length = (size_t) commandLength;
+	if ((enum traceOptions) optionIndex == TRACE_ADD) {
+	    TraceCommandInfo *tcmdPtr;
+
+	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+			    + length + 1));
+	    tcmdPtr->flags = flags;
+	    tcmdPtr->stepTrace = NULL;
+	    tcmdPtr->startLevel = 0;
+	    tcmdPtr->startCmd = NULL;
+	    tcmdPtr->length = length;
+	    tcmdPtr->refCount = 1;
+	    flags |= TCL_TRACE_DELETE;
+	    memcpy(tcmdPtr->command, command, length+1);
+	    name = Tcl_GetString(objv[3]);
+	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+		    (ClientData) tcmdPtr) != TCL_OK) {
+		ckfree((char *) tcmdPtr);
+		return TCL_ERROR;
+	    }
+	} else {
+	    /*
+	     * Search through all of our traces on this command to see if
+	     * there's one with the given command. If so, then delete the
+	     * first one that matches.
+	     */
+
+	    TraceCommandInfo *tcmdPtr;
+	    ClientData clientData = NULL;
+	    name = Tcl_GetString(objv[3]);
+
+	    /*
+	     * First ensure the name given is valid.
+	     */
+
+	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
+		return TCL_ERROR;
+	    }
+
+	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+		    TraceCommandProc, clientData)) != NULL) {
+		tcmdPtr = (TraceCommandInfo *) clientData;
+		if ((tcmdPtr->length == length)
+			&& (tcmdPtr->flags == flags)
+			&& (strncmp(command, tcmdPtr->command,
+				(size_t) length) == 0)) {
+		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
+			    TraceCommandProc, clientData);
+		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
+		    if ((--tcmdPtr->refCount) <= 0) {
+			ckfree((char *) tcmdPtr);
+		    }
+		    break;
+		}
+	    }
+	}
+	break;
+    }
+    case TRACE_INFO: {
+	ClientData clientData;
+	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name");
+	    return TCL_ERROR;
+	}
+
+	clientData = NULL;
+	name = Tcl_GetString(objv[3]);
+
+	/*
+	 * First ensure the name given is valid.
+	 */
+
+	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
+	    return TCL_ERROR;
+	}
+
+	resultListPtr = Tcl_NewListObj(0, NULL);
+	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+		TraceCommandProc, clientData)) != NULL) {
+	    int numOps = 0;
+	    Tcl_Obj *opObj;
+	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+	    /*
+	     * Build a list with the ops list as the first obj element and the
+	     * tcmdPtr->command string as the second obj element. Append this
+	     * list (as an element) to the end of the result object list.
+	     */
+
+	    elemObjPtr = Tcl_NewListObj(0, NULL);
+	    Tcl_IncrRefCount(elemObjPtr);
+	    if (tcmdPtr->flags & TCL_TRACE_RENAME) {
+		TclNewLiteralStringObj(opObj, "rename");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tcmdPtr->flags & TCL_TRACE_DELETE) {
+		TclNewLiteralStringObj(opObj, "delete");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
+	    if (0 == numOps) {
+		Tcl_DecrRefCount(elemObjPtr);
+		continue;
+	    }
+	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+	    Tcl_DecrRefCount(elemObjPtr);
+
+	    elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+	    Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
+	}
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVariableObjCmd --
+ *
+ *	Helper function for Tcl_TraceObjCmd; implements the [trace
+ *	{add|info|remove} variable ...] subcommands. See the user
+ *	documentation for details on what these do.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the operation (add, remove, or info) being performed; may
+ *	add or remove variable traces on a variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceVariableObjCmd(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int optionIndex,		/* Add, info or remove */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int commandLength, index;
+    char *name, *command;
+    size_t length;
+    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
+    static const char *opStrings[] = {
+	"array", "read", "unset", "write", NULL
+    };
+    enum operations {
+	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
+    };
+
+    switch ((enum traceOptions) optionIndex) {
+    case TRACE_ADD:
+    case TRACE_REMOVE: {
+	int flags = 0;
+	int i, listLen, result;
+	Tcl_Obj **elemPtrs;
+
+	if (objc != 6) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Make sure the ops argument is a list object; get its length and a
+	 * pointer to its array of element pointers.
+	 */
+
+	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (listLen == 0) {
+	    Tcl_SetResult(interp, "bad operation list \"\": must be "
+		    "one or more of array, read, unset, or write", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	for (i = 0; i < listLen ; i++) {
+	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+		    "operation", TCL_EXACT, &index) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum operations) index) {
+	    case TRACE_VAR_ARRAY:
+		flags |= TCL_TRACE_ARRAY;
+		break;
+	    case TRACE_VAR_READ:
+		flags |= TCL_TRACE_READS;
+		break;
+	    case TRACE_VAR_UNSET:
+		flags |= TCL_TRACE_UNSETS;
+		break;
+	    case TRACE_VAR_WRITE:
+		flags |= TCL_TRACE_WRITES;
+		break;
+	    }
+	}
+	command = Tcl_GetStringFromObj(objv[5], &commandLength);
+	length = (size_t) commandLength;
+	if ((enum traceOptions) optionIndex == TRACE_ADD) {
+	    CombinedTraceVarInfo *ctvarPtr;
+
+	    ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
+		    (sizeof(CombinedTraceVarInfo) + length + 1
+		    - sizeof(ctvarPtr->traceCmdInfo.command)));
+	    ctvarPtr->traceCmdInfo.flags = flags;
+	    if (objv[0] == NULL) {
+		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
+	    }
+	    ctvarPtr->traceCmdInfo.length = length;
+	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
+	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
+	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
+	    ctvarPtr->traceInfo.clientData = (ClientData)
+		    &ctvarPtr->traceCmdInfo;
+	    ctvarPtr->traceInfo.flags = flags;
+	    name = Tcl_GetString(objv[3]);
+	    if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {
+		ckfree((char *) ctvarPtr);
+		return TCL_ERROR;
+	    }
+	} else {
+	    /*
+	     * Search through all of our traces on this variable to see if
+	     * there's one with the given command. If so, then delete the
+	     * first one that matches.
+	     */
+
+	    TraceVarInfo *tvarPtr;
+	    ClientData clientData = 0;
+	    name = Tcl_GetString(objv[3]);
+	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		    TraceVarProc, clientData)) != 0) {
+		tvarPtr = (TraceVarInfo *) clientData;
+		if ((tvarPtr->length == length)
+			&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
+			&& (strncmp(command, tvarPtr->command,
+				(size_t) length) == 0)) {
+		    Tcl_UntraceVar2(interp, name, NULL,
+			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
+			    TraceVarProc, clientData);
+		    break;
+		}
+	    }
+	}
+	break;
+    }
+    case TRACE_INFO: {
+	ClientData clientData;
+	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "name");
+	    return TCL_ERROR;
+	}
+
+	resultListPtr = Tcl_NewObj();
+	clientData = 0;
+	name = Tcl_GetString(objv[3]);
+	while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
+		clientData)) != 0) {
+	    Tcl_Obj *opObj;
+	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+	    /*
+	     * Build a list with the ops list as the first obj element and the
+	     * tcmdPtr->command string as the second obj element. Append this
+	     * list (as an element) to the end of the result object list.
+	     */
+
+	    elemObjPtr = Tcl_NewListObj(0, NULL);
+	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+		TclNewLiteralStringObj(opObj, "array");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_READS) {
+		TclNewLiteralStringObj(opObj, "read");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		TclNewLiteralStringObj(opObj, "write");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		TclNewLiteralStringObj(opObj, "unset");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+	    }
+	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+
+	    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+	    Tcl_ListObjAppendElement(interp, resultListPtr,
+		    eachTraceObjPtr);
+	}
+	Tcl_SetObjResult(interp, resultListPtr);
+	break;
+    }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CommandTraceInfo --
+ *
+ *	Return the clientData value associated with a trace on a command.
+ *	This function can also be used to step through all of the traces on a
+ *	particular command that have the same trace function.
+ *
+ * Results:
+ *	The return value is the clientData value associated with a trace on
+ *	the given command. Information will only be returned for a trace with
+ *	proc as trace function. If the clientData argument is NULL then the
+ *	first such trace is returned; otherwise, the next relevant one after
+ *	the one given by clientData will be returned. If the command doesn't
+ *	exist then an error message is left in the interpreter and NULL is
+ *	returned. Also, if there are no (more) traces for the given command,
+ *	NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_CommandTraceInfo(
+    Tcl_Interp *interp,		/* Interpreter containing command. */
+    const char *cmdName,	/* Name of command. */
+    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY (can be 0). */
+    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
+    ClientData prevClientData)	/* If non-NULL, gives last value returned by
+				 * this function, so this call will return the
+				 * next trace after that one. If NULL, this
+				 * call will return the first trace. */
+{
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
+
+    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
+
+    tracePtr = cmdPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceCommand --
+ *
+ *	Arrange for rename/deletes to a command to cause a function to be
+ *	invoked, which can monitor the operations.
+ *
+ *	Also optionally arrange for execution of that command to cause a
+ *	function to be invoked.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the command given by cmdName, such that future
+ *	changes to the command will be intermediated by proc. See the manual
+ *	entry for complete details on the calling sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceCommand(
+    Tcl_Interp *interp,		/* Interpreter in which command is to be
+				 * traced. */
+    const char *cmdName,	/* Name of command. */
+    int flags,			/* OR-ed collection of bits, including any of
+				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
+				 * of the TRACE_*_EXEC flags */
+    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
+				 * invoked upon cmdName. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
+
+    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set up trace information.
+     */
+
+    tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+    tracePtr->traceProc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->flags = flags &
+	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
+    tracePtr->nextPtr = cmdPtr->tracePtr;
+    tracePtr->refCount = 1;
+    cmdPtr->tracePtr = tracePtr;
+    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+	/*
+	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
+	 */
+	
+	if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
+	    Interp *iPtr = (Interp *) interp;
+	    iPtr->compileEpoch++;
+	}
+	cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
+    }
+
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceCommand --
+ *
+ *	Remove a previously-created trace for a command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the command given by cmdName with the
+ *	given flags, proc, and clientData, then that trace is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceCommand(
+    Tcl_Interp *interp,		/* Interpreter containing command. */
+    const char *cmdName,	/* Name of command. */
+    int flags,			/* OR-ed collection of bits, including any of
+				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
+				 * of the TRACE_*_EXEC flags */
+    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    register CommandTrace *tracePtr;
+    CommandTrace *prevPtr;
+    Command *cmdPtr;
+    Interp *iPtr = (Interp *) interp;
+    ActiveCommandTrace *activePtr;
+    int hasExecTraces = 0;
+
+    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return;
+    }
+
+    flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
+
+    for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
+	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    return;
+	}
+	if ((tracePtr->traceProc == proc)
+		&& ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE |
+			TCL_TRACE_ANY_EXEC)) == flags)
+		&& (tracePtr->clientData == clientData)) {
+	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+		hasExecTraces = 1;
+	    }
+	    break;
+	}
+    }
+
+    /*
+     * The code below makes it possible to delete traces while traces are
+     * active: it makes sure that the deleted trace won't be processed by
+     * CallCommandTraces.
+     */
+
+    for (activePtr = iPtr->activeCmdTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    if (activePtr->reverseScan) {
+		activePtr->nextTracePtr = prevPtr;
+	    } else {
+		activePtr->nextTracePtr = tracePtr->nextPtr;
+	    }
+	}
+    }
+    if (prevPtr == NULL) {
+	cmdPtr->tracePtr = tracePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = tracePtr->nextPtr;
+    }
+    tracePtr->flags = 0;
+
+    if ((--tracePtr->refCount) <= 0) {
+	ckfree((char *) tracePtr);
+    }
+
+    if (hasExecTraces) {
+	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
+		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+		return;
+	    }
+	}
+
+	/*
+	 * None of the remaining traces on this command are execution traces.
+	 * We therefore remove this flag:
+	 */
+
+	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
+
+        /*
+	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
+	 */
+	
+	if (cmdPtr->compileProc != NULL) {
+	    Interp *iPtr = (Interp *) interp;
+	    iPtr->compileEpoch++;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceCommandProc --
+ *
+ *	This function is called to handle command changes that have been
+ *	traced using the "trace" command, when using the 'rename' or 'delete'
+ *	options.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+TraceCommandProc(
+    ClientData clientData,	/* Information about the command trace. */
+    Tcl_Interp *interp,		/* Interpreter containing command. */
+    const char *oldName,	/* Name of command being changed. */
+    const char *newName,	/* New name of command. Empty string or NULL
+				 * means command is being deleted (renamed to
+				 * ""). */
+    int flags)			/* OR-ed bits giving operation and other
+				 * information. */
+{
+    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    int code;
+    Tcl_DString cmd;
+
+    tcmdPtr->refCount++;
+
+    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)
+	    && !Tcl_LimitExceeded(interp)) {
+	/*
+	 * Generate a command to execute by appending list elements for the
+	 * old and new command name and the operation.
+	 */
+
+	Tcl_DStringInit(&cmd);
+	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
+	Tcl_DStringAppendElement(&cmd, oldName);
+	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
+	if (flags & TCL_TRACE_RENAME) {
+	    Tcl_DStringAppend(&cmd, " rename", 7);
+	} else if (flags & TCL_TRACE_DELETE) {
+	    Tcl_DStringAppend(&cmd, " delete", 7);
+	}
+
+	/*
+	 * Execute the command. We discard any object result the command
+	 * returns.
+	 *
+	 * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other
+	 * areas that this will be destroyed by us, otherwise a double-free
+	 * might occur depending on what the eval does.
+	 */
+
+	if (flags & TCL_TRACE_DESTROYED) {
+	    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
+	}
+	code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+		Tcl_DStringLength(&cmd), 0);
+	if (code != TCL_OK) {
+	    /* We ignore errors in these traced commands */
+	    /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+	}
+	Tcl_DStringFree(&cmd);
+    }
+
+    /*
+     * We delete when the trace was destroyed or if this is a delete trace,
+     * because command deletes are unconditional, so the trace must go away.
+     */
+
+    if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
+	int untraceFlags = tcmdPtr->flags;
+	Tcl_InterpState state;
+
+	if (tcmdPtr->stepTrace != NULL) {
+	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+	    tcmdPtr->stepTrace = NULL;
+	    if (tcmdPtr->startCmd != NULL) {
+		ckfree((char *) tcmdPtr->startCmd);
+	    }
+	}
+	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+	    /*
+	     * Postpone deletion, until exec trace returns.
+	     */
+
+	    tcmdPtr->flags = 0;
+	}
+
+	/*
+	 * We need to construct the same flags for Tcl_UntraceCommand as were
+	 * passed to Tcl_TraceCommand. Reproduce the processing of [trace add
+	 * execution/command]. Be careful to keep this code in sync with that.
+	 */
+
+	if (untraceFlags & TCL_TRACE_ANY_EXEC) {
+	    untraceFlags |= TCL_TRACE_DELETE;
+	    if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC
+		    | TCL_TRACE_LEAVE_DURING_EXEC)) {
+		untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+	    }
+	} else if (untraceFlags & TCL_TRACE_RENAME) {
+	    untraceFlags |= TCL_TRACE_DELETE;
+	}
+
+	/*
+	 * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the
+	 * command we're tracing has just gone away. Then decrement the
+	 * clientData refCount that was set up by trace creation.
+	 *
+	 * Note that we save the (return) state of the interpreter to prevent
+	 * bizarre error messages.
+	 */
+
+	state = Tcl_SaveInterpState(interp, TCL_OK);
+	Tcl_UntraceCommand(interp, oldName, untraceFlags,
+		TraceCommandProc, clientData);
+	(void) Tcl_RestoreInterpState(interp, state);
+	tcmdPtr->refCount--;
+    }
+    if ((--tcmdPtr->refCount) <= 0) {
+	ckfree((char *) tcmdPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCheckExecutionTraces --
+ *
+ *	Checks on all current command execution traces, and invokes functions
+ *	which have been registered. This function can be used by other code
+ *	which performs execution to unify the tracing system, so that
+ *	execution traces will function for that other code.
+ *
+ *	For instance extensions like [incr Tcl] which use their own execution
+ *	technique can make use of Tcl's tracing.
+ *
+ *	This function is called by 'TclEvalObjvInternal'
+ *
+ * Results:
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR, etc.
+ *
+ * Side effects:
+ *	Those side effects made by any trace functions called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCheckExecutionTraces(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    const char *command,	/* Pointer to beginning of the current command
+				 * string. */
+    int numChars,		/* The number of characters in 'command' which
+				 * are part of the command string. */
+    Command *cmdPtr,		/* Points to command's Command struct. */
+    int code,			/* The current result code. */
+    int traceFlags,		/* Current tracing situation. */
+    int objc,			/* Number of arguments for the command. */
+    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
+{
+    Interp *iPtr = (Interp *) interp;
+    CommandTrace *tracePtr, *lastTracePtr;
+    ActiveCommandTrace active;
+    int curLevel;
+    int traceCode = TCL_OK;
+    Tcl_InterpState state = NULL;
+
+    if (cmdPtr->tracePtr == NULL) {
+	return traceCode;
+    }
+
+    curLevel = iPtr->varFramePtr->level;
+
+    active.nextPtr = iPtr->activeCmdTracePtr;
+    iPtr->activeCmdTracePtr = &active;
+
+    active.cmdPtr = cmdPtr;
+    lastTracePtr = NULL;
+    for (tracePtr = cmdPtr->tracePtr;
+	    (traceCode == TCL_OK) && (tracePtr != NULL);
+	    tracePtr = active.nextTracePtr) {
+	if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
+	    /*
+	     * Execute the trace command in order of creation for "leave".
+	     */
+
+	    active.reverseScan = 1;
+	    active.nextTracePtr = NULL;
+	    tracePtr = cmdPtr->tracePtr;
+	    while (tracePtr->nextPtr != lastTracePtr) {
+		active.nextTracePtr = tracePtr;
+		tracePtr = tracePtr->nextPtr;
+	    }
+	} else {
+	    active.reverseScan = 0;
+	    active.nextTracePtr = tracePtr->nextPtr;
+	}
+	if (tracePtr->traceProc == TraceCommandProc) {
+	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
+		    tracePtr->clientData;
+
+	    if (tcmdPtr->flags != 0) {
+		tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
+		tcmdPtr->curCode  = code;
+		tcmdPtr->refCount++;
+		if (state == NULL) {
+		    state = Tcl_SaveInterpState(interp, code);
+		}
+		traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp,
+			curLevel, command, (Tcl_Command) cmdPtr, objc, objv);
+		if ((--tcmdPtr->refCount) <= 0) {
+		    ckfree((char *) tcmdPtr);
+		}
+	    }
+	}
+	if (active.nextTracePtr) {
+	    lastTracePtr = active.nextTracePtr->nextPtr;
+	}
+    }
+    iPtr->activeCmdTracePtr = active.nextPtr;
+    if (state) {
+	(void) Tcl_RestoreInterpState(interp, state);
+    }
+
+    return(traceCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCheckInterpTraces --
+ *
+ *	Checks on all current traces, and invokes functions which have been
+ *	registered. This function can be used by other code which performs
+ *	execution to unify the tracing system. For instance extensions like
+ *	[incr Tcl] which use their own execution technique can make use of
+ *	Tcl's tracing.
+ *
+ *	This function is called by 'TclEvalObjvInternal'
+ *
+ * Results:
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR, etc.
+ *
+ * Side effects:
+ *	Those side effects made by any trace functions called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCheckInterpTraces(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    const char *command,	/* Pointer to beginning of the current command
+				 * string. */
+    int numChars,		/* The number of characters in 'command' which
+				 * are part of the command string. */
+    Command *cmdPtr,		/* Points to command's Command struct. */
+    int code,			/* The current result code. */
+    int traceFlags,		/* Current tracing situation. */
+    int objc,			/* Number of arguments for the command. */
+    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Trace *tracePtr, *lastTracePtr;
+    ActiveInterpTrace active;
+    int curLevel;
+    int traceCode = TCL_OK;
+    Tcl_InterpState state = NULL;
+
+    if ((iPtr->tracePtr == NULL)
+	    || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
+	return(traceCode);
+    }
+
+    curLevel = iPtr->numLevels;
+
+    active.nextPtr = iPtr->activeInterpTracePtr;
+    iPtr->activeInterpTracePtr = &active;
+
+    lastTracePtr = NULL;
+    for (tracePtr = iPtr->tracePtr;
+	    (traceCode == TCL_OK) && (tracePtr != NULL);
+	    tracePtr = active.nextTracePtr) {
+	if (traceFlags & TCL_TRACE_ENTER_EXEC) {
+	    /*
+	     * Execute the trace command in reverse order of creation for
+	     * "enterstep" operation. The order is changed for "enterstep"
+	     * instead of for "leavestep" as was done in
+	     * TclCheckExecutionTraces because for step traces,
+	     * Tcl_CreateObjTrace creates one more linked list of traces which
+	     * results in one more reversal of trace invocation.
+	     */
+
+	    active.reverseScan = 1;
+	    active.nextTracePtr = NULL;
+	    tracePtr = iPtr->tracePtr;
+	    while (tracePtr->nextPtr != lastTracePtr) {
+		active.nextTracePtr = tracePtr;
+		tracePtr = tracePtr->nextPtr;
+	    }
+	    if (active.nextTracePtr) {
+		lastTracePtr = active.nextTracePtr->nextPtr;
+	    }
+	} else {
+	    active.reverseScan = 0;
+	    active.nextTracePtr = tracePtr->nextPtr;
+	}
+
+	if (tracePtr->level > 0 && curLevel > tracePtr->level) {
+	    continue;
+	}
+
+	if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) {
+	    /*
+	     * The proc invoked might delete the traced command which which
+	     * might try to free tracePtr. We want to use tracePtr until the
+	     * end of this if section, so we use Tcl_Preserve() and
+	     * Tcl_Release() to be sure it is not freed while we still need
+	     * it.
+	     */
+
+	    Tcl_Preserve((ClientData) tracePtr);
+	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+	    if (state == NULL) {
+		state = Tcl_SaveInterpState(interp, code);
+	    }
+
+	    if (tracePtr->flags &
+		    (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
+		/*
+		 * New style trace.
+		 */
+
+		if (tracePtr->flags & traceFlags) {
+		    if (tracePtr->proc == TraceExecutionProc) {
+			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
+				tracePtr->clientData;
+
+			tcmdPtr->curFlags = traceFlags;
+			tcmdPtr->curCode = code;
+		    }
+		    traceCode = (tracePtr->proc)(tracePtr->clientData,
+			    interp, curLevel, command, (Tcl_Command) cmdPtr,
+			    objc, objv);
+		}
+	    } else {
+		/*
+		 * Old-style trace.
+		 */
+
+		if (traceFlags & TCL_TRACE_ENTER_EXEC) {
+		    /*
+		     * Old-style interpreter-wide traces only trigger before
+		     * the command is executed.
+		     */
+
+		    traceCode = CallTraceFunction(interp, tracePtr, cmdPtr,
+			    command, numChars, objc, objv);
+		}
+	    }
+	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
+	    Tcl_Release((ClientData) tracePtr);
+	}
+    }
+    iPtr->activeInterpTracePtr = active.nextPtr;
+    if (state) {
+	if (traceCode == TCL_OK) {
+	    (void) Tcl_RestoreInterpState(interp, state);
+	} else {
+	    Tcl_DiscardInterpState(state);
+	}
+    }
+
+    return(traceCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraceFunction --
+ *
+ *	Invokes a trace function registered with an interpreter. These
+ *	functions trace command execution. Currently this trace function is
+ *	called with the address of the string-based Tcl_CmdProc for the
+ *	command, not the Tcl_ObjCmdProc.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Those side effects made by the trace function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CallTraceFunction(
+    Tcl_Interp *interp,		/* The current interpreter. */
+    register Trace *tracePtr,	/* Describes the trace function to call. */
+    Command *cmdPtr,		/* Points to command's Command struct. */
+    const char *command,	/* Points to the first character of the
+				 * command's source before substitutions. */
+    int numChars,		/* The number of characters in the command's
+				 * source. */
+    register int objc,		/* Number of arguments for the command. */
+    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *commandCopy;
+    int traceCode;
+
+    /*
+     * Copy the command characters into a new string.
+     */
+
+    commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
+    memcpy(commandCopy, command, (size_t) numChars);
+    commandCopy[numChars] = '\0';
+
+    /*
+     * Call the trace function then free allocated storage.
+     */
+
+    traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr,
+	    iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
+
+    TclStackFree(interp, commandCopy);
+    return traceCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommandObjTraceDeleted --
+ *
+ *	Ensure the trace is correctly deleted by decrementing its refCount and
+ *	only deleting if no other references exist.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May release memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CommandObjTraceDeleted(
+    ClientData clientData)
+{
+    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+    if ((--tcmdPtr->refCount) <= 0) {
+	ckfree((char *) tcmdPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceExecutionProc --
+ *
+ *	This function is invoked whenever code relevant to a 'trace execution'
+ *	command is executed. It is called in one of two ways in Tcl's core:
+ *
+ *	(i) by the TclCheckExecutionTraces, when an execution trace has been
+ *	triggered.
+ *	(ii) by TclCheckInterpTraces, when a prior execution trace has created
+ *	a trace of the internals of a procedure, passing in this function as
+ *	the one to be called.
+ *
+ * Results:
+ *	The return value is a standard Tcl completion code such as TCL_OK or
+ *	TCL_ERROR, etc.
+ *
+ * Side effects:
+ *	May invoke an arbitrary Tcl procedure, and may create or delete an
+ *	interpreter-wide trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceExecutionProc(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int level,
+    const char *command,
+    Tcl_Command cmdInfo,
+    int objc,
+    struct Tcl_Obj *const objv[])
+{
+    int call = 0;
+    Interp *iPtr = (Interp *) interp;
+    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    int flags = tcmdPtr->curFlags;
+    int code = tcmdPtr->curCode;
+    int traceCode = TCL_OK;
+
+    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+	/*
+	 * Inside any kind of execution trace callback, we do not allow any
+	 * further execution trace callbacks to be called for the same trace.
+	 */
+
+	return traceCode;
+    }
+
+    if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
+	/*
+	 * Check whether the current call is going to eval arbitrary Tcl code
+	 * with a generated trace, or whether we are only going to setup
+	 * interpreter-wide traces to implement the 'step' traces. This latter
+	 * situation can happen if we create a command trace without either
+	 * before or after operations, but with either of the step operations.
+	 */
+
+	if (flags & TCL_TRACE_EXEC_DIRECT) {
+	    call = flags & tcmdPtr->flags &
+		    (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+	} else {
+	    call = 1;
+	}
+
+	/*
+	 * First, if we have returned back to the level at which we created an
+	 * interpreter trace for enterstep and/or leavestep execution traces,
+	 * we remove it here.
+	 */
+
+	if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL)
+		&& (level == tcmdPtr->startLevel)
+		&& (strcmp(command, tcmdPtr->startCmd) == 0)) {
+	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+	    tcmdPtr->stepTrace = NULL;
+	    if (tcmdPtr->startCmd != NULL) {
+		ckfree((char *) tcmdPtr->startCmd);
+	    }
+	}
+
+	/*
+	 * Second, create the tcl callback, if required.
+	 */
+
+	if (call) {
+	    Tcl_DString cmd;
+	    Tcl_DString sub;
+	    int i, saveInterpFlags;
+
+	    Tcl_DStringInit(&cmd);
+	    Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
+
+	    /*
+	     * Append command with arguments.
+	     */
+
+	    Tcl_DStringInit(&sub);
+	    for (i = 0; i < objc; i++) {
+		Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i]));
+	    }
+	    Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
+	    Tcl_DStringFree(&sub);
+
+	    if (flags & TCL_TRACE_ENTER_EXEC) {
+		/*
+		 * Append trace operation.
+		 */
+
+		if (flags & TCL_TRACE_EXEC_DIRECT) {
+		    Tcl_DStringAppendElement(&cmd, "enter");
+		} else {
+		    Tcl_DStringAppendElement(&cmd, "enterstep");
+		}
+	    } else if (flags & TCL_TRACE_LEAVE_EXEC) {
+		Tcl_Obj *resultCode;
+		char *resultCodeStr;
+
+		/*
+		 * Append result code.
+		 */
+
+		resultCode = Tcl_NewIntObj(code);
+		resultCodeStr = Tcl_GetString(resultCode);
+		Tcl_DStringAppendElement(&cmd, resultCodeStr);
+		Tcl_DecrRefCount(resultCode);
+
+		/*
+		 * Append result string.
+		 */
+
+		Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp));
+
+		/*
+		 * Append trace operation.
+		 */
+
+		if (flags & TCL_TRACE_EXEC_DIRECT) {
+		    Tcl_DStringAppendElement(&cmd, "leave");
+		} else {
+		    Tcl_DStringAppendElement(&cmd, "leavestep");
+		}
+	    } else {
+		Tcl_Panic("TraceExecutionProc: bad flag combination");
+	    }
+
+	    /*
+	     * Execute the command. We discard any object result the command
+	     * returns.
+	     */
+
+	    saveInterpFlags = iPtr->flags;
+	    iPtr->flags    |= INTERP_TRACE_IN_PROGRESS;
+	    tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+	    tcmdPtr->refCount++;
+
+	    /*
+	     * This line can have quite arbitrary side-effects, including
+	     * deleting the trace, the command being traced, or even the
+	     * interpreter.
+	     */
+
+	    traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	    tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
+
+	    /*
+	     * Restore the interp tracing flag to prevent cmd traces from
+	     * affecting interp traces.
+	     */
+
+	    iPtr->flags = saveInterpFlags;
+	    if (tcmdPtr->flags == 0) {
+		flags |= TCL_TRACE_DESTROYED;
+	    }
+	    Tcl_DStringFree(&cmd);
+	}
+
+	/*
+	 * Third, if there are any step execution traces for this proc, we
+	 * register an interpreter trace to invoke enterstep and/or leavestep
+	 * traces. We also need to save the current stack level and the proc
+	 * string in startLevel and startCmd so that we can delete this
+	 * interpreter trace when it reaches the end of this proc.
+	 */
+
+	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
+		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
+			TCL_TRACE_LEAVE_DURING_EXEC))) {
+	    register unsigned len = strlen(command) + 1;
+
+	    tcmdPtr->startLevel = level;
+	    tcmdPtr->startCmd = ckalloc(len);
+	    memcpy(tcmdPtr->startCmd, command, len);
+	    tcmdPtr->refCount++;
+	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
+		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
+		   TraceExecutionProc, (ClientData)tcmdPtr,
+		   CommandObjTraceDeleted);
+	}
+    }
+    if (flags & TCL_TRACE_DESTROYED) {
+	if (tcmdPtr->stepTrace != NULL) {
+	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+	    tcmdPtr->stepTrace = NULL;
+	    if (tcmdPtr->startCmd != NULL) {
+		ckfree(tcmdPtr->startCmd);
+	    }
+	}
+    }
+    if (call) {
+	if ((--tcmdPtr->refCount) <= 0) {
+	    ckfree((char *) tcmdPtr);
+	}
+    }
+    return traceCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarProc --
+ *
+ *	This function is called to handle variable accesses that have been
+ *	traced using the "trace" command.
+ *
+ * Results:
+ *	Normally returns NULL. If the trace command returns an error, then
+ *	this function returns an error string.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static char *
+TraceVarProc(
+    ClientData clientData,	/* Information about the variable trace. */
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *name1,		/* Name of variable or array. */
+    const char *name2,		/* Name of element within array; NULL means
+				 * scalar variable is being referenced. */
+    int flags)			/* OR-ed bits giving operation and other
+				 * information. */
+{
+    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+    char *result;
+    int code, destroy = 0;
+    Tcl_DString cmd;
+
+    /*
+     * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
+     * which might try to free tvarPtr. We want to use tvarPtr until the end
+     * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
+     * it is not freed while we still need it.
+     */
+
+    result = NULL;
+    if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)
+	    && !Tcl_LimitExceeded(interp)) {
+	if (tvarPtr->length != (size_t) 0) {
+	    /*
+	     * Generate a command to execute by appending list elements for
+	     * the two variable names and the operation.
+	     */
+
+	    Tcl_DStringInit(&cmd);
+	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
+	    Tcl_DStringAppendElement(&cmd, name1);
+	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
+		if (flags & TCL_TRACE_ARRAY) {
+		    Tcl_DStringAppend(&cmd, " a", 2);
+		} else if (flags & TCL_TRACE_READS) {
+		    Tcl_DStringAppend(&cmd, " r", 2);
+		} else if (flags & TCL_TRACE_WRITES) {
+		    Tcl_DStringAppend(&cmd, " w", 2);
+		} else if (flags & TCL_TRACE_UNSETS) {
+		    Tcl_DStringAppend(&cmd, " u", 2);
+		}
+	    } else {
+#endif
+		if (flags & TCL_TRACE_ARRAY) {
+		    Tcl_DStringAppend(&cmd, " array", 6);
+		} else if (flags & TCL_TRACE_READS) {
+		    Tcl_DStringAppend(&cmd, " read", 5);
+		} else if (flags & TCL_TRACE_WRITES) {
+		    Tcl_DStringAppend(&cmd, " write", 6);
+		} else if (flags & TCL_TRACE_UNSETS) {
+		    Tcl_DStringAppend(&cmd, " unset", 6);
+		}
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	    }
+#endif
+
+	    /*
+	     * Execute the command. We discard any object result the command
+	     * returns.
+	     *
+	     * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
+	     * other areas that this will be destroyed by us, otherwise a
+	     * double-free might occur depending on what the eval does.
+	     */
+
+	    if ((flags & TCL_TRACE_DESTROYED)
+		    && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
+		destroy = 1;
+		tvarPtr->flags |= TCL_TRACE_DESTROYED;
+	    }
+	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+		    Tcl_DStringLength(&cmd), 0);
+	    if (code != TCL_OK) {		/* copy error msg to result */
+		Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+		Tcl_IncrRefCount(errMsgObj);
+		result = (char *) errMsgObj;
+	    }
+	    Tcl_DStringFree(&cmd);
+	}
+    }
+    if (destroy && result != NULL) {
+	register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+
+	Tcl_DecrRefCount(errMsgObj);
+	result = NULL;
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateObjTrace --
+ *
+ *	Arrange for a function to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed to
+ *	Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command function is
+ *	called to execute a Tcl command. Calls to proc will have the following
+ *	form:
+ *
+ *	void proc(ClientData	 clientData,
+ *		  Tcl_Interp *	 interp,
+ *		  int		 level,
+ *		  const char *	 command,
+ *		  Tcl_Command	 commandInfo,
+ *		  int		 objc,
+ *		  Tcl_Obj *const objv[]);
+ *
+ *	The 'clientData' and 'interp' arguments to 'proc' will be the same as
+ *	the arguments to Tcl_CreateObjTrace. The 'level' argument gives the
+ *	nesting depth of command interpretation within the interpreter. The
+ *	'command' argument is the ASCII text of the command being evaluated -
+ *	before any substitutions are performed. The 'commandInfo' argument
+ *	gives a handle to the command procedure that will be evaluated. The
+ *	'objc' and 'objv' parameters give the parameter vector that will be
+ *	passed to the command procedure. Proc does not return a value.
+ *
+ *	It is permissible for 'proc' to call Tcl_SetCommandTokenInfo to change
+ *	the command procedure or client data for the command being evaluated,
+ *	and these changes will take effect with the current evaluation.
+ *
+ *	The 'level' argument specifies the maximum nesting level of calls to
+ *	be traced. If the execution depth of the interpreter exceeds 'level',
+ *	the trace callback is not executed.
+ *
+ *	The 'flags' argument is either zero or the value,
+ *	TCL_ALLOW_INLINE_COMPILATION. If the TCL_ALLOW_INLINE_COMPILATION flag
+ *	is not present, the bytecode compiler will not generate inline code
+ *	for Tcl's built-in commands. This behavior will have a significant
+ *	impact on performance, but will ensure that all command evaluations
+ *	are traced. If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
+ *	bytecode compiler will have its normal behavior of compiling in-line
+ *	code for some of Tcl's built-in commands. In this case, the tracing
+ *	will be imprecise - in-line code will not be traced - but run-time
+ *	performance will be improved. The latter behavior is desired for many
+ *	applications such as profiling of run time.
+ *
+ *	When the trace is deleted, the 'delProc' function will be invoked,
+ *	passing it the original client data.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateObjTrace(
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    int level,			/* Maximum nesting level */
+    int flags,			/* Flags, see above */
+    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
+    ClientData clientData,	/* Client data for the callback */
+    Tcl_CmdObjTraceDeleteProc *delProc)
+				/* Function to call when trace is deleted */
+{
+    register Trace *tracePtr;
+    register Interp *iPtr = (Interp *) interp;
+
+    /*
+     * Test if this trace allows inline compilation of commands.
+     */
+
+    if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
+	if (iPtr->tracesForbiddingInline == 0) {
+	    /*
+	     * When the first trace forbidding inline compilation is created,
+	     * invalidate existing compiled code for this interpreter and
+	     * arrange (by setting the DONT_COMPILE_CMDS_INLINE flag) that
+	     * when compiling new code, no commands will be compiled inline
+	     * (i.e., into an inline sequence of instructions). We do this
+	     * because commands that were compiled inline will never result in
+	     * a command trace being called.
+	     */
+
+	    iPtr->compileEpoch++;
+	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+	}
+	iPtr->tracesForbiddingInline++;
+    }
+
+    tracePtr = (Trace *) ckalloc(sizeof(Trace));
+    tracePtr->level = level;
+    tracePtr->proc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->delProc = delProc;
+    tracePtr->nextPtr = iPtr->tracePtr;
+    tracePtr->flags = flags;
+    iPtr->tracePtr = tracePtr;
+
+    return (Tcl_Trace) tracePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateTrace --
+ *
+ *	Arrange for a function to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed to
+ *	Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command procedure is
+ *	called to execute a Tcl command. Calls to proc will have the following
+ *	form:
+ *
+ *	void
+ *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
+ *		argc, argv)
+ *	    ClientData clientData;
+ *	    Tcl_Interp *interp;
+ *	    int level;
+ *	    char *command;
+ *	    int (*cmdProc)();
+ *	    ClientData cmdClientData;
+ *	    int argc;
+ *	    char **argv;
+ *	{
+ *	}
+ *
+ *	The clientData and interp arguments to proc will be the same as the
+ *	corresponding arguments to this function. Level gives the nesting
+ *	level of command interpretation for this interpreter (0 corresponds to
+ *	top level). Command gives the ASCII text of the raw command, cmdProc
+ *	and cmdClientData give the function that will be called to process the
+ *	command and the ClientData value it will receive, and argc and argv
+ *	give the arguments to the command, after any argument parsing and
+ *	substitution. Proc does not return a value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateTrace(
+    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
+    int level,			/* Only call proc for commands at nesting
+				 * level<=argument level (1=>top level). */
+    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
+				 * command. */
+    ClientData clientData)	/* Arbitrary value word to pass to proc. */
+{
+    StringTraceData *data = (StringTraceData *)
+	    ckalloc(sizeof(StringTraceData));
+
+    data->clientData = clientData;
+    data->proc = proc;
+    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
+	    (ClientData) data, StringTraceDeleteProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceProc --
+ *
+ *	Invoke a string-based trace function from an object-based callback.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the string-based trace function does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTraceProc(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int level,
+    const char *command,
+    Tcl_Command commandInfo,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    StringTraceData *data = (StringTraceData *) clientData;
+    Command *cmdPtr = (Command *) commandInfo;
+    const char **argv;		/* Args to pass to string trace proc */
+    int i;
+
+    /*
+     * This is a bit messy because we have to emulate the old trace interface,
+     * which uses strings for everything.
+     */
+
+    argv = (const char **) TclStackAlloc(interp,
+	    (unsigned) ((objc + 1) * sizeof(const char *)));
+    for (i = 0; i < objc; i++) {
+	argv[i] = Tcl_GetString(objv[i]);
+    }
+    argv[objc] = 0;
+
+    /*
+     * Invoke the command function. Note that we cast away const-ness on two
+     * parameters for compatibility with legacy code; the code MUST NOT modify
+     * either command or argv.
+     */
+
+    (data->proc)(data->clientData, interp, level, (char *) command,
+	    cmdPtr->proc, cmdPtr->clientData, objc, argv);
+    TclStackFree(interp, (void *) argv);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceDeleteProc --
+ *
+ *	Clean up memory when a string-based trace is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated memory is returned to the system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StringTraceDeleteProc(
+    ClientData clientData)
+{
+    ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteTrace --
+ *
+ *	Remove a trace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on there will be no more calls to the function given in
+ *	trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteTrace(
+    Tcl_Interp *interp,		/* Interpreter that contains trace. */
+    Tcl_Trace trace)		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
+{
+    Interp *iPtr = (Interp *) interp;
+    Trace *prevPtr, *tracePtr = (Trace *) trace;
+    register Trace **tracePtr2 = &(iPtr->tracePtr);
+    ActiveInterpTrace *activePtr;
+
+    /*
+     * Locate the trace entry in the interpreter's trace list, and remove it
+     * from the list.
+     */
+
+    prevPtr = NULL;
+    while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
+	prevPtr = *tracePtr2;
+	tracePtr2 = &((*tracePtr2)->nextPtr);
+    }
+    if (*tracePtr2 == NULL) {
+	return;
+    }
+    (*tracePtr2) = (*tracePtr2)->nextPtr;
+
+    /*
+     * The code below makes it possible to delete traces while traces are
+     * active: it makes sure that the deleted trace won't be processed by
+     * TclCheckInterpTraces.
+     */
+
+    for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    if (activePtr->reverseScan) {
+		activePtr->nextTracePtr = prevPtr;
+	    } else {
+		activePtr->nextTracePtr = tracePtr->nextPtr;
+	    }
+	}
+    }
+
+    /*
+     * If the trace forbids bytecode compilation, change the interpreter's
+     * state. If bytecode compilation is now permitted, flag the fact and
+     * advance the compilation epoch so that procs will be recompiled to take
+     * advantage of it.
+     */
+
+    if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) {
+	iPtr->tracesForbiddingInline--;
+	if (iPtr->tracesForbiddingInline == 0) {
+	    iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+	    iPtr->compileEpoch++;
+	}
+    }
+
+    /*
+     * Execute any delete callback.
+     */
+
+    if (tracePtr->delProc != NULL) {
+	(tracePtr->delProc)(tracePtr->clientData);
+    }
+
+    /*
+     * Delete the trace object.
+     */
+
+    Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceVarExists --
+ *
+ *	This is called from info exists. We need to trigger read and/or array
+ *	traces because they may end up creating a variable that doesn't
+ *	currently exist.
+ *
+ * Results:
+ *	A pointer to the Var structure, or NULL.
+ *
+ * Side effects:
+ *	May fill in error messages in the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Var *
+TclVarTraceExists(
+    Tcl_Interp *interp,		/* The interpreter */
+    const char *varName)	/* The variable name */
+{
+    Var *varPtr;
+    Var *arrayPtr;
+
+    /*
+     * The choice of "create" flag values is delicate here, and matches the
+     * semantics of GetVar. Things are still not perfect, however, because if
+     * you do "info exists x" you get a varPtr and therefore trigger traces.
+     * However, if you do "info exists x(i)", then you only get a varPtr if x
+     * is already known to be an array. Otherwise you get NULL, and no trace
+     * is triggered. This matches Tcl 7.6 semantics.
+     */
+
+    varPtr = TclLookupVar(interp, varName, NULL, 0, "access",
+	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+
+    if (varPtr == NULL) {
+	return NULL;
+    }
+
+    if ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
+	TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
+		TCL_TRACE_READS, /* leaveErrMsg */ 0);
+    }
+
+    /*
+     * If the variable doesn't exist anymore and no-one's using it, then free
+     * up the relevant structures and hash table entries.
+     */
+
+    if (TclIsVarUndefined(varPtr)) {
+	TclCleanupVar(varPtr, arrayPtr);
+	return NULL;
+    }
+
+    return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCallVarTraces --
+ *
+ *	This function is invoked to find and invoke relevant trace functions
+ *	associated with a particular operation on a variable. This function
+ *	invokes traces both on the variable and on its containing array (where
+ *	relevant).
+ *
+ * Results:
+ *	Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
+ *	invocation of a trace function indicated an error. When TCL_ERROR is
+ *	returned and leaveErrMsg is true, then the errorInfo field of iPtr has
+ *	information about the error placed in it.
+ *
+ * Side effects:
+ *	Almost anything can happen, depending on trace; this function itself
+ *	doesn't have any side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclObjCallVarTraces(
+    Interp *iPtr,		/* Interpreter containing variable. */
+    register Var *arrayPtr,	/* Pointer to array variable that contains the
+				 * variable, or NULL if the variable isn't an
+				 * element of an array. */
+    Var *varPtr,		/* Variable whose traces are to be invoked. */
+    Tcl_Obj *part1Ptr,
+    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
+    int flags,			/* Flags passed to trace functions: indicates
+				 * what's happening to variable, plus maybe
+				 * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
+    int leaveErrMsg,		/* If true, and one of the traces indicates an
+				 * error, then leave an error message and
+				 * stack trace information in *iPTr. */
+    int index)			/* Index into the local variable table of the
+				 * variable, or -1. Only used when part1Ptr is
+				 * NULL. */
+{
+    char *part1, *part2;
+
+    if (!part1Ptr) {
+	part1Ptr = localName(iPtr->varFramePtr, index);
+    }
+    part1 = TclGetString(part1Ptr);
+    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
+
+    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
+	    leaveErrMsg);
+}
+
+int
+TclCallVarTraces(
+    Interp *iPtr,		/* Interpreter containing variable. */
+    register Var *arrayPtr,	/* Pointer to array variable that contains the
+				 * variable, or NULL if the variable isn't an
+				 * element of an array. */
+    Var *varPtr,		/* Variable whose traces are to be invoked. */
+    const char *part1,
+    const char *part2,		/* Variable's two-part name. */
+    int flags,			/* Flags passed to trace functions: indicates
+				 * what's happening to variable, plus maybe
+				 * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
+    int leaveErrMsg)		/* If true, and one of the traces indicates an
+				 * error, then leave an error message and
+				 * stack trace information in *iPTr. */
+{
+    register VarTrace *tracePtr;
+    ActiveVarTrace active;
+    char *result;
+    const char *openParen, *p;
+    Tcl_DString nameCopy;
+    int copiedName;
+    int code = TCL_OK;
+    int disposeFlags = 0;
+    Tcl_InterpState state = NULL;
+    Tcl_HashEntry *hPtr;
+    int traceflags = flags & VAR_ALL_TRACES;
+
+    /*
+     * If there are already similar trace functions active for the variable,
+     * don't call them again.
+     */
+
+    if (TclIsVarTraceActive(varPtr)) {
+	return code;
+    }
+    TclSetVarTraceActive(varPtr);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	VarHashRefCount(arrayPtr)++;
+    }
+
+    /*
+     * If the variable name hasn't been parsed into array name and element, do
+     * it here. If there really is an array element, make a copy of the
+     * original name so that NULLs can be inserted into it to separate the
+     * names (can't modify the name string in place, because the string might
+     * get used by the callbacks we invoke).
+     */
+
+    copiedName = 0;
+    if (part2 == NULL) {
+	for (p = part1; *p ; p++) {
+	    if (*p == '(') {
+		openParen = p;
+		do {
+		    p++;
+		} while (*p != '\0');
+		p--;
+		if (*p == ')') {
+		    int offset = (openParen - part1);
+		    char *newPart1;
+
+		    Tcl_DStringInit(&nameCopy);
+		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+		    newPart1 = Tcl_DStringValue(&nameCopy);
+		    newPart1[offset] = 0;
+		    part1 = newPart1;
+		    part2 = newPart1 + offset + 1;
+		    copiedName = 1;
+		}
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Ignore any caller-provided TCL_INTERP_DESTROYED flag.  Only we can
+     * set it correctly.
+     */
+
+    flags &= ~TCL_INTERP_DESTROYED;
+
+    /*
+     * Invoke traces on the array containing the variable, if relevant.
+     */
+
+    result = NULL;
+    active.nextPtr = iPtr->activeVarTracePtr;
+    iPtr->activeVarTracePtr = &active;
+    Tcl_Preserve((ClientData) iPtr);
+    if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
+	    && (arrayPtr->flags & traceflags)) {
+	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
+	active.varPtr = arrayPtr;
+	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
+	    active.nextTracePtr = tracePtr->nextPtr;
+	    if (!(tracePtr->flags & flags)) {
+		continue;
+	    }
+	    Tcl_Preserve((ClientData) tracePtr);
+	    if (state == NULL) {
+		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+	    }
+	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
+		flags |= TCL_INTERP_DESTROYED;
+	    }
+	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+		    (Tcl_Interp *) iPtr, part1, part2, flags);
+	    if (result != NULL) {
+		if (flags & TCL_TRACE_UNSETS) {
+		    /*
+		     * Ignore errors in unset traces.
+		     */
+
+		    DisposeTraceResult(tracePtr->flags, result);
+		} else {
+		    disposeFlags = tracePtr->flags;
+		    code = TCL_ERROR;
+		}
+	    }
+	    Tcl_Release((ClientData) tracePtr);
+	    if (code == TCL_ERROR) {
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     * Invoke traces on the variable itself.
+     */
+
+    if (flags & TCL_TRACE_UNSETS) {
+	flags |= TCL_TRACE_DESTROYED;
+    }
+    active.varPtr = varPtr;
+    if (varPtr->flags & traceflags) {
+	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
+	    active.nextTracePtr = tracePtr->nextPtr;
+	    if (!(tracePtr->flags & flags)) {
+		continue;
+	    }
+	    Tcl_Preserve((ClientData) tracePtr);
+	    if (state == NULL) {
+		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+	    }
+	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
+		flags |= TCL_INTERP_DESTROYED;
+	    }
+	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+		    (Tcl_Interp *) iPtr, part1, part2, flags);
+	    if (result != NULL) {
+		if (flags & TCL_TRACE_UNSETS) {
+		    /*
+		     * Ignore errors in unset traces.
+		     */
+
+		    DisposeTraceResult(tracePtr->flags, result);
+		} else {
+		    disposeFlags = tracePtr->flags;
+		    code = TCL_ERROR;
+		}
+	    }
+	    Tcl_Release((ClientData) tracePtr);
+	    if (code == TCL_ERROR) {
+		goto done;
+	    }
+	}
+    }
+
+    /*
+     * Restore the variable's flags, remove the record of our active traces,
+     * and then return.
+     */
+
+  done:
+    if (code == TCL_ERROR) {
+	if (leaveErrMsg) {
+	    const char *verb = "";
+	    const char *type = "";
+
+	    switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
+	    case TCL_TRACE_READS:
+		verb = "read";
+		type = verb;
+		break;
+	    case TCL_TRACE_WRITES:
+		verb = "set";
+		type = "write";
+		break;
+	    case TCL_TRACE_ARRAY:
+		verb = "trace array";
+		type = "array";
+		break;
+	    }
+
+	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
+	    } else {
+		Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
+	    }
+	    Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
+
+	    Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf(
+		    "\n    (%s trace on \"%s%s%s%s\")", type, part1,
+		    (part2 ? "(" : ""), (part2 ? part2 : ""),
+		    (part2 ? ")" : "") ));
+	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
+		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb,
+			Tcl_GetString((Tcl_Obj *) result));
+	    } else {
+		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result);
+	    }
+	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
+	    Tcl_DiscardInterpState(state);
+	} else {
+	    (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+	}
+	DisposeTraceResult(disposeFlags,result);
+    } else if (state) {
+	if (code == TCL_OK) {
+	    code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+	} else {
+	    Tcl_DiscardInterpState(state);
+	}
+    }
+
+    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	VarHashRefCount(arrayPtr)--;
+    }
+    if (copiedName) {
+	Tcl_DStringFree(&nameCopy);
+    }
+    TclClearVarTraceActive(varPtr);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
+    iPtr->activeVarTracePtr = active.nextPtr;
+    Tcl_Release((ClientData) iPtr);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeTraceResult--
+ *
+ *	This function is called to dispose of the result returned from a trace
+ *	function. The disposal method appropriate to the type of result is
+ *	determined by flags.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The memory allocated for the trace result may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeTraceResult(
+    int flags,			/* Indicates type of result to determine
+				 * proper disposal method. */
+    char *result)		/* The result returned from a trace function
+				 * to be disposed. */
+{
+    if (flags & TCL_TRACE_RESULT_DYNAMIC) {
+	ckfree(result);
+    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
+	Tcl_DecrRefCount((Tcl_Obj *) result);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by varName with the
+ *	given flags, proc, and clientData, then that trace is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *varName,	/* Name of variable; may end with "(index)" to
+				 * signify an array reference. */
+    int flags,			/* OR-ed collection of bits describing current
+				 * trace, including any of TCL_TRACE_READS,
+				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
+				 * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceVar2 --
+ *
+ *	Remove a previously-created trace for a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the variable given by part1 and part2 with
+ *	the given flags, proc, and clientData, then that trace is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_UntraceVar2(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *part1,		/* Name of variable or array. */
+    const char *part2,		/* Name of element within array; NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags,			/* OR-ed collection of bits describing current
+				 * trace, including any of TCL_TRACE_READS,
+				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
+				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    register VarTrace *tracePtr;
+    VarTrace *prevPtr, *nextPtr;
+    Var *varPtr, *arrayPtr;
+    Interp *iPtr = (Interp *) interp;
+    ActiveVarTrace *activePtr;
+    int flagMask, allFlags = 0;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * Set up a mask to mask out the parts of the flags that we are not
+     * interested in now.
+     */
+
+    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+    varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL || !(varPtr->flags & VAR_ALL_TRACES & flags)) {
+	return;
+    }
+
+    /*
+     * Set up a mask to mask out the parts of the flags that we are not
+     * interested in now.
+     */
+
+    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+    flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+    flags &= flagMask;
+
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+	    (char *) varPtr);
+    for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
+	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    goto updateFlags;
+	}
+	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
+		&& (tracePtr->clientData == clientData)) {
+	    break;
+	}
+	allFlags |= tracePtr->flags;
+    }
+
+    /*
+     * The code below makes it possible to delete traces while traces are
+     * active: it makes sure that the deleted trace won't be processed by
+     * TclCallVarTraces.
+     *
+     * Caveat (Bug 3062331): When an unset trace handler on a variable
+     * tries to delete a different unset trace handler on the same variable,
+     * the results may be surprising.  When variable unset traces fire, the
+     * traced variable is already gone.  So the TclLookupVar() call above
+     * will not find that variable, and not finding it will never reach here
+     * to perform the deletion.  This means callers of Tcl_UntraceVar*()
+     * attempting to delete unset traces from within the handler of another
+     * unset trace have to account for the possibility that their call to
+     * Tcl_UntraceVar*() is a no-op.
+     */
+
+    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	}
+    }
+    nextPtr = tracePtr->nextPtr;
+    if (prevPtr == NULL) {
+	if (nextPtr) {
+	    Tcl_SetHashValue(hPtr, nextPtr);
+	} else {
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+    } else {
+	prevPtr->nextPtr = nextPtr;
+    }
+    tracePtr->nextPtr = NULL;
+    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+
+    for (tracePtr = nextPtr; tracePtr != NULL;
+	    tracePtr = tracePtr->nextPtr) {
+	allFlags |= tracePtr->flags;
+    }
+
+  updateFlags:
+    varPtr->flags &= ~VAR_ALL_TRACES;
+    if (allFlags & VAR_ALL_TRACES) {
+	varPtr->flags |= (allFlags & VAR_ALL_TRACES);
+    } else if (TclIsVarUndefined(varPtr)) {
+	/*
+	 * If this is the last trace on the variable, and the variable is
+	 * unset and unused, then free up the variable.
+	 */
+
+	TclCleanupVar(varPtr, NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo --
+ *
+ *	Return the clientData value associated with a trace on a variable.
+ *	This function can also be used to step through all of the traces on a
+ *	particular variable that have the same trace function.
+ *
+ * Results:
+ *	The return value is the clientData value associated with a trace on
+ *	the given variable. Information will only be returned for a trace with
+ *	proc as trace function. If the clientData argument is NULL then the
+ *	first such trace is returned; otherwise, the next relevant one after
+ *	the one given by clientData will be returned. If the variable doesn't
+ *	exist, or if there are no (more) traces for it, then NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_VarTraceInfo(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *varName,	/* Name of variable; may end with "(index)" to
+				 * signify an array reference. */
+    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY (can be 0). */
+    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
+    ClientData prevClientData)	/* If non-NULL, gives last value returned by
+				 * this function, so this call will return the
+				 * next trace after that one. If NULL, this
+				 * call will return the first trace. */
+{
+    return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
+	    prevClientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarTraceInfo2 --
+ *
+ *	Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
+ *	one.
+ *
+ * Results:
+ *	Same as Tcl_VarTraceInfo.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_VarTraceInfo2(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *part1,		/* Name of variable or array. */
+    const char *part2,		/* Name of element within array; NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
+    ClientData prevClientData)	/* If non-NULL, gives last value returned by
+				 * this function, so this call will return the
+				 * next trace after that one. If NULL, this
+				 * call will return the first trace. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register VarTrace *tracePtr;
+    Var *varPtr, *arrayPtr;
+    Tcl_HashEntry *hPtr;
+
+    varPtr = TclLookupVar(interp, part1, part2,
+	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
+	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
+
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+	    (char *) varPtr);
+
+    if (hPtr) {
+	tracePtr = Tcl_GetHashValue(hPtr);
+
+	if (prevClientData != NULL) {
+	    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+		if ((tracePtr->clientData == prevClientData)
+			&& (tracePtr->traceProc == proc)) {
+		    tracePtr = tracePtr->nextPtr;
+		    break;
+		}
+	    }
+	}
+	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
+	    if (tracePtr->traceProc == proc) {
+		return tracePtr->clientData;
+	    }
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a function to
+ *	be invoked, which can monitor the operations and/or change their
+ *	actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by varName, such that future
+ *	references to the variable will be intermediated by proc. See the
+ *	manual entry for complete details on the calling sequence for proc.
+ *     The variable's flags are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar(
+    Tcl_Interp *interp,		/* Interpreter in which variable is to be
+				 * traced. */
+    const char *varName,	/* Name of variable; may end with "(index)" to
+				 * signify an array reference. */
+    int flags,			/* OR-ed collection of bits, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
+				 * TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceVar2 --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a function to
+ *	be invoked, which can monitor the operations and/or change their
+ *	actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by part1 and part2, such that
+ *	future references to the variable will be intermediated by proc. See
+ *	the manual entry for complete details on the calling sequence for
+ *	proc. The variable's flags are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceVar2(
+    Tcl_Interp *interp,		/* Interpreter in which variable is to be
+				 * traced. */
+    const char *part1,		/* Name of scalar variable or array. */
+    const char *part2,		/* Name of element within array; NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    int flags,			/* OR-ed collection of bits, including any of
+				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
+				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
+				 * TCL_NAMESPACE_ONLY. */
+    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData)	/* Arbitrary argument to pass to proc. */
+{
+    register VarTrace *tracePtr;
+    int result;
+
+    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+    tracePtr->traceProc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->flags = flags;
+
+    result = TraceVarEx(interp, part1, part2, tracePtr);
+
+    if (result != TCL_OK) {
+	ckfree((char *) tracePtr);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarEx --
+ *
+ *	Arrange for reads and/or writes to a variable to cause a function to
+ *	be invoked, which can monitor the operations and/or change their
+ *	actions.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the variable given by part1 and part2, such that
+ *	future references to the variable will be intermediated by the
+ *	traceProc listed in tracePtr. See the manual entry for complete
+ *	details on the calling sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceVarEx(
+    Tcl_Interp *interp,		/* Interpreter in which variable is to be
+				 * traced. */
+    const char *part1,		/* Name of scalar variable or array. */
+    const char *part2,		/* Name of element within array; NULL means
+				 * trace applies to scalar variable or array
+				 * as-a-whole. */
+    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
+				 * clientData fields. Others should be left
+				 * blank. Will be ckfree()d (eventually) if
+				 * this function returns TCL_OK, and up to
+				 * caller to free if this function returns
+				 * TCL_ERROR. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr, *arrayPtr;
+    int flagMask, isNew;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * We strip 'flags' down to just the parts which are relevant to
+     * TclLookupVar, to avoid conflicts between trace flags and internal
+     * namespace flags such as 'TCL_FIND_ONLY_NS'. This can now occur since we
+     * have trace flags with values 0x1000 and higher.
+     */
+
+    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+    varPtr = TclLookupVar(interp, part1, part2,
+	    (tracePtr->flags & flagMask) | TCL_LEAVE_ERR_MSG,
+	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check for a nonsense flag combination. Note that this is a Tcl_Panic()
+     * because there should be no code path that ever sets both flags.
+     */
+
+    if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC)
+	    && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) {
+	Tcl_Panic("bad result flag combination");
+    }
+
+    /*
+     * Set up trace information.
+     */
+
+    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+    flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+    tracePtr->flags = tracePtr->flags & flagMask;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew);
+    if (isNew) {
+	tracePtr->nextPtr = NULL;
+    } else {
+	tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+    }
+    Tcl_SetHashValue(hPtr, (char *) tracePtr);
+
+    /*
+     * Mark the variable as traced so we know to call them.
+     */
+
+    varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);
+
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index bbe1204..5c88639 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -23,7 +23,7 @@
  * to the same alternate page number.
  */
 
-static CONST unsigned short pageMap[] = {
+static const unsigned short pageMap[] = {
     0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
     448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800,
     832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088,
@@ -546,7 +546,7 @@ static CONST unsigned short pageMap[] = {
  * set of character attributes.
  */
 
-static CONST unsigned char groupMap[] = {
+static const unsigned char groupMap[] = {
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
     1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8,
     3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 3, 10, 10, 10,
@@ -1354,7 +1354,7 @@ static CONST unsigned char groupMap[] = {
  *			    highest field so we can easily sign extend.
  */
 
-static CONST int groups[] = {
+static const int groups[] = {
     0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 8257, 28, 19, 8322, 29,
     5, 23, 16, 11, -190078, 24, 2, -30846, 321, 386, -50879, 59522,
     -30911, 76930, -49790, 53825, 52801, 52545, 20289, 51777, 52033,
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index b6da7c3..83900e9 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -5,8 +5,8 @@
  *
  * Copyright (c) 1997-1998 Sun Microsystems, Inc.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
@@ -18,45 +18,45 @@
 #include "tclUniData.c"
 
 /*
- * The following macros are used for fast character category tests.  The
- * x_BITS values are shifted right by the category value to determine whether
- * the given category is included in the set.
+ * The following macros are used for fast character category tests. The x_BITS
+ * values are shifted right by the category value to determine whether the
+ * given category is included in the set.
  */
 
 #define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \
-    | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1 << OTHER_LETTER))
+	| (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1<<OTHER_LETTER))
 
 #define CONTROL_BITS ((1 << CONTROL) | (1 << FORMAT) | (1 << PRIVATE_USE))
 
 #define DIGIT_BITS (1 << DECIMAL_DIGIT_NUMBER)
 
 #define SPACE_BITS ((1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) \
-    | (1 << PARAGRAPH_SEPARATOR))
+	| (1 << PARAGRAPH_SEPARATOR))
 
 #define WORD_BITS (ALPHA_BITS | DIGIT_BITS | (1 << CONNECTOR_PUNCTUATION))
 
 #define PUNCT_BITS ((1 << CONNECTOR_PUNCTUATION) | \
-	    (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
-	    (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
-	    (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION))
+	(1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
+	(1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
+	(1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION))
 
 #define GRAPH_BITS (WORD_BITS | PUNCT_BITS | \
-	    (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
-	    (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
-	    (1 << OTHER_NUMBER) | \
-	    (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
-	    (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
+	(1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
+	(1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
+	(1 << OTHER_NUMBER) | \
+	(1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
+	(1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
 
 /*
- * Unicode characters less than this value are represented by themselves
- * in UTF-8 strings.
+ * Unicode characters less than this value are represented by themselves in
+ * UTF-8 strings.
  */
 
 #define UNICODE_SELF	0x80
 
 /*
- * The following structures are used when mapping between Unicode (UCS-2)
- * and UTF-8.
+ * The following structures are used when mapping between Unicode (UCS-2) and
+ * UTF-8.
  */
 
 static CONST unsigned char totalBytes[256] = {
@@ -86,11 +86,10 @@ static CONST unsigned char totalBytes[256] = {
 };
 
 /*
- * Procedures used only in this module.
+ * Functions used only in this module.
  */
 
-static int UtfCount _ANSI_ARGS_((int ch));
-
+static int		UtfCount(int ch);
 
 /*
  *---------------------------------------------------------------------------
@@ -109,8 +108,8 @@ static int UtfCount _ANSI_ARGS_((int ch));
  */
 
 INLINE static int
-UtfCount(ch)
-    int ch;			/* The Tcl_UniChar whose size is returned. */
+UtfCount(
+    int ch)			/* The Tcl_UniChar whose size is returned. */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
 	return 1;
@@ -141,11 +140,11 @@ UtfCount(ch)
  * Tcl_UniCharToUtf --
  *
  *	Store the given Tcl_UniChar as a sequence of UTF-8 bytes in the
- *	provided buffer.  Equivalent to Plan 9 runetochar().
+ *	provided buffer. Equivalent to Plan 9 runetochar().
  *
  * Results:
- *	The return values is the number of bytes in the buffer that
- *	were consumed.
+ *	The return values is the number of bytes in the buffer that were
+ *	consumed.
  *
  * Side effects:
  *	None.
@@ -154,55 +153,55 @@ UtfCount(ch)
  */
 
 INLINE int
-Tcl_UniCharToUtf(ch, str)
-    int ch;			/* The Tcl_UniChar to be stored in the
+Tcl_UniCharToUtf(
+    int ch,			/* The Tcl_UniChar to be stored in the
 				 * buffer. */
-    char *str;			/* Buffer in which the UTF-8 representation
-				 * of the Tcl_UniChar is stored.  Buffer must
-				 * be large enough to hold the UTF-8 character
+    char *buf)			/* Buffer in which the UTF-8 representation of
+				 * the Tcl_UniChar is stored. Buffer must be
+				 * large enough to hold the UTF-8 character
 				 * (at most TCL_UTF_MAX bytes). */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
-	str[0] = (char) ch;
+	buf[0] = (char) ch;
 	return 1;
     }
     if (ch >= 0) {
 	if (ch <= 0x7FF) {
-	    str[1] = (char) ((ch | 0x80) & 0xBF);
-	    str[0] = (char) ((ch >> 6) | 0xC0);
+	    buf[1] = (char) ((ch | 0x80) & 0xBF);
+	    buf[0] = (char) ((ch >> 6) | 0xC0);
 	    return 2;
 	}
 	if (ch <= 0xFFFF) {
 	three:
-	    str[2] = (char) ((ch | 0x80) & 0xBF);
-	    str[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    str[0] = (char) ((ch >> 12) | 0xE0);
+	    buf[2] = (char) ((ch | 0x80) & 0xBF);
+	    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
+	    buf[0] = (char) ((ch >> 12) | 0xE0);
 	    return 3;
 	}
 
 #if TCL_UTF_MAX > 3
 	if (ch <= 0x1FFFFF) {
-	    str[3] = (char) ((ch | 0x80) & 0xBF);
-	    str[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    str[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
-	    str[0] = (char) ((ch >> 18) | 0xF0);
+	    buf[3] = (char) ((ch | 0x80) & 0xBF);
+	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
+	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
+	    buf[0] = (char) ((ch >> 18) | 0xF0);
 	    return 4;
 	}
 	if (ch <= 0x3FFFFFF) {
-	    str[4] = (char) ((ch | 0x80) & 0xBF);
-	    str[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    str[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
-	    str[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
-	    str[0] = (char) ((ch >> 24) | 0xF8);
+	    buf[4] = (char) ((ch | 0x80) & 0xBF);
+	    buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
+	    buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
+	    buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
+	    buf[0] = (char) ((ch >> 24) | 0xF8);
 	    return 5;
 	}
 	if (ch <= 0x7FFFFFFF) {
-	    str[5] = (char) ((ch | 0x80) & 0xBF);
-	    str[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    str[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
-	    str[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
-	    str[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
-	    str[0] = (char) ((ch >> 30) | 0xFC);
+	    buf[5] = (char) ((ch | 0x80) & 0xBF);
+	    buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
+	    buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
+	    buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
+	    buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
+	    buf[0] = (char) ((ch >> 30) | 0xFC);
 	    return 6;
 	}
 #endif
@@ -221,8 +220,8 @@ Tcl_UniCharToUtf(ch, str)
  *
  * Results:
  *	The return value is a pointer to the UTF-8 representation of the
- *	Unicode string.  Storage for the return value is appended to the
- *	end of dsPtr.
+ *	Unicode string. Storage for the return value is appended to the end of
+ *	dsPtr.
  *
  * Side effects:
  *	None.
@@ -231,13 +230,12 @@ Tcl_UniCharToUtf(ch, str)
  */
 
 char *
-Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
-    CONST Tcl_UniChar *wString;	/* Unicode string to convert to UTF-8. */
-    int numChars;		/* Length of Unicode string in Tcl_UniChars
+Tcl_UniCharToUtfDString(
+    CONST Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
+    int uniLength,		/* Length of Unicode string in Tcl_UniChars
 				 * (must be >= 0). */
-    Tcl_DString *dsPtr;		/* UTF-8 representation of string is
-				 * appended to this previously initialized
-				 * DString. */
+    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
+				 * to this previously initialized DString. */
 {
     CONST Tcl_UniChar *w, *wEnd;
     char *p, *string;
@@ -249,12 +247,12 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
      */
 
     oldLength = Tcl_DStringLength(dsPtr);
-    Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX);
+    Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
     string = Tcl_DStringValue(dsPtr) + oldLength;
 
     p = string;
-    wEnd = wString + numChars;
-    for (w = wString; w < wEnd; ) {
+    wEnd = uniStr + uniLength;
+    for (w = uniStr; w < wEnd; ) {
 	p += Tcl_UniCharToUtf(*w, p);
 	w++;
     }
@@ -268,16 +266,16 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
  *
  * Tcl_UtfToUniChar --
  *
- *	Extract the Tcl_UniChar represented by the UTF-8 string.  Bad
- *	UTF-8 sequences are converted to valid Tcl_UniChars and processing
- *	continues.  Equivalent to Plan 9 chartorune().
+ *	Extract the Tcl_UniChar represented by the UTF-8 string. Bad UTF-8
+ *	sequences are converted to valid Tcl_UniChars and processing
+ *	continues. Equivalent to Plan 9 chartorune().
  *
- *	The caller must ensure that the source buffer is long enough that
- *	this routine does not run off the end and dereference non-existent
- *	memory looking for trail bytes.  If the source buffer is known to
- *	be '\0' terminated, this cannot happen.  Otherwise, the caller
- *	should call Tcl_UtfCharComplete() before calling this routine to
- *	ensure that enough bytes remain in the string.
+ *	The caller must ensure that the source buffer is long enough that this
+ *	routine does not run off the end and dereference non-existent memory
+ *	looking for trail bytes. If the source buffer is known to be '\0'
+ *	terminated, this cannot happen. Otherwise, the caller should call
+ *	Tcl_UtfCharComplete() before calling this routine to ensure that
+ *	enough bytes remain in the string.
  *
  * Results:
  *	*chPtr is filled with the Tcl_UniChar, and the return value is the
@@ -290,10 +288,10 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
  */
 
 int
-Tcl_UtfToUniChar(str, chPtr)
-    register CONST char *str;	 /* The UTF-8 string. */
-    register Tcl_UniChar *chPtr; /* Filled with the Tcl_UniChar represented
-				  * by the UTF-8 string. */
+Tcl_UtfToUniChar(
+    register CONST char *src,	/* The UTF-8 string. */
+    register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
+				 * the UTF-8 string. */
 {
     register int byte;
 
@@ -301,7 +299,7 @@ Tcl_UtfToUniChar(str, chPtr)
      * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
      */
 
-    byte = *((unsigned char *) str);
+    byte = *((unsigned char *) src);
     if (byte < 0xC0) {
 	/*
 	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
@@ -312,14 +310,15 @@ Tcl_UtfToUniChar(str, chPtr)
 	*chPtr = (Tcl_UniChar) byte;
 	return 1;
     } else if (byte < 0xE0) {
-	if ((str[1] & 0xC0) == 0x80) {
+	if ((src[1] & 0xC0) == 0x80) {
 	    /*
 	     * Two-byte-character lead-byte followed by a trail-byte.
 	     */
 
-	    *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F));
+	    *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
 	    return 2;
 	}
+
 	/*
 	 * A two-byte-character lead-byte not followed by trail-byte
 	 * represents itself.
@@ -328,15 +327,16 @@ Tcl_UtfToUniChar(str, chPtr)
 	*chPtr = (Tcl_UniChar) byte;
 	return 1;
     } else if (byte < 0xF0) {
-	if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) {
+	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
 	    /*
 	     * Three-byte-character lead byte followed by two trail bytes.
 	     */
 
 	    *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
-		    | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F));
+		    | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
 	    return 3;
 	}
+
 	/*
 	 * A three-byte-character lead-byte not followed by two trail-bytes
 	 * represents itself.
@@ -346,7 +346,7 @@ Tcl_UtfToUniChar(str, chPtr)
 	return 1;
     }
 #if TCL_UTF_MAX > 3
-    else {
+    {
 	int ch, total, trail;
 
 	total = totalBytes[byte];
@@ -354,13 +354,13 @@ Tcl_UtfToUniChar(str, chPtr)
 	if (trail > 0) {
 	    ch = byte & (0x3F >> trail);
 	    do {
-		str++;
-		if ((*str & 0xC0) != 0x80) {
+		src++;
+		if ((*src & 0xC0) != 0x80) {
 		    *chPtr = byte;
 		    return 1;
 		}
 		ch <<= 6;
-		ch |= (*str & 0x3F);
+		ch |= (*src & 0x3F);
 		trail--;
 	    } while (trail > 0);
 	    *chPtr = ch;
@@ -382,9 +382,8 @@ Tcl_UtfToUniChar(str, chPtr)
  *
  * Results:
  *	The return value is a pointer to the Unicode representation of the
- *	UTF-8 string.  Storage for the return value is appended to the
- *	end of dsPtr.  The Unicode string is terminated with a Unicode
- *	NULL character.
+ *	UTF-8 string. Storage for the return value is appended to the end of
+ *	dsPtr. The Unicode string is terminated with a Unicode NULL character.
  *
  * Side effects:
  *	None.
@@ -393,11 +392,11 @@ Tcl_UtfToUniChar(str, chPtr)
  */
 
 Tcl_UniChar *
-Tcl_UtfToUniCharDString(string, length, dsPtr)
-    CONST char *string;		/* UTF-8 string to convert to Unicode. */
-    int length;			/* Length of UTF-8 string in bytes, or -1
-				 * for strlen(). */
-    Tcl_DString *dsPtr;		/* Unicode representation of string is
+Tcl_UtfToUniCharDString(
+    CONST char *src,		/* UTF-8 string to convert to Unicode. */
+    int length,			/* Length of UTF-8 string in bytes, or -1 for
+				 * strlen(). */
+    Tcl_DString *dsPtr)		/* Unicode representation of string is
 				 * appended to this previously initialized
 				 * DString. */
 {
@@ -406,12 +405,12 @@ Tcl_UtfToUniCharDString(string, length, dsPtr)
     int oldLength;
 
     if (length < 0) {
-	length = strlen(string);
+	length = strlen(src);
     }
 
     /*
-     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length
-     * in bytes.
+     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
+     * bytes.
      */
 
     oldLength = Tcl_DStringLength(dsPtr);
@@ -420,8 +419,8 @@ Tcl_UtfToUniCharDString(string, length, dsPtr)
     wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
 
     w = wString;
-    end = string + length;
-    for (p = string; p < end; ) {
+    end = src + length;
+    for (p = src; p < end; ) {
 	p += TclUtfToUniChar(p, w);
 	w++;
     }
@@ -437,9 +436,9 @@ Tcl_UtfToUniCharDString(string, length, dsPtr)
  *
  * Tcl_UtfCharComplete --
  *
- *	Determine if the UTF-8 string of the given length is long enough
- *	to be decoded by Tcl_UtfToUniChar().  This does not ensure that the
- *	UTF-8 string is properly formed.  Equivalent to Plan 9 fullrune().
+ *	Determine if the UTF-8 string of the given length is long enough to be
+ *	decoded by Tcl_UtfToUniChar(). This does not ensure that the UTF-8
+ *	string is properly formed. Equivalent to Plan 9 fullrune().
  *
  * Results:
  *	The return value is 0 if the string is not long enough, non-zero
@@ -452,15 +451,15 @@ Tcl_UtfToUniCharDString(string, length, dsPtr)
  */
 
 int
-Tcl_UtfCharComplete(str, len)
-    CONST char *str;		/* String to check if first few bytes
-				 * contain a complete UTF-8 character. */
-    int len;			/* Length of above string in bytes. */
+Tcl_UtfCharComplete(
+    CONST char *src,		/* String to check if first few bytes contain
+				 * a complete UTF-8 character. */
+    int length)			/* Length of above string in bytes. */
 {
     int ch;
 
-    ch = *((unsigned char *) str);
-    return len >= totalBytes[ch];
+    ch = *((unsigned char *) src);
+    return length >= totalBytes[ch];
 }
 
 /*
@@ -468,9 +467,9 @@ Tcl_UtfCharComplete(str, len)
  *
  * Tcl_NumUtfChars --
  *
- *	Returns the number of characters (not bytes) in the UTF-8 string,
- *	not including the terminating NULL byte.  This is equivalent to
- *	Plan 9 utflen() and utfnlen().
+ *	Returns the number of characters (not bytes) in the UTF-8 string, not
+ *	including the terminating NULL byte. This is equivalent to Plan 9
+ *	utflen() and utfnlen().
  *
  * Results:
  *	As above.
@@ -482,9 +481,9 @@ Tcl_UtfCharComplete(str, len)
  */
 
 int
-Tcl_NumUtfChars(str, len)
-    register CONST char *str;	/* The UTF-8 string to measure. */
-    int len;			/* The length of the string in bytes, or -1
+Tcl_NumUtfChars(
+    register CONST char *src,	/* The UTF-8 string to measure. */
+    int length)			/* The length of the string in bytes, or -1
 				 * for strlen(string). */
 {
     Tcl_UniChar ch;
@@ -494,27 +493,27 @@ Tcl_NumUtfChars(str, len)
     /*
      * The separate implementations are faster.
      *
-     * Since this is a time-sensitive function, we also do the check for
-     * the single-byte char case specially.
+     * Since this is a time-sensitive function, we also do the check for the
+     * single-byte char case specially.
      */
 
     i = 0;
-    if (len < 0) {
-	while (*str != '\0') {
-	    str += TclUtfToUniChar(str, chPtr);
+    if (length < 0) {
+	while (*src != '\0') {
+	    src += TclUtfToUniChar(src, chPtr);
 	    i++;
 	}
     } else {
 	register int n;
 
-	while (len > 0) {
-	    if (UCHAR(*str) < 0xC0) {
-		len--;
-		str++;
+	while (length > 0) {
+	    if (UCHAR(*src) < 0xC0) {
+		length--;
+		src++;
 	    } else {
-		n = Tcl_UtfToUniChar(str, chPtr);
-		len -= n;
-		str += n;
+		n = Tcl_UtfToUniChar(src, chPtr);
+		length -= n;
+		src += n;
 	    }
 	    i++;
 	}
@@ -527,37 +526,37 @@ Tcl_NumUtfChars(str, len)
  *
  * Tcl_UtfFindFirst --
  *
- *	Returns a pointer to the first occurance of the given Tcl_UniChar
- *	in the NULL-terminated UTF-8 string.  The NULL terminator is
- *	considered part of the UTF-8 string.  Equivalent to Plan 9
- *	utfrune().
+ *	Returns a pointer to the first occurance of the given Tcl_UniChar in
+ *	the NULL-terminated UTF-8 string. The NULL terminator is considered
+ *	part of the UTF-8 string. Equivalent to Plan 9 utfrune().
  *
  * Results:
- *	As above.  If the Tcl_UniChar does not exist in the given string,
- *	the return value is NULL.
+ *	As above. If the Tcl_UniChar does not exist in the given string, the
+ *	return value is NULL.
  *
  * Side effects:
  *	None.
  *
  *---------------------------------------------------------------------------
  */
+
 CONST char *
-Tcl_UtfFindFirst(string, ch)
-    CONST char *string;		/* The UTF-8 string to be searched. */
-    int ch;			/* The Tcl_UniChar to search for. */
+Tcl_UtfFindFirst(
+    CONST char *src,		/* The UTF-8 string to be searched. */
+    int ch)			/* The Tcl_UniChar to search for. */
 {
     int len;
     Tcl_UniChar find;
 
     while (1) {
-	len = TclUtfToUniChar(string, &find);
+	len = TclUtfToUniChar(src, &find);
 	if (find == ch) {
-	    return string;
+	    return src;
 	}
-	if (*string == '\0') {
+	if (*src == '\0') {
 	    return NULL;
 	}
-	string += len;
+	src += len;
     }
 }
 
@@ -566,14 +565,13 @@ Tcl_UtfFindFirst(string, ch)
  *
  * Tcl_UtfFindLast --
  *
- *	Returns a pointer to the last occurance of the given Tcl_UniChar
- *	in the NULL-terminated UTF-8 string.  The NULL terminator is
- *	considered part of the UTF-8 string.  Equivalent to Plan 9
- *	utfrrune().
+ *	Returns a pointer to the last occurance of the given Tcl_UniChar in
+ *	the NULL-terminated UTF-8 string. The NULL terminator is considered
+ *	part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
  *
  * Results:
- *	As above.  If the Tcl_UniChar does not exist in the given string,
- *	the return value is NULL.
+ *	As above. If the Tcl_UniChar does not exist in the given string, the
+ *	return value is NULL.
  *
  * Side effects:
  *	None.
@@ -582,9 +580,9 @@ Tcl_UtfFindFirst(string, ch)
  */
 
 CONST char *
-Tcl_UtfFindLast(string, ch)
-    CONST char *string;		/* The UTF-8 string to be searched. */
-    int ch;			/* The Tcl_UniChar to search for. */
+Tcl_UtfFindLast(
+    CONST char *src,		/* The UTF-8 string to be searched. */
+    int ch)			/* The Tcl_UniChar to search for. */
 {
     int len;
     Tcl_UniChar find;
@@ -592,14 +590,14 @@ Tcl_UtfFindLast(string, ch)
 
     last = NULL;
     while (1) {
-	len = TclUtfToUniChar(string, &find);
+	len = TclUtfToUniChar(src, &find);
 	if (find == ch) {
-	    last = string;
+	    last = src;
 	}
-	if (*string == '\0') {
+	if (*src == '\0') {
 	    break;
 	}
-	string += len;
+	src += len;
     }
     return last;
 }
@@ -609,14 +607,13 @@ Tcl_UtfFindLast(string, ch)
  *
  * Tcl_UtfNext --
  *
- *	Given a pointer to some current location in a UTF-8 string,
- *	move forward one character.  The caller must ensure that they
- *	are not asking for the next character after the last character
- *	in the string.
+ *	Given a pointer to some current location in a UTF-8 string, move
+ *	forward one character. The caller must ensure that they are not asking
+ *	for the next character after the last character in the string.
  *
  * Results:
- *	The return value is the pointer to the next character in
- *	the UTF-8 string.
+ *	The return value is the pointer to the next character in the UTF-8
+ *	string.
  *
  * Side effects:
  *	None.
@@ -625,12 +622,12 @@ Tcl_UtfFindLast(string, ch)
  */
 
 CONST char *
-Tcl_UtfNext(str)
-    CONST char *str;		    /* The current location in the string. */
+Tcl_UtfNext(
+    CONST char *src)		/* The current location in the string. */
 {
     Tcl_UniChar ch;
 
-    return str + TclUtfToUniChar(str, &ch);
+    return src + TclUtfToUniChar(src, &ch);
 }
 
 /*
@@ -638,15 +635,15 @@ Tcl_UtfNext(str)
  *
  * Tcl_UtfPrev --
  *
- *	Given a pointer to some current location in a UTF-8 string,
- *	move backwards one character.  This works correctly when the
- *	pointer is in the middle of a UTF-8 character.
+ *	Given a pointer to some current location in a UTF-8 string, move
+ *	backwards one character. This works correctly when the pointer is in
+ *	the middle of a UTF-8 character.
  *
  * Results:
- *	The return value is a pointer to the previous character in the
- *	UTF-8 string.  If the current location was already at the
- *	beginning of the string, the return value will also be a
- *	pointer to the beginning of the string.
+ *	The return value is a pointer to the previous character in the UTF-8
+ *	string. If the current location was already at the beginning of the
+ *	string, the return value will also be a pointer to the beginning of
+ *	the string.
  *
  * Side effects:
  *	None.
@@ -655,21 +652,20 @@ Tcl_UtfNext(str)
  */
 
 CONST char *
-Tcl_UtfPrev(str, start)
-    CONST char *str;		    /* The current location in the string. */
-    CONST char *start;		    /* Pointer to the beginning of the
-				     * string, to avoid going backwards too
-				     * far. */
+Tcl_UtfPrev(
+    CONST char *src,		/* The current location in the string. */
+    CONST char *start)		/* Pointer to the beginning of the string, to
+				 * avoid going backwards too far. */
 {
     CONST char *look;
     int i, byte;
 
-    str--;
-    look = str;
+    src--;
+    look = src;
     for (i = 0; i < TCL_UTF_MAX; i++) {
 	if (look < start) {
-	    if (str < start) {
-		str = start;
+	    if (src < start) {
+		src = start;
 	    }
 	    break;
 	}
@@ -682,7 +678,7 @@ Tcl_UtfPrev(str, start)
 	}
 	look--;
     }
-    return str;
+    return src;
 }
 
 /*
@@ -690,8 +686,8 @@ Tcl_UtfPrev(str, start)
  *
  * Tcl_UniCharAtIndex --
  *
- *	Returns the Unicode character represented at the specified
- *	character (not byte) position in the UTF-8 string.
+ *	Returns the Unicode character represented at the specified character
+ *	(not byte) position in the UTF-8 string.
  *
  * Results:
  *	As above.
@@ -703,9 +699,9 @@ Tcl_UtfPrev(str, start)
  */
 
 Tcl_UniChar
-Tcl_UniCharAtIndex(src, index)
-    register CONST char *src;	/* The UTF-8 string to dereference. */
-    register int index;		/* The position of the desired character. */
+Tcl_UniCharAtIndex(
+    register CONST char *src,	/* The UTF-8 string to dereference. */
+    register int index)		/* The position of the desired character. */
 {
     Tcl_UniChar ch;
 
@@ -721,8 +717,8 @@ Tcl_UniCharAtIndex(src, index)
  *
  * Tcl_UtfAtIndex --
  *
- *	Returns a pointer to the specified character (not byte) position
- *	in the UTF-8 string.
+ *	Returns a pointer to the specified character (not byte) position in
+ *	the UTF-8 string.
  *
  * Results:
  *	As above.
@@ -734,9 +730,9 @@ Tcl_UniCharAtIndex(src, index)
  */
 
 CONST char *
-Tcl_UtfAtIndex(src, index)
-    register CONST char *src;	/* The UTF-8 string. */
-    register int index;		/* The position of the desired character. */
+Tcl_UtfAtIndex(
+    register CONST char *src,	/* The UTF-8 string. */
+    register int index)		/* The position of the desired character. */
 {
     Tcl_UniChar ch;
 
@@ -756,31 +752,30 @@ Tcl_UtfAtIndex(src, index)
  *
  * Results:
  *	Stores the bytes represented by the backslash sequence in dst and
- *	returns the number of bytes written to dst.  At most TCL_UTF_MAX
- *	bytes are written to dst; dst must have been large enough to accept
- *	those bytes.  If readPtr isn't NULL then it is filled in with a
- *	count of the number of bytes in the backslash sequence.
+ *	returns the number of bytes written to dst. At most TCL_UTF_MAX bytes
+ *	are written to dst; dst must have been large enough to accept those
+ *	bytes. If readPtr isn't NULL then it is filled in with a count of the
+ *	number of bytes in the backslash sequence.
  *
  * Side effects:
- *	The maximum number of bytes it takes to represent a Unicode
- *	character in UTF-8 is guaranteed to be less than the number of
- *	bytes used to express the backslash sequence that represents
- *	that Unicode character.  If the target buffer into which the
- *	caller is going to store the bytes that represent the Unicode
- *	character is at least as large as the source buffer from which
- *	the backslashed sequence was extracted, no buffer overruns should
- *	occur.
+ *	The maximum number of bytes it takes to represent a Unicode character
+ *	in UTF-8 is guaranteed to be less than the number of bytes used to
+ *	express the backslash sequence that represents that Unicode character.
+ *	If the target buffer into which the caller is going to store the bytes
+ *	that represent the Unicode character is at least as large as the
+ *	source buffer from which the backslashed sequence was extracted, no
+ *	buffer overruns should occur.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_UtfBackslash(src, readPtr, dst)
-    CONST char *src;		/* Points to the backslash character of
-				 * a backslash sequence. */
-    int *readPtr;		/* Fill in with number of characters read
-				 * from src, unless NULL. */
-    char *dst;			/* Filled with the bytes represented by the
+Tcl_UtfBackslash(
+    CONST char *src,		/* Points to the backslash character of a
+				 * backslash sequence. */
+    int *readPtr,		/* Fill in with number of characters read from
+				 * src, unless NULL. */
+    char *dst)			/* Filled with the bytes represented by the
 				 * backslash sequence. */
 {
 #define LINE_LENGTH 128
@@ -789,7 +784,10 @@ Tcl_UtfBackslash(src, readPtr, dst)
 
     result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
     if (numRead == LINE_LENGTH) {
-	/* We ate a whole line.  Pay the price of a strlen() */
+	/*
+	 * We ate a whole line. Pay the price of a strlen()
+	 */
+
 	result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
     }
     if (readPtr != NULL) {
@@ -803,12 +801,12 @@ Tcl_UtfBackslash(src, readPtr, dst)
  *
  * Tcl_UtfToUpper --
  *
- *	Convert lowercase characters to uppercase characters in a UTF
- *	string in place.  The conversion may shrink the UTF string.
+ *	Convert lowercase characters to uppercase characters in a UTF string
+ *	in place. The conversion may shrink the UTF string.
  *
  * Results:
- *	Returns the number of bytes in the resulting string
- *	excluding the trailing null.
+ *	Returns the number of bytes in the resulting string excluding the
+ *	trailing null.
  *
  * Side effects:
  *	Writes a terminating null after the last converted character.
@@ -817,8 +815,8 @@ Tcl_UtfBackslash(src, readPtr, dst)
  */
 
 int
-Tcl_UtfToUpper(str)
-    char *str;			/* String to convert in place. */
+Tcl_UtfToUpper(
+    char *str)			/* String to convert in place. */
 {
     Tcl_UniChar ch, upChar;
     char *src, *dst;
@@ -830,13 +828,13 @@ Tcl_UtfToUpper(str)
 
     src = dst = str;
     while (*src) {
-        bytes = TclUtfToUniChar(src, &ch);
+	bytes = TclUtfToUniChar(src, &ch);
 	upChar = Tcl_UniCharToUpper(ch);
 
 	/*
-	 * To keep badly formed Utf strings from getting inflated by
-	 * the conversion (thereby causing a segfault), only copy the
-	 * upper case char to dst if its size is <= the original char.
+	 * To keep badly formed Utf strings from getting inflated by the
+	 * conversion (thereby causing a segfault), only copy the upper case
+	 * char to dst if its size is <= the original char.
 	 */
 
 	if (bytes < UtfCount(upChar)) {
@@ -856,12 +854,12 @@ Tcl_UtfToUpper(str)
  *
  * Tcl_UtfToLower --
  *
- *	Convert uppercase characters to lowercase characters in a UTF
- *	string in place.  The conversion may shrink the UTF string.
+ *	Convert uppercase characters to lowercase characters in a UTF string
+ *	in place. The conversion may shrink the UTF string.
  *
  * Results:
- *	Returns the number of bytes in the resulting string
- *	excluding the trailing null.
+ *	Returns the number of bytes in the resulting string excluding the
+ *	trailing null.
  *
  * Side effects:
  *	Writes a terminating null after the last converted character.
@@ -870,8 +868,8 @@ Tcl_UtfToUpper(str)
  */
 
 int
-Tcl_UtfToLower(str)
-    char *str;			/* String to convert in place. */
+Tcl_UtfToLower(
+    char *str)			/* String to convert in place. */
 {
     Tcl_UniChar ch, lowChar;
     char *src, *dst;
@@ -887,9 +885,9 @@ Tcl_UtfToLower(str)
 	lowChar = Tcl_UniCharToLower(ch);
 
 	/*
-	 * To keep badly formed Utf strings from getting inflated by
-	 * the conversion (thereby causing a segfault), only copy the
-	 * lower case char to dst if its size is <= the original char.
+	 * To keep badly formed Utf strings from getting inflated by the
+	 * conversion (thereby causing a segfault), only copy the lower case
+	 * char to dst if its size is <= the original char.
 	 */
 
 	if (bytes < UtfCount(lowChar)) {
@@ -909,13 +907,13 @@ Tcl_UtfToLower(str)
  *
  * Tcl_UtfToTitle --
  *
- *	Changes the first character of a UTF string to title case or
- *	uppercase and the rest of the string to lowercase.  The
- *	conversion happens in place and may shrink the UTF string.
+ *	Changes the first character of a UTF string to title case or uppercase
+ *	and the rest of the string to lowercase. The conversion happens in
+ *	place and may shrink the UTF string.
  *
  * Results:
- *	Returns the number of bytes in the resulting string
- *	excluding the trailing null.
+ *	Returns the number of bytes in the resulting string excluding the
+ *	trailing null.
  *
  * Side effects:
  *	Writes a terminating null after the last converted character.
@@ -924,8 +922,8 @@ Tcl_UtfToLower(str)
  */
 
 int
-Tcl_UtfToTitle(str)
-    char *str;			/* String to convert in place. */
+Tcl_UtfToTitle(
+    char *str)			/* String to convert in place. */
 {
     Tcl_UniChar ch, titleChar, lowChar;
     char *src, *dst;
@@ -971,8 +969,8 @@ Tcl_UtfToTitle(str)
  *
  * TclpUtfNcmp2 --
  *
- *	Compare at most n bytes of utf-8 strings cs and ct.  Both cs
- *	and ct are assumed to be at least n bytes long.
+ *	Compare at most numBytes bytes of utf-8 strings cs and ct. Both cs and
+ *	ct are assumed to be at least numBytes bytes long.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -984,26 +982,28 @@ Tcl_UtfToTitle(str)
  */
 
 int
-TclpUtfNcmp2(cs, ct, n)
-    CONST char *cs;		/* UTF string to compare to ct. */
-    CONST char *ct;		/* UTF string cs is compared to. */
-    unsigned long n;		/* Number of *bytes* to compare. */
+TclpUtfNcmp2(
+    CONST char *cs,		/* UTF string to compare to ct. */
+    CONST char *ct,		/* UTF string cs is compared to. */
+    unsigned long numBytes)	/* Number of *bytes* to compare. */
 {
     /*
-     * We can't simply call 'memcmp(cs, ct, n);' because we need to check
-     * for Tcl's \xC0\x80 non-utf-8 null encoding.
-     * Otherwise utf-8 lexes fine in the strcmp manner.
+     * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
+     * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
+     * fine in the strcmp manner.
      */
+
     register int result = 0;
 
-    for ( ; n != 0; n--, cs++, ct++) {
+    for ( ; numBytes != 0; numBytes--, cs++, ct++) {
 	if (*cs != *ct) {
 	    result = UCHAR(*cs) - UCHAR(*ct);
 	    break;
 	}
     }
-    if (n && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
+    if (numBytes && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
 	unsigned char c1, c2;
+
 	c1 = ((UCHAR(*cs) == 0xC0) && (UCHAR(cs[1]) == 0x80)) ? 0 : UCHAR(*cs);
 	c2 = ((UCHAR(*ct) == 0xC0) && (UCHAR(ct[1]) == 0x80)) ? 0 : UCHAR(*ct);
 	result = (c1 - c2);
@@ -1016,8 +1016,8 @@ TclpUtfNcmp2(cs, ct, n)
  *
  * Tcl_UtfNcmp --
  *
- *	Compare at most n UTF chars of string cs to string ct.  Both cs
- *	and ct are assumed to be at least n UTF chars long.
+ *	Compare at most numChars UTF chars of string cs to string ct. Both cs
+ *	and ct are assumed to be at least numChars UTF chars long.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -1029,23 +1029,26 @@ TclpUtfNcmp2(cs, ct, n)
  */
 
 int
-Tcl_UtfNcmp(cs, ct, n)
-    CONST char *cs;		/* UTF string to compare to ct. */
-    CONST char *ct;		/* UTF string cs is compared to. */
-    unsigned long n;		/* Number of UTF chars to compare. */
+Tcl_UtfNcmp(
+    CONST char *cs,		/* UTF string to compare to ct. */
+    CONST char *ct,		/* UTF string cs is compared to. */
+    unsigned long numChars)	/* Number of UTF chars to compare. */
 {
     Tcl_UniChar ch1, ch2;
+
     /*
-     * Cannot use 'memcmp(cs, ct, n);' as byte representation of
-     * \u0000 (the pair of bytes 0xc0,0x80) is larger than byte
-     * representation of \u0001 (the byte 0x01.)
+     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
+     * pair of bytes 0xc0,0x80) is larger than byte representation of \u0001
+     * (the byte 0x01.)
      */
-    while (n-- > 0) {
+
+    while (numChars-- > 0) {
 	/*
-	 * n must be interpreted as chars, not bytes.
-	 * This should be called only when both strings are of
-	 * at least n chars long (no need for \0 check)
+	 * n must be interpreted as chars, not bytes. This should be called
+	 * only when both strings are of at least n chars long (no need for \0
+	 * check)
 	 */
+
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
 	if (ch1 != ch2) {
@@ -1060,9 +1063,9 @@ Tcl_UtfNcmp(cs, ct, n)
  *
  * Tcl_UtfNcasecmp --
  *
- *	Compare at most n UTF chars of string cs to string ct case
- *	insensitive.  Both cs and ct are assumed to be at least n
- *	UTF chars long.
+ *	Compare at most numChars UTF chars of string cs to string ct case
+ *	insensitive. Both cs and ct are assumed to be at least numChars UTF
+ *	chars long.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -1074,13 +1077,13 @@ Tcl_UtfNcmp(cs, ct, n)
  */
 
 int
-Tcl_UtfNcasecmp(cs, ct, n)
-    CONST char *cs;		/* UTF string to compare to ct. */
-    CONST char *ct;		/* UTF string cs is compared to. */
-    unsigned long n;			/* Number of UTF chars to compare. */
+Tcl_UtfNcasecmp(
+    CONST char *cs,		/* UTF string to compare to ct. */
+    CONST char *ct,		/* UTF string cs is compared to. */
+    unsigned long numChars)	/* Number of UTF chars to compare. */
 {
     Tcl_UniChar ch1, ch2;
-    while (n-- > 0) {
+    while (numChars-- > 0) {
 	/*
 	 * n must be interpreted as chars, not bytes.
 	 * This should be called only when both strings are of
@@ -1116,8 +1119,8 @@ Tcl_UtfNcasecmp(cs, ct, n)
  */
 
 Tcl_UniChar
-Tcl_UniCharToUpper(ch)
-    int ch;			/* Unicode character to convert. */
+Tcl_UniCharToUpper(
+    int ch)			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
 
@@ -1144,8 +1147,8 @@ Tcl_UniCharToUpper(ch)
  */
 
 Tcl_UniChar
-Tcl_UniCharToLower(ch)
-    int ch;			/* Unicode character to convert. */
+Tcl_UniCharToLower(
+    int ch)			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
 
@@ -1172,8 +1175,8 @@ Tcl_UniCharToLower(ch)
  */
 
 Tcl_UniChar
-Tcl_UniCharToTitle(ch)
-    int ch;			/* Unicode character to convert. */
+Tcl_UniCharToTitle(
+    int ch)			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
     int mode = GetCaseType(info);
@@ -1195,7 +1198,7 @@ Tcl_UniCharToTitle(ch)
  *
  * Tcl_UniCharLen --
  *
- *	Find the length of a UniChar string.  The str input must be null
+ *	Find the length of a UniChar string. The str input must be null
  *	terminated.
  *
  * Results:
@@ -1208,14 +1211,14 @@ Tcl_UniCharToTitle(ch)
  */
 
 int
-Tcl_UniCharLen(str)
-    CONST Tcl_UniChar *str;	/* Unicode string to find length of. */
+Tcl_UniCharLen(
+    CONST Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
 {
     int len = 0;
 
-    while (*str != '\0') {
+    while (*uniStr != '\0') {
 	len++;
-	str++;
+	uniStr++;
     }
     return len;
 }
@@ -1225,11 +1228,11 @@ Tcl_UniCharLen(str)
  *
  * Tcl_UniCharNcmp --
  *
- *	Compare at most n unichars of string cs to string ct.  Both cs
- *	and ct are assumed to be at least n unichars long.
+ *	Compare at most numChars unichars of string ucs to string uct.
+ *	Both ucs and uct are assumed to be at least numChars unichars long.
  *
  * Results:
- *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
  *
  * Side effects:
  *	None.
@@ -1238,24 +1241,26 @@ Tcl_UniCharLen(str)
  */
 
 int
-Tcl_UniCharNcmp(cs, ct, n)
-    CONST Tcl_UniChar *cs;		/* Unicode string to compare to ct. */
-    CONST Tcl_UniChar *ct;		/* Unicode string cs is compared to. */
-    unsigned long n;			/* Number of unichars to compare. */
+Tcl_UniCharNcmp(
+    CONST Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    CONST Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
+    unsigned long numChars)	/* Number of unichars to compare. */
 {
 #ifdef WORDS_BIGENDIAN
     /*
      * We are definitely on a big-endian machine; memcmp() is safe
      */
-    return memcmp(cs, ct, n*sizeof(Tcl_UniChar));
+
+    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
 
 #else /* !WORDS_BIGENDIAN */
     /*
      * We can't simply call memcmp() because that is not lexically correct.
      */
-    for ( ; n != 0; cs++, ct++, n--) {
-	if (*cs != *ct) {
-	    return (*cs - *ct);
+
+    for ( ; numChars != 0; ucs++, uct++, numChars--) {
+	if (*ucs != *uct) {
+	    return (*ucs - *uct);
 	}
     }
     return 0;
@@ -1267,12 +1272,12 @@ Tcl_UniCharNcmp(cs, ct, n)
  *
  * Tcl_UniCharNcasecmp --
  *
- *	Compare at most n unichars of string cs to string ct case
- *	insensitive.  Both cs and ct are assumed to be at least n
+ *	Compare at most numChars unichars of string ucs to string uct case
+ *	insensitive. Both ucs and uct are assumed to be at least numChars
  *	unichars long.
  *
  * Results:
- *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
  *
  * Side effects:
  *	None.
@@ -1281,15 +1286,16 @@ Tcl_UniCharNcmp(cs, ct, n)
  */
 
 int
-Tcl_UniCharNcasecmp(cs, ct, n)
-    CONST Tcl_UniChar *cs;		/* Unicode string to compare to ct. */
-    CONST Tcl_UniChar *ct;		/* Unicode string cs is compared to. */
-    unsigned long n;			/* Number of unichars to compare. */
+Tcl_UniCharNcasecmp(
+    CONST Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    CONST Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
+    unsigned long numChars)	/* Number of unichars to compare. */
 {
-    for ( ; n != 0; n--, cs++, ct++) {
-	if (*cs != *ct) {
-	    Tcl_UniChar lcs = Tcl_UniCharToLower(*cs);
-	    Tcl_UniChar lct = Tcl_UniCharToLower(*ct);
+    for ( ; numChars != 0; numChars--, ucs++, uct++) {
+	if (*ucs != *uct) {
+	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
+	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
+
 	    if (lcs != lct) {
 		return (lcs - lct);
 	    }
@@ -1315,8 +1321,8 @@ Tcl_UniCharNcasecmp(cs, ct, n)
  */
 
 int
-Tcl_UniCharIsAlnum(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsAlnum(
+    int ch)			/* Unicode character to test. */
 {
     return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
 }
@@ -1338,8 +1344,8 @@ Tcl_UniCharIsAlnum(ch)
  */
 
 int
-Tcl_UniCharIsAlpha(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsAlpha(
+    int ch)			/* Unicode character to test. */
 {
     return ((ALPHA_BITS >> GetCategory(ch)) & 1);
 }
@@ -1361,8 +1367,8 @@ Tcl_UniCharIsAlpha(ch)
  */
 
 int
-Tcl_UniCharIsControl(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsControl(
+    int ch)			/* Unicode character to test. */
 {
     return ((CONTROL_BITS >> GetCategory(ch)) & 1);
 }
@@ -1384,8 +1390,8 @@ Tcl_UniCharIsControl(ch)
  */
 
 int
-Tcl_UniCharIsDigit(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsDigit(
+    int ch)			/* Unicode character to test. */
 {
     return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
 }
@@ -1407,8 +1413,8 @@ Tcl_UniCharIsDigit(ch)
  */
 
 int
-Tcl_UniCharIsGraph(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsGraph(
+    int ch)			/* Unicode character to test. */
 {
     return ((GRAPH_BITS >> GetCategory(ch)) & 1);
 }
@@ -1430,8 +1436,8 @@ Tcl_UniCharIsGraph(ch)
  */
 
 int
-Tcl_UniCharIsLower(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsLower(
+    int ch)			/* Unicode character to test. */
 {
     return (GetCategory(ch) == LOWERCASE_LETTER);
 }
@@ -1453,8 +1459,8 @@ Tcl_UniCharIsLower(ch)
  */
 
 int
-Tcl_UniCharIsPrint(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsPrint(
+    int ch)			/* Unicode character to test. */
 {
     return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
 }
@@ -1476,8 +1482,8 @@ Tcl_UniCharIsPrint(ch)
  */
 
 int
-Tcl_UniCharIsPunct(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsPunct(
+    int ch)			/* Unicode character to test. */
 {
     return ((PUNCT_BITS >> GetCategory(ch)) & 1);
 }
@@ -1499,8 +1505,8 @@ Tcl_UniCharIsPunct(ch)
  */
 
 int
-Tcl_UniCharIsSpace(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsSpace(
+    int ch)			/* Unicode character to test. */
 {
     /*
      * If the character is within the first 127 characters, just use the
@@ -1531,8 +1537,8 @@ Tcl_UniCharIsSpace(ch)
  */
 
 int
-Tcl_UniCharIsUpper(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsUpper(
+    int ch)			/* Unicode character to test. */
 {
     return (GetCategory(ch) == UPPERCASE_LETTER);
 }
@@ -1542,8 +1548,7 @@ Tcl_UniCharIsUpper(ch)
  *
  * Tcl_UniCharIsWordChar --
  *
- *	Test if a character is alphanumeric or a connector punctuation
- *	mark.
+ *	Test if a character is alphanumeric or a connector punctuation mark.
  *
  * Results:
  *	Returns 1 if character is a word character.
@@ -1555,8 +1560,8 @@ Tcl_UniCharIsUpper(ch)
  */
 
 int
-Tcl_UniCharIsWordChar(ch)
-    int ch;			/* Unicode character to test. */
+Tcl_UniCharIsWordChar(
+    int ch)			/* Unicode character to test. */
 {
     return ((WORD_BITS >> GetCategory(ch)) & 1);
 }
@@ -1567,17 +1572,16 @@ Tcl_UniCharIsWordChar(ch)
  * Tcl_UniCharCaseMatch --
  *
  *	See if a particular Unicode string matches a particular pattern.
- *	Allows case insensitivity.  This is the Unicode equivalent of
- *	the char* Tcl_StringCaseMatch.  The UniChar strings must be
- *	NULL-terminated.  This has no provision for counted UniChar
- *	strings, thus should not be used where NULLs are expected in the
- *	UniChar string.  Use TclUniCharMatch where possible.
+ *	Allows case insensitivity. This is the Unicode equivalent of the char*
+ *	Tcl_StringCaseMatch. The UniChar strings must be NULL-terminated.
+ *	This has no provision for counted UniChar strings, thus should not be
+ *	used where NULLs are expected in the UniChar string. Use
+ *	TclUniCharMatch where possible.
  *
  * Results:
- *	The return value is 1 if string matches pattern, and
- *	0 otherwise.  The matching operation permits the following
- *	special characters in the pattern: *?\[] (see the manual
- *	entry for details on what these mean).
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
  *
  * Side effects:
  *	None.
@@ -1586,33 +1590,34 @@ Tcl_UniCharIsWordChar(ch)
  */
 
 int
-Tcl_UniCharCaseMatch(string, pattern, nocase)
-    CONST Tcl_UniChar *string;	/* Unicode String. */
-    CONST Tcl_UniChar *pattern;	/* Pattern, which may contain special
+Tcl_UniCharCaseMatch(
+    CONST Tcl_UniChar *uniStr,	/* Unicode String. */
+    CONST Tcl_UniChar *uniPattern,
+				/* Pattern, which may contain special
 				 * characters. */
-    int nocase;			/* 0 for case sensitive, 1 for insensitive */
+    int nocase)			/* 0 for case sensitive, 1 for insensitive */
 {
     Tcl_UniChar ch1, p;
 
     while (1) {
-	p = *pattern;
+	p = *uniPattern;
 
 	/*
-	 * See if we're at the end of both the pattern and the string.  If
-	 * so, we succeeded.  If we're at the end of the pattern but not at
-	 * the end of the string, we failed.
+	 * See if we're at the end of both the pattern and the string. If so,
+	 * we succeeded. If we're at the end of the pattern but not at the end
+	 * of the string, we failed.
 	 */
 
 	if (p == 0) {
-	    return (*string == 0);
+	    return (*uniStr == 0);
 	}
-	if ((*string == 0) && (p != '*')) {
+	if ((*uniStr == 0) && (p != '*')) {
 	    return 0;
 	}
 
 	/*
-	 * Check for a "*" as the next pattern character.  It matches any
-	 * substring.  We handle this by skipping all the characters up to the
+	 * Check for a "*" as the next pattern character. It matches any
+	 * substring. We handle this by skipping all the characters up to the
 	 * next matching one in the pattern, and then calling ourselves
 	 * recursively for each postfix of string, until either we match or we
 	 * reach the end of the string.
@@ -1622,8 +1627,11 @@ Tcl_UniCharCaseMatch(string, pattern, nocase)
 	    /*
 	     * Skip all successive *'s in the pattern
 	     */
-	    while (*(++pattern) == '*') {}
-	    p = *pattern;
+
+	    while (*(++uniPattern) == '*') {
+		/* empty body */
+	    }
+	    p = *uniPattern;
 	    if (p == 0) {
 		return 1;
 	    }
@@ -1636,63 +1644,67 @@ Tcl_UniCharCaseMatch(string, pattern, nocase)
 		 * quickly if the next char in the pattern isn't a special
 		 * character
 		 */
+
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
-			while (*string && (p != *string)
-				&& (p != Tcl_UniCharToLower(*string))) {
-			    string++;
+			while (*uniStr && (p != *uniStr)
+				&& (p != Tcl_UniCharToLower(*uniStr))) {
+			    uniStr++;
 			}
 		    } else {
-			while (*string && (p != *string)) { string++; }
+			while (*uniStr && (p != *uniStr)) {
+			    uniStr++;
+			}
 		    }
 		}
-		if (Tcl_UniCharCaseMatch(string, pattern, nocase)) {
+		if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) {
 		    return 1;
 		}
-		if (*string == 0) {
+		if (*uniStr == 0) {
 		    return 0;
 		}
-		string++;
+		uniStr++;
 	    }
 	}
 
 	/*
-	 * Check for a "?" as the next pattern character.  It matches
-	 * any single character.
+	 * Check for a "?" as the next pattern character. It matches any
+	 * single character.
 	 */
 
 	if (p == '?') {
-	    pattern++;
-	    string++;
+	    uniPattern++;
+	    uniStr++;
 	    continue;
 	}
 
 	/*
-	 * Check for a "[" as the next pattern character.  It is followed
-	 * by a list of characters that are acceptable, or by a range
-	 * (two characters separated by "-").
+	 * Check for a "[" as the next pattern character. It is followed by a
+	 * list of characters that are acceptable, or by a range (two
+	 * characters separated by "-").
 	 */
 
 	if (p == '[') {
 	    Tcl_UniChar startChar, endChar;
 
-	    pattern++;
-	    ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
-	    string++;
+	    uniPattern++;
+	    ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
+	    uniStr++;
 	    while (1) {
-		if ((*pattern == ']') || (*pattern == 0)) {
+		if ((*uniPattern == ']') || (*uniPattern == 0)) {
 		    return 0;
 		}
-		startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
-		pattern++;
-		if (*pattern == '-') {
-		    pattern++;
-		    if (*pattern == 0) {
+		startChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+			: *uniPattern);
+		uniPattern++;
+		if (*uniPattern == '-') {
+		    uniPattern++;
+		    if (*uniPattern == 0) {
 			return 0;
 		    }
-		    endChar = (nocase ? Tcl_UniCharToLower(*pattern)
-			    : *pattern);
-		    pattern++;
+		    endChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+			    : *uniPattern);
+		    uniPattern++;
 		    if (((startChar <= ch1) && (ch1 <= endChar))
 			    || ((endChar <= ch1) && (ch1 <= startChar))) {
 			/*
@@ -1704,42 +1716,43 @@ Tcl_UniCharCaseMatch(string, pattern, nocase)
 		    break;
 		}
 	    }
-	    while (*pattern != ']') {
-		if (*pattern == 0) {
-		    pattern--;
+	    while (*uniPattern != ']') {
+		if (*uniPattern == 0) {
+		    uniPattern--;
 		    break;
 		}
-		pattern++;
+		uniPattern++;
 	    }
-	    pattern++;
+	    uniPattern++;
 	    continue;
 	}
 
 	/*
-	 * If the next pattern character is '\', just strip off the '\'
-	 * so we do exact matching on the character that follows.
+	 * If the next pattern character is '\', just strip off the '\' so we
+	 * do exact matching on the character that follows.
 	 */
 
 	if (p == '\\') {
-	    if (*(++pattern) == '\0') {
+	    if (*(++uniPattern) == '\0') {
 		return 0;
 	    }
 	}
 
 	/*
-	 * There's no special character.  Just make sure that the next
-	 * bytes of each string match.
+	 * There's no special character. Just make sure that the next bytes of
+	 * each string match.
 	 */
 
 	if (nocase) {
-	    if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
+	    if (Tcl_UniCharToLower(*uniStr) !=
+		    Tcl_UniCharToLower(*uniPattern)) {
 		return 0;
 	    }
-	} else if (*string != *pattern) {
+	} else if (*uniStr != *uniPattern) {
 	    return 0;
 	}
-	string++;
-	pattern++;
+	uniStr++;
+	uniPattern++;
     }
 }
 
@@ -1749,15 +1762,14 @@ Tcl_UniCharCaseMatch(string, pattern, nocase)
  * TclUniCharMatch --
  *
  *	See if a particular Unicode string matches a particular pattern.
- *	Allows case insensitivity.  This is the Unicode equivalent of the
- *	char* Tcl_StringCaseMatch.  This variant of Tcl_UniCharCaseMatch
- *	uses counted Strings, so embedded NULLs are allowed.
+ *	Allows case insensitivity. This is the Unicode equivalent of the char*
+ *	Tcl_StringCaseMatch. This variant of Tcl_UniCharCaseMatch uses counted
+ *	Strings, so embedded NULLs are allowed.
  *
  * Results:
- *	The return value is 1 if string matches pattern, and
- *	0 otherwise.  The matching operation permits the following
- *	special characters in the pattern: *?\[] (see the manual
- *	entry for details on what these mean).
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
  *
  * Side effects:
  *	None.
@@ -1766,25 +1778,25 @@ Tcl_UniCharCaseMatch(string, pattern, nocase)
  */
 
 int
-TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
-    CONST Tcl_UniChar *string;	/* Unicode String. */
-    int strLen;			/* length of String */
-    CONST Tcl_UniChar *pattern;	/* Pattern, which may contain special
+TclUniCharMatch(
+    CONST Tcl_UniChar *string,	/* Unicode String. */
+    int strLen,			/* Length of String */
+    CONST Tcl_UniChar *pattern,	/* Pattern, which may contain special
 				 * characters. */
-    int ptnLen;			/* length of Pattern */
-    int nocase;			/* 0 for case sensitive, 1 for insensitive */
+    int ptnLen,			/* Length of Pattern */
+    int nocase)			/* 0 for case sensitive, 1 for insensitive */
 {
     CONST Tcl_UniChar *stringEnd, *patternEnd;
     Tcl_UniChar p;
 
-    stringEnd  = string + strLen;
+    stringEnd = string + strLen;
     patternEnd = pattern + ptnLen;
 
     while (1) {
 	/*
-	 * See if we're at the end of both the pattern and the string.  If
-	 * so, we succeeded.  If we're at the end of the pattern but not at
-	 * the end of the string, we failed.
+	 * See if we're at the end of both the pattern and the string. If so,
+	 * we succeeded. If we're at the end of the pattern but not at the end
+	 * of the string, we failed.
 	 */
 
 	if (pattern == patternEnd) {
@@ -1796,8 +1808,8 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	}
 
 	/*
-	 * Check for a "*" as the next pattern character.  It matches any
-	 * substring.  We handle this by skipping all the characters up to the
+	 * Check for a "*" as the next pattern character. It matches any
+	 * substring. We handle this by skipping all the characters up to the
 	 * next matching one in the pattern, and then calling ourselves
 	 * recursively for each postfix of string, until either we match or we
 	 * reach the end of the string.
@@ -1805,9 +1817,12 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 
 	if (p == '*') {
 	    /*
-	     * Skip all successive *'s in the pattern
+	     * Skip all successive *'s in the pattern.
 	     */
-	    while (*(++pattern) == '*') {}
+
+	    while (*(++pattern) == '*') {
+		/* empty body */
+	    }
 	    if (pattern == patternEnd) {
 		return 1;
 	    }
@@ -1819,8 +1834,9 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 		/*
 		 * Optimization for matching - cruise through the string
 		 * quickly if the next char in the pattern isn't a special
-		 * character
+		 * character.
 		 */
+
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
 			while ((string < stringEnd) && (p != *string)
@@ -1845,8 +1861,8 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	}
 
 	/*
-	 * Check for a "?" as the next pattern character.  It matches
-	 * any single character.
+	 * Check for a "?" as the next pattern character. It matches any
+	 * single character.
 	 */
 
 	if (p == '?') {
@@ -1856,9 +1872,9 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	}
 
 	/*
-	 * Check for a "[" as the next pattern character.  It is followed
-	 * by a list of characters that are acceptable, or by a range
-	 * (two characters separated by "-").
+	 * Check for a "[" as the next pattern character. It is followed by a
+	 * list of characters that are acceptable, or by a range (two
+	 * characters separated by "-").
 	 */
 
 	if (p == '[') {
@@ -1904,8 +1920,8 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	}
 
 	/*
-	 * If the next pattern character is '\', just strip off the '\'
-	 * so we do exact matching on the character that follows.
+	 * If the next pattern character is '\', just strip off the '\' so we
+	 * do exact matching on the character that follows.
 	 */
 
 	if (p == '\\') {
@@ -1915,8 +1931,8 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	}
 
 	/*
-	 * There's no special character.  Just make sure that the next
-	 * bytes of each string match.
+	 * There's no special character. Just make sure that the next bytes of
+	 * each string match.
 	 */
 
 	if (nocase) {
@@ -1930,3 +1946,11 @@ TclUniCharMatch(string, strLen, pattern, ptnLen, nocase)
 	pattern++;
     }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index b327b99..5f4cdae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1,118 +1,466 @@
-/* 
+/*
  * tclUtil.c --
  *
- *	This file contains utility procedures that are used by many Tcl
+ *	This file contains utility functions that are used by many Tcl
  *	commands.
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
+#include <float.h>
+#include <math.h>
 
 /*
- * The following variable holds the full path name of the binary
- * from which this application was executed, or NULL if it isn't
- * know.  The value of the variable is set by the procedure
- * Tcl_FindExecutable.  The storage space is dynamically allocated.
+ * The absolute pathname of the executable in which this Tcl library is
+ * running.
  */
 
-char *tclExecutableName = NULL;
-char *tclNativeExecutableName = NULL;
+static ProcessGlobalValue executableName = {
+    0, 0, NULL, NULL, NULL, NULL, NULL
+};
 
 /*
- * The following values are used in the flags returned by Tcl_ScanElement
- * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also
- * defined in tcl.h;  make sure its value doesn't overlap with any of the
- * values below.
- *
- * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in
- *				braces (e.g. it contains unmatched braces,
- *				or ends in a backslash character, or user
- *				just doesn't want braces);  handle all
- *				special characters by adding backslashes.
- * USE_BRACES -			1 means the string contains a special
- *				character that can be handled simply by
- *				enclosing the entire argument in braces.
- * BRACES_UNMATCHED -		1 means that braces aren't properly matched
- *				in the argument.
+ * The following values are used in the flags arguments of Tcl*Scan*Element and
+ * Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and TCL_DONT_QUOTE_HASH
+ * are defined in tcl.h, like so:
+ *
+#define TCL_DONT_USE_BRACES     1
+#define TCL_DONT_QUOTE_HASH     8
+ *
+ * Those are public flag bits which callers of the public routines
+ * Tcl_Convert*Element() can use to indicate:
+ *
+ * TCL_DONT_USE_BRACES -	1 means the caller is insisting that brace
+ *				quoting not be used when converting the list
+ *				element.
+ * TCL_DONT_QUOTE_HASH -	1 means the caller insists that a leading hash
+ * 				character ('#') should *not* be quoted. This
+ * 				is appropriate when the caller can guarantee
+ * 				the element is not the first element of a
+ * 				list, so [eval] cannot mis-parse the element
+ * 				as a comment.
+ *
+ * The remaining values which can be carried by the flags of these routines
+ * are for internal use only.  Make sure they do not overlap with the public
+ * values above.
+ *
+ * The Tcl*Scan*Element() routines make a determination which of 4 modes of
+ * conversion is most appropriate for Tcl*Convert*Element() to perform, and
+ * sets two bits of the flags value to indicate the mode selected.
+ *
+ * CONVERT_NONE		The element needs no quoting.  Its literal string
+ *			is suitable as is.
+ * CONVERT_BRACE	The conversion should be enclosing the literal string
+ *			in braces.
+ * CONVERT_ESCAPE	The conversion should be using backslashes to escape
+ *			any characters in the string that require it.
+ * CONVERT_MASK		A mask value used to extract the conversion mode from
+ *			the flags argument.
+ *			Also indicates a strange conversion mode where all
+ *			special characters are escaped with backslashes 
+ *			*except for braces*.  This is a strange and unnecessary
+ *			case, but it's part of the historical way in which
+ *			lists have been formatted in Tcl.  To experiment with
+ *			removing this case, set the value of COMPAT to 0.
+ *
+ * One last flag value is used only by callers of TclScanElement().  The flag
+ * value produced by a call to Tcl*Scan*Element() will never leave this bit
+ * set.
+ *
+ * CONVERT_ANY		The caller of TclScanElement() declares it can make
+ *			no promise about what public flags will be passed to
+ *			the matching call of TclConvertElement().  As such,
+ *			TclScanElement() has to determine the worst case
+ *			destination buffer length over all possibilities, and
+ *			in other cases this means an overestimate of the
+ *			required size.
+ *
+ * For more details, see the comments on the Tcl*Scan*Element and 
+ * Tcl*Convert*Element routines.
  */
 
-#define USE_BRACES		2
-#define BRACES_UNMATCHED	4
+#define COMPAT 1
+#define CONVERT_NONE	0
+#define CONVERT_BRACE	2
+#define CONVERT_ESCAPE	4
+#define CONVERT_MASK	(CONVERT_BRACE | CONVERT_ESCAPE)
+#define CONVERT_ANY	16
 
 /*
- * The following values determine the precision used when converting
- * floating-point values to strings.  This information is linked to all
- * of the tcl_precision variables in all interpreters via the procedure
- * TclPrecTraceProc.
+ * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
+ * access the precision to be used for double formatting.
  */
 
-static char precisionString[10] = "12";
-				/* The string value of all the tcl_precision
-				 * variables. */
-static char precisionFormat[10] = "%.12g";
-				/* The format string actually used in calls
-				 * to sprintf. */
-TCL_DECLARE_MUTEX(precisionMutex)
+static Tcl_ThreadDataKey precisionKey;
 
 /*
- * Prototypes for procedures defined later in this file.
+ * Prototypes for functions defined later in this file.
  */
 
-static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
-static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
-					    Tcl_Obj* objPtr));
+static void		ClearHash(Tcl_HashTable *tablePtr);
+static void		FreeProcessGlobalValue(ClientData clientData);
+static void		FreeThreadHash(ClientData clientData);
+static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
+static int		SetEndOffsetFromAny(Tcl_Interp* interp,
+			    Tcl_Obj* objPtr);
+static void		UpdateStringOfEndOffset(Tcl_Obj* objPtr);
 
 /*
- * The following is the Tcl object type definition for an object
- * that represents a list index in the form, "end-offset".  It is
- * used as a performance optimization in TclGetIntForIndex.  The
- * internal rep is an integer, so no memory management is required
- * for it.
+ * The following is the Tcl object type definition for an object that
+ * represents a list index in the form, "end-offset". It is used as a
+ * performance optimization in TclGetIntForIndex. The internal rep is an
+ * integer, so no memory management is required for it.
  */
 
 Tcl_ObjType tclEndOffsetType = {
     "end-offset",			/* name */
-    (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */
-    (Tcl_DupInternalRepProc*) NULL,     /* dupIntRepProc */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
     UpdateStringOfEndOffset,		/* updateStringProc */
-    SetEndOffsetFromAny    
+    SetEndOffsetFromAny
 };
+
+/*
+ *	*	STRING REPRESENTATION OF LISTS	*	*	*
+ *
+ * The next several routines implement the conversions of strings to and
+ * from Tcl lists.  To understand their operation, the rules of parsing
+ * and generating the string representation of lists must be known.  Here
+ * we describe them in one place.
+ *
+ * A list is made up of zero or more elements.  Any string is a list if
+ * it is made up of alternating substrings of element-separating ASCII
+ * whitespace and properly formatted elements.
+ *
+ * The ASCII characters which can make up the whitespace between list
+ * elements are:
+ *
+ *	\u0009	\t	TAB
+ *	\u000A	\n	NEWLINE
+ *	\u000B	\v	VERTICAL TAB
+ *	\u000C	\f	FORM FEED
+ * 	\u000D	\r	CARRIAGE RETURN
+ *	\u0020		SPACE
+ *
+ * NOTE: differences between this and other places where Tcl defines a role
+ * for "whitespace".
+ *
+ *	* Unlike command parsing, here NEWLINE is just another whitespace
+ *	  character; its role as a command terminator in a script has no
+ *	  importance here.
+ *
+ *	* Unlike command parsing, the BACKSLASH NEWLINE sequence is not
+ *	  considered to be a whitespace character.
+ *
+ *	* Other Unicode whitespace characters (recognized by
+ *	  [string is space] or Tcl_UniCharIsSpace()) do not play any role
+ *	  as element separators in Tcl lists.
+ *
+ *	* The NUL byte ought not appear, as it is not in strings properly
+ *	  encoded for Tcl, but if it is present, it is not treated as
+ *	  separating whitespace, or a string terminator.  It is just
+ *	  another character in a list element.
+ *
+ * The interpretation of a formatted substring as a list element follows
+ * rules similar to the parsing of the words of a command in a Tcl script.
+ * Backslash substitution plays a key role, and is defined exactly as it is
+ * in command parsing.  The same routine, TclParseBackslash() is used in both
+ * command parsing and list parsing.  
+ *
+ * NOTE:  This means that if and when backslash substitution rules ever
+ * change for command parsing, the interpretation of strings as lists also
+ * changes.
+ * 
+ * Backslash substitution replaces an "escape sequence" of one or more
+ * characters starting with
+ *		\u005c	\	BACKSLASH
+ * with a single character.  The one character escape sequence case happens
+ * only when BACKSLASH is the last character in the string.  In all other
+ * cases, the escape sequence is at least two characters long.
+ *
+ * The formatted substrings are interpreted as element values according to
+ * the following cases:
+ *
+ * * If the first character of a formatted substring is
+ *		\u007b	{	OPEN BRACE
+ *   then the end of the substring is the matching 
+ *		\u007d	}	CLOSE BRACE
+ *   character, where matching is determined by counting nesting levels,
+ *   and not including any brace characters that are contained within a
+ *   backslash escape sequence in the nesting count.  Having found the
+ *   matching brace, all characters between the braces are the string
+ *   value of the element.  If no matching close brace is found before the
+ *   end of the string, the string is not a Tcl list.  If the character
+ *   following the close brace is not an element separating whitespace
+ *   character, or the end of the string, then the string is not a Tcl list.
+ *
+ *   NOTE: this differs from a brace-quoted word in the parsing of a
+ *   Tcl command only in its treatment of the backslash-newline sequence.
+ *   In a list element, the literal characters in the backslash-newline
+ *   sequence become part of the element value.  In a script word,
+ *   conversion to a single SPACE character is done.
+ *
+ *   NOTE: Most list element values can be represented by a formatted
+ *   substring using brace quoting.  The exceptions are any element value
+ *   that includes an unbalanced brace not in a backslash escape sequence,
+ *   and any value that ends with a backslash not itself in a backslash
+ *   escape sequence.
+ * 
+ * * If the first character of a formatted substring is
+ *		\u0022	"	QUOTE
+ *   then the end of the substring is the next QUOTE character, not counting
+ *   any QUOTE characters that are contained within a backslash escape
+ *   sequence.  If no next QUOTE is found before the end of the string, the
+ *   string is not a Tcl list.  If the character following the closing QUOTE
+ *   is not an element separating whitespace character, or the end of the
+ *   string, then the string is not a Tcl list.  Having found the limits
+ *   of the substring, the element value is produced by performing backslash
+ *   substitution on the character sequence between the open and close QUOTEs.
+ *
+ *   NOTE: Any element value can be represented by this style of formatting,
+ *   given suitable choice of backslash escape sequences.
+ *
+ * * All other formatted substrings are terminated by the next element
+ *   separating whitespace character in the string.  Having found the limits
+ *   of the substring, the element value is produced by performing backslash
+ *   substitution on it.
+ *
+ *   NOTE:  Any element value can be represented by this style of formatting,
+ *   given suitable choice of backslash escape sequences, with one exception.
+ *   The empty string cannot be represented as a list element without the use
+ *   of either braces or quotes to delimit it.
+ *
+ * This collection of parsing rules is implemented in the routine
+ * TclFindElement().
+ *
+ * In order to produce lists that can be parsed by these rules, we need
+ * the ability to distinguish between characters that are part of a list
+ * element value from characters providing syntax that define the structure
+ * of the list.  This means that our code that generates lists must at a
+ * minimum be able to produce escape sequences for the 10 characters
+ * identified above that have significance to a list parser.
+ *
+ *	*	*	CANONICAL LISTS	*	*	*	*	*	
+ *
+ * In addition to the basic rules for parsing strings into Tcl lists, there
+ * are additional properties to be met by the set of list values that are
+ * generated by Tcl.  Such list values are often said to be in "canonical
+ * form":
+ *
+ * * When any canonical list is evaluated as a Tcl script, it is a script
+ *   of either zero commands (an empty list) or exactly one command.  The
+ *   command word is exactly the first element of the list, and each argument
+ *   word is exactly one of the following elements of the list.  This means
+ *   that any characters that have special meaning during script evaluation
+ *   need special treatment when canonical lists are produced:
+ *
+ *	* Whitespace between elements may not include NEWLINE.
+ *	* The command terminating character,
+ *		\u003b	;	SEMICOLON
+ *	  must be BRACEd, QUOTEd, or escaped so that it does not terminate
+ * 	  the command prematurely.
+ *	* Any of the characters that begin substitutions in scripts,
+ *		\u0024	$	DOLLAR
+ *		\u005b	[	OPEN BRACKET
+ *		\u005c	\	BACKSLASH
+ *	  need to be BRACEd or escaped.
+ *	* In any list where the first character of the first element is
+ *		\u0023	#	HASH
+ *	  that HASH character must be BRACEd, QUOTEd, or escaped so that it
+ *	  does not convert the command into a comment.
+ *	* Any list element that contains the character sequence
+ *	  BACKSLASH NEWLINE cannot be formatted with BRACEs.  The
+ *	  BACKSLASH character must be represented by an escape
+ *	  sequence, and unless QUOTEs are used, the NEWLINE must
+ *	  be as well.
+ *
+ * * It is also guaranteed that one can use a canonical list as a building
+ *   block of a larger script within command substitution, as in this example:
+ *	set script "puts \[[list $cmd $arg]]"; eval $script
+ *   To support this usage, any appearance of the character
+ *		\u005d	]	CLOSE BRACKET
+ *   in a list element must be BRACEd, QUOTEd, or escaped.
+ *
+ * * Finally it is guaranteed that enclosing a canonical list in braces
+ *   produces a new value that is also a canonical list.  This new list has
+ *   length 1, and its only element is the original canonical list.  This
+ *   same guarantee also makes it possible to construct scripts where an
+ *   argument word is given a list value by enclosing the canonical form
+ *   of that list in braces:
+ *	set script "puts {[list $one $two $three]}"; eval $script
+ *   This sort of coding was once fairly common, though it's become more
+ *   idiomatic to see the following instead:
+ *	set script [list puts [list $one $two $three]]; eval $script
+ *   In order to support this guarantee, every canonical list must have 
+ *   balance when counting those braces that are not in escape sequences.
+ *
+ * Within these constraints, the canonical list generation routines
+ * TclScanElement() and TclConvertElement() attempt to generate the string
+ * for any list that is easiest to read.  When an element value is itself
+ * acceptable as the formatted substring, it is usually used (CONVERT_NONE).
+ * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE)
+ * is usually preferred over the use of escape sequences (CONVERT_ESCAPE).
+ * There are some exceptions to both of these preferences for reasons of
+ * code simplicity, efficiency, and continuation of historical habits.
+ * Canonical lists never use the QUOTE formatting to delimit their elements
+ * because that form of quoting does not nest, which makes construction of
+ * nested lists far too much trouble.  Canonical lists always use only a
+ * single SPACE character for element-separating whitespace.
+ *
+ *	*	*	FUTURE CONSIDERATIONS	*	*	*
+ *
+ * When a list element requires quoting or escaping due to a CLOSE BRACKET
+ * character or an internal QUOTE character, a strange formatting mode is
+ * recommended.  For example, if the value "a{b]c}d" is converted by the
+ * usual modes:
+ *
+ *	CONVERT_BRACE:	a{b]c}d		=> {a{b]c}d}
+ *	CONVERT_ESCAPE:	a{b]c}d		=> a\{b\]c\}d
+ *
+ * we get perfectly usable formatted list elements.  However, this is not
+ * what Tcl releases have been producing.  Instead, we have:
+ *
+ *	CONVERT_MASK:	a{b]c}d		=> a{b\]c}d
+ *
+ * where the CLOSE BRACKET is escaped, but the BRACEs are not.  The same
+ * effect can be seen replacing ] with " in this example.  There does not
+ * appear to be any functional or aesthetic purpose for this strange
+ * additional mode.  The sole purpose I can see for preserving it is to
+ * keep generating the same formatted lists programmers have become accustomed
+ * to, and perhaps written tests to expect.  That is, compatibility only.
+ * The additional code complexity required to support this mode is significant.
+ * The lines of code supporting it are delimited in the routines below with
+ * #if COMPAT directives.  This makes it easy to experiment with eliminating
+ * this formatting mode simply with "#define COMPAT 0" above.  I believe
+ * this is worth considering.
+ * 
+ * Another consideration is the treatment of QUOTE characters in list elements.
+ * TclConvertElement() must have the ability to produce the escape sequence
+ * \" so that when a list element begins with a QUOTE we do not confuse
+ * that first character with a QUOTE used as list syntax to define list
+ * structure.  However, that is the only place where QUOTE characters need
+ * quoting.  In this way, handling QUOTE could really be much more like
+ * the way we handle HASH which also needs quoting and escaping only in
+ * particular situations.  Following up this could increase the set of
+ * list elements that can use the CONVERT_NONE formatting mode.
+ *
+ * More speculative is that the demands of canonical list form require brace
+ * balance for the list as a whole, while the current implementation achieves
+ * this by establishing brace balance for every element.
+ *
+ * Finally, a reminder that the rules for parsing and formatting lists are
+ * closely tied together with the rules for parsing and evaluating scripts,
+ * and will need to evolve in sync.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMaxListLength --
+ *
+ *	Given 'bytes' pointing to 'numBytes' bytes, scan through them and
+ *	count the number of whitespace runs that could be list element
+ *	separators.  If 'numBytes' is -1, scan to the terminating '\0'.
+ *	Not a full list parser.  Typically used to get a quick and dirty
+ *	overestimate of length size in order to allocate space for an
+ *	actual list parser to operate with.
+ *
+ * Results:
+ *	Returns the largest number of list elements that could possibly
+ *	be in this string, interpreted as a Tcl list.  If 'endPtr' is not
+ *	NULL, writes a pointer to the end of the string scanned there.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMaxListLength(
+    CONST char *bytes,
+    int numBytes,
+    CONST char **endPtr)
+{
+    int count = 0;
+
+    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
+	/* Empty string case - quick exit */
+	goto done;
+    }
 
+    /* No list element before leading white space */
+    count += 1 - TclIsSpaceProc(*bytes); 
+
+    /* Count white space runs as potential element separators */
+    while (numBytes) {
+	if ((numBytes == -1) && (*bytes == '\0')) {
+	    break;
+	}
+	if (TclIsSpaceProc(*bytes)) {
+	    /* Space run started; bump count */
+	    count++;
+	    do {
+		bytes++;
+		numBytes -= (numBytes != -1);
+	    } while (numBytes && TclIsSpaceProc(*bytes));
+	    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
+		break;
+	    }
+	    /* (*bytes) is non-space; return to counting state */
+	}
+	bytes++;
+	numBytes -= (numBytes != -1);
+    }
+
+    /* No list element following trailing white space */
+    count -= TclIsSpaceProc(bytes[-1]); 
+
+    done:
+    if (endPtr) {
+	*endPtr = bytes;
+    }
+    return count;
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclFindElement --
  *
- *	Given a pointer into a Tcl list, locate the first (or next)
- *	element in the list.
+ *	Given a pointer into a Tcl list, locate the first (or next) element in
+ *	the list.
  *
  * Results:
- *	The return value is normally TCL_OK, which means that the
- *	element was successfully located.  If TCL_ERROR is returned
- *	it means that list didn't have proper list structure;
- *	the interp's result contains a more detailed error message.
+ *	The return value is normally TCL_OK, which means that the element was
+ *	successfully located. If TCL_ERROR is returned it means that list
+ *	didn't have proper list structure; the interp's result contains a more
+ *	detailed error message.
  *
  *	If TCL_OK is returned, then *elementPtr will be set to point to the
  *	first element of list, and *nextPtr will be set to point to the
  *	character just after any white space following the last character
- *	that's part of the element. If this is the last argument in the
- *	list, then *nextPtr will point just after the last character in the
- *	list (i.e., at the character at list+listLength). If sizePtr is
- *	non-NULL, *sizePtr is filled in with the number of characters in the
- *	element.  If the element is in braces, then *elementPtr will point
- *	to the character after the opening brace and *sizePtr will not
- *	include either of the braces. If there isn't an element in the list,
- *	*sizePtr will be zero, and both *elementPtr and *termPtr will point
- *	just after the last character in the list. Note: this procedure does
- *	NOT collapse backslash sequences.
+ *	that's part of the element. If this is the last argument in the list,
+ *	then *nextPtr will point just after the last character in the list
+ *	(i.e., at the character at list+listLength). If sizePtr is non-NULL,
+ *	*sizePtr is filled in with the number of bytes in the element. If
+ *	the element is in braces, then *elementPtr will point to the character
+ *	after the opening brace and *sizePtr will not include either of the
+ *	braces. If there isn't an element in the list, *sizePtr will be zero,
+ *	and both *elementPtr and *nextPtr will point just after the last
+ *	character in the list. If literalPtr is non-NULL, *literalPtr is set
+ *	to a boolean value indicating whether the substring returned as
+ *	the values of **elementPtr and *sizePtr is the literal value of
+ *	a list element.  If not, a call to TclCopyAndCollapse() is needed
+ *	to produce the actual value of the list element.  Note: this function
+ *	does NOT collapse backslash sequences, but uses *literalPtr to tell
+ * 	callers when it is required for them to do so.
  *
  * Side effects:
  *	None.
@@ -121,25 +469,27 @@ Tcl_ObjType tclEndOffsetType = {
  */
 
 int
-TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
-	       bracePtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
-				 * If NULL, then no error message is left
-				 * after errors. */
-    CONST char *list;		/* Points to the first byte of a string
+TclFindElement(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    CONST char *list,		/* Points to the first byte of a string
 				 * containing a Tcl list with zero or more
 				 * elements (possibly in braces). */
-    int listLength;		/* Number of bytes in the list's string. */
-    CONST char **elementPtr;	/* Where to put address of first significant
+    int listLength,		/* Number of bytes in the list's string. */
+    CONST char **elementPtr,	/* Where to put address of first significant
 				 * character in first element of list. */
-    CONST char **nextPtr;	/* Fill in with location of character just
+    CONST char **nextPtr,	/* Fill in with location of character just
 				 * after all white space following end of
 				 * argument (next arg or end of list). */
-    int *sizePtr;		/* If non-zero, fill in with size of
+    int *sizePtr,		/* If non-zero, fill in with size of
 				 * element. */
-    int *bracePtr;		/* If non-zero, fill in with non-zero/zero
-				 * to indicate that arg was/wasn't
-				 * in braces. */
+    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
+				 * indicate that the substring of *sizePtr
+				 * bytes starting at **elementPtr is/is not
+				 * the literal list element and therefore
+				 * does not/does require a call to 
+				 * TclCopyAndCollapse() by the caller. */
 {
     CONST char *p = list;
     CONST char *elemStart;	/* Points to first byte of first element. */
@@ -148,16 +498,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
     int inQuotes = 0;
     int size = 0;		/* lint. */
     int numChars;
+    int literal = 1;
     CONST char *p2;
-    
+
     /*
-     * Skim off leading white space and check for an opening brace or
-     * quote. We treat embedded NULLs in the list as bytes belonging to
-     * a list element.
+     * Skim off leading white space and check for an opening brace or quote.
+     * We treat embedded NULLs in the list as bytes belonging to a list
+     * element.
      */
 
     limit = (list + listLength);
-    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+    while ((p < limit) && (TclIsSpaceProc(*p))) {
 	p++;
     }
     if (p == limit) {		/* no element found */
@@ -173,9 +524,6 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
 	p++;
     }
     elemStart = p;
-    if (bracePtr != 0) {
-	*bracePtr = openBraces;
-    }
 
     /*
      * Find element's end (a space, close brace, or the end of the string).
@@ -183,123 +531,119 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
 
     while (p < limit) {
 	switch (*p) {
-
 	    /*
 	     * Open brace: don't treat specially unless the element is in
 	     * braces. In this case, keep a nesting count.
 	     */
 
-	    case '{':
-		if (openBraces != 0) {
-		    openBraces++;
-		}
-		break;
+	case '{':
+	    if (openBraces != 0) {
+		openBraces++;
+	    }
+	    break;
 
 	    /*
 	     * Close brace: if element is in braces, keep nesting count and
 	     * quit when the last close brace is seen.
 	     */
 
-	    case '}':
-		if (openBraces > 1) {
-		    openBraces--;
-		} else if (openBraces == 1) {
-		    size = (p - elemStart);
-		    p++;
-		    if ((p >= limit)
-			    || isspace(UCHAR(*p))) { /* INTL: ISO space. */
-			goto done;
-		    }
+	case '}':
+	    if (openBraces > 1) {
+		openBraces--;
+	    } else if (openBraces == 1) {
+		size = (p - elemStart);
+		p++;
+		if ((p >= limit) || TclIsSpaceProc(*p)) {
+		    goto done;
+		}
 
-		    /*
-		     * Garbage after the closing brace; return an error.
-		     */
-		    
-		    if (interp != NULL) {
-			char buf[100];
-			
-			p2 = p;
-			while ((p2 < limit)
-				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
-			        && (p2 < p+20)) {
-			    p2++;
-			}
-			sprintf(buf,
-				"list element in braces followed by \"%.*s\" instead of space",
-				(int) (p2-p), p);
-			Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		/*
+		 * Garbage after the closing brace; return an error.
+		 */
+
+		if (interp != NULL) {
+		    p2 = p;
+		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
+			    && (p2 < p+20)) {
+			p2++;
 		    }
-		    return TCL_ERROR;
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "list element in braces followed by \"%.*s\" "
+			    "instead of space", (int) (p2-p), p));
 		}
-		break;
+		return TCL_ERROR;
+	    }
+	    break;
 
 	    /*
-	     * Backslash:  skip over everything up to the end of the
-	     * backslash sequence.
+	     * Backslash: skip over everything up to the end of the backslash
+	     * sequence.
 	     */
 
-	    case '\\': {
-		TclParseBackslash(p, limit - p, &numChars, NULL);
-		p += (numChars - 1);
-		break;
+	case '\\':
+	    if (openBraces == 0) {
+		/*
+		 * A backslash sequence not within a brace quoted element
+		 * means the value of the element is different from the
+		 * substring we are parsing.  A call to TclCopyAndCollapse()
+		 * is needed to produce the element value.  Inform the caller.
+		 */
+		literal = 0;
 	    }
+	    TclParseBackslash(p, limit - p, &numChars, NULL);
+	    p += (numChars - 1);
+	    break;
 
 	    /*
 	     * Space: ignore if element is in braces or quotes; otherwise
 	     * terminate element.
 	     */
 
-	    case ' ':
-	    case '\f':
-	    case '\n':
-	    case '\r':
-	    case '\t':
-	    case '\v':
-		if ((openBraces == 0) && !inQuotes) {
-		    size = (p - elemStart);
-		    goto done;
-		}
-		break;
+	case ' ':
+	case '\f':
+	case '\n':
+	case '\r':
+	case '\t':
+	case '\v':
+	    if ((openBraces == 0) && !inQuotes) {
+		size = (p - elemStart);
+		goto done;
+	    }
+	    break;
 
 	    /*
 	     * Double-quote: if element is in quotes then terminate it.
 	     */
 
-	    case '"':
-		if (inQuotes) {
-		    size = (p - elemStart);
-		    p++;
-		    if ((p >= limit)
-			    || isspace(UCHAR(*p))) { /* INTL: ISO space */
-			goto done;
-		    }
+	case '"':
+	    if (inQuotes) {
+		size = (p - elemStart);
+		p++;
+		if ((p >= limit) || TclIsSpaceProc(*p)) {
+		    goto done;
+		}
 
-		    /*
-		     * Garbage after the closing quote; return an error.
-		     */
-		    
-		    if (interp != NULL) {
-			char buf[100];
-			
-			p2 = p;
-			while ((p2 < limit)
-				&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */
-				 && (p2 < p+20)) {
-			    p2++;
-			}
-			sprintf(buf,
-				"list element in quotes followed by \"%.*s\" %s",
-				(int) (p2-p), p, "instead of space");
-			Tcl_SetResult(interp, buf, TCL_VOLATILE);
+		/*
+		 * Garbage after the closing quote; return an error.
+		 */
+
+		if (interp != NULL) {
+		    p2 = p;
+		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
+			    && (p2 < p+20)) {
+			p2++;
 		    }
-		    return TCL_ERROR;
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "list element in quotes followed by \"%.*s\" "
+			    "instead of space", (int) (p2-p), p));
 		}
-		break;
+		return TCL_ERROR;
+	    }
+	    break;
 	}
 	p++;
     }
 
-
     /*
      * End of list: terminate element.
      */
@@ -321,8 +665,8 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
 	size = (p - elemStart);
     }
 
-    done:
-    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
+  done:
+    while ((p < limit) && (TclIsSpaceProc(*p))) {
 	p++;
     }
     *elementPtr = elemStart;
@@ -330,6 +674,9 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
     if (sizePtr != 0) {
 	*sizePtr = size;
     }
+    if (literalPtr != 0) {
+	*literalPtr = literal;
+    }
     return TCL_OK;
 }
 
@@ -338,7 +685,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
  *
  * TclCopyAndCollapse --
  *
- *	Copy a string and eliminate any backslashes that aren't in braces.
+ *	Copy a string and substitute all backslash escape sequences
  *
  * Results:
  *	Count bytes get copied from src to dst. Along the way, backslash
@@ -353,10 +700,10 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
  */
 
 int
-TclCopyAndCollapse(count, src, dst)
-    int count;			/* Number of bytes to copy from src. */
-    CONST char *src;		/* Copy from here... */
-    char *dst;			/* ... to here. */
+TclCopyAndCollapse(
+    int count,			/* Number of byte to copy from src. */
+    CONST char *src,		/* Copy from here... */
+    char *dst)			/* ... to here. */
 {
     int newCount = 0;
 
@@ -390,21 +737,19 @@ TclCopyAndCollapse(count, src, dst)
  *	Splits a list up into its constituent fields.
  *
  * Results
- *	The return value is normally TCL_OK, which means that
- *	the list was successfully split up.  If TCL_ERROR is
- *	returned, it means that "list" didn't have proper list
- *	structure;  the interp's result will contain a more detailed
- *	error message.
- *
- *	*argvPtr will be filled in with the address of an array
- *	whose elements point to the elements of list, in order.
- *	*argcPtr will get filled in with the number of valid elements
- *	in the array.  A single block of memory is dynamically allocated
- *	to hold both the argv array and a copy of the list (with
- *	backslashes and braces removed in the standard way).
- *	The caller must eventually free this memory by calling free()
- *	on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
- *	if the procedure returns normally.
+ *	The return value is normally TCL_OK, which means that the list was
+ *	successfully split up. If TCL_ERROR is returned, it means that "list"
+ *	didn't have proper list structure; the interp's result will contain a
+ *	more detailed error message.
+ *
+ *	*argvPtr will be filled in with the address of an array whose elements
+ *	point to the elements of list, in order. *argcPtr will get filled in
+ *	with the number of valid elements in the array. A single block of
+ *	memory is dynamically allocated to hold both the argv array and a copy
+ *	of the list (with backslashes and braces removed in the standard way).
+ *	The caller must eventually free this memory by calling free() on
+ *	*argvPtr. Note: *argvPtr and *argcPtr are only modified if the
+ *	function returns normally.
  *
  * Side effects:
  *	Memory is allocated.
@@ -413,54 +758,40 @@ TclCopyAndCollapse(count, src, dst)
  */
 
 int
-Tcl_SplitList(interp, list, argcPtr, argvPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
-				 * If NULL, no error message is left. */
-    CONST char *list;		/* Pointer to string with list structure. */
-    int *argcPtr;		/* Pointer to location to fill in with
-				 * the number of elements in the list. */
-    CONST char ***argvPtr;	/* Pointer to place to store pointer to
-				 * array of pointers to list elements. */
+Tcl_SplitList(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, no error message is left. */
+    CONST char *list,		/* Pointer to string with list structure. */
+    int *argcPtr,		/* Pointer to location to fill in with the
+				 * number of elements in the list. */
+    CONST char ***argvPtr)	/* Pointer to place to store pointer to array
+				 * of pointers to list elements. */
 {
-    CONST char **argv;
-    CONST char *l;
+    CONST char **argv, *end, *element;
     char *p;
-    int length, size, i, result, elSize, brace;
-    CONST char *element;
+    int length, size, i, result, elSize;
 
     /*
-     * Figure out how much space to allocate.  There must be enough
-     * space for both the array of pointers and also for a copy of
-     * the list.  To estimate the number of pointers needed, count
-     * the number of space characters in the list.
+     * Allocate enough space to work in. A (CONST char *) for each
+     * (possible) list element plus one more for terminating NULL,
+     * plus as many bytes as in the original string value, plus one
+     * more for a terminating '\0'.  Space used to hold element separating
+     * white space in the original string gets re-purposed to hold '\0'
+     * characters in the argv array.
      */
 
-    for (size = 2, l = list; *l != 0; l++) {
-	if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
-	    size++;
-	    /* Consecutive space can only count as a single list delimiter */
-	    while (1) {
-		char next = *(l + 1);
-		if (next == '\0') {
-		    break;
-		}
-		++l;
-		if (isspace(UCHAR(next))) {
-		    continue;
-		}
-		break;
-	    }
-	}
-    }
-    length = l - list;
+    size = TclMaxListLength(list, -1, &end) + 1;
+    length = end - list;
     argv = (CONST char **) ckalloc((unsigned)
 	    ((size * sizeof(char *)) + length + 1));
+
     for (i = 0, p = ((char *) argv) + size*sizeof(char *);
 	    *list != 0;  i++) {
 	CONST char *prevList = list;
-	
-	result = TclFindElement(interp, list, length, &element,
-				&list, &elSize, &brace);
+	int literal;
+
+	result = TclFindElement(interp, list, length, &element, &list,
+		&elSize, &literal);
 	length -= (list - prevList);
 	if (result != TCL_OK) {
 	    ckfree((char *) argv);
@@ -478,14 +809,13 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
 	    return TCL_ERROR;
 	}
 	argv[i] = p;
-	if (brace) {
-	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
+	if (literal) {
+	    memcpy(p, element, (size_t) elSize);
 	    p += elSize;
 	    *p = 0;
 	    p++;
 	} else {
-	    TclCopyAndCollapse(elSize, element, p);
-	    p += elSize+1;
+	    p += 1 + TclCopyAndCollapse(elSize, element, p);
 	}
     }
 
@@ -500,17 +830,15 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
  *
  * Tcl_ScanElement --
  *
- *	This procedure is a companion procedure to Tcl_ConvertElement.
- *	It scans a string to see what needs to be done to it (e.g. add
- *	backslashes or enclosing braces) to make the string into a
- *	valid Tcl list element.
+ *	This function is a companion function to Tcl_ConvertElement. It scans
+ *	a string to see what needs to be done to it (e.g. add backslashes or
+ *	enclosing braces) to make the string into a valid Tcl list element.
  *
  * Results:
- *	The return value is an overestimate of the number of characters
- *	that will be needed by Tcl_ConvertElement to produce a valid
- *	list element from string.  The word at *flagPtr is filled in
- *	with a value needed by Tcl_ConvertElement when doing the actual
- *	conversion.
+ *	The return value is an overestimate of the number of bytes that
+ *	will be needed by Tcl_ConvertElement to produce a valid list element
+ *	from src. The word at *flagPtr is filled in with a value needed by
+ *	Tcl_ConvertElement when doing the actual conversion.
  *
  * Side effects:
  *	None.
@@ -519,12 +847,12 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
  */
 
 int
-Tcl_ScanElement(string, flagPtr)
-    register CONST char *string; /* String to convert to list element. */
-    register int *flagPtr;	 /* Where to store information to guide
-				  * Tcl_ConvertCountedElement. */
+Tcl_ScanElement(
+    register CONST char *src,	/* String to convert to list element. */
+    register int *flagPtr)	/* Where to store information to guide
+				 * Tcl_ConvertCountedElement. */
 {
-    return Tcl_ScanCountedElement(string, -1, flagPtr);
+    return Tcl_ScanCountedElement(src, -1, flagPtr);
 }
 
 /*
@@ -532,19 +860,17 @@ Tcl_ScanElement(string, flagPtr)
  *
  * Tcl_ScanCountedElement --
  *
- *	This procedure is a companion procedure to
- *	Tcl_ConvertCountedElement.  It scans a string to see what
- *	needs to be done to it (e.g. add backslashes or enclosing
- *	braces) to make the string into a valid Tcl list element.
- *	If length is -1, then the string is scanned up to the first
- *	null byte.
+ *	This function is a companion function to Tcl_ConvertCountedElement. It
+ *	scans a string to see what needs to be done to it (e.g. add
+ *	backslashes or enclosing braces) to make the string into a valid Tcl
+ *	list element. If length is -1, then the string is scanned from src up
+ *	to the first null byte.
  *
  * Results:
- *	The return value is an overestimate of the number of characters
- *	that will be needed by Tcl_ConvertCountedElement to produce a
- *	valid list element from string.  The word at *flagPtr is
- *	filled in with a value needed by Tcl_ConvertCountedElement
- *	when doing the actual conversion.
+ *	The return value is an overestimate of the number of bytes that
+ *	will be needed by Tcl_ConvertCountedElement to produce a valid list
+ *	element from src. The word at *flagPtr is filled in with a value
+ *	needed by Tcl_ConvertCountedElement when doing the actual conversion.
  *
  * Side effects:
  *	None.
@@ -553,115 +879,266 @@ Tcl_ScanElement(string, flagPtr)
  */
 
 int
-Tcl_ScanCountedElement(string, length, flagPtr)
-    CONST char *string;		/* String to convert to Tcl list element. */
-    int length;			/* Number of bytes in string, or -1. */
-    int *flagPtr;		/* Where to store information to guide
+Tcl_ScanCountedElement(
+    CONST char *src,		/* String to convert to Tcl list element. */
+    int length,			/* Number of bytes in src, or -1. */
+    int *flagPtr)		/* Where to store information to guide
 				 * Tcl_ConvertElement. */
 {
-    int flags, nestingLevel;
-    register CONST char *p, *lastChar;
+    int flags = CONVERT_ANY;
+    int numBytes = TclScanElement(src, length, &flags);
 
-    /*
-     * This procedure and Tcl_ConvertElement together do two things:
-     *
-     * 1. They produce a proper list, one that will yield back the
-     * argument strings when evaluated or when disassembled with
-     * Tcl_SplitList.  This is the most important thing.
-     * 
-     * 2. They try to produce legible output, which means minimizing the
-     * use of backslashes (using braces instead).  However, there are
-     * some situations where backslashes must be used (e.g. an element
-     * like "{abc": the leading brace will have to be backslashed.
-     * For each element, one of three things must be done:
-     *
-     * (a) Use the element as-is (it doesn't contain any special
-     * characters).  This is the most desirable option.
-     *
-     * (b) Enclose the element in braces, but leave the contents alone.
-     * This happens if the element contains embedded space, or if it
-     * contains characters with special interpretation ($, [, ;, or \),
-     * or if it starts with a brace or double-quote, or if there are
-     * no characters in the element.
-     *
-     * (c) Don't enclose the element in braces, but add backslashes to
-     * prevent special interpretation of special characters.  This is a
-     * last resort used when the argument would normally fall under case
-     * (b) but contains unmatched braces.  It also occurs if the last
-     * character of the argument is a backslash or if the element contains
-     * a backslash followed by newline.
-     *
-     * The procedure figures out how many bytes will be needed to store
-     * the result (actually, it overestimates). It also collects information
-     * about the element in the form of a flags word.
-     *
-     * Note: list elements produced by this procedure and
-     * Tcl_ConvertCountedElement must have the property that they can be
-     * enclosing in curly braces to make sub-lists.  This means, for
-     * example, that we must not leave unmatched curly braces in the
-     * resulting list element.  This property is necessary in order for
-     * procedures like Tcl_DStringStartSublist to work.
-     */
+    *flagPtr = flags;
+    return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclScanElement --
+ *
+ *	This function is a companion function to TclConvertElement. It
+ *	scans a string to see what needs to be done to it (e.g. add
+ *	backslashes or enclosing braces) to make the string into a valid Tcl
+ *	list element. If length is -1, then the string is scanned from src up
+ *	to the first null byte.  A NULL value for src is treated as an
+ *	empty string.  The incoming value of *flagPtr is a report from the
+ *	caller what additional flags it will pass to TclConvertElement().
+ *
+ * Results:
+ *	The recommended formatting mode for the element is determined and
+ *	a value is written to *flagPtr indicating that recommendation.  This
+ *	recommendation is combined with the incoming flag values in *flagPtr
+ *	set by the caller to determine how many bytes will be needed by
+ *	TclConvertElement() in which to write the formatted element following
+ *	the recommendation modified by the flag values.  This number of bytes
+ *	is the return value of the routine.  In some situations it may be
+ *	an overestimate, but so long as the caller passes the same flags
+ *	to TclConvertElement(), it will be large enough.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    nestingLevel = 0;
-    flags = 0;
-    if (string == NULL) {
-	string = "";
-    }
-    if (length == -1) {
-	length = strlen(string);
+int
+TclScanElement(
+    CONST char *src,		/* String to convert to Tcl list element. */
+    int length,			/* Number of bytes in src, or -1. */
+    int *flagPtr)		/* Where to store information to guide
+				 * Tcl_ConvertElement. */
+{
+    CONST char *p = src;
+    int nestingLevel = 0;	/* Brace nesting count */
+    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
+				   needs protection or escape. */
+    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
+				 * reason bare or brace-quoted form fails. */
+    int extra = 0;		/* Count of number of extra bytes needed for
+				 * formatted element, assuming we use escape
+				 * sequences in formatting. */
+    int bytesNeeded;		/* Buffer length computed to complete the
+				 * element formatting in the selected mode. */
+#if COMPAT
+    int preferEscape = 0;	/* Use preferences to track whether to use */
+    int preferBrace = 0;	/* CONVERT_MASK mode. */
+    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
+#endif
+    
+    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
+	/* Empty string element must be brace quoted. */
+	*flagPtr = CONVERT_BRACE;
+	return 2;
     }
-    lastChar = string + length;
-    p = string;
-    if ((p == lastChar) || (*p == '{') || (*p == '"')) {
-	flags |= USE_BRACES;
+
+    if ((*p == '{') || (*p == '"')) {
+	/*
+	 * Must escape or protect so leading character of value is not
+	 * misinterpreted as list element delimiting syntax.
+	 */
+	forbidNone = 1;
+#if COMPAT
+	preferBrace = 1;
+#endif
     }
-    for ( ; p < lastChar; p++) {
+
+    while (length) {
 	switch (*p) {
-	    case '{':
-		nestingLevel++;
-		break;
-	    case '}':
-		nestingLevel--;
-		if (nestingLevel < 0) {
-		    flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
-		}
-		break;
-	    case '[':
-	    case '$':
-	    case ';':
-	    case ' ':
-	    case '\f':
-	    case '\n':
-	    case '\r':
-	    case '\t':
-	    case '\v':
-		flags |= USE_BRACES;
+	case '{':
+#if COMPAT
+	    braceCount++;
+#endif
+	    extra++;				/* Escape '{' => '\{' */
+	    nestingLevel++;
+	    break;
+	case '}':
+#if COMPAT
+	    braceCount++;
+#endif
+	    extra++;				/* Escape '}' => '\}' */
+	    nestingLevel--;
+	    if (nestingLevel < 0) {
+		/* Unbalanced braces!  Cannot format with brace quoting. */
+		requireEscape = 1;
+	    }
+	    break;
+	case ']':
+	case '"':
+#if COMPAT
+	    forbidNone = 1;
+	    extra++;		/* Escapes all just prepend a backslash */
+	    preferEscape = 1;
+	    break;
+#else
+	    /* FLOW THROUGH */
+#endif
+	case '[':
+	case '$':
+	case ';':
+	case ' ':
+	case '\f':
+	case '\n':
+	case '\r':
+	case '\t':
+	case '\v':
+	    forbidNone = 1;
+	    extra++;		/* Escape sequences all one byte longer. */
+#if COMPAT
+	    preferBrace = 1;
+#endif
+	    break;
+	case '\\':
+	    extra++;				/* Escape '\' => '\\' */
+	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
+		/* Final backslash. Cannot format with brace quoting. */
+		requireEscape = 1;		
 		break;
-	    case '\\':
-		if ((p+1 == lastChar) || (p[1] == '\n')) {
-		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
-		} else {
-		    int size;
-
-		    TclParseBackslash(p, lastChar - p, &size, NULL);
-		    p += size-1;
-		    flags |= USE_BRACES;
-		}
+	    }
+	    if (p[1] == '\n') {
+		extra++;	/* Escape newline => '\n', one byte longer */
+		/* Backslash newline sequence.  Brace quoting not permitted. */
+		requireEscape = 1;
+		length -= (length > 0);
+		p++;
 		break;
+	    }
+	    if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
+		extra++;	/* Escape sequences all one byte longer. */
+		length -= (length > 0);
+		p++;
+	    }
+	    forbidNone = 1;
+#if COMPAT
+	    preferBrace = 1;
+#endif
+	    break;
+	case '\0':
+	    if (length == -1) {
+		goto endOfString;
+	    }
+	    /* TODO: Panic on improper encoding? */
+	    break;
 	}
+	length -= (length > 0);
+	p++;
     }
+
+    endOfString:
     if (nestingLevel != 0) {
-	flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+	/* Unbalanced braces!  Cannot format with brace quoting. */
+	requireEscape = 1;
     }
-    *flagPtr = flags;
 
-    /*
-     * Allow enough space to backslash every character plus leave
-     * two spaces for braces.
-     */
+    /* We need at least as many bytes as are in the element value... */
+    bytesNeeded = p - src;
 
-    return 2*(p-string) + 2;
+    if (requireEscape) {
+	/*
+	 * We must use escape sequences.  Add all the extra bytes needed
+	 * to have room to create them.
+	 */
+	bytesNeeded += extra;
+	/* Make room to escape leading #, if needed. */
+	if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+	    bytesNeeded++;
+	}
+	*flagPtr = CONVERT_ESCAPE;
+	goto overflowCheck;
+    }
+    if (*flagPtr & CONVERT_ANY) {
+	/*
+	 * The caller has not let us know what flags it will pass to
+	 * TclConvertElement() so compute the max size we might need for
+	 * any possible choice.  Normally the formatting using escape
+	 * sequences is the longer one, and a minimum "extra" value of 2
+	 * makes sure we don't request too small a buffer in those edge
+	 * cases where that's not true.
+	 */
+	if (extra < 2) {
+	    extra = 2;
+	}
+	*flagPtr &= ~CONVERT_ANY;
+	*flagPtr |= TCL_DONT_USE_BRACES;
+    }
+    if (forbidNone) {
+	/* We must request some form of quoting of escaping... */
+#if COMPAT
+	if (preferEscape && !preferBrace) {
+	    /*
+	     * If we are quoting solely due to ] or internal " characters
+	     * use the CONVERT_MASK mode where we escape all special 
+	     * characters except for braces.  "extra" counted space needed
+	     * to escape braces too, so substract "braceCount" to get our
+	     * actual needs.
+	     */
+	    bytesNeeded += (extra - braceCount);
+	    /* Make room to escape leading #, if needed. */
+	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+		bytesNeeded++;
+	    }
+	    /*
+	     * If the caller reports it will direct TclConvertElement() to
+	     * use full escapes on the element, add back the bytes needed to
+	     * escape the braces.
+	     */
+	    if (*flagPtr & TCL_DONT_USE_BRACES) {
+		bytesNeeded += braceCount;
+	    }
+	    *flagPtr = CONVERT_MASK;
+	    goto overflowCheck;
+	}
+#endif
+	if (*flagPtr & TCL_DONT_USE_BRACES) {
+	    /*
+	     * If the caller reports it will direct TclConvertElement() to
+	     * use escapes, add the extra bytes needed to have room for them.
+	     */
+	    bytesNeeded += extra;
+	    /* Make room to escape leading #, if needed. */
+	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+		bytesNeeded++;
+	    }
+	} else {
+	    /* Add 2 bytes for room for the enclosing braces. */
+	    bytesNeeded += 2;
+	}
+	*flagPtr = CONVERT_BRACE;
+	goto overflowCheck;
+    }
+
+    /* So far, no need to quote or escape anything. */
+    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+	/* If we need to quote a leading #, make room to enclose in braces. */
+	bytesNeeded += 2;
+    }
+    *flagPtr = CONVERT_NONE;
+
+    overflowCheck:
+    if (bytesNeeded < 0) {
+	Tcl_Panic("TclScanElement: string length overflow");
+    }
+    return bytesNeeded;
 }
 
 /*
@@ -669,16 +1146,15 @@ Tcl_ScanCountedElement(string, length, flagPtr)
  *
  * Tcl_ConvertElement --
  *
- *	This is a companion procedure to Tcl_ScanElement.  Given
- *	the information produced by Tcl_ScanElement, this procedure
- *	converts a string to a list element equal to that string.
+ *	This is a companion function to Tcl_ScanElement. Given the information
+ *	produced by Tcl_ScanElement, this function converts a string to a list
+ *	element equal to that string.
  *
  * Results:
- *	Information is copied to *dst in the form of a list element
- *	identical to src (i.e. if Tcl_SplitList is applied to dst it
- *	will produce a string identical to src).  The return value is
- *	a count of the number of characters copied (not including the
- *	terminating NULL character).
+ *	Information is copied to *dst in the form of a list element identical
+ *	to src (i.e. if Tcl_SplitList is applied to dst it will produce a
+ *	string identical to src). The return value is a count of the number of
+ *	characters copied (not including the terminating NULL character).
  *
  * Side effects:
  *	None.
@@ -687,10 +1163,10 @@ Tcl_ScanCountedElement(string, length, flagPtr)
  */
 
 int
-Tcl_ConvertElement(src, dst, flags)
-    register CONST char *src;	/* Source information for list element. */
-    register char *dst;		/* Place to put list-ified element. */
-    register int flags;		/* Flags produced by Tcl_ScanElement. */
+Tcl_ConvertElement(
+    register CONST char *src,	/* Source information for list element. */
+    register char *dst,		/* Place to put list-ified element. */
+    register int flags)		/* Flags produced by Tcl_ScanElement. */
 {
     return Tcl_ConvertCountedElement(src, -1, dst, flags);
 }
@@ -700,17 +1176,15 @@ Tcl_ConvertElement(src, dst, flags)
  *
  * Tcl_ConvertCountedElement --
  *
- *	This is a companion procedure to Tcl_ScanCountedElement.  Given
- *	the information produced by Tcl_ScanCountedElement, this
- *	procedure converts a string to a list element equal to that
- *	string.
+ *	This is a companion function to Tcl_ScanCountedElement. Given the
+ *	information produced by Tcl_ScanCountedElement, this function converts
+ *	a string to a list element equal to that string.
  *
  * Results:
- *	Information is copied to *dst in the form of a list element
- *	identical to src (i.e. if Tcl_SplitList is applied to dst it
- *	will produce a string identical to src).  The return value is
- *	a count of the number of characters copied (not including the
- *	terminating NULL character).
+ *	Information is copied to *dst in the form of a list element identical
+ *	to src (i.e. if Tcl_SplitList is applied to dst it will produce a
+ *	string identical to src). The return value is a count of the number of
+ *	characters copied (not including the terminating NULL character).
  *
  * Side effects:
  *	None.
@@ -719,118 +1193,177 @@ Tcl_ConvertElement(src, dst, flags)
  */
 
 int
-Tcl_ConvertCountedElement(src, length, dst, flags)
-    register CONST char *src;	/* Source information for list element. */
-    int length;			/* Number of bytes in src, or -1. */
-    char *dst;			/* Place to put list-ified element. */
-    int flags;			/* Flags produced by Tcl_ScanElement. */
+Tcl_ConvertCountedElement(
+    register CONST char *src,	/* Source information for list element. */
+    int length,			/* Number of bytes in src, or -1. */
+    char *dst,			/* Place to put list-ified element. */
+    int flags)			/* Flags produced by Tcl_ScanElement. */
 {
-    register char *p = dst;
-    register CONST char *lastChar;
+    int numBytes = TclConvertElement(src, length, dst, flags);
+    dst[numBytes] = '\0';
+    return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclConvertElement --
+ *
+ *	This is a companion function to TclScanElement. Given the
+ *	information produced by TclScanElement, this function converts
+ *	a string to a list element equal to that string.
+ *
+ * Results:
+ *	Information is copied to *dst in the form of a list element identical
+ *	to src (i.e. if Tcl_SplitList is applied to dst it will produce a
+ *	string identical to src). The return value is a count of the number of
+ *	characters copied (not including the terminating NULL character).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    /*
-     * See the comment block at the beginning of the Tcl_ScanElement
-     * code for details of how this works.
-     */
+int TclConvertElement(
+    register CONST char *src,	/* Source information for list element. */
+    int length,			/* Number of bytes in src, or -1. */
+    char *dst,			/* Place to put list-ified element. */
+    int flags)			/* Flags produced by Tcl_ScanElement. */
+{
+    int conversion = flags & CONVERT_MASK;
+    char *p = dst;
 
-    if (src && length == -1) {
-	length = strlen(src);
+    /* Let the caller demand we use escape sequences rather than braces. */
+    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
+	conversion = CONVERT_ESCAPE;
     }
-    if ((src == NULL) || (length == 0)) {
-	p[0] = '{';
-	p[1] = '}';
-	p[2] = 0;
-	return 2;
+
+    /* No matter what the caller demands, empty string must be braced! */
+    if ((src == NULL) || (length == 0) || ((*src == '\0') && (length == -1))) {
+	src = tclEmptyStringRep;
+	length = 0;
+	conversion = CONVERT_BRACE;
+    }
+
+    /* Escape leading hash as needed and requested. */
+    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
+	if (conversion == CONVERT_ESCAPE) {
+	    p[0] = '\\';
+	    p[1] = '#';
+	    p += 2;
+	    src++;
+	    length -= (length > 0);
+	} else {
+	    conversion = CONVERT_BRACE;
+	}
     }
-    lastChar = src + length;
-    if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
+
+    /* No escape or quoting needed.  Copy the literal string value. */
+    if (conversion == CONVERT_NONE) {
+	if (length == -1) {
+	    /* TODO: INT_MAX overflow? */
+	    while (*src) {
+		*p++ = *src++;
+	    }
+	    return p - dst;
+	} else {
+	    memcpy(dst, src, length);
+	    return length;
+	}
+    }
+
+    /* Formatted string is original string enclosed in braces. */
+    if (conversion == CONVERT_BRACE) {
 	*p = '{';
 	p++;
-	for ( ; src != lastChar; src++, p++) {
-	    *p = *src;
+	if (length == -1) {
+	    /* TODO: INT_MAX overflow? */
+	    while (*src) {
+		*p++ = *src++;
+	    }
+	} else {
+	    memcpy(p, src, length);
+	    p += length;
 	}
 	*p = '}';
 	p++;
-    } else {
-	if (*src == '{') {
-	    /*
-	     * Can't have a leading brace unless the whole element is
-	     * enclosed in braces.  Add a backslash before the brace.
-	     * Furthermore, this may destroy the balance between open
-	     * and close braces, so set BRACES_UNMATCHED.
-	     */
+	return p - dst;
+    }
 
-	    p[0] = '\\';
-	    p[1] = '{';
-	    p += 2;
-	    src++;
-	    flags |= BRACES_UNMATCHED;
-	}
-	for (; src != lastChar; src++) {
-	    switch (*src) {
-		case ']':
-		case '[':
-		case '$':
-		case ';':
-		case ' ':
-		case '\\':
-		case '"':
-		    *p = '\\';
-		    p++;
-		    break;
-		case '{':
-		case '}':
-		    /*
-		     * It may not seem necessary to backslash braces, but
-		     * it is.  The reason for this is that the resulting
-		     * list element may actually be an element of a sub-list
-		     * enclosed in braces (e.g. if Tcl_DStringStartSublist
-		     * has been invoked), so there may be a brace mismatch
-		     * if the braces aren't backslashed.
-		     */
-
-		    if (flags & BRACES_UNMATCHED) {
-			*p = '\\';
-			p++;
-		    }
-		    break;
-		case '\f':
-		    *p = '\\';
-		    p++;
-		    *p = 'f';
-		    p++;
-		    continue;
-		case '\n':
-		    *p = '\\';
-		    p++;
-		    *p = 'n';
-		    p++;
-		    continue;
-		case '\r':
-		    *p = '\\';
-		    p++;
-		    *p = 'r';
-		    p++;
-		    continue;
-		case '\t':
-		    *p = '\\';
-		    p++;
-		    *p = 't';
-		    p++;
-		    continue;
-		case '\v':
-		    *p = '\\';
-		    p++;
-		    *p = 'v';
-		    p++;
-		    continue;
+    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */
+
+    /* Formatted string is original string converted to escape sequences. */
+    for ( ; length; src++, length -= (length > 0)) {
+	switch (*src) {
+	case ']':
+	case '[':
+	case '$':
+	case ';':
+	case ' ':
+	case '\\':
+	case '"':
+	    *p = '\\';
+	    p++;
+	    break;
+	case '{':
+	case '}':
+#if COMPAT
+	    if (conversion == CONVERT_ESCAPE) {
+#endif
+		*p = '\\';
+		p++;
+#if COMPAT
 	    }
-	    *p = *src;
+#endif
+	    break;
+	case '\f':
+	    *p = '\\';
+	    p++;
+	    *p = 'f';
+	    p++;
+	    continue;
+	case '\n':
+	    *p = '\\';
+	    p++;
+	    *p = 'n';
+	    p++;
+	    continue;
+	case '\r':
+	    *p = '\\';
 	    p++;
+	    *p = 'r';
+	    p++;
+	    continue;
+	case '\t':
+	    *p = '\\';
+	    p++;
+	    *p = 't';
+	    p++;
+	    continue;
+	case '\v':
+	    *p = '\\';
+	    p++;
+	    *p = 'v';
+	    p++;
+	    continue;
+	case '\0':
+	    if (length == -1) {
+		return p - dst;
+	    }
+	    /* 
+	     * If we reach this point, there's an embedded NULL in the
+	     * string range being processed, which should not happen when
+	     * the encoding rules for Tcl strings are properly followed.
+	     * If the day ever comes when we stop tolerating such things,
+	     * this is where to put the Tcl_Panic().
+	     */
+	    break;
 	}
+	*p = *src;
+	p++;
     }
-    *p = '\0';
-    return p-dst;
+    return p - dst;
 }
 
 /*
@@ -838,15 +1371,14 @@ Tcl_ConvertCountedElement(src, length, dst, flags)
  *
  * Tcl_Merge --
  *
- *	Given a collection of strings, merge them together into a
- *	single string that has proper Tcl list structured (i.e.
- *	Tcl_SplitList may be used to retrieve strings equal to the
- *	original elements, and Tcl_Eval will parse the string back
- *	into its original elements).
+ *	Given a collection of strings, merge them together into a single
+ *	string that has proper Tcl list structured (i.e. Tcl_SplitList may be
+ *	used to retrieve strings equal to the original elements, and Tcl_Eval
+ *	will parse the string back into its original elements).
  *
  * Results:
- *	The return value is the address of a dynamically-allocated
- *	string containing the merged list.
+ *	The return value is the address of a dynamically-allocated string
+ *	containing the merged list.
  *
  * Side effects:
  *	None.
@@ -855,16 +1387,25 @@ Tcl_ConvertCountedElement(src, length, dst, flags)
  */
 
 char *
-Tcl_Merge(argc, argv)
-    int argc;			/* How many strings to merge. */
-    CONST char * CONST *argv;	/* Array of string values. */
+Tcl_Merge(
+    int argc,			/* How many strings to merge. */
+    CONST char * CONST *argv)	/* Array of string values. */
 {
 #   define LOCAL_SIZE 20
-    int localFlags[LOCAL_SIZE], *flagPtr;
-    int numChars;
-    char *result;
-    char *dst;
-    int i;
+    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+    int i, bytesNeeded = 0;
+    char *result, *dst;
+    const int maxFlags = UINT_MAX / sizeof(int);
+
+    if (argc == 0) {
+	/*
+	 * Handle empty list case first, so logic of the general case
+	 * can be simpler.
+	 */
+	result = ckalloc(1);
+	result[0] = '\0';
+	return result;
+    }
 
     /*
      * Pass 1: estimate space, gather flags.
@@ -872,31 +1413,48 @@ Tcl_Merge(argc, argv)
 
     if (argc <= LOCAL_SIZE) {
 	flagPtr = localFlags;
+    } else if (argc > maxFlags) {
+	/*
+	 * We cannot allocate a large enough flag array to format this
+	 * list in one pass.  We could imagine converting this routine
+	 * to a multi-pass implementation, but for sizeof(int) == 4, 
+	 * the limit is a max of 2^30 list elements and since each element
+	 * is at least one byte formatted, and requires one byte space
+	 * between it and the next one, that a minimum space requirement
+	 * of 2^31 bytes, which is already INT_MAX. If we tried to format
+	 * a list of > maxFlags elements, we're just going to overflow
+	 * the size limits on the formatted string anyway, so just issue
+	 * that same panic early.
+	 */
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     } else {
 	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
     }
-    numChars = 1;
     for (i = 0; i < argc; i++) {
-	numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
+	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
+	if (bytesNeeded < 0) {
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
+    }
+    if (bytesNeeded > INT_MAX - argc + 1) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
+    bytesNeeded += argc;
 
     /*
      * Pass two: copy into the result area.
      */
 
-    result = (char *) ckalloc((unsigned) numChars);
+    result = ckalloc((unsigned) bytesNeeded);
     dst = result;
     for (i = 0; i < argc; i++) {
-	numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
-	dst += numChars;
+	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
 	*dst = ' ';
 	dst++;
     }
-    if (dst == result) {
-	*dst = 0;
-    } else {
-	dst[-1] = 0;
-    }
+    dst[-1] = 0;
 
     if (flagPtr != localFlags) {
 	ckfree((char *) flagPtr);
@@ -912,10 +1470,10 @@ Tcl_Merge(argc, argv)
  *	Figure out how to handle a backslash sequence.
  *
  * Results:
- *	The return value is the character that should be substituted
- *	in place of the backslash sequence that starts at src.  If
- *	readPtr isn't NULL then it is filled in with a count of the
- *	number of characters in the backslash sequence.
+ *	The return value is the character that should be substituted in place
+ *	of the backslash sequence that starts at src. If readPtr isn't NULL
+ *	then it is filled in with a count of the number of characters in the
+ *	backslash sequence.
  *
  * Side effects:
  *	None.
@@ -924,11 +1482,11 @@ Tcl_Merge(argc, argv)
  */
 
 char
-Tcl_Backslash(src, readPtr)
-    CONST char *src;		/* Points to the backslash character of
-				 * a backslash sequence. */
-    int *readPtr;		/* Fill in with number of characters read
-				 * from src, unless NULL. */
+Tcl_Backslash(
+    CONST char *src,		/* Points to the backslash character of a
+				 * backslash sequence. */
+    int *readPtr)		/* Fill in with number of characters read from
+				 * src, unless NULL. */
 {
     char buf[TCL_UTF_MAX];
     Tcl_UniChar ch;
@@ -941,73 +1499,228 @@ Tcl_Backslash(src, readPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclTrimRight --
+ *	Takes two counted strings in the Tcl encoding which must both be
+ *	null terminated.  Conceptually trims from the right side of the
+ *	first string all characters found in the second string.
+ *
+ * Results:
+ *	The number of bytes to be removed from the end of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTrimRight(
+    const char *bytes,	/* String to be trimmed... */
+    int numBytes,	/* ...and its length in bytes */
+    const char *trim,	/* String of trim characters... */
+    int numTrim)	/* ...and its length in bytes */
+{
+    const char *p = bytes + numBytes;
+    int pInc;
+
+    if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
+	Tcl_Panic("TclTrimRight works only on null-terminated strings");
+    }
+
+    /* Empty strings -> nothing to do */
+    if ((numBytes == 0) || (numTrim == 0)) {
+	return 0;
+    }
+
+    /* Outer loop: iterate over string to be trimmed */
+    do {
+	Tcl_UniChar ch1;
+	const char *q = trim;
+	int bytesLeft = numTrim;
+
+	p = Tcl_UtfPrev(p, bytes);
+ 	pInc = TclUtfToUniChar(p, &ch1);
+
+	/* Inner loop: scan trim string for match to current character */
+	do {
+	    Tcl_UniChar ch2;
+	    int qInc = TclUtfToUniChar(q, &ch2);
+
+	    if (ch1 == ch2) {
+		break;
+	    }
+
+	    q += qInc;
+	    bytesLeft -= qInc;
+	} while (bytesLeft);
+
+	if (bytesLeft == 0) {
+	    /* No match; trim task done; *p is last non-trimmed char */
+	    p += pInc;
+	    break;
+	}
+    } while (p > bytes);
+
+    return numBytes - (p - bytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTrimLeft --
+ *	Takes two counted strings in the Tcl encoding which must both be
+ *	null terminated.  Conceptually trims from the left side of the
+ *	first string all characters found in the second string.
+ *
+ * Results:
+ *	The number of bytes to be removed from the start of the string.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTrimLeft(
+    const char *bytes,	/* String to be trimmed... */
+    int numBytes,	/* ...and its length in bytes */
+    const char *trim,	/* String of trim characters... */
+    int numTrim)	/* ...and its length in bytes */
+{
+    const char *p = bytes;
+
+    if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
+	Tcl_Panic("TclTrimLeft works only on null-terminated strings");
+    }
+
+    /* Empty strings -> nothing to do */
+    if ((numBytes == 0) || (numTrim == 0)) {
+	return 0;
+    }
+
+    /* Outer loop: iterate over string to be trimmed */
+    do {
+	Tcl_UniChar ch1;
+	int pInc = TclUtfToUniChar(p, &ch1);
+	const char *q = trim;
+	int bytesLeft = numTrim;
+
+	/* Inner loop: scan trim string for match to current character */
+	do {
+	    Tcl_UniChar ch2;
+	    int qInc = TclUtfToUniChar(q, &ch2);
+
+	    if (ch1 == ch2) {
+		break;
+	    }
+
+	    q += qInc;
+	    bytesLeft -= qInc;
+	} while (bytesLeft);
+
+	if (bytesLeft == 0) {
+	    /* No match; trim task done; *p is first non-trimmed char */
+	    break;
+	}
+
+	p += pInc;
+	numBytes -= pInc;
+    } while (numBytes);
+
+    return p - bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Concat --
  *
  *	Concatenate a set of strings into a single large string.
  *
  * Results:
- *	The return value is dynamically-allocated string containing
- *	a concatenation of all the strings in argv, with spaces between
- *	the original argv elements.
+ *	The return value is dynamically-allocated string containing a
+ *	concatenation of all the strings in argv, with spaces between the
+ *	original argv elements.
  *
  * Side effects:
- *	Memory is allocated for the result;  the caller is responsible
- *	for freeing the memory.
+ *	Memory is allocated for the result; the caller is responsible for
+ *	freeing the memory.
  *
  *----------------------------------------------------------------------
  */
 
+/* The whitespace characters trimmed during [concat] operations */
+#define CONCAT_WS " \f\v\r\t\n"
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+
 char *
-Tcl_Concat(argc, argv)
-    int argc;			/* Number of strings to concatenate. */
-    CONST char * CONST *argv;	/* Array of strings to concatenate. */
+Tcl_Concat(
+    int argc,			/* Number of strings to concatenate. */
+    CONST char * CONST *argv)	/* Array of strings to concatenate. */
 {
-    int totalSize, i;
-    char *p;
-    char *result;
+    int i, needSpace = 0, bytesNeeded = 0;
+    char *result, *p;
 
-    for (totalSize = 1, i = 0; i < argc; i++) {
-	totalSize += strlen(argv[i]) + 1;
-    }
-    result = (char *) ckalloc((unsigned) totalSize);
+    /* Dispose of the empty result corner case first to simplify later code */
     if (argc == 0) {
-	*result = '\0';
+	result = (char *) ckalloc(1);
+	result[0] = '\0';
 	return result;
     }
-    for (p = result, i = 0; i < argc; i++) {
-	CONST char *element;
-	int length;
 
+    /* First allocate the result buffer at the size required */
+    for (i = 0;  i < argc;  i++) {
+	bytesNeeded += strlen(argv[i]);
+	if (bytesNeeded < 0) {
+	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
+	}
+    }
+    if (bytesNeeded + argc - 1 < 0) {
 	/*
-	 * Clip white space off the front and back of the string
-	 * to generate a neater result, and ignore any empty
-	 * elements.
+	 * Panic test could be tighter, but not going to bother for 
+	 * this legacy routine.
 	 */
+	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
+    }
+    /* All element bytes + (argc - 1) spaces + 1 terminating NULL */
+    result = (char *) ckalloc((unsigned) (bytesNeeded + argc));
 
+    for (p = result, i = 0;  i < argc;  i++) {
+	int trim, elemLength;
+	const char *element;
+	
 	element = argv[i];
-	while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
-	    element++;
-	}
-	for (length = strlen(element);
-		(length > 0)
-		&& (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
-		&& ((length < 2) || (element[length-2] != '\\'));
-	        length--) {
-	    /* Null loop body. */
-	}
-	if (length == 0) {
+	elemLength = strlen(argv[i]);
+
+	/* Trim away the leading whitespace */
+	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	element += trim;
+	elemLength -= trim;
+
+	/*
+	 * Trim away the trailing whitespace.  Do not permit trimming
+	 * to expose a final backslash character.
+	 */
+
+	trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim -= trim && (element[elemLength - trim - 1] == '\\');
+	elemLength -= trim;
+
+	/* If we're left with empty element after trimming, do nothing */
+	if (elemLength == 0) {
 	    continue;
 	}
-	memcpy((VOID *) p, (VOID *) element, (size_t) length);
-	p += length;
-	*p = ' ';
-	p++;
-    }
-    if (p != result) {
-	p[-1] = 0;
-    } else {
-	*p = 0;
+
+	/* Append to the result with space if needed */
+	if (needSpace) {
+	    *p++ = ' ';
+	}
+	memcpy(p, element, (size_t) elemLength);
+	p += elemLength;
+	needSpace = 1;
     }
+    *p = '\0';
     return result;
 }
 
@@ -1020,8 +1733,8 @@ Tcl_Concat(argc, argv)
  *	object with spaces between the original strings.
  *
  * Results:
- *	The return value is a new string object containing a concatenation
- *	of the strings in objv. Its ref count is zero.
+ *	The return value is a new string object containing a concatenation of
+ *	the strings in objv. Its ref count is zero.
  *
  * Side effects:
  *	A new object is created.
@@ -1030,27 +1743,29 @@ Tcl_Concat(argc, argv)
  */
 
 Tcl_Obj *
-Tcl_ConcatObj(objc, objv)
-    int objc;			/* Number of objects to concatenate. */
-    Tcl_Obj *CONST objv[];	/* Array of objects to concatenate. */
+Tcl_ConcatObj(
+    int objc,			/* Number of objects to concatenate. */
+    Tcl_Obj *CONST objv[])	/* Array of objects to concatenate. */
 {
-    int allocSize, finalSize, length, elemLength, i;
-    char *p;
-    char *element;
-    char *concatStr;
-    Tcl_Obj *objPtr;
+    int i, elemLength, needSpace = 0, bytesNeeded = 0;
+    const char *element;
+    Tcl_Obj *objPtr, *resPtr;
 
     /*
-     * Check first to see if all the items are of list type.  If so,
-     * we will concat them together as lists, and return a list object.
-     * This is only valid when the lists have no current string
-     * representation, since we don't know what the original type was.
-     * An original string rep may have lost some whitespace info when
-     * converted which could be important.
+     * Check first to see if all the items are of list type or empty. If so,
+     * we will concat them together as lists, and return a list object. This
+     * is only valid when the lists are in canonical form.
      */
+
     for (i = 0;  i < objc;  i++) {
+	int length;
+
 	objPtr = objv[i];
-	if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
+	if (TclListObjIsCanonical(objPtr)) {
+	    continue;
+	}
+	Tcl_GetStringFromObj(objPtr, &length);
+	if (length > 0) {
 	    break;
 	}
     }
@@ -1058,92 +1773,90 @@ Tcl_ConcatObj(objc, objv)
 	Tcl_Obj **listv;
 	int listc;
 
-	objPtr = Tcl_NewListObj(0, NULL);
+	resPtr = NULL;
 	for (i = 0;  i < objc;  i++) {
 	    /*
-	     * Tcl_ListObjAppendList could be used here, but this saves
-	     * us a bit of type checking (since we've already done it)
-	     * Use of INT_MAX tells us to always put the new stuff on
-	     * the end.  It will be set right in Tcl_ListObjReplace.
+	     * Tcl_ListObjAppendList could be used here, but this saves us a
+	     * bit of type checking (since we've already done it). Use of
+	     * INT_MAX tells us to always put the new stuff on the end. It
+	     * will be set right in Tcl_ListObjReplace.
+	     * Note that all objs at this point are either lists or have an
+	     * empty string rep.
 	     */
-	    Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
-	    Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
-	}
-	return objPtr;
-    }
 
-    allocSize = 0;
-    for (i = 0;  i < objc;  i++) {
-	objPtr = objv[i];
-	element = Tcl_GetStringFromObj(objPtr, &length);
-	if ((element != NULL) && (length > 0)) {
-	    allocSize += (length + 1);
+	    objPtr = objv[i];
+	    if (objPtr->bytes && objPtr->length == 0) {
+		continue;
+	    }
+	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
+	    if (listc) {
+		if (resPtr) {
+		    Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
+		} else {
+		    resPtr = TclListObjCopy(NULL, objPtr);
+		}
+	    }
 	}
-    }
-    if (allocSize == 0) {
-	allocSize = 1;		/* enough for the NULL byte at end */
+	if (!resPtr) {
+	    resPtr = Tcl_NewObj();
+	}
+	return resPtr;
     }
 
     /*
-     * Allocate storage for the concatenated result. Note that allocSize
-     * is one more than the total number of characters, and so includes
-     * room for the terminating NULL byte.
+     * Something cannot be determined to be safe, so build the concatenation
+     * the slow way, using the string representations.
      */
-    
-    concatStr = (char *) ckalloc((unsigned) allocSize);
 
+    /* First try to pre-allocate the size required */
+    for (i = 0;  i < objc;  i++) {
+	element = TclGetStringFromObj(objv[i], &elemLength);
+	bytesNeeded += elemLength;
+	if (bytesNeeded < 0) {
+	    break;
+	}
+    }
     /*
-     * Now concatenate the elements. Clip white space off the front and back
-     * to generate a neater result, and ignore any empty elements. Also put
-     * a null byte at the end.
+     * Does not matter if this fails, will simply try later to build up
+     * the string with each Append reallocating as needed with the usual
+     * string append algorithm.  When that fails it will report the error.
      */
+    TclNewObj(resPtr);
+    Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
+    Tcl_SetObjLength(resPtr, 0);
 
-    finalSize = 0;
-    if (objc == 0) {
-	*concatStr = '\0';
-    } else {
-	p = concatStr;
-        for (i = 0;  i < objc;  i++) {
-	    objPtr = objv[i];
-	    element = Tcl_GetStringFromObj(objPtr, &elemLength);
-	    while ((elemLength > 0) && (UCHAR(*element) < 127)
-		    && isspace(UCHAR(*element))) { /* INTL: ISO C space. */
-	         element++;
-		 elemLength--;
-	    }
+    for (i = 0;  i < objc;  i++) {
+	int trim;
+	
+	element = TclGetStringFromObj(objv[i], &elemLength);
 
-	    /*
-	     * Trim trailing white space.  But, be careful not to trim
-	     * a space character if it is preceded by a backslash: in
-	     * this case it could be significant.
-	     */
+	/* Trim away the leading whitespace */
+	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	element += trim;
+	elemLength -= trim;
 
-	    while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127)
-		    && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO C space. */
-		    && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
-		elemLength--;
-	    }
-	    if (elemLength == 0) {
-	         continue;	/* nothing left of this element */
-	    }
-	    memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
-	    p += elemLength;
-	    *p = ' ';
-	    p++;
-	    finalSize += (elemLength + 1);
-        }
-        if (p != concatStr) {
-	    p[-1] = 0;
-	    finalSize -= 1;	/* we overwrote the final ' ' */
-        } else {
-	    *p = 0;
-        }
+	/*
+	 * Trim away the trailing whitespace.  Do not permit trimming
+	 * to expose a final backslash character.
+	 */
+
+	trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim -= trim && (element[elemLength - trim - 1] == '\\');
+	elemLength -= trim;
+
+	/* If we're left with empty element after trimming, do nothing */
+	if (elemLength == 0) {
+	    continue;
+	}
+
+	/* Append to the result with space if needed */
+	if (needSpace) {
+	    Tcl_AppendToObj(resPtr, " ", 1);
+	}
+	Tcl_AppendToObj(resPtr, element, elemLength);
+	needSpace = 1;
     }
-    
-    TclNewObj(objPtr);
-    objPtr->bytes  = concatStr;
-    objPtr->length = finalSize;
-    return objPtr;
+    return resPtr;
 }
 
 /*
@@ -1154,10 +1867,9 @@ Tcl_ConcatObj(objc, objv)
  *	See if a particular string matches a particular pattern.
  *
  * Results:
- *	The return value is 1 if string matches pattern, and
- *	0 otherwise.  The matching operation permits the following
- *	special characters in the pattern: *?\[] (see the manual
- *	entry for details on what these mean).
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
  *
  * Side effects:
  *	None.
@@ -1166,12 +1878,12 @@ Tcl_ConcatObj(objc, objv)
  */
 
 int
-Tcl_StringMatch(string, pattern)
-    CONST char *string;		/* String. */
-    CONST char *pattern;	/* Pattern, which may contain special
+Tcl_StringMatch(
+    CONST char *str,		/* String. */
+    CONST char *pattern)	/* Pattern, which may contain special
 				 * characters. */
 {
-    return Tcl_StringCaseMatch(string, pattern, 0);
+    return Tcl_StringCaseMatch(str, pattern, 0);
 }
 
 /*
@@ -1179,14 +1891,13 @@ Tcl_StringMatch(string, pattern)
  *
  * Tcl_StringCaseMatch --
  *
- *	See if a particular string matches a particular pattern.
- *	Allows case insensitivity.
+ *	See if a particular string matches a particular pattern. Allows case
+ *	insensitivity.
  *
  * Results:
- *	The return value is 1 if string matches pattern, and
- *	0 otherwise.  The matching operation permits the following
- *	special characters in the pattern: *?\[] (see the manual
- *	entry for details on what these mean).
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
  *
  * Side effects:
  *	None.
@@ -1195,127 +1906,133 @@ Tcl_StringMatch(string, pattern)
  */
 
 int
-Tcl_StringCaseMatch(string, pattern, nocase)
-    CONST char *string;		/* String. */
-    CONST char *pattern;	/* Pattern, which may contain special
+Tcl_StringCaseMatch(
+    CONST char *str,		/* String. */
+    CONST char *pattern,	/* Pattern, which may contain special
 				 * characters. */
-    int nocase;			/* 0 for case sensitive, 1 for insensitive */
+    int nocase)			/* 0 for case sensitive, 1 for insensitive */
 {
     int p, charLen;
     CONST char *pstart = pattern;
     Tcl_UniChar ch1, ch2;
-    
+
     while (1) {
 	p = *pattern;
-	
+
 	/*
-	 * See if we're at the end of both the pattern and the string.  If
-	 * so, we succeeded.  If we're at the end of the pattern but not at
-	 * the end of the string, we failed.
+	 * See if we're at the end of both the pattern and the string. If so,
+	 * we succeeded. If we're at the end of the pattern but not at the end
+	 * of the string, we failed.
 	 */
-	
+
 	if (p == '\0') {
-	    return (*string == '\0');
+	    return (*str == '\0');
 	}
-	if ((*string == '\0') && (p != '*')) {
+	if ((*str == '\0') && (p != '*')) {
 	    return 0;
 	}
 
 	/*
-	 * Check for a "*" as the next pattern character.  It matches
-	 * any substring.  We handle this by calling ourselves
-	 * recursively for each postfix of string, until either we
-	 * match or we reach the end of the string.
+	 * Check for a "*" as the next pattern character. It matches any
+	 * substring. We handle this by calling ourselves recursively for each
+	 * postfix of string, until either we match or we reach the end of the
+	 * string.
 	 */
-	
+
 	if (p == '*') {
 	    /*
 	     * Skip all successive *'s in the pattern
 	     */
+
 	    while (*(++pattern) == '*') {}
 	    p = *pattern;
 	    if (p == '\0') {
 		return 1;
 	    }
+
 	    /*
 	     * This is a special case optimization for single-byte utf.
 	     */
+
 	    if (UCHAR(*pattern) < 0x80) {
 		ch2 = (Tcl_UniChar)
-		    (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
+			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 	    } else {
 		Tcl_UtfToUniChar(pattern, &ch2);
 		if (nocase) {
 		    ch2 = Tcl_UniCharToLower(ch2);
 		}
 	    }
+
 	    while (1) {
 		/*
 		 * Optimization for matching - cruise through the string
 		 * quickly if the next char in the pattern isn't a special
 		 * character
 		 */
+
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
-			while (*string) {
-			    charLen = TclUtfToUniChar(string, &ch1);
+			while (*str) {
+			    charLen = TclUtfToUniChar(str, &ch1);
 			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
 				break;
 			    }
-			    string += charLen;
+			    str += charLen;
 			}
 		    } else {
 			/*
 			 * There's no point in trying to make this code
-			 * shorter, as the number of bytes you want to
-			 * compare each time is non-constant.
+			 * shorter, as the number of bytes you want to compare
+			 * each time is non-constant.
 			 */
-			while (*string) {
-			    charLen = TclUtfToUniChar(string, &ch1);
+
+			while (*str) {
+			    charLen = TclUtfToUniChar(str, &ch1);
 			    if (ch2 == ch1) {
 				break;
 			    }
-			    string += charLen;
+			    str += charLen;
 			}
 		    }
 		}
-		if (Tcl_StringCaseMatch(string, pattern, nocase)) {
+		if (Tcl_StringCaseMatch(str, pattern, nocase)) {
 		    return 1;
 		}
-		if (*string == '\0') {
+		if (*str == '\0') {
 		    return 0;
 		}
-		string += TclUtfToUniChar(string, &ch1);
+		str += TclUtfToUniChar(str, &ch1);
 	    }
 	}
 
 	/*
-	 * Check for a "?" as the next pattern character.  It matches
-	 * any single character.
+	 * Check for a "?" as the next pattern character. It matches any
+	 * single character.
 	 */
 
 	if (p == '?') {
 	    pattern++;
-	    string += TclUtfToUniChar(string, &ch1);
+	    str += TclUtfToUniChar(str, &ch1);
 	    continue;
 	}
 
 	/*
-	 * Check for a "[" as the next pattern character.  It is followed
-	 * by a list of characters that are acceptable, or by a range
-	 * (two characters separated by "-").
+	 * Check for a "[" as the next pattern character. It is followed by a
+	 * list of characters that are acceptable, or by a range (two
+	 * characters separated by "-").
 	 */
 
 	if (p == '[') {
 	    Tcl_UniChar startChar, endChar;
 
 	    pattern++;
-	    if (UCHAR(*string) < 0x80) {
+	    if (UCHAR(*str) < 0x80) {
 		ch1 = (Tcl_UniChar)
-		    (nocase ? tolower(UCHAR(*string)) : UCHAR(*string));
-		string++;
+			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
+		str++;
 	    } else {
-		string += Tcl_UtfToUniChar(string, &ch1);
+		str += Tcl_UtfToUniChar(str, &ch1);
 		if (nocase) {
 		    ch1 = Tcl_UniCharToLower(ch1);
 		}
@@ -1325,8 +2042,8 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 		    return 0;
 		}
 		if (UCHAR(*pattern) < 0x80) {
-		    startChar = (Tcl_UniChar)
-			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
+		    startChar = (Tcl_UniChar) (nocase
+			    ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 		    pattern++;
 		} else {
 		    pattern += Tcl_UtfToUniChar(pattern, &startChar);
@@ -1340,9 +2057,8 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 			return 0;
 		    }
 		    if (UCHAR(*pattern) < 0x80) {
-			endChar = (Tcl_UniChar)
-			    (nocase ? tolower(UCHAR(*pattern))
-				    : UCHAR(*pattern));
+			endChar = (Tcl_UniChar) (nocase
+				? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 			pattern++;
 		    } else {
 			pattern += Tcl_UtfToUniChar(pattern, &endChar);
@@ -1374,8 +2090,8 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 	}
 
 	/*
-	 * If the next pattern character is '\', just strip off the '\'
-	 * so we do exact matching on the character that follows.
+	 * If the next pattern character is '\', just strip off the '\' so we
+	 * do exact matching on the character that follows.
 	 */
 
 	if (p == '\\') {
@@ -1386,11 +2102,11 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 	}
 
 	/*
-	 * There's no special character.  Just make sure that the next
-	 * bytes of each string match.
+	 * There's no special character. Just make sure that the next bytes of
+	 * each string match.
 	 */
 
-	string  += TclUtfToUniChar(string, &ch1);
+	str += TclUtfToUniChar(str, &ch1);
 	pattern += TclUtfToUniChar(pattern, &ch2);
 	if (nocase) {
 	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
@@ -1405,14 +2121,16 @@ Tcl_StringCaseMatch(string, pattern, nocase)
 /*
  *----------------------------------------------------------------------
  *
- * TclMatchIsTrivial --
+ * TclByteArrayMatch --
  *
- *	Test whether a particular glob pattern is a trivial pattern.
- *	(i.e. where matching is the same as equality testing).
+ *	See if a particular string matches a particular pattern.  Does not
+ *	allow for case insensitivity.
+ *	Parallels tclUtf.c:TclUniCharMatch, adjusted for char* and sans nocase.
  *
  * Results:
- *	A boolean indicating whether the pattern is free of all of the
- *	glob special chars.
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
  *
  * Side effects:
  *	None.
@@ -1421,32 +2139,222 @@ Tcl_StringCaseMatch(string, pattern, nocase)
  */
 
 int
-TclMatchIsTrivial(pattern)
-    CONST char *pattern;
+TclByteArrayMatch(
+    const unsigned char *string,	/* String. */
+    int strLen,				/* Length of String */
+    const unsigned char *pattern,	/* Pattern, which may contain special
+					 * characters. */
+    int ptnLen,				/* Length of Pattern */
+    int flags)
 {
-    CONST char *p = pattern;
+    const unsigned char *stringEnd, *patternEnd;
+    unsigned char p;
+
+    stringEnd = string + strLen;
+    patternEnd = pattern + ptnLen;
 
     while (1) {
-	switch (*p++) {
-	case '\0':
-	    return 1;
-	case '*':
-	case '?':
-	case '[':
-	case '\\':
+	/*
+	 * See if we're at the end of both the pattern and the string. If so,
+	 * we succeeded. If we're at the end of the pattern but not at the end
+	 * of the string, we failed.
+	 */
+
+	if (pattern == patternEnd) {
+	    return (string == stringEnd);
+	}
+	p = *pattern;
+	if ((string == stringEnd) && (p != '*')) {
+	    return 0;
+	}
+
+	/*
+	 * Check for a "*" as the next pattern character. It matches any
+	 * substring. We handle this by skipping all the characters up to the
+	 * next matching one in the pattern, and then calling ourselves
+	 * recursively for each postfix of string, until either we match or we
+	 * reach the end of the string.
+	 */
+
+	if (p == '*') {
+	    /*
+	     * Skip all successive *'s in the pattern.
+	     */
+
+	    while ((++pattern < patternEnd) && (*pattern == '*')) {
+		/* empty body */
+	    }
+	    if (pattern == patternEnd) {
+		return 1;
+	    }
+	    p = *pattern;
+	    while (1) {
+		/*
+		 * Optimization for matching - cruise through the string
+		 * quickly if the next char in the pattern isn't a special
+		 * character.
+		 */
+
+		if ((p != '[') && (p != '?') && (p != '\\')) {
+		    while ((string < stringEnd) && (p != *string)) {
+			string++;
+		    }
+		}
+		if (TclByteArrayMatch(string, stringEnd - string,
+				pattern, patternEnd - pattern, 0)) {
+		    return 1;
+		}
+		if (string == stringEnd) {
+		    return 0;
+		}
+		string++;
+	    }
+	}
+
+	/*
+	 * Check for a "?" as the next pattern character. It matches any
+	 * single character.
+	 */
+
+	if (p == '?') {
+	    pattern++;
+	    string++;
+	    continue;
+	}
+
+	/*
+	 * Check for a "[" as the next pattern character. It is followed by a
+	 * list of characters that are acceptable, or by a range (two
+	 * characters separated by "-").
+	 */
+
+	if (p == '[') {
+	    unsigned char ch1, startChar, endChar;
+
+	    pattern++;
+	    ch1 = *string;
+	    string++;
+	    while (1) {
+		if ((*pattern == ']') || (pattern == patternEnd)) {
+		    return 0;
+		}
+		startChar = *pattern;
+		pattern++;
+		if (*pattern == '-') {
+		    pattern++;
+		    if (pattern == patternEnd) {
+			return 0;
+		    }
+		    endChar = *pattern;
+		    pattern++;
+		    if (((startChar <= ch1) && (ch1 <= endChar))
+			    || ((endChar <= ch1) && (ch1 <= startChar))) {
+			/*
+			 * Matches ranges of form [a-z] or [z-a].
+			 */
+			break;
+		    }
+		} else if (startChar == ch1) {
+		    break;
+		}
+	    }
+	    while (*pattern != ']') {
+		if (pattern == patternEnd) {
+		    pattern--;
+		    break;
+		}
+		pattern++;
+	    }
+	    pattern++;
+	    continue;
+	}
+
+	/*
+	 * If the next pattern character is '\', just strip off the '\' so we
+	 * do exact matching on the character that follows.
+	 */
+
+	if (p == '\\') {
+	    if (++pattern == patternEnd) {
+		return 0;
+	    }
+	}
+
+	/*
+	 * There's no special character. Just make sure that the next bytes of
+	 * each string match.
+	 */
+
+	if (*string != *pattern) {
 	    return 0;
 	}
+	string++;
+	pattern++;
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * TclStringMatchObj --
+ *
+ *	See if a particular string matches a particular pattern.
+ *	Allows case insensitivity.  This is the generic multi-type handler
+ *	for the various matching algorithms.
+ *
+ * Results:
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStringMatchObj(
+    Tcl_Obj *strObj,	/* string object. */
+    Tcl_Obj *ptnObj,	/* pattern object. */
+    int flags)		/* Only TCL_MATCH_NOCASE should be passed or 0. */
+{
+    int match, length, plen;
+
+    /*
+     * Promote based on the type of incoming object.
+     * XXX: Currently doesn't take advantage of exact-ness that
+     * XXX: TclReToGlob tells us about
+    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
+     */
+
+    if (strObj->typePtr == &tclStringType) {
+	Tcl_UniChar *udata, *uptn;
+
+	udata = Tcl_GetUnicodeFromObj(strObj, &length);
+	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
+	match = TclUniCharMatch(udata, length, uptn, plen, flags);
+    } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+	unsigned char *data, *ptn;
+
+	data = Tcl_GetByteArrayFromObj(strObj, &length);
+	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);
+	match = TclByteArrayMatch(data, length, ptn, plen, 0);
+    } else {
+	match = Tcl_StringCaseMatch(TclGetString(strObj),
+		TclGetString(ptnObj), flags);
+    }
+    return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DStringInit --
  *
- *	Initializes a dynamic string, discarding any previous contents
- *	of the string (Tcl_DStringFree should have been called already
- *	if the dynamic string was previously in use).
+ *	Initializes a dynamic string, discarding any previous contents of the
+ *	string (Tcl_DStringFree should have been called already if the dynamic
+ *	string was previously in use).
  *
  * Results:
  *	None.
@@ -1458,8 +2366,8 @@ TclMatchIsTrivial(pattern)
  */
 
 void
-Tcl_DStringInit(dsPtr)
-    Tcl_DString *dsPtr;		/* Pointer to structure for dynamic string. */
+Tcl_DStringInit(
+    Tcl_DString *dsPtr)		/* Pointer to structure for dynamic string. */
 {
     dsPtr->string = dsPtr->staticSpace;
     dsPtr->length = 0;
@@ -1472,66 +2380,63 @@ Tcl_DStringInit(dsPtr)
  *
  * Tcl_DStringAppend --
  *
- *	Append more characters to the current value of a dynamic string.
+ *	Append more bytes to the current value of a dynamic string.
  *
  * Results:
  *	The return value is a pointer to the dynamic string's new value.
  *
  * Side effects:
- *	Length bytes from string (or all of string if length is less
- *	than zero) are added to the current value of the string. Memory
- *	gets reallocated if needed to accomodate the string's new size.
+ *	Length bytes from "bytes" (or all of "bytes" if length is less than
+ *	zero) are added to the current value of the string. Memory gets
+ *	reallocated if needed to accomodate the string's new size.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_DStringAppend(dsPtr, string, length)
-    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
-    CONST char *string;		/* String to append.  If length is -1 then
-				 * this must be null-terminated. */
-    int length;			/* Number of characters from string to
-				 * append.  If < 0, then append all of string,
-				 * up to null at end. */
+Tcl_DStringAppend(
+    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
+    CONST char *bytes,		/* String to append. If length is -1 then this
+				 * must be null-terminated. */
+    int length)			/* Number of bytes from "bytes" to append. If
+				 * < 0, then append all of bytes, up to null
+				 * at end. */
 {
     int newSize;
     char *dst;
     CONST char *end;
 
     if (length < 0) {
-	length = strlen(string);
+	length = strlen(bytes);
     }
     newSize = length + dsPtr->length;
 
     /*
-     * Allocate a larger buffer for the string if the current one isn't
-     * large enough. Allocate extra space in the new buffer so that there
-     * will be room to grow before we have to allocate again.
+     * Allocate a larger buffer for the string if the current one isn't large
+     * enough. Allocate extra space in the new buffer so that there will be
+     * room to grow before we have to allocate again.
      */
 
     if (newSize >= dsPtr->spaceAvl) {
 	dsPtr->spaceAvl = newSize * 2;
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString;
+	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
 
-	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
-	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
-		    (size_t) dsPtr->length);
+	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+	    dsPtr->string = ckrealloc((void *) dsPtr->string,
 		    (size_t) dsPtr->spaceAvl);
 	}
     }
 
     /*
-     * Copy the new string into the buffer at the end of the old
-     * one.
+     * Copy the new string into the buffer at the end of the old one.
      */
 
-    for (dst = dsPtr->string + dsPtr->length, end = string+length;
-	    string < end; string++, dst++) {
-	*dst = *string;
+    for (dst = dsPtr->string + dsPtr->length, end = bytes+length;
+	    bytes < end; bytes++, dst++) {
+	*dst = *bytes;
     }
     *dst = '\0';
     dsPtr->length += length;
@@ -1549,62 +2454,67 @@ Tcl_DStringAppend(dsPtr, string, length)
  *	The return value is a pointer to the dynamic string's new value.
  *
  * Side effects:
- *	String is reformatted as a list element and added to the current
- *	value of the string.  Memory gets reallocated if needed to
- *	accomodate the string's new size.
+ *	String is reformatted as a list element and added to the current value
+ *	of the string. Memory gets reallocated if needed to accomodate the
+ *	string's new size.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-Tcl_DStringAppendElement(dsPtr, string)
-    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
-    CONST char *string;		/* String to append.  Must be
+Tcl_DStringAppendElement(
+    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
+    CONST char *element)	/* String to append. Must be
 				 * null-terminated. */
 {
-    int newSize, flags, strSize;
-    char *dst;
-
-    strSize = ((string == NULL) ? 0 : strlen(string));
-    newSize = Tcl_ScanCountedElement(string, strSize, &flags)
-	+ dsPtr->length + 1;
+    char *dst = dsPtr->string + dsPtr->length;
+    int needSpace = TclNeedSpace(dsPtr->string, dst);
+    int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
+    int newSize = dsPtr->length + needSpace
+	    + TclScanElement(element, -1, &flags);
 
     /*
-     * Allocate a larger buffer for the string if the current one isn't
-     * large enough.  Allocate extra space in the new buffer so that there
-     * will be room to grow before we have to allocate again.
-     * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
-     * to a larger buffer, since there may be embedded NULLs in the
-     * string in some cases.
+     * Allocate a larger buffer for the string if the current one isn't large
+     * enough. Allocate extra space in the new buffer so that there will be
+     * room to grow before we have to allocate again. SPECIAL NOTE: must use
+     * memcpy, not strcpy, to copy the string to a larger buffer, since there
+     * may be embedded NULLs in the string in some cases.
      */
 
     if (newSize >= dsPtr->spaceAvl) {
 	dsPtr->spaceAvl = newSize * 2;
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString;
+	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
 
-	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
-	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
-		    (size_t) dsPtr->length);
+	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
 		    (size_t) dsPtr->spaceAvl);
 	}
+	dst = dsPtr->string + dsPtr->length;
     }
 
     /*
-     * Convert the new string to a list element and copy it into the
-     * buffer at the end, with a space, if needed.
+     * Convert the new string to a list element and copy it into the buffer at
+     * the end, with a space, if needed.
      */
 
-    dst = dsPtr->string + dsPtr->length;
-    if (TclNeedSpace(dsPtr->string, dst)) {
+    if (needSpace) {
 	*dst = ' ';
 	dst++;
 	dsPtr->length++;
+
+	/*
+	 * If we need a space to separate this element from preceding stuff,
+	 * then this element will not lead a list, and need not have it's
+	 * leading '#' quoted.
+	 */
+
+	flags |= TCL_DONT_QUOTE_HASH;
     }
-    dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags);
+    dsPtr->length += TclConvertElement(element, -1, dst, flags);
+    dsPtr->string[dsPtr->length] = '\0';
     return dsPtr->string;
 }
 
@@ -1613,25 +2523,24 @@ Tcl_DStringAppendElement(dsPtr, string)
  *
  * Tcl_DStringSetLength --
  *
- *	Change the length of a dynamic string.  This can cause the
- *	string to either grow or shrink, depending on the value of
- *	length.
+ *	Change the length of a dynamic string. This can cause the string to
+ *	either grow or shrink, depending on the value of length.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The length of dsPtr is changed to length and a null byte is
- *	stored at that position in the string.  If length is larger
- *	than the space allocated for dsPtr, then a panic occurs.
+ *	The length of dsPtr is changed to length and a null byte is stored at
+ *	that position in the string. If length is larger than the space
+ *	allocated for dsPtr, then a panic occurs.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DStringSetLength(dsPtr, length)
-    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
-    int length;			/* New length for dynamic string. */
+Tcl_DStringSetLength(
+    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
+    int length)			/* New length for dynamic string. */
 {
     int newsize;
 
@@ -1640,15 +2549,15 @@ Tcl_DStringSetLength(dsPtr, length)
     }
     if (length >= dsPtr->spaceAvl) {
 	/*
-	 * There are two interesting cases here.  In the first case, the user
-	 * may be trying to allocate a large buffer of a specific size.  It
+	 * There are two interesting cases here. In the first case, the user
+	 * may be trying to allocate a large buffer of a specific size. It
 	 * would be wasteful to overallocate that buffer, so we just allocate
-	 * enough for the requested size plus the trailing null byte.  In the
+	 * enough for the requested size plus the trailing null byte. In the
 	 * second case, we are growing the buffer incrementally, so we need
-	 * behavior similar to Tcl_DStringAppend.  The requested length will
-	 * usually be a small delta above the current spaceAvl, so we'll end up
-	 * doubling the old size.  This won't grow the buffer quite as quickly,
-	 * but it should be close enough.
+	 * behavior similar to Tcl_DStringAppend. The requested length will
+	 * usually be a small delta above the current spaceAvl, so we'll end
+	 * up doubling the old size. This won't grow the buffer quite as
+	 * quickly, but it should be close enough.
 	 */
 
 	newsize = dsPtr->spaceAvl * 2;
@@ -1658,14 +2567,12 @@ Tcl_DStringSetLength(dsPtr, length)
 	    dsPtr->spaceAvl = length + 1;
 	}
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString;
+	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
 
-	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
-	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
-		    (size_t) dsPtr->length);
+	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
 		    (size_t) dsPtr->spaceAvl);
 	}
     }
@@ -1678,21 +2585,22 @@ Tcl_DStringSetLength(dsPtr, length)
  *
  * Tcl_DStringFree --
  *
- *	Frees up any memory allocated for the dynamic string and
- *	reinitializes the string to an empty state.
+ *	Frees up any memory allocated for the dynamic string and reinitializes
+ *	the string to an empty state.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The previous contents of the dynamic string are lost, and
- *	the new value is an empty string.
+ *	The previous contents of the dynamic string are lost, and the new
+ *	value is an empty string.
  *
- *---------------------------------------------------------------------- */
+ *----------------------------------------------------------------------
+ */
 
 void
-Tcl_DStringFree(dsPtr)
-    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+Tcl_DStringFree(
+    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
 {
     if (dsPtr->string != dsPtr->staticSpace) {
 	ckfree(dsPtr->string);
@@ -1708,29 +2616,28 @@ Tcl_DStringFree(dsPtr)
  *
  * Tcl_DStringResult --
  *
- *	This procedure moves the value of a dynamic string into an
- *	interpreter as its string result. Afterwards, the dynamic string
- *	is reset to an empty string.
+ *	This function moves the value of a dynamic string into an interpreter
+ *	as its string result. Afterwards, the dynamic string is reset to an
+ *	empty string.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The string is "moved" to interp's result, and any existing
- *	string result for interp is freed. dsPtr is reinitialized to
- *	an empty string.
+ *	The string is "moved" to interp's result, and any existing string
+ *	result for interp is freed. dsPtr is reinitialized to an empty string.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DStringResult(interp, dsPtr)
-    Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */
-    Tcl_DString *dsPtr;		/* Dynamic string that is to become the
+Tcl_DStringResult(
+    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
+    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
 				 * result of interp. */
 {
     Tcl_ResetResult(interp);
-    
+
     if (dsPtr->string != dsPtr->staticSpace) {
 	interp->result = dsPtr->string;
 	interp->freeProc = TCL_DYNAMIC;
@@ -1740,7 +2647,7 @@ Tcl_DStringResult(interp, dsPtr)
     } else {
 	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
     }
-    
+
     dsPtr->string = dsPtr->staticSpace;
     dsPtr->length = 0;
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
@@ -1752,14 +2659,14 @@ Tcl_DStringResult(interp, dsPtr)
  *
  * Tcl_DStringGetResult --
  *
- *	This procedure moves an interpreter's result into a dynamic string.
+ *	This function moves an interpreter's result into a dynamic string.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The interpreter's string result is cleared, and the previous
- *	contents of dsPtr are freed.
+ *	The interpreter's string result is cleared, and the previous contents
+ *	of dsPtr are freed.
  *
  *	If the string result is empty, the object result is moved to the
  *	string result, then the object result is reset.
@@ -1768,26 +2675,23 @@ Tcl_DStringResult(interp, dsPtr)
  */
 
 void
-Tcl_DStringGetResult(interp, dsPtr)
-    Tcl_Interp *interp;		/* Interpreter whose result is to be reset. */
-    Tcl_DString *dsPtr;		/* Dynamic string that is to become the
-				 * result of interp. */
+Tcl_DStringGetResult(
+    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
+    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
+				 * of interp. */
 {
     Interp *iPtr = (Interp *) interp;
-    
+
     if (dsPtr->string != dsPtr->staticSpace) {
 	ckfree(dsPtr->string);
     }
 
     /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
+     * If the string result is empty, move the object result to the string
+     * result, then reset the object result.
      */
 
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
-    }
+    (void) Tcl_GetStringResult(interp);
 
     dsPtr->length = strlen(iPtr->result);
     if (iPtr->freeProc != NULL) {
@@ -1796,7 +2700,7 @@ Tcl_DStringGetResult(interp, dsPtr)
 	    dsPtr->spaceAvl = dsPtr->length+1;
 	} else {
 	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
-	    strcpy(dsPtr->string, iPtr->result);
+	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
 	    (*iPtr->freeProc)(iPtr->result);
 	}
 	dsPtr->spaceAvl = dsPtr->length+1;
@@ -1809,9 +2713,9 @@ Tcl_DStringGetResult(interp, dsPtr)
 	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
 	    dsPtr->spaceAvl = dsPtr->length + 1;
 	}
-	strcpy(dsPtr->string, iPtr->result);
+	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
     }
-    
+
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
 }
@@ -1821,9 +2725,9 @@ Tcl_DStringGetResult(interp, dsPtr)
  *
  * Tcl_DStringStartSublist --
  *
- *	This procedure adds the necessary information to a dynamic
- *	string (e.g. " {" to start a sublist.  Future element
- *	appends will be in the sublist rather than the main list.
+ *	This function adds the necessary information to a dynamic string
+ *	(e.g. " {") to start a sublist. Future element appends will be in the
+ *	sublist rather than the main list.
  *
  * Results:
  *	None.
@@ -1835,8 +2739,8 @@ Tcl_DStringGetResult(interp, dsPtr)
  */
 
 void
-Tcl_DStringStartSublist(dsPtr)
-    Tcl_DString *dsPtr;			/* Dynamic string. */
+Tcl_DStringStartSublist(
+    Tcl_DString *dsPtr)		/* Dynamic string. */
 {
     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
 	Tcl_DStringAppend(dsPtr, " {", -1);
@@ -1850,10 +2754,9 @@ Tcl_DStringStartSublist(dsPtr)
  *
  * Tcl_DStringEndSublist --
  *
- *	This procedure adds the necessary characters to a dynamic
- *	string to end a sublist (e.g. "}").  Future element appends
- *	will be in the enclosing (sub)list rather than the current
- *	sublist.
+ *	This function adds the necessary characters to a dynamic string to end
+ *	a sublist (e.g. "}"). Future element appends will be in the enclosing
+ *	(sub)list rather than the current sublist.
  *
  * Results:
  *	None.
@@ -1865,8 +2768,8 @@ Tcl_DStringStartSublist(dsPtr)
  */
 
 void
-Tcl_DStringEndSublist(dsPtr)
-    Tcl_DString *dsPtr;			/* Dynamic string. */
+Tcl_DStringEndSublist(
+    Tcl_DString *dsPtr)		/* Dynamic string. */
 {
     Tcl_DStringAppend(dsPtr, "}", -1);
 }
@@ -1876,14 +2779,14 @@ Tcl_DStringEndSublist(dsPtr)
  *
  * Tcl_PrintDouble --
  *
- *	Given a floating-point value, this procedure converts it to
- *	an ASCII string using.
+ *	Given a floating-point value, this function converts it to an ASCII
+ *	string using.
  *
  * Results:
- *	The ASCII equivalent of "value" is written at "dst".  It is
- *	written using the current precision, and it is guaranteed to
- *	contain a decimal point or exponent, so that it looks like
- *	a floating-point value and not an integer.
+ *	The ASCII equivalent of "value" is written at "dst". It is written
+ *	using the current precision, and it is guaranteed to contain a decimal
+ *	point or exponent, so that it looks like a floating-point value and
+ *	not an integer.
  *
  * Side effects:
  *	None.
@@ -1892,43 +2795,158 @@ Tcl_DStringEndSublist(dsPtr)
  */
 
 void
-Tcl_PrintDouble(interp, value, dst)
-    Tcl_Interp *interp;			/* Interpreter whose tcl_precision
-					 * variable used to be used to control
-					 * printing.  It's ignored now. */
-    double value;			/* Value to print as string. */
-    char *dst;				/* Where to store converted value;
-					 * must have at least TCL_DOUBLE_SPACE
-					 * characters. */
+Tcl_PrintDouble(
+    Tcl_Interp *interp,		/* Interpreter whose tcl_precision variable
+				 * used to be used to control printing. It's
+				 * ignored now. */
+    double value,		/* Value to print as string. */
+    char *dst)			/* Where to store converted value; must have
+				 * at least TCL_DOUBLE_SPACE characters. */
 {
     char *p, c;
-    Tcl_UniChar ch;
+    int exponent;
+    int signum;
+    char* digits;
+    char* end;
 
-    Tcl_MutexLock(&precisionMutex);
-    sprintf(dst, precisionFormat, value);
-    Tcl_MutexUnlock(&precisionMutex);
+    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
 
     /*
-     * If the ASCII result looks like an integer, add ".0" so that it
-     * doesn't look like an integer anymore.  This prevents floating-point
-     * values from being converted to integers unintentionally.
-     * Check for ASCII specifically to speed up the function.
-     */
+	 * Handle NaN.
+	 */
 
-    for (p = dst; *p != 0; ) {
-	if (UCHAR(*p) < 0x80) {
-	    c = *p++;
-	} else {
-	    p += Tcl_UtfToUniChar(p, &ch);
-	    c = UCHAR(ch);
+	if (TclIsNaN(value)) {
+	    TclFormatNaN(value, dst);
+	    return;
 	}
-	if ((c == '.') || isalpha(UCHAR(c))) {	/* INTL: ISO only. */
+
+	/*
+	 * Handle infinities.
+	 */
+
+	if (TclIsInfinite(value)) {
+	/*
+	 * Remember to copy the terminating NUL too.
+	 */
+	
+	    if (value < 0) {
+	    memcpy(dst, "-Inf", 5);
+	    } else {
+	    memcpy(dst, "Inf", 4);
+	    }
 	    return;
 	}
+
+	/*
+	 * Ordinary (normal and denormal) values.
+	 */
+
+    if (*precisionPtr == 0) {
+	digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
+				 &exponent, &signum, &end);
+    } else {
+	/*
+	 * There are at least two possible interpretations for tcl_precision.
+	 *
+	 * The first is, "choose the decimal representation having
+	 * $tcl_precision digits of significance that is nearest to the
+	 * given number, breaking ties by rounding to even, and then
+	 * trimming trailing zeros." This gives the greatest possible
+	 * precision in the decimal string, but offers the anomaly that
+	 * [expr 0.1] will be "0.10000000000000001".
+	 *
+	 * The second is "choose the decimal representation having at
+	 * most $tcl_precision digits of significance that is nearest
+	 * to the given number. If no such representation converts
+	 * exactly to the given number, choose the one that is closest,
+	 * breaking ties by rounding to even. If more than one such
+	 * representation converts exactly to the given number, choose
+	 * the shortest, breaking ties in favour of the nearest, breaking
+	 * remaining ties in favour of the one ending in an even digit."
+	 *
+	 * Tcl 8.4 implements the first of these, which gives rise to
+	 * anomalies in formatting:
+	 *
+	 * % expr 0.1
+	 * 0.10000000000000001
+	 * % expr 0.01
+	 * 0.01
+	 * % expr 1e-7
+	 * 9.9999999999999995e-08
+	 *
+	 * For human readability, it appears better to choose the second rule,
+	 * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we
+	 * prefer the first (the recommended zero value for tcl_precision
+	 * avoids the problem entirely).
+	 *
+	 * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the
+	 * method that allows floating point values to be shortened if
+	 * it can be done without loss of precision.
+	 */
+
+	digits = TclDoubleDigits(value, *precisionPtr,
+				 TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, 
+				 &exponent, &signum, &end);
+    }
+	if (signum) {
+	    *dst++ = '-';
+	}
+    p = digits;
+    if (exponent < -4 || exponent > 16) {
+	/*
+	 * E format for numbers < 1e-3 or >= 1e17.
+	 */
+	
+	*dst++ = *p++;
+	c = *p;
+	if (c != '\0') {
+	    *dst++ = '.';
+	    while (c != '\0') {
+		*dst++ = c;
+		c = *++p;
+	    }
+	}
+	/* 
+	 * Tcl 8.4 appears to format with at least a two-digit exponent; \
+	 * preserve that behaviour when tcl_precision != 0
+	 */
+	if (*precisionPtr == 0) {
+	    sprintf(dst, "e%+d", exponent);
+	} else {
+	    sprintf(dst, "e%+03d", exponent);
+	}
+    } else {
+	/*
+	 * F format for others.
+	 */
+	
+	if (exponent < 0) {
+	    *dst++ = '0';
+	}
+	c = *p;
+	while (exponent-- >= 0) {
+	    if (c != '\0') {
+		*dst++ = c;
+		c = *++p;
+	    } else {
+		*dst++ = '0';
+	    }
+	}
+	*dst++ = '.';
+	if (c == '\0') {
+	    *dst++ = '0';
+	} else {
+	    while (++exponent < -1) {
+		*dst++ = '0';
+	    }
+	    while (c != '\0') {
+		*dst++ = c;
+		c = *++p;
+	    }
+	}
+	*dst++ = '\0';
     }
-    p[0] = '.';
-    p[1] = '0';
-    p[2] = 0;
+    ckfree(digits);
 }
 
 /*
@@ -1936,33 +2954,33 @@ Tcl_PrintDouble(interp, value, dst)
  *
  * TclPrecTraceProc --
  *
- *	This procedure is invoked whenever the variable "tcl_precision"
- *	is written.
+ *	This function is invoked whenever the variable "tcl_precision" is
+ *	written.
  *
  * Results:
- *	Returns NULL if all went well, or an error message if the
- *	new value for the variable doesn't make sense.
+ *	Returns NULL if all went well, or an error message if the new value
+ *	for the variable doesn't make sense.
  *
  * Side effects:
- *	If the new value doesn't make sense then this procedure
- *	undoes the effect of the variable modification.  Otherwise
- *	it modifies the format string that's used by Tcl_PrintDouble.
+ *	If the new value doesn't make sense then this function undoes the
+ *	effect of the variable modification. Otherwise it modifies the format
+ *	string that's used by Tcl_PrintDouble.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 char *
-TclPrecTraceProc(clientData, interp, name1, name2, flags)
-    ClientData clientData;	/* Not used. */
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *name1;		/* Name of variable. */
-    CONST char *name2;		/* Second part of variable name. */
-    int flags;			/* Information about what happened. */
+TclPrecTraceProc(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    CONST char *name1,		/* Name of variable. */
+    CONST char *name2,		/* Second part of variable name. */
+    int flags)			/* Information about what happened. */
 {
-    CONST char *value;
-    char *end;
+    Tcl_Obj* value;
     int prec;
+    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
 
     /*
      * If the variable is unset, then recreate the trace.
@@ -1974,54 +2992,39 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
 		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
 		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
 	}
-	return (char *) NULL;
+	return NULL;
     }
 
     /*
-     * When the variable is read, reset its value from our shared
-     * value.  This is needed in case the variable was modified in
-     * some other interpreter so that this interpreter's value is
-     * out of date.
+     * When the variable is read, reset its value from our shared value. This
+     * is needed in case the variable was modified in some other interpreter
+     * so that this interpreter's value is out of date.
      */
 
-    Tcl_MutexLock(&precisionMutex);
 
     if (flags & TCL_TRACE_READS) {
-	Tcl_SetVar2(interp, name1, name2, precisionString,
+	Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
 		flags & TCL_GLOBAL_ONLY);
-	Tcl_MutexUnlock(&precisionMutex);
-	return (char *) NULL;
+	return NULL;
     }
 
     /*
-     * The variable is being written.  Check the new value and disallow
-     * it if it isn't reasonable or if this is a safe interpreter (we
-     * don't want safe interpreters messing up the precision of other
-     * interpreters).
+     * The variable is being written. Check the new value and disallow it if
+     * it isn't reasonable or if this is a safe interpreter (we don't want
+     * safe interpreters messing up the precision of other interpreters).
      */
 
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetVar2(interp, name1, name2, precisionString,
-		flags & TCL_GLOBAL_ONLY);
-	Tcl_MutexUnlock(&precisionMutex);
 	return "can't modify precision from a safe interpreter";
     }
-    value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
-    if (value == NULL) {
-	value = "";
-    }
-    prec = strtoul(value, &end, 10);
-    if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
-	    (end == value) || (*end != 0)) {
-	Tcl_SetVar2(interp, name1, name2, precisionString,
-		flags & TCL_GLOBAL_ONLY);
-	Tcl_MutexUnlock(&precisionMutex);
+    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
+    if (value == NULL
+	    || Tcl_GetIntFromObj((Tcl_Interp*) NULL, value, &prec) != TCL_OK
+	    || prec < 0 || prec > TCL_MAX_PREC) {
 	return "improper value for precision";
     }
-    TclFormatInt(precisionString, prec);
-    sprintf(precisionFormat, "%%.%dg", prec);
-    Tcl_MutexUnlock(&precisionMutex);
-    return (char *) NULL;
+    *precisionPtr = prec;
+    return NULL;
 }
 
 /*
@@ -2029,9 +3032,8 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
  *
  * TclNeedSpace --
  *
- *	This procedure checks to see whether it is appropriate to
- *	add a space before appending a new list element to an
- *	existing string.
+ *	This function checks to see whether it is appropriate to add a space
+ *	before appending a new list element to an existing string.
  *
  * Results:
  *	The return value is 1 if a space is appropriate, 0 otherwise.
@@ -2043,24 +3045,25 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
  */
 
 int
-TclNeedSpace(start, end)
-    CONST char *start;		/* First character in string. */
-    CONST char *end;		/* End of string (place where space will
-				 * be added, if appropriate). */
+TclNeedSpace(
+    CONST char *start,		/* First character in string. */
+    CONST char *end)		/* End of string (place where space will be
+				 * added, if appropriate). */
 {
     /*
-     * A space is needed unless either
+     * A space is needed unless either:
      * (a) we're at the start of the string, or
      */
+
     if (end == start) {
 	return 0;
     }
 
     /*
-     * (b) we're at the start of a nested list-element, quoted with an
-     *     open curly brace; we can be nested arbitrarily deep, so long
-     *     as the first curly brace starts an element, so backtrack over
-     *     open curly braces that are trailing characters of the string; and
+     * (b) we're at the start of a nested list-element, quoted with an open
+     *	   curly brace; we can be nested arbitrarily deep, so long as the
+     *	   first curly brace starts an element, so backtrack over open curly
+     *	   braces that are trailing characters of the string; and
      */
 
     end = Tcl_UtfPrev(end, start);
@@ -2073,39 +3076,39 @@ TclNeedSpace(start, end)
 
     /*
      * (c) the trailing character of the string is already a list-element
-     *     separator (according to TclFindElement); that is, one of these
-     *     characters:
-     *     	\u0009	\t	TAB
-     *     	\u000A	\n	NEWLINE
-     *     	\u000B	\v	VERTICAL TAB
-     *     	\u000C	\f	FORM FEED
-     *     	\u000D	\r	CARRIAGE RETURN
-     *     	\u0020		SPACE
-     *     with the condition that the penultimate character is not a
-     *     backslash.
+     *	   separator (according to TclFindElement); that is, one of these
+     *	   characters:
+     *		\u0009	\t	TAB
+     *		\u000A	\n	NEWLINE
+     *		\u000B	\v	VERTICAL TAB
+     *		\u000C	\f	FORM FEED
+     *		\u000D	\r	CARRIAGE RETURN
+     *		\u0020		SPACE
+     *	   with the condition that the penultimate character is not a
+     *	   backslash.
      */
 
     if (*end > 0x20) {
 	/*
-	 * Performance tweak.  All ASCII spaces are <= 0x20. So get
-	 * a quick answer for most characters before comparing against
-	 * all spaces in the switch below.
+	 * Performance tweak. All ASCII spaces are <= 0x20. So get a quick
+	 * answer for most characters before comparing against all spaces in
+	 * the switch below.
 	 *
-	 * NOTE: Remove this if other Unicode spaces ever get accepted
-	 * as list-element separators.
+	 * NOTE: Remove this if other Unicode spaces ever get accepted as
+	 * list-element separators.
 	 */
 	return 1;
     }
     switch (*end) {
-	case ' ':
-        case '\t':
-        case '\n':
-        case '\r':
-        case '\v':
-        case '\f':
-	    if ((end == start) || (end[-1] != '\\')) {
-		return 0;
-	    }
+    case ' ':
+    case '\t':
+    case '\n':
+    case '\r':
+    case '\v':
+    case '\f':
+	if ((end == start) || (end[-1] != '\\')) {
+	    return 0;
+	}
     }
     return 1;
 }
@@ -2120,7 +3123,9 @@ TclNeedSpace(start, end)
  *	inserted at the start of the buffer. A null character is inserted at
  *	the end of the formatted characters. It is the caller's
  *	responsibility to ensure that enough storage is available. This
- *	procedure has the effect of sprintf(buffer, "%d", n) but is faster.
+ *	procedure has the effect of sprintf(buffer, "%ld", n) but is faster
+ *	as proven in benchmarks.  This is key to UpdateStringOfInt, which
+ *	is a common path for a lot of code (e.g. int-indexed arrays).
  *
  * Results:
  *	An integer representing the number of characters formatted, not
@@ -2162,8 +3167,7 @@ TclFormatInt(buffer, n)
 
     intVal = -n;			/* [Bug 3390638] Workaround for*/
     if (n == -n || intVal == n) {	/* broken compiler optimizers. */
-	sprintf(buffer, "%ld", n);
-	return strlen(buffer);
+	return sprintf(buffer, "%ld", n);
     }
 
     /*
@@ -2199,133 +3203,119 @@ TclFormatInt(buffer, n)
 /*
  *----------------------------------------------------------------------
  *
- * TclLooksLikeInt --
- *
- *	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.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclLooksLikeInt(bytes, length)
-    register CONST char *bytes;	/* Points to first byte of the string. */
-    int length;			/* Number of bytes in the string. If < 0
-				 * bytes up to the first null byte are
-				 * considered (if they may appear in an 
-				 * integer). */
-{
-    register CONST char *p;
-
-    if ((bytes == NULL) && (length > 0)) {
-	Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);
-    }
-
-    if (length < 0) {
-        length = (bytes? strlen(bytes) : 0);
-    }
-
-    p = bytes;
-    while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
-	length--; p++;
-    }
-    if (length == 0) {
-        return 0;
-    }
-    if ((*p == '+') || (*p == '-')) {
-        p++; length--;
-    }
-
-    return (0 != TclParseInteger(p, length));
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclGetIntForIndex --
  *
- *	This procedure returns an integer corresponding to the list index
- *	held in a Tcl object. The Tcl object's value is expected to be
- *	either an integer or a string of the form "end([+-]integer)?". 
+ *	This function returns an integer corresponding to the list index held
+ *	in a Tcl object. The Tcl object's value is expected to be in the
+ *	format integer([+-]integer)? or the format end([+-]integer)?.
  *
  * Results:
  *	The return value is normally TCL_OK, which means that the index was
- *	successfully stored into the location referenced by "indexPtr".  If
- *	the Tcl object referenced by "objPtr" has the value "end", the
- *	value stored is "endValue". If "objPtr"s values is not of the form
- *	"end([+-]integer)?" and
- *	can not be converted to an integer, TCL_ERROR is returned and, if
- *	"interp" is non-NULL, an error message is left in the interpreter's
- *	result object.
+ *	successfully stored into the location referenced by "indexPtr". If the
+ *	Tcl object referenced by "objPtr" has the value "end", the value
+ *	stored is "endValue". If "objPtr"s values is not of one of the
+ *	expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
+ *	an error message is left in the interpreter's result object.
  *
  * Side effects:
- *	The object referenced by "objPtr" might be converted to an
- *	integer, wide integer, or end-based-index object.
+ *	The object referenced by "objPtr" might be converted to an integer,
+ *	wide integer, or end-based-index object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
-				 * If NULL, then no error message is left
-				 * after errors. */
-    Tcl_Obj *objPtr;		/* Points to an object containing either
-				 * "end" or an integer. */
-    int endValue;		/* The value to be stored at "indexPtr" if
+TclGetIntForIndex(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
+				 * or an integer. */
+    int endValue,		/* The value to be stored at "indexPtr" if
 				 * "objPtr" holds "end". */
-    int *indexPtr;		/* Location filled in with an integer
+    int *indexPtr)		/* Location filled in with an integer
 				 * representing an index. */
 {
-    if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
+    int length;
+    char *opPtr, *bytes;
+
+    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
 	return TCL_OK;
     }
 
     if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
 	/*
-	 * If the object is already an offset from the end of the
-	 * list, or can be converted to one, use it.
+	 * If the object is already an offset from the end of the list, or can
+	 * be converted to one, use it.
 	 */
 
 	*indexPtr = endValue + objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+
+    bytes = TclGetStringFromObj(objPtr, &length);
+
+    /*
+     * Leading whitespace is acceptable in an index.
+     */
+
+    while (length && TclIsSpaceProc(*bytes)) {
+	bytes++;
+	length--;
+    }
+
+    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
+	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
+	int code, first, second;
+	char savedOp = *opPtr;
+
+	if ((savedOp != '+') && (savedOp != '-')) {
+	    goto parseError;
+	}
+	if (TclIsSpaceProc(opPtr[1])) {
+	    goto parseError;
+	}
+	*opPtr = '\0';
+	code = Tcl_GetInt(interp, bytes, &first);
+	*opPtr = savedOp;
+	if (code == TCL_ERROR) {
+	    goto parseError;
+	}
+	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
+	    goto parseError;
+	}
+	if (savedOp == '+') {
+	    *indexPtr = first + second;
+	} else {
+	    *indexPtr = first - second;
+	}
+	return TCL_OK;
+    }
+
+    /*
+     * Report a parse error.
+     */
+
+  parseError:
+    if (interp != NULL) {
+	char *bytes = Tcl_GetString(objPtr);
 
-    } else {
 	/*
-	 * Report a parse error.
+	 * The result might not be empty; this resets it which should be both
+	 * a cheap operation, and of little problem because this is an
+	 * error-generation path anyway.
 	 */
 
-	if (interp != NULL) {
-	    char *bytes = Tcl_GetString(objPtr);
-	    /*
-	     * The result might not be empty; this resets it which
-	     * should be both a cheap operation, and of little problem
-	     * because this is an error-generation path anyway.
-	     */
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-				   "bad index \"", bytes,
-				   "\": must be integer or end?-integer?",
-				   (char *) NULL);
-	    if (!strncmp(bytes, "end-", 3)) {
-		bytes += 3;
-	    }
-	    TclCheckBadOctal(interp, bytes);
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "bad index \"", bytes,
+		"\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
+	if (!strncmp(bytes, "end-", 4)) {
+	    bytes += 4;
 	}
-
-	return TCL_ERROR;
+	TclCheckBadOctal(interp, bytes);
     }
-	    
-    return TCL_OK;
+
+    return TCL_ERROR;
 }
 
 /*
@@ -2342,16 +3332,15 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
  * Side effects:
  *	Stores a valid string in the object's string rep.
  *
- * This procedure does NOT free any earlier string rep.  If it is
- * called on an object that already has a valid string rep, it will
- * leak memory.
+ * This function does NOT free any earlier string rep. If it is called on an
+ * object that already has a valid string rep, it will leak memory.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfEndOffset(objPtr)
-    register Tcl_Obj* objPtr;
+UpdateStringOfEndOffset(
+    register Tcl_Obj* objPtr)
 {
     char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
     register int len;
@@ -2362,8 +3351,8 @@ UpdateStringOfEndOffset(objPtr)
 	buffer[len++] = '-';
 	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
     }
-    objPtr->bytes = ckalloc((unsigned) (len+1));
-    strcpy(objPtr->bytes, buffer);
+    objPtr->bytes = ckalloc((unsigned) len+1);
+    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
     objPtr->length = len;
 }
 
@@ -2372,100 +3361,104 @@ UpdateStringOfEndOffset(objPtr)
  *
  * SetEndOffsetFromAny --
  *
- *	Look for a string of the form "end-offset" and convert it
- *	to an internal representation holding the offset.
+ *	Look for a string of the form "end[+-]offset" and convert it to an
+ *	internal representation holding the offset.
  *
  * Results:
  *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
  *
  * Side effects:
- *	If interp is not NULL, stores an error message in the
- *	interpreter result.
+ *	If interp is not NULL, stores an error message in the interpreter
+ *	result.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetEndOffsetFromAny(interp, objPtr)
-     Tcl_Interp* interp;	/* Tcl interpreter or NULL */
-     Tcl_Obj* objPtr;		/* Pointer to the object to parse */
+SetEndOffsetFromAny(
+    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
+    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
 {
     int offset;			/* Offset in the "end-offset" expression */
-    Tcl_ObjType* oldTypePtr = objPtr->typePtr;
-				/* Old internal rep type of the object */
     register char* bytes;	/* String rep of the object */
     int length;			/* Length of the object's string rep */
 
-    /* If it's already the right type, we're fine. */
+    /*
+     * If it's already the right type, we're fine.
+     */
 
     if (objPtr->typePtr == &tclEndOffsetType) {
 	return TCL_OK;
     }
 
-    /* Check for a string rep of the right form. */
+    /*
+     * Check for a string rep of the right form.
+     */
 
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    bytes = TclGetStringFromObj(objPtr, &length);
     if ((*bytes != 'e') || (strncmp(bytes, "end",
 	    (size_t)((length > 3) ? 3 : length)) != 0)) {
 	if (interp != NULL) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-				   "bad index \"", bytes,
-				   "\": must be end?-integer?",
-				   (char*) NULL);
+	    Tcl_AppendResult(interp, "bad index \"", bytes,
+		    "\": must be end?[+-]integer?", NULL);
 	}
 	return TCL_ERROR;
     }
 
-    /* Convert the string rep */
+    /*
+     * Convert the string rep.
+     */
 
     if (length <= 3) {
 	offset = 0;
-    } else if ((length > 4) && (bytes[3] == '-')) {
+    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
 	/*
-	 * This is our limited string expression evaluator.  Pass everything
+	 * This is our limited string expression evaluator. Pass everything
 	 * after "end-" to Tcl_GetInt, then reverse for offset.
 	 */
+
+	if (TclIsSpaceProc(bytes[4])) {
+	    return TCL_ERROR;
+	}
 	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	offset = -offset;
+	if (bytes[3] == '-') {
+	    offset = -offset;
+	}
     } else {
 	/*
-	 * Conversion failed.  Report the error.
+	 * Conversion failed. Report the error.
 	 */
+
 	if (interp != NULL) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-				   "bad index \"", bytes,
-				   "\": must be integer or end?-integer?",
-				   (char *) NULL);
+	    Tcl_AppendResult(interp, "bad index \"", bytes,
+		    "\": must be end?[+-]integer?", NULL);
 	}
 	return TCL_ERROR;
     }
 
     /*
-     * The conversion succeeded. Free the old internal rep and set
-     * the new one.
+     * The conversion succeeded. Free the old internal rep and set the new
+     * one.
      */
 
-    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
-	oldTypePtr->freeIntRepProc(objPtr);
-    }
-    
+    TclFreeIntRep(objPtr);
     objPtr->internalRep.longValue = offset;
     objPtr->typePtr = &tclEndOffsetType;
 
     return TCL_OK;
-}    
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclCheckBadOctal --
  *
- *	This procedure checks for a bad octal value and appends a
- *	meaningful error to the interp's result.
+ *	This function checks for a bad octal value and appends a meaningful
+ *	error to the interp's result.
  *
  * Results:
  *	1 if the argument was a bad octal, else 0.
@@ -2477,41 +3470,48 @@ SetEndOffsetFromAny(interp, objPtr)
  */
 
 int
-TclCheckBadOctal(interp, value)
-    Tcl_Interp *interp;		/* Interpreter to use for error reporting. 
-				 * If NULL, then no error message is left
-				 * after errors. */
-    CONST char *value;		/* String to check. */
+TclCheckBadOctal(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    CONST char *value)		/* String to check. */
 {
     register CONST char *p = value;
 
     /*
-     * A frequent mistake is invalid octal values due to an unwanted
-     * leading zero. Try to generate a meaningful error message.
+     * A frequent mistake is invalid octal values due to an unwanted leading
+     * zero. Try to generate a meaningful error message.
      */
 
-    while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */
+    while (TclIsSpaceProc(*p)) {
 	p++;
     }
     if (*p == '+' || *p == '-') {
 	p++;
     }
     if (*p == '0') {
+	if ((p[1] == 'o') || p[1] == 'O') {
+	    p+=2;
+	}
 	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */
 	    p++;
 	}
-	while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */
+	while (TclIsSpaceProc(*p)) {
 	    p++;
 	}
 	if (*p == '\0') {
-	    /* Reached end of string */
+	    /*
+	     * Reached end of string.
+	     */
+
 	    if (interp != NULL) {
 		/*
-		 * Don't reset the result here because we want this result
-		 * to be added to an existing error message as extra info.
+		 * Don't reset the result here because we want this result to
+		 * be added to an existing error message as extra info.
 		 */
+
 		Tcl_AppendResult(interp, " (looks like invalid octal number)",
-			(char *) NULL);
+			NULL);
 	    }
 	    return 1;
 	}
@@ -2522,28 +3522,353 @@ TclCheckBadOctal(interp, value)
 /*
  *----------------------------------------------------------------------
  *
+ * ClearHash --
+ *
+ *	Remove all the entries in the hash table *tablePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClearHash(
+    Tcl_HashTable *tablePtr)
+{
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+
+    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&search)) {
+	Tcl_Obj *objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+	Tcl_DecrRefCount(objPtr);
+	Tcl_DeleteHashEntry(hPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadHash --
+ *
+ *	Get a thread-specific (Tcl_HashTable *) associated with a thread data
+ *	key.
+ *
+ * Results:
+ *	The Tcl_HashTable * corresponding to *keyPtr.
+ *
+ * Side effects:
+ *	The first call on a keyPtr in each thread creates a new Tcl_HashTable,
+ *	and registers a thread exit handler to dispose of it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashTable *
+GetThreadHash(
+    Tcl_ThreadDataKey *keyPtr)
+{
+    Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
+	    Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *));
+
+    if (NULL == *tablePtrPtr) {
+	*tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+	Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr);
+	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
+    }
+    return *tablePtrPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeThreadHash --
+ *
+ *	Thread exit handler used by GetThreadHash to dispose of a thread hash
+ *	table.
+ *
+ * Side effects:
+ *	Frees a Tcl_HashTable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeThreadHash(
+    ClientData clientData)
+{
+    Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
+
+    ClearHash(tablePtr);
+    Tcl_DeleteHashTable(tablePtr);
+    ckfree((char *) tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeProcessGlobalValue --
+ *
+ *	Exit handler used by Tcl(Set|Get)ProcessGlobalValue to cleanup a
+ *	ProcessGlobalValue at exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeProcessGlobalValue(
+    ClientData clientData)
+{
+    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;
+
+    pgvPtr->epoch++;
+    pgvPtr->numBytes = 0;
+    ckfree(pgvPtr->value);
+    pgvPtr->value = NULL;
+    if (pgvPtr->encoding) {
+	Tcl_FreeEncoding(pgvPtr->encoding);
+	pgvPtr->encoding = NULL;
+    }
+    Tcl_MutexFinalize(&pgvPtr->mutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetProcessGlobalValue --
+ *
+ *	Utility routine to set a global value shared by all threads in the
+ *	process while keeping a thread-local copy as well.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetProcessGlobalValue(
+    ProcessGlobalValue *pgvPtr,
+    Tcl_Obj *newValue,
+    Tcl_Encoding encoding)
+{
+    CONST char *bytes;
+    Tcl_HashTable *cacheMap;
+    Tcl_HashEntry *hPtr;
+    int dummy;
+
+    Tcl_MutexLock(&pgvPtr->mutex);
+
+    /*
+     * Fill the global string value.
+     */
+
+    pgvPtr->epoch++;
+    if (NULL != pgvPtr->value) {
+	ckfree(pgvPtr->value);
+    } else {
+	Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
+    }
+    bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
+    pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1);
+    memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
+    if (pgvPtr->encoding) {
+	Tcl_FreeEncoding(pgvPtr->encoding);
+    }
+    pgvPtr->encoding = encoding;
+
+    /*
+     * Fill the local thread copy directly with the Tcl_Obj value to avoid
+     * loss of the intrep. Increment newValue refCount early to handle case
+     * where we set a PGV to itself.
+     */
+
+    Tcl_IncrRefCount(newValue);
+    cacheMap = GetThreadHash(&pgvPtr->key);
+    ClearHash(cacheMap);
+    hPtr = Tcl_CreateHashEntry(cacheMap,
+	    (char *) INT2PTR(pgvPtr->epoch), &dummy);
+    Tcl_SetHashValue(hPtr, (ClientData) newValue);
+    Tcl_MutexUnlock(&pgvPtr->mutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetProcessGlobalValue --
+ *
+ *	Retrieve a global value shared among all threads of the process,
+ *	preferring a thread-local copy as long as it remains valid.
+ *
+ * Results:
+ *	Returns a (Tcl_Obj *) that holds a copy of the global value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetProcessGlobalValue(
+    ProcessGlobalValue *pgvPtr)
+{
+    Tcl_Obj *value = NULL;
+    Tcl_HashTable *cacheMap;
+    Tcl_HashEntry *hPtr;
+    int epoch = pgvPtr->epoch;
+
+    if (pgvPtr->encoding) {
+	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
+
+	if (pgvPtr->encoding != current) {
+	    /*
+	     * The system encoding has changed since the master string value
+	     * was saved. Convert the master value to be based on the new
+	     * system encoding.
+	     */
+
+	    Tcl_DString native, newValue;
+
+	    Tcl_MutexLock(&pgvPtr->mutex);
+	    pgvPtr->epoch++;
+	    epoch = pgvPtr->epoch;
+	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
+		    pgvPtr->numBytes, &native);
+	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
+	    Tcl_DStringLength(&native), &newValue);
+	    Tcl_DStringFree(&native);
+	    ckfree(pgvPtr->value);
+	    pgvPtr->value = ckalloc((unsigned int)
+		    Tcl_DStringLength(&newValue) + 1);
+	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
+		    (size_t) Tcl_DStringLength(&newValue) + 1);
+	    Tcl_DStringFree(&newValue);
+	    Tcl_FreeEncoding(pgvPtr->encoding);
+	    pgvPtr->encoding = current;
+	    Tcl_MutexUnlock(&pgvPtr->mutex);
+	} else {
+	    Tcl_FreeEncoding(current);
+	}
+    }
+    cacheMap = GetThreadHash(&pgvPtr->key);
+    hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
+    if (NULL == hPtr) {
+	int dummy;
+
+	/*
+	 * No cache for the current epoch - must be a new one.
+	 *
+	 * First, clear the cacheMap, as anything in it must refer to some
+	 * expired epoch.
+	 */
+
+	ClearHash(cacheMap);
+
+	/*
+	 * If no thread has set the shared value, call the initializer.
+	 */
+
+	Tcl_MutexLock(&pgvPtr->mutex);
+	if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
+	    pgvPtr->epoch++;
+	    (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
+		    &pgvPtr->encoding);
+	    if (pgvPtr->value == NULL) {
+		Tcl_Panic("PGV Initializer did not initialize");
+	    }
+	    Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData)pgvPtr);
+	}
+
+	/*
+	 * Store a copy of the shared value in our epoch-indexed cache.
+	 */
+
+	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
+	hPtr = Tcl_CreateHashEntry(cacheMap,
+		(char *) INT2PTR(pgvPtr->epoch), &dummy);
+	Tcl_MutexUnlock(&pgvPtr->mutex);
+	Tcl_SetHashValue(hPtr, (ClientData) value);
+	Tcl_IncrRefCount(value);
+    }
+    return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetObjNameOfExecutable --
+ *
+ *	This function stores the absolute pathname of the executable file
+ *	(normally as computed by TclpFindExecutable).
+ *
+ * Results:
+ * 	None.
+ *
+ * Side effects:
+ *	Stores the executable name.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetObjNameOfExecutable(
+    Tcl_Obj *name,
+    Tcl_Encoding encoding)
+{
+    TclSetProcessGlobalValue(&executableName, name, encoding);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetObjNameOfExecutable --
+ *
+ *	This function retrieves the absolute pathname of the application in
+ *	which the Tcl library is running, usually as previously stored by
+ *	TclpFindExecutable(). This function call is the C API equivalent to
+ *	the "info nameofexecutable" command.
+ *
+ * Results:
+ *	A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if the
+ *	pathname of the application is unknown.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetObjNameOfExecutable(void)
+{
+    return TclGetProcessGlobalValue(&executableName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetNameOfExecutable --
  *
- *	This procedure simply returns a pointer to the internal full
- *	path name of the executable file as computed by
- *	Tcl_FindExecutable.  This procedure call is the C API
- *	equivalent to the "info nameofexecutable" command.
+ *	This function retrieves the absolute pathname of the application in
+ *	which the Tcl library is running, and returns it in string form.
+ *
+ * 	The returned string belongs to Tcl and should be copied if the caller
+ * 	plans to keep it, to guard against it becoming invalid.
  *
  * Results:
- *	A pointer to the internal string or NULL if the internal full
- *	path name has not been computed or unknown.
+ *	A pointer to the internal string or NULL if the internal full path
+ *	name has not been computed or unknown.
  *
  * Side effects:
- *	The object referenced by "objPtr" might be converted to an
- *	integer object.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
 
 CONST char *
-Tcl_GetNameOfExecutable()
+Tcl_GetNameOfExecutable(void)
 {
-    return tclExecutableName;
+    int numBytes;
+    const char *bytes =
+	    Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
+
+    if (numBytes == 0) {
+	return NULL;
+    }
+    return bytes;
 }
 
 /*
@@ -2551,7 +3876,9 @@ Tcl_GetNameOfExecutable()
  *
  * TclpGetTime --
  *
- *	Deprecated synonym for Tcl_GetTime.
+ *	Deprecated synonym for Tcl_GetTime. This function is provided for the
+ *	benefit of extensions written before Tcl_GetTime was exported from the
+ *	library.
  *
  * Results:
  *	None.
@@ -2559,15 +3886,265 @@ Tcl_GetNameOfExecutable()
  * Side effects:
  *	Stores current time in the buffer designated by "timePtr"
  *
- * This procedure is provided for the benefit of extensions written
- * before Tcl_GetTime was exported from the library.
- *
  *----------------------------------------------------------------------
  */
 
 void
-TclpGetTime(timePtr)
-    Tcl_Time* timePtr;
+TclpGetTime(
+    Tcl_Time *timePtr)
 {
     Tcl_GetTime(timePtr);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetPlatform --
+ *
+ *	This is a kludge that allows the test library to get access the
+ *	internal tclPlatform variable.
+ *
+ * Results:
+ *	Returns a pointer to the tclPlatform variable.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclPlatformType *
+TclGetPlatform(void)
+{
+    return &tclPlatform;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclReToGlob --
+ *
+ *	Attempt to convert a regular expression to an equivalent glob pattern.
+ *
+ * Results:
+ *	Returns TCL_OK on success, TCL_ERROR on failure. If interp is not
+ *	NULL, an error message is placed in the result. On success, the
+ *	DString will contain an exact equivalent glob pattern. The caller is
+ *	responsible for calling Tcl_DStringFree on success. If exactPtr is not
+ *	NULL, it will be 1 if an exact match qualifies.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclReToGlob(
+    Tcl_Interp *interp,
+    const char *reStr,
+    int reStrLen,
+    Tcl_DString *dsPtr,
+    int *exactPtr)
+{
+    int anchorLeft, anchorRight, lastIsStar, numStars;
+    char *dsStr, *dsStrStart, *msg;
+    const char *p, *strEnd;
+
+    strEnd = reStr + reStrLen;
+    Tcl_DStringInit(dsPtr);
+
+    /*
+     * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
+     */
+
+    if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
+	/*
+	 * At most, the glob pattern has length 2*reStrLen + 2 to
+	 * backslash escape every character and have * at each end.
+	 */
+	Tcl_DStringSetLength(dsPtr, 2*reStrLen + 2);
+	dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
+	*dsStr++ = '*';
+	for (p = reStr + 4; p < strEnd; p++) {
+	    switch (*p) {
+	    case '\\': case '*': case '[': case ']': case '?':
+		/* Only add \ where necessary for glob */
+		*dsStr++ = '\\';
+		/* fall through */
+	    default:
+		*dsStr++ = *p;
+		break;
+	    }
+	}
+	*dsStr++ = '*';
+	Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
+	if (exactPtr) {
+	    *exactPtr = 0;
+	}
+	return TCL_OK;
+    }
+
+    /*
+     * At most, the glob pattern has length reStrLen + 2 to account
+     * for possible * at each end.
+     */
+
+    Tcl_DStringSetLength(dsPtr, reStrLen + 2);
+    dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
+
+    /*
+     * Check for anchored REs (ie ^foo$), so we can use string equal if
+     * possible. Do not alter the start of str so we can free it correctly.
+     *
+     * Keep track of the last char being an unescaped star to prevent
+     * multiple instances.  Simpler than checking that the last star
+     * may be escaped.
+     */
+
+    msg = NULL;
+    p = reStr;
+    anchorRight = 0;
+    lastIsStar = 0;
+    numStars = 0;
+
+    if (*p == '^') {
+	anchorLeft = 1;
+	p++;
+    } else {
+	anchorLeft = 0;
+	*dsStr++ = '*';
+	lastIsStar = 1;
+    }
+
+    for ( ; p < strEnd; p++) {
+	switch (*p) {
+	case '\\':
+	    p++;
+	    switch (*p) {
+	    case 'a':
+		*dsStr++ = '\a';
+		break;
+	    case 'b':
+		*dsStr++ = '\b';
+		break;
+	    case 'f':
+		*dsStr++ = '\f';
+		break;
+	    case 'n':
+		*dsStr++ = '\n';
+		break;
+	    case 'r':
+		*dsStr++ = '\r';
+		break;
+	    case 't':
+		*dsStr++ = '\t';
+		break;
+	    case 'v':
+		*dsStr++ = '\v';
+		break;
+	    case 'B': case '\\':
+		*dsStr++ = '\\';
+		*dsStr++ = '\\';
+		anchorLeft = 0; /* prevent exact match */
+		break;
+	    case '*': case '[': case ']': case '?':
+		/* Only add \ where necessary for glob */
+		*dsStr++ = '\\';
+		anchorLeft = 0; /* prevent exact match */
+		/* fall through */
+	    case '{': case '}': case '(': case ')': case '+':
+	    case '.': case '|': case '^': case '$':
+		*dsStr++ = *p;
+		break;
+	    default:
+		msg = "invalid escape sequence";
+		goto invalidGlob;
+	    }
+	    break;
+	case '.':
+	    anchorLeft = 0; /* prevent exact match */
+	    if (p+1 < strEnd) {
+		if (p[1] == '*') {
+		    p++;
+		    if (!lastIsStar) {
+			*dsStr++ = '*';
+			lastIsStar = 1;
+			numStars++;
+		    }
+		    continue;
+		} else if (p[1] == '+') {
+		    p++;
+		    *dsStr++ = '?';
+		    *dsStr++ = '*';
+		    lastIsStar = 1;
+		    numStars++;
+		    continue;
+		}
+	    }
+	    *dsStr++ = '?';
+	    break;
+	case '$':
+	    if (p+1 != strEnd) {
+		msg = "$ not anchor";
+		goto invalidGlob;
+	    }
+	    anchorRight = 1;
+	    break;
+	case '*': case '+': case '?': case '|': case '^':
+	case '{': case '}': case '(': case ')': case '[': case ']':
+	    msg = "unhandled RE special char";
+	    goto invalidGlob;
+	    break;
+	default:
+	    *dsStr++ = *p;
+	    break;
+	}
+	lastIsStar = 0;
+    }
+    if (numStars > 1) {
+	/*
+	 * Heuristic: if >1 non-anchoring *, the risk is large that glob
+	 * matching is slower than the RE engine, so report invalid.
+	 */
+	msg = "excessive recursive glob backtrack potential";
+	goto invalidGlob;
+    }
+
+    if (!anchorRight && !lastIsStar) {
+	*dsStr++ = '*';
+    }
+    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
+
+    if (exactPtr) {
+	*exactPtr = (anchorLeft && anchorRight);
+    }
+
+#if 0
+    fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n",
+	    reStrLen, reStr,
+	    Tcl_DStringValue(dsPtr), anchorLeft, anchorRight);
+    fflush(stderr);
+#endif
+    return TCL_OK;
+
+  invalidGlob:
+#if 0
+    fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
+	    reStrLen, reStr, msg, *p);
+    fflush(stderr);
+#endif
+    if (interp != NULL) {
+	Tcl_AppendResult(interp, msg, NULL);
+    }
+    Tcl_DStringFree(dsPtr);
+    return TCL_ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index c029877..d000296 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -1,8 +1,8 @@
-/* 
+/*
  * tclVar.c --
  *
- *	This file contains routines that implement Tcl variables
- *	(both scalars and arrays).
+ *	This file contains routines that implement Tcl variables (both scalars
+ *	and arrays).
  *
  *	The implementation of arrays is modelled after an initial
  *	implementation by Mark Diekhans and Karl Lehenbauer.
@@ -10,147 +10,331 @@
  * Copyright (c) 1987-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Miguel Sofer
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
-#include "tclPort.h"
 
+/*
+ * Prototypes for the variable hash key methods.
+ */
+
+static Tcl_HashEntry *	AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
+static void		FreeVarEntry(Tcl_HashEntry *hPtr);
+static int		CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashVarKey(Tcl_HashTable *tablePtr, void *keyPtr);
+
+static Tcl_HashKeyType tclVarHashKeyType = {
+    TCL_HASH_KEY_TYPE_VERSION,	/* version */
+    0,				/* flags */
+    HashVarKey,			/* hashKeyProc */
+    CompareVarKeys,		/* compareKeysProc */
+    AllocVarEntry,		/* allocEntryProc */
+    FreeVarEntry		/* freeEntryProc */
+};
+
+static inline Var *	VarHashCreateVar(TclVarHashTable *tablePtr,
+			    Tcl_Obj *key, int *newPtr);
+static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
+			    Tcl_HashSearch *searchPtr);
+static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
+static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);
+
+#define VarHashGetValue(hPtr) \
+    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in.  This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
+static inline Var *
+VarHashCreateVar(
+    TclVarHashTable *tablePtr,
+    Tcl_Obj *key,
+    int *newPtr)
+{
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
+	    (char *) key, newPtr);
+
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+#define VarHashFindVar(tablePtr, key) \
+    VarHashCreateVar((tablePtr), (key), NULL)
+#define VarHashInvalidateEntry(varPtr) \
+    ((varPtr)->flags |= VAR_DEAD_HASH)
+#define VarHashDeleteEntry(varPtr) \
+    Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))
+
+#define VarHashFirstEntry(tablePtr, searchPtr) \
+    Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr))
+
+#define VarHashNextEntry(searchPtr) \
+    Tcl_NextHashEntry((searchPtr))
+
+static inline Var *
+VarHashFirstVar(
+    TclVarHashTable *tablePtr,
+    Tcl_HashSearch *searchPtr)
+{
+    Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);
+
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+static inline Var *
+VarHashNextVar(
+    Tcl_HashSearch *searchPtr)
+{
+    Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);
+
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+#define VarHashGetKey(varPtr) \
+    (((VarInHash *)(varPtr))->entry.key.objPtr)
+
+#define VarHashDeleteTable(tablePtr) \
+    Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr))
 
 /*
- * The strings below are used to indicate what went wrong when a
- * variable access is denied.
+ * The strings below are used to indicate what went wrong when a variable
+ * access is denied.
  */
 
-static CONST char *noSuchVar =		"no such variable";
-static CONST char *isArray =		"variable is array";
-static CONST char *needArray =		"variable isn't array";
-static CONST char *noSuchElement =	"no such element in array";
-static CONST char *danglingElement =
-				"upvar refers to element in deleted array";
-static CONST char *danglingVar =	
-				"upvar refers to variable in deleted namespace";
-static CONST char *badNamespace =	"parent namespace doesn't exist";
-static CONST char *missingName =	"missing variable name";
-static CONST char *isArrayElement =	"name refers to an element in an array";
+static const char *noSuchVar =		"no such variable";
+static const char *isArray =		"variable is array";
+static const char *needArray =		"variable isn't array";
+static const char *noSuchElement =	"no such element in array";
+static const char *danglingElement =
+	"upvar refers to element in deleted array";
+static const char *danglingVar =
+	"upvar refers to variable in deleted namespace";
+static const char *badNamespace =	"parent namespace doesn't exist";
+static const char *missingName =	"missing variable name";
+static const char *isArrayElement =
+	"name refers to an element in an array";
 
 /*
- * Forward references to procedures defined later in this file:
+ * A test to see if we are in a call frame that has local variables. This is
+ * true if we are inside a procedure body.
  */
 
-static int		CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
-			    Var *varPtr, CONST char *part1, CONST char *part2,
-			    int flags, CONST int leaveErrMsg));
-static void		CleanupVar _ANSI_ARGS_((Var *varPtr,
-			    Var *arrayPtr));
-static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
-static void		DeleteArray _ANSI_ARGS_((Interp *iPtr,
-			    CONST char *arrayName, Var *varPtr, int flags));
-static void		DisposeTraceResult _ANSI_ARGS_((int flags,
-			    char *result));
-static int              ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, 
-                            CallFrame *framePtr, Tcl_Obj *otherP1Ptr, 
-                            CONST char *otherP2, CONST int otherFlags,
-		            CONST char *myName, int myFlags, int index));
-static Var *		NewVar _ANSI_ARGS_((void));
-static ArraySearch *	ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST Var *varPtr, CONST char *varName,
-			    Tcl_Obj *handleObj));
-static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *part1, CONST char *part2,
-			    CONST char *operation, CONST char *reason));
-static int		SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr));
-static void		UnsetVarStruct _ANSI_ARGS_((Var *varPtr, Var *arrayPtr,
-			    Interp *iPtr, CONST char *part1, CONST char *part2,
-			    int flags));
+#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
 
 /*
- * Functions defined in this file that may be exported in the future
- * for use by the bytecode compiler and engine or to the public interface.
+ * Forward references to functions defined later in this file:
  */
 
-Var *		TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp,
-		    CONST char *varName, int flags, CONST int create,
-		    CONST char **errMsgPtr, int *indexPtr));
-int		TclObjUnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Obj *part1Ptr, CONST char *part2, int flags));
+static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *patternPtr, int includeLinks);
+static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
+static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
+			    Var *varPtr, int flags);
+static Tcl_Var          ObjFindNamespaceVar(Tcl_Interp *interp,
+			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
+			    int flags);
+static int		ObjMakeUpvar(Tcl_Interp *interp,
+			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
+			    const char *otherP2, const int otherFlags,
+			    Tcl_Obj *myNamePtr, int myFlags, int index);
+static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
+			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
+static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
+			    Interp *iPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, int flags);
+static int		SetArraySearchObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
 
-static Tcl_FreeInternalRepProc FreeLocalVarName;
-static Tcl_DupInternalRepProc DupLocalVarName;
-static Tcl_UpdateStringProc UpdateLocalVarName;
-static Tcl_FreeInternalRepProc FreeNsVarName;
-static Tcl_DupInternalRepProc DupNsVarName;
-static Tcl_FreeInternalRepProc FreeParsedVarName;
-static Tcl_DupInternalRepProc DupParsedVarName;
-static Tcl_UpdateStringProc UpdateParsedVarName;
+/*
+ * Functions defined in this file that may be exported in the future for use
+ * by the bytecode compiler and engine or to the public interface.
+ */
+
+MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
+			    Tcl_Obj *varNamePtr, int flags, const int create,
+			    const char **errMsgPtr, int *indexPtr);
+
+static Tcl_DupInternalRepProc	DupLocalVarName;
+static Tcl_FreeInternalRepProc	FreeLocalVarName;
+static Tcl_UpdateStringProc	PanicOnUpdateVarName;
+
+static Tcl_FreeInternalRepProc	FreeParsedVarName;
+static Tcl_DupInternalRepProc	DupParsedVarName;
+static Tcl_UpdateStringProc	UpdateParsedVarName;
+
+static Tcl_UpdateStringProc	PanicOnUpdateVarName;
+static Tcl_SetFromAnyProc	PanicOnSetVarName;
 
 /*
  * Types of Tcl_Objs used to cache variable lookups.
  *
- * 
  * localVarName - INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1 = pointer to the corresponding Proc 
- *   twoPtrValue.ptr2 = index into locals table
+ *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
+ *                        or NULL if it is this same obj
+ *   ptrAndLongRep.value: index into locals table
  *
  * nsVarName - INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1: pointer to the namespace containing the 
- *                     reference
- *   twoPtrValue.ptr2: pointer to the corresponding Var 
+ *   twoPtrValue.ptr1:	pointer to the namespace containing the reference
+ *   twoPtrValue.ptr2:	pointer to the corresponding Var
  *
  * parsedVarName - INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1 = pointer to the array name Tcl_Obj, 
- *                      or NULL if it is a scalar variable
- *   twoPtrValue.ptr2 = pointer to the element name string
- *                      (owned by this Tcl_Obj), or NULL if 
- *                      it is a scalar variable
+ *   twoPtrValue.ptr1:	pointer to the array name Tcl_Obj, or NULL if it is a
+ *			scalar variable
+ *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
+ *			Tcl_Obj), or NULL if it is a scalar variable
  */
 
-static Tcl_ObjType tclLocalVarNameType = {
+static Tcl_ObjType localVarNameType = {
     "localVarName",
-    FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL
+    FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
 };
 
+/*
+ * Caching of namespace variables disabled: no simple way was found to avoid
+ * interfering with the resolver's idea of variable existence. A cached
+ * varName may keep a variable's name in the namespace's hash table, which is
+ * the resolver's criterion for existence (see test namespace-17.10).
+ */
+
+#define ENABLE_NS_VARNAME_CACHING 0
+
+#if ENABLE_NS_VARNAME_CACHING
+static Tcl_FreeInternalRepProc FreeNsVarName;
+static Tcl_DupInternalRepProc DupNsVarName;
+
 static Tcl_ObjType tclNsVarNameType = {
     "namespaceVarName",
-    FreeNsVarName, DupNsVarName, NULL, NULL
+    FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
 };
+#endif
 
 static Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
-    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL
+    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
 };
 
 /*
  * Type of Tcl_Objs used to speed up array searches.
  *
  * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1 = searchIdNumber as offset from (char*)NULL
- *   twoPtrValue.ptr2 = variableNameStartInString as offset from (char*)NULL
+ *   twoPtrValue.ptr1:	searchIdNumber (cast to pointer)
+ *   twoPtrValue.ptr2:	variableNameStartInString (cast to pointer)
  *
- * Note that the value stored in ptr2 is the offset into the string of
- * the start of the variable name and not the address of the variable
- * name itself, as this can be safely copied.
+ * Note that the value stored in ptr2 is the offset into the string of the
+ * start of the variable name and not the address of the variable name itself,
+ * as this can be safely copied.
  */
+
 Tcl_ObjType tclArraySearchType = {
     "array search",
     NULL, NULL, NULL, SetArraySearchObj
 };
+
+Var *
+TclVarHashCreateVar(
+    TclVarHashTable *tablePtr,
+    const char *key,
+    int *newPtr)
+{
+    Tcl_Obj *keyPtr;
+    Var *varPtr;
+
+    keyPtr = Tcl_NewStringObj(key, -1);
+    Tcl_IncrRefCount(keyPtr);
+    varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
+    Tcl_DecrRefCount(keyPtr);
+
+    return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupVar --
+ *
+ *	This function is called when it looks like it may be OK to free up a
+ *	variable's storage. If the variable is in a hashtable, its Var
+ *	structure and hash table entry will be freed along with those of its
+ *	containing array, if any. This function is called, for example, when
+ *	a trace on a variable deletes a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the variable (or its containing array) really is dead and in a
+ *	hashtable, then its Var structure, and possibly its hash table entry,
+ *	is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+CleanupVar(
+    Var *varPtr,		/* Pointer to variable that may be a candidate
+				 * for being expunged. */
+    Var *arrayPtr)		/* Array that contains the variable, or NULL
+				 * if this variable isn't an array element. */
+{
+    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
+	    && !TclIsVarTraced(varPtr)
+	    && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
+	if (VarHashRefCount(varPtr) == 0) {
+	    ckfree((char *) varPtr);
+	} else {
+	    VarHashDeleteEntry(varPtr);
+	}
+    }
+    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
+	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
+	    (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
+	if (VarHashRefCount(arrayPtr) == 0) {
+	    ckfree((char *) arrayPtr);
+	} else {
+	    VarHashDeleteEntry(arrayPtr);
+	}
+    }
+}
 
+void
+TclCleanupVar(
+    Var *varPtr,		/* Pointer to variable that may be a candidate
+				 * for being expunged. */
+    Var *arrayPtr)		/* Array that contains the variable, or NULL
+				 * if this variable isn't an array element. */
+{
+    CleanupVar(varPtr, arrayPtr);
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclLookupVar --
  *
- *	This procedure is used to locate a variable given its name(s). It
- *      has been mostly superseded by TclObjLookupVar, it is now only used 
- *      by the string-based interfaces. It is kept in tcl8.4 mainly because 
- *      it is in the internal stubs table, so that some extension may be 
- *      calling it. 
+ *	This function is used to locate a variable given its name(s). It has
+ *	been mostly superseded by TclObjLookupVar, it is now only used by the
+ *	trace code. It is kept in tcl8.5 mainly because it is in the internal
+ *	stubs table, so that some extension may be calling it.
  *
  * Results:
  *	The return value is a pointer to the variable structure indicated by
@@ -164,14 +348,14 @@ Tcl_ObjType tclArraySearchType = {
  *
  *	If the variable isn't found and creation wasn't specified, or some
  *	other error occurs, NULL is returned and an error message is left in
- *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags. 
+ *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
- *	Note: it's possible for the variable returned to be VAR_UNDEFINED
- *	even if createPart1 or createPart2 are 1 (these only cause the hash
- *	table entry or array to be created). For example, the variable might
- *	be a global that has been unset but is still referenced by a
- *	procedure, or a variable that has been unset but it only being kept
- *	in existence (if VAR_UNDEFINED) by a trace.
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED even
+ *	if createPart1 or createPart2 are 1 (these only cause the hash table
+ *	entry or array to be created). For example, the variable might be a
+ *	global that has been unset but is still referenced by a procedure, or
+ *	a variable that has been unset but it only being kept in existence (if
+ *	VAR_UNDEFINED) by a trace.
  *
  * Side effects:
  *	New hashtable entries may be created if createPart1 or createPart2
@@ -179,132 +363,59 @@ Tcl_ObjType tclArraySearchType = {
  *
  *----------------------------------------------------------------------
  */
+
 Var *
-TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
-        arrayPtrPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
-    CONST char *part1;	        /* If part2 isn't NULL, this is the name of
-				 * an array. Otherwise, this
-				 * is a full variable name that could
-				 * include a parenthesized array element. */
-    CONST char *part2;		/* Name of element within array, or NULL. */
-    int flags;			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+TclLookupVar(
+    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
+    const char *part1,		/* If part2 isn't NULL, this is the name of an
+				 * array. Otherwise, this is a full variable
+				 * name that could include a parenthesized
+				 * array element. */
+    const char *part2,		/* Name of element within array, or NULL. */
+    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * and TCL_LEAVE_ERR_MSG bits matter. */
-    CONST char *msg;			/* Verb to use in error messages, e.g.
-				 * "read" or "set". Only needed if
-				 * TCL_LEAVE_ERR_MSG is set in flags. */
-    int createPart1;		/* If 1, create hash table entry for part 1
-				 * of name, if it doesn't already exist. If
-				 * 0, return error if it doesn't exist. */
-    int createPart2;		/* If 1, create hash table entry for part 2
-				 * of name, if it doesn't already exist. If
-				 * 0, return error if it doesn't exist. */
-    Var **arrayPtrPtr;		/* If the name refers to an element of an
+    const char *msg,		/* Verb to use in error messages, e.g. "read"
+				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
+				 * is set in flags. */
+    int createPart1,		/* If 1, create hash table entry for part 1 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    int createPart2,		/* If 1, create hash table entry for part 2 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    Var **arrayPtrPtr)		/* If the name refers to an element of an
 				 * array, *arrayPtrPtr gets filled in with
-				 * address of array variable. Otherwise
-				 * this is set to NULL. */
+				 * address of array variable. Otherwise this
+				 * is set to NULL. */
 {
     Var *varPtr;
-    CONST char *elName;		/* Name of array element or NULL; may be
-				 * same as part2, or may be openParen+1. */
-    int openParen, closeParen;
-                                /* If this procedure parses a name into
-				 * array and index, these are the offsets to 
-				 * the parens around the index.  Otherwise 
-				 * they are -1. */
-    register CONST char *p;
-    CONST char *errMsg = NULL;
-    int index;
-#define VAR_NAME_BUF_SIZE 26
-    char buffer[VAR_NAME_BUF_SIZE];
-    char *newVarName = buffer;
+    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    varPtr = NULL;
-    *arrayPtrPtr = NULL;
-    openParen = closeParen = -1;
-
-    /*
-     * Parse part1 into array name and index.
-     * Always check if part1 is an array element name and allow it only if
-     * part2 is not given.   
-     * (if one does not care about creating array elements that can't be used
-     *  from tcl, and prefer slightly better performance, one can put
-     *  the following in an   if (part2 == NULL) { ... } block and remove
-     *  the part2's test and error reporting  or move that code in array set)
-     */
-
-    elName = part2;
-    for (p = part1; *p ; p++) {
-	if (*p == '(') {
-	    openParen = p - part1;
-	    do {
-		p++;
-	    } while (*p != '\0');
-	    p--;
-	    if (*p == ')') {
-		if (part2 != NULL) {
-		    if (flags & TCL_LEAVE_ERR_MSG) {
-			VarErrMsg(interp, part1, part2, msg, needArray);
-		    }
-		    return NULL;
-		}
-		closeParen = p - part1;
-	    } else {
-		openParen = -1;
-	    }
-	    break;
-	}
-    }
-    if (openParen != -1) {
-	if (closeParen >= VAR_NAME_BUF_SIZE) {
-	    newVarName = ckalloc((unsigned int) (closeParen+1));
-	}
-	memcpy(newVarName, part1, (unsigned int) closeParen);
-	newVarName[openParen] = '\0';
-	newVarName[closeParen] = '\0';
-	part1 = newVarName;
-	elName = newVarName + openParen + 1;
+    if (createPart1) {
+	Tcl_IncrRefCount(part1Ptr);
     }
 
-    varPtr = TclLookupSimpleVar(interp, part1, flags, 
-            createPart1, &errMsg, &index);
-    if (varPtr == NULL) {
-	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	    VarErrMsg(interp, part1, elName, msg, errMsg);
-	}
-    } else {
-	while (TclIsVarLink(varPtr)) {
-	    varPtr = varPtr->value.linkPtr;
-	}
-	if (elName != NULL) {
-	    *arrayPtrPtr = varPtr;
-	    varPtr = TclLookupArrayElement(interp, part1, elName, flags, 
-		    msg, createPart1, createPart2, varPtr);
-	}
-    }
-    if (newVarName != buffer) {
-	ckfree(newVarName);
-    }
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
+	    createPart1, createPart2, arrayPtrPtr);
 
+    TclDecrRefCount(part1Ptr);
     return varPtr;
-	
-#undef VAR_NAME_BUF_SIZE
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjLookupVar --
+ * TclObjLookupVar, TclObjLookupVarEx --
  *
- *	This procedure is used by virtually all of the variable code to
- *	locate a variable given its name(s). The parsing into array/element
- *      components and (if possible) the lookup results are cached in 
- *      part1Ptr, which is converted to one of the varNameTypes.
+ *	This function is used by virtually all of the variable code to locate
+ *	a variable given its name(s). The parsing into array/element
+ *	components and (if possible) the lookup results are cached in
+ *	part1Ptr, which is converted to one of the varNameTypes.
  *
  * Results:
  *	The return value is a pointer to the variable structure indicated by
- *	part1Ptr and part2, or NULL if the variable couldn't be found. If 
- *      the variable is found, *arrayPtrPtr is filled with the address of the
+ *	part1Ptr and part2, or NULL if the variable couldn't be found. If *
+ *	the variable is found, *arrayPtrPtr is filled with the address of the
  *	variable structure for the array that contains the variable (or NULL
  *	if the variable is a scalar). If the variable can't be found and
  *	either createPart1 or createPart2 are 1, a new as-yet-undefined
@@ -313,48 +424,99 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
  *
  *	If the variable isn't found and creation wasn't specified, or some
  *	other error occurs, NULL is returned and an error message is left in
- *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags. 
+ *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
- *	Note: it's possible for the variable returned to be VAR_UNDEFINED
- *	even if createPart1 or createPart2 are 1 (these only cause the hash
- *	table entry or array to be created). For example, the variable might
- *	be a global that has been unset but is still referenced by a
- *	procedure, or a variable that has been unset but it only being kept
- *	in existence (if VAR_UNDEFINED) by a trace.
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED even
+ *	if createPart1 or createPart2 are 1 (these only cause the hash table
+ *	entry or array to be created). For example, the variable might be a
+ *	global that has been unset but is still referenced by a procedure, or
+ *	a variable that has been unset but it only being kept in existence (if
+ *	VAR_UNDEFINED) by a trace.
  *
  * Side effects:
  *	New hashtable entries may be created if createPart1 or createPart2
- *	are 1.
- *      The object part1Ptr is converted to one of tclLocalVarNameType, 
- *      tclNsVarNameType or tclParsedVarNameType and caches as much of the
- *      lookup as it can.
+ *	are 1. The object part1Ptr is converted to one of localVarNameType,
+ *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
+ *	lookup as it can.
+ *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ *	plan to DecrRefCount it.
  *
  *----------------------------------------------------------------------
  */
+
 Var *
-TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
-        arrayPtrPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
-    register Tcl_Obj *part1Ptr;	/* If part2 isn't NULL, this is the name 
-				 * of an array. Otherwise, this is a full 
-				 * variable name that could include a parenthesized 
+TclObjLookupVar(
+    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
+    register Tcl_Obj *part1Ptr,	/* If part2 isn't NULL, this is the name of an
+				 * array. Otherwise, this is a full variable
+				 * name that could include a parenthesized
 				 * array element. */
-    CONST char *part2;		/* Name of element within array, or NULL. */
-    int flags;		        /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+    const char *part2,		/* Name of element within array, or NULL. */
+    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * and TCL_LEAVE_ERR_MSG bits matter. */
+    const char *msg,		/* Verb to use in error messages, e.g. "read"
+				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
+				 * is set in flags. */
+    const int createPart1,	/* If 1, create hash table entry for part 1 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    const int createPart2,	/* If 1, create hash table entry for part 2 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    Var **arrayPtrPtr)		/* If the name refers to an element of an
+				 * array, *arrayPtrPtr gets filled in with
+				 * address of array variable. Otherwise this
+				 * is set to NULL. */
+{
+    Tcl_Obj *part2Ptr = NULL;
+    Var *resPtr;
+
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	if (createPart2) {
+	    Tcl_IncrRefCount(part2Ptr);
+	}
+    }
+
+    resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+	    flags, msg, createPart1, createPart2, arrayPtrPtr);
+
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+
+    return resPtr;
+}
+
+/*
+ *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ *	plan to DecrRefCount it.
+ *	When createPart2 is 1, callers must IncrRefCount part2Ptr if they
+ *	plan to DecrRefCount it.
+ */
+Var *
+TclObjLookupVarEx(
+    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
+    Tcl_Obj *part1Ptr,		/* If part2Ptr isn't NULL, this is the name of
+				 * an array. Otherwise, this is a full
+				 * variable name that could include a
+				 * parenthesized array element. */
+    Tcl_Obj *part2Ptr,		/* Name of element within array, or NULL. */
+    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * and TCL_LEAVE_ERR_MSG bits matter. */
-    CONST char *msg;		/* Verb to use in error messages, e.g.
-				 * "read" or "set". Only needed if
-				 * TCL_LEAVE_ERR_MSG is set in flags. */
-    CONST int createPart1;	/* If 1, create hash table entry for part 1
-				 * of name, if it doesn't already exist. If
-				 * 0, return error if it doesn't exist. */
-    CONST int createPart2;	/* If 1, create hash table entry for part 2
-				 * of name, if it doesn't already exist. If
-				 * 0, return error if it doesn't exist. */
-    Var **arrayPtrPtr;		/* If the name refers to an element of an
+    const char *msg,		/* Verb to use in error messages, e.g. "read"
+				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
+				 * is set in flags. */
+    const int createPart1,	/* If 1, create hash table entry for part 1 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    const int createPart2,	/* If 1, create hash table entry for part 2 of
+				 * name, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    Var **arrayPtrPtr)		/* If the name refers to an element of an
 				 * array, *arrayPtrPtr gets filled in with
-				 * address of array variable. Otherwise
-				 * this is set to NULL. */
+				 * address of array variable. Otherwise this
+				 * is set to NULL. */
 {
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr;	/* Points to the variable's in-frame Var
@@ -363,117 +525,150 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
     int index, len1, len2;
     int parsed = 0;
     Tcl_Obj *objPtr;
-    Tcl_ObjType *typePtr = part1Ptr->typePtr;
-    CONST char *errMsg = NULL;
+    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
+    const char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
+#if ENABLE_NS_VARNAME_CACHING
     Namespace *nsPtr;
-
-    /*
-     * If part1Ptr is a tclParsedVarNameType, separate it into the 
-     * pre-parsed parts.
-     */
+#endif
+    char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
+    char *newPart2 = NULL;
 
     *arrayPtrPtr = NULL;
-    if (typePtr == &tclParsedVarNameType) {
-	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
-	    if (part2 != NULL) {
-		/*
-		 * ERROR: part1Ptr is already an array element, cannot 
-		 * specify a part2.
-		 */
 
-		if (flags & TCL_LEAVE_ERR_MSG) {
-		    part1 = TclGetString(part1Ptr);
-		    VarErrMsg(interp, part1, part2, msg, needArray);
-		}
-		return NULL;
-	    }
-	    part2 = (char *) part1Ptr->internalRep.twoPtrValue.ptr2;
-	    part1Ptr = (Tcl_Obj *) part1Ptr->internalRep.twoPtrValue.ptr1;
-	    typePtr = part1Ptr->typePtr;
-	}
-	parsed = 1;
-    }
-    part1 = Tcl_GetStringFromObj(part1Ptr, &len1);    
+#if ENABLE_NS_VARNAME_CACHING
+    if (varFramePtr) {
+	nsPtr = varFramePtr->nsPtr;
+    } else {
+	/*
+	 * Some variables in the global ns have to be initialized before the
+	 * root call frame is in place.
+	 */
 
-    nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
-    if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
-	goto doParse;
+	nsPtr = NULL;
     }
-    
-    if (typePtr == &tclLocalVarNameType) {
-	Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1;
-	int localIndex = (int) part1Ptr->internalRep.twoPtrValue.ptr2;
-	int useLocal;
+#endif
+
+    if (typePtr == &localVarNameType) {
+	int localIndex;
 
-	useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame
-	        && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)));
-	if (useLocal && (procPtr == varFramePtr->procPtr)) {
+    localVarNameTypeHandling:
+	localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
+	if (HasLocalVars(varFramePtr)
+		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+		&& (localIndex < varFramePtr->numCompiledLocals)) {
 	    /*
-	     * part1Ptr points to an indexed local variable of the
-	     * correct procedure: use the cached value.
+	     * Use the cached index if the names coincide.
 	     */
-	    
-	    varPtr = &(varFramePtr->compiledLocals[localIndex]);
-	    goto donePart1;
+
+	    Tcl_Obj *namePtr = (Tcl_Obj *)
+		    part1Ptr->internalRep.ptrAndLongRep.ptr;
+	    Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
+
+	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
+		    (namePtr && (checkNamePtr == namePtr))) {
+		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
+		goto donePart1;
+	    }
 	}
 	goto doneParsing;
+#if ENABLE_NS_VARNAME_CACHING
     } else if (typePtr == &tclNsVarNameType) {
-	Namespace *cachedNsPtr;
 	int useGlobal, useReference;
+	Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1;
+	varPtr = part1Ptr->internalRep.twoPtrValue.ptr2;
+
+	useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
+		(flags & TCL_GLOBAL_ONLY) ||
+		(part1[0]==':' && part1[1]==':') ||
+		(!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr)));
 
-	varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2;
-	cachedNsPtr = (Namespace *) part1Ptr->internalRep.twoPtrValue.ptr1;
-	useGlobal = (cachedNsPtr == iPtr->globalNsPtr) 
-	    && ((flags & TCL_GLOBAL_ONLY) 
-		|| ((*part1 == ':') && (*(part1+1) == ':'))
-		|| (varFramePtr == NULL) 
-		|| (!varFramePtr->isProcCallFrame 
-		    && (nsPtr == iPtr->globalNsPtr)));
-	useReference = useGlobal || ((cachedNsPtr == nsPtr) 
-	        && ((flags & TCL_NAMESPACE_ONLY) 
-		    || (varFramePtr && !varFramePtr->isProcCallFrame 
-			&& !(flags & TCL_GLOBAL_ONLY)
-			/* careful: an undefined ns variable could
-			 * be hiding a valid global reference. */
-			&& !(varPtr->flags & VAR_UNDEFINED))));
-	if (useReference && (varPtr->hPtr != NULL)) {
+	useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
+		(flags & TCL_NAMESPACE_ONLY) ||
+		(!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) &&
+		/*
+		 * Careful: an undefined ns variable could be hiding a valid
+		 * global reference.
+		 */
+		!TclIsVarUndefined(varPtr))));
+
+	if (useReference && !TclIsVarDeadHash(varPtr)) {
 	    /*
-	     * A straight global or namespace reference, use it. It isn't 
-	     * so simple to deal with 'implicit' namespace references, i.e., 
-	     * those where the reference could be to either a namespace 
-	     * or a global variable. Those we lookup again.
+	     * A straight global or namespace reference, use it. It isn't so
+	     * simple to deal with 'implicit' namespace references, i.e.,
+	     * those where the reference could be to either a namespace or a
+	     * global variable. Those we lookup again.
 	     *
-	     * If (varPtr->hPtr == NULL), this might be a reference to a
+	     * If TclIsVarDeadHash(varPtr), this might be a reference to a
 	     * variable in a deleted namespace, kept alive by e.g. part1Ptr.
 	     * We could conceivably be so unlucky that a new namespace was
-	     * created at the same address as the deleted one, so to be 
-	     * safe we test for a valid hPtr.
+	     * created at the same address as the deleted one, so to be safe
+	     * we test for a valid hPtr.
 	     */
+
 	    goto donePart1;
 	}
 	goto doneParsing;
+#endif
+    }
+
+    /*
+     * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
+     * parts.
+     */
+
+    if (typePtr == &tclParsedVarNameType) {
+	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
+	    if (part2Ptr != NULL) {
+		/*
+		 * ERROR: part1Ptr is already an array element, cannot specify
+		 * a part2.
+		 */
+
+		if (flags & TCL_LEAVE_ERR_MSG) {
+		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+			    noSuchVar, -1);
+		}
+		return NULL;
+	    }
+	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
+	    if (newPart2) {
+		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+		if (createPart2) {
+		    Tcl_IncrRefCount(part2Ptr);
+		}
+	    }
+	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
+	    typePtr = part1Ptr->typePtr;
+	    if (typePtr == &localVarNameType) {
+		goto localVarNameTypeHandling;
+	    }
+	}
+	parsed = 1;
     }
+    part1 = TclGetStringFromObj(part1Ptr, &len1);
 
-    doParse:
     if (!parsed && (*(part1 + len1 - 1) == ')')) {
 	/*
 	 * part1Ptr is possibly an unparsed array element.
 	 */
+
 	register int i;
-	char *newPart2;
+
 	len2 = -1;
 	for (i = 0; i < len1; i++) {
 	    if (*(part1 + i) == '(') {
-		if (part2 != NULL) {
+		if (part2Ptr != NULL) {
 		    if (flags & TCL_LEAVE_ERR_MSG) {
-			VarErrMsg(interp, part1, part2, msg, needArray);
+			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+				needArray, -1);
 		    }
-		}			
+		    return NULL;
+		}
 
 		/*
-		 * part1Ptr points to an array element; first copy 
-		 * the element name to a new string part2.
+		 * part1Ptr points to an array element; first copy the element
+		 * name to a new string part2.
 		 */
 
 		part2 = part1 + i + 1;
@@ -484,30 +679,32 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
 		memcpy(newPart2, part2, (unsigned int) len2);
 		*(newPart2+len2) = '\0';
 		part2 = newPart2;
+		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+		if (createPart2) {
+		    Tcl_IncrRefCount(part2Ptr);
+		}
 
 		/*
-		 * Free the internal rep of the original part1Ptr, now
-		 * renamed objPtr, and set it to tclParsedVarNameType.
+		 * Free the internal rep of the original part1Ptr, now renamed
+		 * objPtr, and set it to tclParsedVarNameType.
 		 */
 
 		objPtr = part1Ptr;
-		if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-		    typePtr->freeIntRepProc(objPtr);
-		}
+		TclFreeIntRep(objPtr);
 		objPtr->typePtr = &tclParsedVarNameType;
 
 		/*
-		 * Define a new string object to hold the new part1Ptr, i.e., 
+		 * Define a new string object to hold the new part1Ptr, i.e.,
 		 * the array name. Set the internal rep of objPtr, reset
-		 * typePtr and part1 to contain the references to the
-		 * array name.
+		 * typePtr and part1 to contain the references to the array
+		 * name.
 		 */
 
-		part1Ptr = Tcl_NewStringObj(part1, len1);
+		TclNewStringObj(part1Ptr, part1, len1);
 		Tcl_IncrRefCount(part1Ptr);
 
-		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;
-		objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;		
+		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
+		objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
 
 		typePtr = part1Ptr->typePtr;
 		part1 = TclGetString(part1Ptr);
@@ -515,23 +712,24 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
 	    }
 	}
     }
-    
-    doneParsing:
+
+  doneParsing:
     /*
-     * part1Ptr is not an array element; look it up, and convert 
-     * it to one of the cached types if possible.
+     * part1Ptr is not an array element; look it up, and convert it to one of
+     * the cached types if possible.
      */
 
-    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	typePtr->freeIntRepProc(part1Ptr);
-	part1Ptr->typePtr = NULL;
-    }
+    TclFreeIntRep(part1Ptr);
+    part1Ptr->typePtr = NULL;
 
-    varPtr = TclLookupSimpleVar(interp, part1, flags, 
-            createPart1, &errMsg, &index);
+    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
+	    &errMsg, &index);
     if (varPtr == NULL) {
 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	    VarErrMsg(interp, part1, part2, msg, errMsg);
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
+	}
+	if (newPart2) {
+	    Tcl_DecrRefCount(part2Ptr);
 	}
 	return NULL;
     }
@@ -541,52 +739,51 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
      */
 
     if (index >= 0) {
-        /*
+	/*
 	 * An indexed local variable.
 	 */
 
-	Proc *procPtr = ((Interp *) interp)->varFramePtr->procPtr;
-
-	part1Ptr->typePtr = &tclLocalVarNameType;
-	procPtr->refCount++;
-	part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
-#if 0
-    /*
-     * TEMPORARYLY DISABLED tclNsVarNameType
-     *
-     * This optimisation will hopefully be turned back on soon.
-     *      Miguel Sofer, 2004-05-22
-     */
-
+	part1Ptr->typePtr = &localVarNameType;
+	if (part1Ptr != localName(iPtr->varFramePtr, index)) {
+	    part1Ptr->internalRep.ptrAndLongRep.ptr =
+		    localName(iPtr->varFramePtr, index);
+	    Tcl_IncrRefCount((Tcl_Obj *)
+		    part1Ptr->internalRep.ptrAndLongRep.ptr);
+	} else {
+	    part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
+	}
+	part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
+#if ENABLE_NS_VARNAME_CACHING
     } else if (index > -3) {
 	/*
 	 * A cacheable namespace or global variable.
 	 */
+
 	Namespace *nsPtr;
-    
-	nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr);
+
+	nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
 	varPtr->refCount++;
 	part1Ptr->typePtr = &tclNsVarNameType;
-	part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
+	part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
+	part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
 #endif
     } else {
 	/*
 	 * At least mark part1Ptr as already parsed.
 	 */
+
 	part1Ptr->typePtr = &tclParsedVarNameType;
 	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
 	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
     }
-    
-    donePart1:
+
+  donePart1:
 #if 0
     if (varPtr == NULL) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    part1 = TclGetString(part1Ptr);
-	    VarErrMsg(interp, part1, part2, msg, 
-		    "Cached variable reference is NULL.");
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+		    "Cached variable reference is NULL.", -1);
 	}
 	return NULL;
     }
@@ -595,271 +792,265 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
 	varPtr = varPtr->value.linkPtr;
     }
 
-    if (part2 != NULL) {
+    if (part2Ptr != NULL) {
 	/*
 	 * Array element sought: look it up.
 	 */
 
-	part1 = TclGetString(part1Ptr);
 	*arrayPtrPtr = varPtr;
-	varPtr = TclLookupArrayElement(interp, part1, part2, 
-                flags, msg, createPart1, createPart2, varPtr);
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
+		createPart1, createPart2, varPtr, -1);
+	if (newPart2) {
+	    Tcl_DecrRefCount(part2Ptr);
+	}
     }
     return varPtr;
 }
 
 /*
- * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for 
- * upvar (or similar) purposes, with slightly different rules:
- *   - Bug #696893 - variable is either proc-local or in the current
- *     namespace; never follow the second (global) resolution path 
- *   - Bug #631741 - do not use special namespace or interp resolvers
+ * This flag bit should not interfere with TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
+ * lookup is performed for upvar (or similar) purposes, with slightly
+ * different rules:
+ *    - Bug #696893 - variable is either proc-local or in the current
+ *	namespace; never follow the second (global) resolution path
+ *    - Bug #631741 - do not use special namespace or interp resolvers
+ *
+ * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
+ * (Bug #835020)
  */
-#define LOOKUP_FOR_UPVAR 0x40000
+
+#define AVOID_RESOLVERS 0x40000
 
 /*
  *----------------------------------------------------------------------
  *
  * TclLookupSimpleVar --
  *
- *	This procedure is used by to locate a simple variable (i.e., not
- *      an array element) given its name.
+ *	This function is used by to locate a simple variable (i.e., not an
+ *	array element) given its name.
  *
  * Results:
  *	The return value is a pointer to the variable structure indicated by
- *	varName, or NULL if the variable couldn't be found. If the variable 
- *      can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED) 
- *      variable structure is created, entered into a hash table, and returned.
- *
- *      If the current CallFrame corresponds to a proc and the variable found is
- *      one of the compiledLocals, its index is placed in *indexPtr. Otherwise,
- *      *indexPtr will be set to (according to the needs of TclObjLookupVar):
- *               -1 a global reference
- *               -2 a reference to a namespace variable
- *               -3 a non-cachable reference, i.e., one of:
- *                    . non-indexed local var
- *                    . a reference of unknown origin;
- *                    . resolution by a namespace or interp resolver
+ *	varName, or NULL if the variable couldn't be found. If the variable
+ *	can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED)
+ *	variable structure is created, entered into a hash table, and
+ *	returned.
+ *
+ *	If the current CallFrame corresponds to a proc and the variable found
+ *	is one of the compiledLocals, its index is placed in *indexPtr.
+ *	Otherwise, *indexPtr will be set to (according to the needs of
+ *	TclObjLookupVar):
+ *	    -1 a global reference
+ *	    -2 a reference to a namespace variable
+ *	    -3 a non-cachable reference, i.e., one of:
+ *		. non-indexed local var
+ *		. a reference of unknown origin;
+ *		. resolution by a namespace or interp resolver
  *
  *	If the variable isn't found and creation wasn't specified, or some
  *	other error occurs, NULL is returned and the corresponding error
- *	message is left in *errMsgPtr. 
+ *	message is left in *errMsgPtr.
  *
- *	Note: it's possible for the variable returned to be VAR_UNDEFINED
- *	even if create is 1 (this only causes the hash table entry to be
- *	created).  For example, the variable might be a global that has been
- *	unset but is still referenced by a procedure, or a variable that has
- *	been unset but it only being kept in existence (if VAR_UNDEFINED) by
- *	a trace.
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED even
+ *	if create is 1 (this only causes the hash table entry to be created).
+ *	For example, the variable might be a global that has been unset but is
+ *	still referenced by a procedure, or a variable that has been unset but
+ *	it only being kept in existence (if VAR_UNDEFINED) by a trace.
  *
  * Side effects:
  *	A new hashtable entry may be created if create is 1.
+ *	Callers must Incr varNamePtr if they plan to Decr it if create is 1.
  *
  *----------------------------------------------------------------------
  */
 
 Var *
-TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
-    CONST char *varName;        /* This is a simple variable name that could
-				 * representa scalar or an array. */
-    int flags;		        /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
-				 * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits 
+TclLookupSimpleVar(
+    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
+    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
+				 * represent a scalar or an array. */
+    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
 				 * matter. */
-    CONST int create;		/* If 1, create hash table entry for varname,
-				 * if it doesn't already exist. If 0, return 
+    const int create,		/* If 1, create hash table entry for varname,
+				 * if it doesn't already exist. If 0, return
 				 * error if it doesn't exist. */
-    CONST char **errMsgPtr;
-    int *indexPtr;
-{    
+    const char **errMsgPtr,
+    int *indexPtr)
+{
     Interp *iPtr = (Interp *) interp;
     CallFrame *varFramePtr = iPtr->varFramePtr;
 				/* Points to the procedure call frame whose
-				 * variables are currently in use. Same as
-				 * the current procedure's frame, if any,
-				 * unless an "uplevel" is executing. */
-    Tcl_HashTable *tablePtr;	/* Points to the hashtable, if any, in which
+				 * variables are currently in use. Same as the
+				 * current procedure's frame, if any, unless
+				 * an "uplevel" is executing. */
+    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
 				 * to look up the variable. */
-    Tcl_Var var;                /* Used to search for global names. */
+    Tcl_Var var;		/* Used to search for global names. */
     Var *varPtr;		/* Points to the Var structure returned for
 				 * the variable. */
     Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
     ResolverScheme *resPtr;
-    Tcl_HashEntry *hPtr;
-    int new, i, result;
+    int isNew, i, result;
+    const char *varName = TclGetString(varNamePtr);
 
     varPtr = NULL;
-    varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */
+    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
     *indexPtr = -3;
 
-    if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
-        cxtNsPtr = iPtr->globalNsPtr;
+    if (flags & TCL_GLOBAL_ONLY) {
+	cxtNsPtr = iPtr->globalNsPtr;
     } else {
-        cxtNsPtr = iPtr->varFramePtr->nsPtr;
+	cxtNsPtr = iPtr->varFramePtr->nsPtr;
     }
 
     /*
-     * If this namespace has a variable resolver, then give it first
-     * crack at the variable resolution.  It may return a Tcl_Var
-     * value, it may signal to continue onward, or it may signal
-     * an error.
+     * If this namespace has a variable resolver, then give it first crack at
+     * the variable resolution. It may return a Tcl_Var value, it may signal
+     * to continue onward, or it may signal an error.
      */
 
-    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) 
-	    && !(flags & LOOKUP_FOR_UPVAR)) {
-        resPtr = iPtr->resolverPtr;
-
-        if (cxtNsPtr->varResProc) {
-            result = (*cxtNsPtr->varResProc)(interp, varName,
+    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
+	    && !(flags & AVOID_RESOLVERS)) {
+	resPtr = iPtr->resolverPtr;
+	if (cxtNsPtr->varResProc) {
+	    result = (*cxtNsPtr->varResProc)(interp, varName,
 		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
-        } else {
-            result = TCL_CONTINUE;
-        }
+	} else {
+	    result = TCL_CONTINUE;
+	}
 
-        while (result == TCL_CONTINUE && resPtr) {
-            if (resPtr->varResProc) {
-                result = (*resPtr->varResProc)(interp, varName,
+	while (result == TCL_CONTINUE && resPtr) {
+	    if (resPtr->varResProc) {
+		result = (*resPtr->varResProc)(interp, varName,
 			(Tcl_Namespace *) cxtNsPtr, flags, &var);
-            }
-            resPtr = resPtr->nextPtr;
-        }
-
-        if (result == TCL_OK) {
-            varPtr = (Var *) var;
-	    return varPtr;
-        } else if (result != TCL_CONTINUE) {
+	    }
+	    resPtr = resPtr->nextPtr;
+	}
+
+	if (result == TCL_OK) {
+	    return (Var *) var;
+	} else if (result != TCL_CONTINUE) {
 	    return NULL;
-        }
+	}
     }
 
     /*
      * Look up varName. Look it up as either a namespace variable or as a
-     * local variable in a procedure call frame (varFramePtr).
-     * Interpret varName as a namespace variable if:
+     * local variable in a procedure call frame (varFramePtr). Interpret
+     * varName as a namespace variable if:
      *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
      *    2) there is no active frame (we're at the global :: scope),
-     *    3) the active frame was pushed to define the namespace context
-     *       for a "namespace eval" or "namespace inscope" command,
+     *    3) the active frame was pushed to define the namespace context for a
+     *	     "namespace eval" or "namespace inscope" command,
      *    4) the name has namespace qualifiers ("::"s).
-     * Otherwise, if varName is a local variable, search first in the
-     * frame's array of compiler-allocated local variables, then in its
-     * hashtable for runtime-created local variables.
+     * Otherwise, if varName is a local variable, search first in the frame's
+     * array of compiler-allocated local variables, then in its hashtable for
+     * runtime-created local variables.
      *
-     * If create and the variable isn't found, create the variable and,
-     * if necessary, create varFramePtr's local var hashtable.
+     * If create and the variable isn't found, create the variable and, if
+     * necessary, create varFramePtr's local var hashtable.
      */
 
     if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
-	    || (varFramePtr == NULL)
-	    || !varFramePtr->isProcCallFrame
+	    || !HasLocalVars(varFramePtr)
 	    || (strstr(varName, "::") != NULL)) {
-	CONST char *tail;
-	int lookGlobal;
-	
-	lookGlobal = (flags & TCL_GLOBAL_ONLY) 
-	    || (cxtNsPtr == iPtr->globalNsPtr)
-	    || ((*varName == ':') && (*(varName+1) == ':'));
+	const char *tail;
+	int lookGlobal = (flags & TCL_GLOBAL_ONLY)
+		|| (cxtNsPtr == iPtr->globalNsPtr)
+		|| ((*varName == ':') && (*(varName+1) == ':'));
+
 	if (lookGlobal) {
 	    *indexPtr = -1;
-	    flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR);
+	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
 	} else {
-	    if (flags & LOOKUP_FOR_UPVAR) {
-		flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR;
+	    if (flags & AVOID_RESOLVERS) {
+		flags = (flags | TCL_NAMESPACE_ONLY);
 	    }
 	    if (flags & TCL_NAMESPACE_ONLY) {
 		*indexPtr = -2;
 	    }
-	} 
+	}
 
 	/*
-	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,
-	 * or otherwise generate our own error!
+	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
+	 * otherwise generate our own error!
 	 */
-	var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
-		flags & ~TCL_LEAVE_ERR_MSG);
-	if (var != (Tcl_Var) NULL) {
-            varPtr = (Var *) var;
-        }
+
+	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
+		(Tcl_Namespace *) cxtNsPtr,
+		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
 	if (varPtr == NULL) {
-	    if (create) {   /* var wasn't found so create it  */
+	    Tcl_Obj *tailPtr;
+
+	    if (create) {	/* Var wasn't found so create it. */
 		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
 			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
 		if (varNsPtr == NULL) {
 		    *errMsgPtr = badNamespace;
 		    return NULL;
-		}
-		if (tail == NULL) {
+		} else if (tail == NULL) {
 		    *errMsgPtr = missingName;
 		    return NULL;
 		}
-		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
-		varPtr = NewVar();
-		Tcl_SetHashValue(hPtr, varPtr);
-		varPtr->hPtr = hPtr;
-		varPtr->nsPtr = varNsPtr;
-		if ((lookGlobal)  || (varNsPtr == NULL)) {
+		if (tail != varName) {
+		    tailPtr = Tcl_NewStringObj(tail, -1);
+		} else {
+		    tailPtr = varNamePtr;
+		}
+		varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
+			&isNew);
+		if (lookGlobal) {
 		    /*
 		     * The variable was created starting from the global
-		     * namespace: a global reference is returned even if 
-		     * it wasn't explicitly requested.
+		     * namespace: a global reference is returned even if it
+		     * wasn't explicitly requested.
 		     */
+
 		    *indexPtr = -1;
 		} else {
 		    *indexPtr = -2;
 		}
-	    } else {		/* var wasn't found and not to create it */
+	    } else {		/* Var wasn't found and not to create it. */
 		*errMsgPtr = noSuchVar;
 		return NULL;
 	    }
 	}
-    } else {			/* local var: look in frame varFramePtr */
-	Proc *procPtr = varFramePtr->procPtr;
-	int localCt = procPtr->numCompiledLocals;
-	CompiledLocal *localPtr = procPtr->firstLocalPtr;
-	Var *localVarPtr = varFramePtr->compiledLocals;
-	int varNameLen = strlen(varName);
-	
-	for (i = 0;  i < localCt;  i++) {
-	    if (!TclIsVarTemporary(localPtr)) {
-		register char *localName = localVarPtr->name;
+    } else {			/* Local var: look in frame varFramePtr. */
+	int localCt = varFramePtr->numCompiledLocals;
+	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
+
+	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
+	    register Tcl_Obj *objPtr = *objPtrPtr;
+
+	    if (objPtr) {
+		char *localName = TclGetString(objPtr);
+
 		if ((varName[0] == localName[0])
-		        && (varNameLen == localPtr->nameLength)
-		        && (strcmp(varName, localName) == 0)) {
+			&& (strcmp(varName, localName) == 0)) {
 		    *indexPtr = i;
-		    return localVarPtr;
+		    return (Var *) &varFramePtr->compiledLocals[i];
 		}
 	    }
-	    localVarPtr++;
-	    localPtr = localPtr->nextPtr;
 	}
 	tablePtr = varFramePtr->varTablePtr;
 	if (create) {
 	    if (tablePtr == NULL) {
-		tablePtr = (Tcl_HashTable *)
-		    ckalloc(sizeof(Tcl_HashTable));
-		Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+		tablePtr = (TclVarHashTable *)
+			ckalloc(sizeof(TclVarHashTable));
+		TclInitVarHashTable(tablePtr, NULL);
 		varFramePtr->varTablePtr = tablePtr;
 	    }
-	    hPtr = Tcl_CreateHashEntry(tablePtr, varName, &new);
-	    if (new) {
-		varPtr = NewVar();
-		Tcl_SetHashValue(hPtr, varPtr);
-		varPtr->hPtr = hPtr;
-		varPtr->nsPtr = NULL; /* a local variable */
-	    } else {
-		varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    }
+	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
 	} else {
-	    hPtr = NULL;
+	    varPtr = NULL;
 	    if (tablePtr != NULL) {
-		hPtr = Tcl_FindHashEntry(tablePtr, varName);
+		varPtr = VarHashFindVar(tablePtr, varNamePtr);
 	    }
-	    if (hPtr == NULL) {
+	    if (varPtr == NULL) {
 		*errMsgPtr = noSuchVar;
-		return NULL;
 	    }
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	}
     }
     return varPtr;
@@ -870,69 +1061,75 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)
  *
  * TclLookupArrayElement --
  *
- *	This procedure is used to locate a variable which is in an array's 
- *      hashtable given a pointer to the array's Var structure and the 
- *      element's name.
+ *	This function is used to locate a variable which is in an array's
+ *	hashtable given a pointer to the array's Var structure and the
+ *	element's name.
  *
  * Results:
- *	The return value is a pointer to the variable structure , or NULL if 
- *      the variable couldn't be found. 
+ *	The return value is a pointer to the variable structure , or NULL if
+ *	the variable couldn't be found.
  *
- *      If arrayPtr points to a variable that isn't an array and createPart1 
- *      is 1, the corresponding variable will be converted to an array. 
- *      Otherwise, NULL is returned and an error message is left in
- *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
+ *	If arrayPtr points to a variable that isn't an array and createPart1
+ *	is 1, the corresponding variable will be converted to an array.
+ *	Otherwise, NULL is returned and an error message is left in the
+ *	interp's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
- *      If the variable is not found and createPart2 is 1, the variable is
- *      created. Otherwise, NULL is returned and an error message is left in
+ *	If the variable is not found and createPart2 is 1, the variable is
+ *	created. Otherwise, NULL is returned and an error message is left in
  *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
- *	Note: it's possible for the variable returned to be VAR_UNDEFINED
- *	even if createPart1 or createPart2 are 1 (these only cause the hash
- *	table entry or array to be created). For example, the variable might
- *	be a global that has been unset but is still referenced by a
- *	procedure, or a variable that has been unset but it only being kept
- *	in existence (if VAR_UNDEFINED) by a trace.
+ *	Note: it's possible for the variable returned to be VAR_UNDEFINED even
+ *	if createPart1 or createPart2 are 1 (these only cause the hash table
+ *	entry or array to be created). For example, the variable might be a
+ *	global that has been unset but is still referenced by a procedure, or
+ *	a variable that has been unset but it only being kept in existence (if
+ *	VAR_UNDEFINED) by a trace.
  *
  * Side effects:
- *      The variable at arrayPtr may be converted to be an array if 
- *      createPart1 is 1. A new hashtable entry may be created if createPart2 
- *      is 1.
+ *	The variable at arrayPtr may be converted to be an array if
+ *	createPart1 is 1. A new hashtable entry may be created if createPart2
+ *	is 1.
+ *	When createElem is 1, callers must incr elNamePtr if they plan
+ *	to decr it.
  *
  *----------------------------------------------------------------------
  */
 
 Var *
-TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, createElem, arrayPtr)
-    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
-    CONST char *arrayName;	        /* This is the name of the array. */
-    CONST char *elName;		/* Name of element within array. */
-    CONST int flags;		/* Only TCL_LEAVE_ERR_MSG bit matters. */
-    CONST char *msg;			/* Verb to use in error messages, e.g.
-				 * "read" or "set". Only needed if
-				 * TCL_LEAVE_ERR_MSG is set in flags. */
-    CONST int createArray;	/* If 1, transform arrayName to be an array
-				 * if it isn't one yet and the transformation 
-				 * is possible. If 0, return error if it 
-				 * isn't already an array. */
-    CONST int createElem;	/* If 1, create hash table entry for the 
-				 * element, if it doesn't already exist. If
-				 * 0, return error if it doesn't exist. */
-    Var *arrayPtr;	        /* Pointer to the array's Var structure. */
+TclLookupArrayElement(
+    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
+    Tcl_Obj *arrayNamePtr,	/* This is the name of the array, or NULL if
+				 * index>= 0. */
+    Tcl_Obj *elNamePtr,		/* Name of element within array. */
+    const int flags,		/* Only TCL_LEAVE_ERR_MSG bit matters. */
+    const char *msg,		/* Verb to use in error messages, e.g. "read"
+				 * or "set". Only needed if TCL_LEAVE_ERR_MSG
+				 * is set in flags. */
+    const int createArray,	/* If 1, transform arrayName to be an array if
+				 * it isn't one yet and the transformation is
+				 * possible. If 0, return error if it isn't
+				 * already an array. */
+    const int createElem,	/* If 1, create hash table entry for the
+				 * element, if it doesn't already exist. If 0,
+				 * return error if it doesn't exist. */
+    Var *arrayPtr,		/* Pointer to the array's Var structure. */
+    int index)			/* If >=0, the index of the local array. */
 {
-    Tcl_HashEntry *hPtr;
-    int new;
+    int isNew;
     Var *varPtr;
+    TclVarHashTable *tablePtr;
+    Namespace *nsPtr;
 
     /*
-     * We're dealing with an array element. Make sure the variable is an
-     * array and look up the element (create the element if desired).
+     * We're dealing with an array element. Make sure the variable is an array
+     * and look up the element (create the element if desired).
      */
 
     if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
 	if (!createArray) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elName, msg, noSuchVar);
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+			noSuchVar, index);
 	    }
 	    return NULL;
 	}
@@ -941,47 +1138,54 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
 	 * Make sure we are not resurrecting a namespace variable from a
 	 * deleted namespace!
 	 */
-	if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
+
+	if (TclIsVarDeadHash(arrayPtr)) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elName, msg, danglingVar);
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+			danglingVar, index);
 	    }
 	    return NULL;
 	}
 
 	TclSetVarArray(arrayPtr);
-	TclClearVarUndefined(arrayPtr);
-	arrayPtr->value.tablePtr =
-	    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+	tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));
+	arrayPtr->value.tablePtr = tablePtr;
+
+	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
+	    nsPtr = TclGetVarNsPtr(arrayPtr);
+	} else {
+	    nsPtr = NULL;
+	}
+	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
     } else if (!TclIsVarArray(arrayPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    VarErrMsg(interp, arrayName, elName, msg, needArray);
+	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
+		    index);
 	}
 	return NULL;
     }
 
     if (createElem) {
-	hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
-	if (new) {
-	    if (arrayPtr->searchPtr != NULL) {
-		DeleteSearches(arrayPtr);
+	varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr,
+		&isNew);
+	if (isNew) {
+	    if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
+		DeleteSearches((Interp *) interp, arrayPtr);
 	    }
-	    varPtr = NewVar();
-	    Tcl_SetHashValue(hPtr, varPtr);
-	    varPtr->hPtr = hPtr;
-	    varPtr->nsPtr = arrayPtr->nsPtr;
 	    TclSetVarArrayElement(varPtr);
 	}
     } else {
-	hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
-	if (hPtr == NULL) {
+	varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
+	if (varPtr == NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elName, msg, noSuchElement);
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
+			noSuchElement, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
+			TclGetString(elNamePtr), NULL);
 	    }
-	    return NULL;
 	}
     }
-    return (Var *) Tcl_GetHashValue(hPtr);
+    return varPtr;
 }
 
 /*
@@ -993,9 +1197,9 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
  *
  * Results:
  *	The return value points to the current value of varName as a string.
- *	If the variable is not defined or can't be read because of a clash
- *	in array usage then a NULL pointer is returned and an error message
- *	is left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.
+ *	If the variable is not defined or can't be read because of a clash in
+ *	array usage then a NULL pointer is returned and an error message is
+ *	left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.
  *	Note: the return value is only valid up until the next change to the
  *	variable; if you depend on the value lasting longer than that, then
  *	make yourself a private copy.
@@ -1006,16 +1210,16 @@ TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, create
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetVar(interp, varName, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    CONST char *varName;	/* Name of a variable in interp. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
+const char *
+Tcl_GetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    const char *varName,	/* Name of a variable in interp. */
+    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
 				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
 				 * bits. */
 {
-    return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
+    return Tcl_GetVar2(interp, varName, NULL, flags);
 }
 
 /*
@@ -1023,17 +1227,17 @@ Tcl_GetVar(interp, varName, flags)
  *
  * Tcl_GetVar2 --
  *
- *	Return the value of a Tcl variable as a string, given a two-part
- *	name consisting of array name and element within array.
+ *	Return the value of a Tcl variable as a string, given a two-part name
+ *	consisting of array name and element within array.
  *
  * Results:
- *	The return value points to the current value of the variable given
- *	by part1 and part2 as a string. If the specified variable doesn't
- *	exist, or if there is a clash in array usage, then NULL is returned
- *	and a message will be left in the interp's result if the
- *	TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid
- *	up until the next change to the variable; if you depend on the value
- *	lasting longer than that, then make yourself a private copy.
+ *	The return value points to the current value of the variable given by
+ *	part1 and part2 as a string. If the specified variable doesn't exist,
+ *	or if there is a clash in array usage, then NULL is returned and a
+ *	message will be left in the interp's result if the TCL_LEAVE_ERR_MSG
+ *	flag is set. Note: the return value is only valid up until the next
+ *	change to the variable; if you depend on the value lasting longer than
+ *	that, then make yourself a private copy.
  *
  * Side effects:
  *	None.
@@ -1041,17 +1245,17 @@ Tcl_GetVar(interp, varName, flags)
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_GetVar2(interp, part1, part2, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    CONST char *part1;		/* Name of an array (if part2 is non-NULL)
-				 * or the name of a variable. */
-    CONST char *part2;		/* If non-NULL, gives the name of an element
+const char *
+Tcl_GetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    const char *part1,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. */
+    const char *part2,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG
-                                 * bits. */
+    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
+				 * bits. */
 {
     Tcl_Obj *objPtr;
 
@@ -1067,8 +1271,8 @@ Tcl_GetVar2(interp, part1, part2, flags)
  *
  * Tcl_GetVar2Ex --
  *
- *	Return the value of a Tcl variable as a Tcl object, given a
- *	two-part name consisting of array name and element within array.
+ *	Return the value of a Tcl variable as a Tcl object, given a two-part
+ *	name consisting of array name and element within array.
  *
  * Results:
  *	The return value points to the current object value of the variable
@@ -1078,35 +1282,39 @@ Tcl_GetVar2(interp, part1, part2, flags)
  *	TCL_LEAVE_ERR_MSG flag is set.
  *
  * Side effects:
- *	The ref count for the returned object is _not_ incremented to
- *	reflect the returned reference; if you want to keep a reference to
- *	the object you must increment its ref count yourself.
+ *	The ref count for the returned object is _not_ incremented to reflect
+ *	the returned reference; if you want to keep a reference to the object
+ *	you must increment its ref count yourself.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_GetVar2Ex(interp, part1, part2, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    CONST char *part1;		/* Name of an array (if part2 is non-NULL)
-				 * or the name of a variable. */
-    CONST char *part2;		/* If non-NULL, gives the name of an element
+Tcl_GetVar2Ex(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    const char *part1,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. */
+    const char *part2,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * and TCL_LEAVE_ERR_MSG bits. */
+    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
+				 * TCL_LEAVE_ERR_MSG bits. */
 {
-    Var *varPtr, *arrayPtr;
+    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    /* Filter to pass through only the flags this interface supports. */
-    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
-    varPtr = TclLookupVar(interp, part1, part2, flags, "read",
-            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
-    if (varPtr == NULL) {
-	return NULL;
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
     }
 
-    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+    resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+
+    return resPtr;
 }
 
 /*
@@ -1114,8 +1322,8 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
  *
  * Tcl_ObjGetVar2 --
  *
- *	Return the value of a Tcl variable as a Tcl object, given a
- *	two-part name consisting of array name and element within array.
+ *	Return the value of a Tcl variable as a Tcl object, given a two-part
+ *	name consisting of array name and element within array.
  *
  * Results:
  *	The return value points to the current object value of the variable
@@ -1125,41 +1333,43 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
  *	TCL_LEAVE_ERR_MSG flag is set.
  *
  * Side effects:
- *	The ref count for the returned object is _not_ incremented to
- *	reflect the returned reference; if you want to keep a reference to
- *	the object you must increment its ref count yourself.
+ *	The ref count for the returned object is _not_ incremented to reflect
+ *	the returned reference; if you want to keep a reference to the object
+ *	you must increment its ref count yourself.
+ *
+ *	Callers must incr part2Ptr if they plan to decr it.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
-				 * an array (if part2 is non-NULL) or the
-				 * name of a variable. */
-    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+Tcl_ObjGetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    register Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
+				 * array (if part2 is non-NULL) or the name of
+				 * a variable. */
+    register Tcl_Obj *part2Ptr,	/* If non-null, points to an object holding
 				 * the name of an element in the array
 				 * part1Ptr. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY and
+    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1, *part2;
 
-    part1 = Tcl_GetString(part1Ptr);
-    part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));
-    
-    /* Filter to pass through only the flags this interface supports. */
+    /*
+     * Filter to pass through only the flags this interface supports.
+     */
+
     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
-            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
+	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
 
-    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+    return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    flags, -1);
 }
 
 /*
@@ -1167,50 +1377,53 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
  *
  * TclPtrGetVar --
  *
- *	Return the value of a Tcl variable as a Tcl object, given the
- *      pointers to the variable's (and possibly containing array's) 
- *      VAR structure.
+ *	Return the value of a Tcl variable as a Tcl object, given the pointers
+ *	to the variable's (and possibly containing array's) VAR structure.
  *
  * Results:
  *	The return value points to the current object value of the variable
- *	given by varPtr. If the specified variable doesn't exist, or if there 
- *      is a clash in array usage, then NULL is returned and a message will be 
- *      left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set.
+ *	given by varPtr. If the specified variable doesn't exist, or if there
+ *	is a clash in array usage, then NULL is returned and a message will be
+ *	left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set.
  *
  * Side effects:
- *	The ref count for the returned object is _not_ incremented to
- *	reflect the returned reference; if you want to keep a reference to
- *	the object you must increment its ref count yourself.
+ *	The ref count for the returned object is _not_ incremented to reflect
+ *	the returned reference; if you want to keep a reference to the object
+ *	you must increment its ref count yourself.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    register Var *varPtr;       /* The variable to be read.*/
-    Var *arrayPtr;              /* NULL for scalar variables, pointer to
-				 * the containing array otherwise. */
-    CONST char *part1;		/* Name of an array (if part2 is non-NULL)
-				 * or the name of a variable. */
-    CONST char *part2;		/* If non-NULL, gives the name of an element
+TclPtrGetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    register Var *varPtr,	/* The variable to be read.*/
+    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
+				 * containing array otherwise. */
+    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. */
+    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * and TCL_LEAVE_ERR_MSG bits. */
+    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
+				 * TCL_LEAVE_ERR_MSG bits. */
+    int index)			/* Index into the local variable table of the
+				 * variable, or -1. Only used when part1Ptr is
+				 * NULL. */
 {
     Interp *iPtr = (Interp *) interp;
-    CONST char *msg;
+    const char *msg;
 
     /*
-     * Invoke any traces that have been set for the variable.
+     * Invoke any read traces that have been set for the variable.
      */
 
-    if ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+    if ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+		part1Ptr, part2Ptr,
 		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
-		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
 	    goto errorReturn;
 	}
     }
@@ -1218,31 +1431,31 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
     /*
      * Return the element if it's an existing scalar variable.
      */
-    
+
     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
 	return varPtr->value.objPtr;
     }
-    
+
     if (flags & TCL_LEAVE_ERR_MSG) {
-	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
-	        && !TclIsVarUndefined(arrayPtr)) {
+	if (TclIsVarUndefined(varPtr) && arrayPtr
+		&& !TclIsVarUndefined(arrayPtr)) {
 	    msg = noSuchElement;
 	} else if (TclIsVarArray(varPtr)) {
 	    msg = isArray;
 	} else {
 	    msg = noSuchVar;
 	}
-	VarErrMsg(interp, part1, part2, "read", msg);
+	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
     }
 
     /*
-     * An error. If the variable doesn't exist anymore and no-one's using
-     * it, then free up the relevant structures and hash table entries.
+     * An error. If the variable doesn't exist anymore and no-one's using it,
+     * then free up the relevant structures and hash table entries.
      */
 
-    errorReturn:
+  errorReturn:
     if (TclIsVarUndefined(varPtr)) {
-	CleanupVar(varPtr, arrayPtr);
+	TclCleanupVar(varPtr, arrayPtr);
     }
     return NULL;
 }
@@ -1252,8 +1465,8 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
  *
  * Tcl_SetObjCmd --
  *
- *	This procedure is invoked to process the "set" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "set" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result value.
@@ -1266,23 +1479,22 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
 
 	/* ARGSUSED */
 int
-Tcl_SetObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;			/* Not used. */
-    register Tcl_Interp *interp;	/* Current interpreter. */
-    int objc;				/* Number of arguments. */
-    Tcl_Obj *CONST objv[];		/* Argument objects. */
+Tcl_SetObjCmd(
+    ClientData dummy,		/* Not used. */
+    register Tcl_Interp *interp,/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *varValueObj;
 
     if (objc == 2) {
-	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
 	if (varValueObj == NULL) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varValueObj);
 	return TCL_OK;
     } else if (objc == 3) {
-
 	varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
 		TCL_LEAVE_ERR_MSG);
 	if (varValueObj == NULL) {
@@ -1305,33 +1517,33 @@ Tcl_SetObjCmd(dummy, interp, objc, objv)
  *
  * Results:
  *	Returns a pointer to the malloc'ed string which is the character
- *	representation of the variable's new value. The caller must not
- *	modify this string. If the write operation was disallowed then NULL
- *	is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
- *	explanatory message will be left in the interp's result. Note that the
- *	returned string may not be the same as newValue; this is because
- *	variable traces may modify the variable's value.
+ *	representation of the variable's new value. The caller must not modify
+ *	this string. If the write operation was disallowed then NULL is
+ *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
+ *	message will be left in the interp's result. Note that the returned
+ *	string may not be the same as newValue; this is because variable
+ *	traces may modify the variable's value.
  *
  * Side effects:
- *	If varName is defined as a local or global variable in interp,
- *	its value is changed to newValue. If varName isn't currently
- *	defined, then a new global variable by that name is created.
+ *	If varName is defined as a local or global variable in interp, its
+ *	value is changed to newValue. If varName isn't currently defined, then
+ *	a new global variable by that name is created.
  *
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_SetVar(interp, varName, newValue, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    CONST char *varName;	/* Name of a variable in interp. */
-    CONST char *newValue;	/* New value for varName. */
-    int flags;			/* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+const char *
+Tcl_SetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    const char *varName,	/* Name of a variable in interp. */
+    const char *newValue,	/* New value for varName. */
+    int flags)			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
+				 * TCL_LEAVE_ERR_MSG. */
 {
-    return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
+    return Tcl_SetVar2(interp, varName, NULL, newValue, flags);
 }
 
 /*
@@ -1339,57 +1551,45 @@ Tcl_SetVar(interp, varName, newValue, flags)
  *
  * Tcl_SetVar2 --
  *
- *      Given a two-part variable name, which may refer either to a
- *      scalar variable or an element of an array, change the value
- *      of the variable.  If the named scalar or array or element
- *      doesn't exist then create one.
+ *	Given a two-part variable name, which may refer either to a scalar
+ *	variable or an element of an array, change the value of the variable.
+ *	If the named scalar or array or element doesn't exist then create one.
  *
  * Results:
  *	Returns a pointer to the malloc'ed string which is the character
- *	representation of the variable's new value. The caller must not
- *	modify this string. If the write operation was disallowed because an
- *	array was expected but not found (or vice versa), then NULL is
- *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
- *	message will be left in the interp's result. Note that the returned
- *	string may not be the same as newValue; this is because variable
- *	traces may modify the variable's value.
+ *	representation of the variable's new value. The caller must not modify
+ *	this string. If the write operation was disallowed because an array
+ *	was expected but not found (or vice versa), then NULL is returned; if
+ *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be
+ *	left in the interp's result. Note that the returned string may not be
+ *	the same as newValue; this is because variable traces may modify the
+ *	variable's value.
  *
  * Side effects:
- *      The value of the given variable is set. If either the array
- *      or the entry didn't exist then a new one is created.
+ *	The value of the given variable is set. If either the array or the
+ *	entry didn't exist then a new one is created.
  *
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Tcl_SetVar2(interp, part1, part2, newValue, flags)
-    Tcl_Interp *interp;         /* Command interpreter in which variable is
-                                 * to be looked up. */
-    CONST char *part1;          /* If part2 is NULL, this is name of scalar
-                                 * variable. Otherwise it is the name of
-                                 * an array. */
-    CONST char *part2;		/* Name of an element within an array, or
+const char *
+Tcl_SetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    const char *part1,		/* If part2 is NULL, this is name of scalar
+				 * variable. Otherwise it is the name of an
+				 * array. */
+    const char *part2,		/* Name of an element within an array, or
 				 * NULL. */
-    CONST char *newValue;       /* New value for variable. */
-    int flags;                  /* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG */
+    const char *newValue,	/* New value for variable. */
+    int flags)			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
+				 * TCL_LEAVE_ERR_MSG. */
 {
-    register Tcl_Obj *valuePtr;
-    Tcl_Obj *varValuePtr;
-
-    /*
-     * Create an object holding the variable's new value and use
-     * Tcl_SetVar2Ex to actually set the variable.
-     */
+    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+	    Tcl_NewStringObj(newValue, -1), flags);
 
-    valuePtr = Tcl_NewStringObj(newValue, -1);
-    Tcl_IncrRefCount(valuePtr);
-
-    varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
-    Tcl_DecrRefCount(valuePtr); /* done with the object */
-    
     if (varValuePtr == NULL) {
 	return NULL;
     }
@@ -1409,10 +1609,10 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
  * Results:
  *	Returns a pointer to the Tcl_Obj holding the new value of the
  *	variable. If the write operation was disallowed because an array was
- *	expected but not found (or vice versa), then NULL is returned; if
- *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
- *	be left in the interpreter's result. Note that the returned object
- *	may not be the same one referenced by newValuePtr; this is because
+ *	expected but not found (or vice versa), then NULL is returned; if the
+ *	TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be
+ *	left in the interpreter's result. Note that the returned object may
+ *	not be the same one referenced by newValuePtr; this is because
  *	variable traces may modify the variable's value.
  *
  * Side effects:
@@ -1421,46 +1621,49 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
  *
  *	The reference count is decremented for any old value of the variable
  *	and incremented for its new value. If the new value for the variable
- *	is not the same one referenced by newValuePtr (perhaps as a result
- *	of a variable trace), then newValuePtr's ref count is left unchanged
- *	by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if
- *	we are appending it as a string value: that is, if "flags" includes
+ *	is not the same one referenced by newValuePtr (perhaps as a result of
+ *	a variable trace), then newValuePtr's ref count is left unchanged by
+ *	Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if we
+ *	are appending it as a string value: that is, if "flags" includes
  *	TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
  *
  *	The reference count for the returned object is _not_ incremented: if
- *	you want to keep a reference to the object you must increment its
- *	ref count yourself.
+ *	you want to keep a reference to the object you must increment its ref
+ *	count yourself.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be found. */
-    CONST char *part1;		/* Name of an array (if part2 is non-NULL)
-				 * or the name of a variable. */
-    CONST char *part2;		/* If non-NULL, gives the name of an element
+Tcl_SetVar2Ex(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be found. */
+    const char *part1,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. */
+    const char *part2,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    Tcl_Obj *newValuePtr;	/* New value for variable. */
-    int flags;			/* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
+    Tcl_Obj *newValuePtr,	/* New value for variable. */
+    int flags)			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
+				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var *varPtr, *arrayPtr;
+    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    /* Filter to pass through only the flags this interface supports. */
-    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
-	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
-    varPtr = TclLookupVar(interp, part1, part2, flags, "set",
-	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-    if (varPtr == NULL) {
-	return NULL;
+    Tcl_IncrRefCount(part1Ptr);
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
     }
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
-            newValuePtr, flags);
+    resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
+
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+
+    return resPtr;
 }
 
 /*
@@ -1468,100 +1671,107 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
  *
  * Tcl_ObjSetVar2 --
  *
- *	This function is the same as Tcl_SetVar2Ex above, except the
- *	variable names are passed in Tcl object instead of strings.
+ *	This function is the same as Tcl_SetVar2Ex above, except the variable
+ *	names are passed in Tcl object instead of strings.
  *
  * Results:
  *	Returns a pointer to the Tcl_Obj holding the new value of the
  *	variable. If the write operation was disallowed because an array was
- *	expected but not found (or vice versa), then NULL is returned; if
- *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
- *	be left in the interpreter's result. Note that the returned object
- *	may not be the same one referenced by newValuePtr; this is because
+ *	expected but not found (or vice versa), then NULL is returned; if the
+ *	TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be
+ *	left in the interpreter's result. Note that the returned object may
+ *	not be the same one referenced by newValuePtr; this is because
  *	variable traces may modify the variable's value.
  *
  * Side effects:
  *	The value of the given variable is set. If either the array or the
  *	entry didn't exist then a new variable is created.
+ *	Callers must Incr part1Ptr if they plan to Decr it.
+ *	Callers must Incr part2Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be found. */
-    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
-				 * an array (if part2 is non-NULL) or the
-				 * name of a variable. */
-    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
+Tcl_ObjSetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be found. */
+    register Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
+				 * array (if part2 is non-NULL) or the name of
+				 * a variable. */
+    register Tcl_Obj *part2Ptr,	/* If non-NULL, points to an object holding
 				 * the name of an element in the array
 				 * part1Ptr. */
-    Tcl_Obj *newValuePtr;	/* New value for variable. */
-    int flags;			/* Various flags that tell how to set value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */
+    Tcl_Obj *newValuePtr,	/* New value for variable. */
+    int flags)			/* Various flags that tell how to set value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
+				 * TCL_LEAVE_ERR_MSG. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1, *part2;
 
-    part1 = TclGetString(part1Ptr);
-    part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));    
+    /*
+     * Filter to pass through only the flags this interface supports.
+     */
 
-    /* Filter to pass through only the flags this interface supports. */
     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
 	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
+	if (newValuePtr->refCount == 0) {
+	    Tcl_DecrRefCount(newValuePtr);
+	}
 	return NULL;
     }
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
-            newValuePtr, flags);
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    newValuePtr, flags, -1);
 }
 
-
 /*
  *----------------------------------------------------------------------
  *
  * TclPtrSetVar --
  *
- *	This function is the same as Tcl_SetVar2Ex above, except that
- *      it requires pointers to the variable's Var structs in addition
- *	to the variable names.
+ *	This function is the same as Tcl_SetVar2Ex above, except that it
+ *	requires pointers to the variable's Var structs in addition to the
+ *	variable names.
  *
  * Results:
  *	Returns a pointer to the Tcl_Obj holding the new value of the
  *	variable. If the write operation was disallowed because an array was
- *	expected but not found (or vice versa), then NULL is returned; if
- *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
- *	be left in the interpreter's result. Note that the returned object
- *	may not be the same one referenced by newValuePtr; this is because
+ *	expected but not found (or vice versa), then NULL is returned; if the
+ *	TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be
+ *	left in the interpreter's result. Note that the returned object may
+ *	not be the same one referenced by newValuePtr; this is because
  *	variable traces may modify the variable's value.
  *
  * Side effects:
  *	The value of the given variable is set. If either the array or the
  *	entry didn't exist then a new variable is created.
-
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be looked up. */
-    register Var *varPtr;
-    Var *arrayPtr;
-    CONST char *part1;		/* Name of an array (if part2 is non-NULL)
-				 * or the name of a variable. */
-    CONST char *part2;		/* If non-NULL, gives the name of an element
+TclPtrSetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be looked up. */
+    register Var *varPtr,	/* Reference to the variable to set. */
+    Var *arrayPtr,		/* Reference to the array containing the
+				 * variable, or NULL if the variable is a
+				 * scalar. */
+    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. NULL if the 'index'
+				 * parameter is >= 0 */
+    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    Tcl_Obj *newValuePtr;	/* New value for variable. */
-    CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * and TCL_LEAVE_ERR_MSG bits. */
+    Tcl_Obj *newValuePtr,	/* New value for variable. */
+    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
+				 * TCL_LEAVE_ERR_MSG bits. */
+    int index)			/* Index of local var where part1 is to be
+				 * found. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *oldValuePtr;
@@ -1570,85 +1780,93 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
 
     /*
      * If the variable is in a hashtable and its hPtr field is NULL, then we
-     * may have an upvar to an array element where the array was deleted
-     * or an upvar to a namespace variable whose namespace was deleted.
-     * Generate an error (allowing the variable to be reset would screw up
-     * our storage allocation and is meaningless anyway).
+     * may have an upvar to an array element where the array was deleted or an
+     * upvar to a namespace variable whose namespace was deleted. Generate an
+     * error (allowing the variable to be reset would screw up our storage
+     * allocation and is meaningless anyway).
      */
 
-    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+    if (TclIsVarDeadHash(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArrayElement(varPtr)) {
-		VarErrMsg(interp, part1, part2, "set", danglingElement);
+		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
+			danglingElement, index);
 	    } else {
-		VarErrMsg(interp, part1, part2, "set", danglingVar);
+		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
+			danglingVar, index);
 	    }
 	}
-	return NULL;
+	goto earlyError;
     }
 
     /*
      * It's an error to try to set an array variable itself.
      */
 
-    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+    if (TclIsVarArray(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    VarErrMsg(interp, part1, part2, "set", isArray);
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
 	}
-	return NULL;
+	goto earlyError;
     }
 
     /*
-     * Invoke any read traces that have been set for the variable if it
+     * Invoke any read traces that have been set for the variable if it is
      * requested. This was done for INST_LAPPEND_* but that was inconsistent
      * with the non-bc instruction, and would cause failures trying to
      * lappend to any non-existing ::env var, which is inconsistent with
-     * documented behavior. [Bug #3057639].
+     * documented behavior.  [Bug #3057639]
      */
 
-    if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) 
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
-	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
-	    return NULL;
+    if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+		part1Ptr, part2Ptr,
+		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
+	    goto earlyError;
 	}
     }
 
     /*
-     * Set the variable's new value. If appending, append the new value to
-     * the variable, either as a list element or as a string. Also, if
-     * appending, then if the variable's old value is unshared we can modify
-     * it directly, otherwise we must create a new copy to modify: this is
-     * "copy on write".
+     * Set the variable's new value. If appending, append the new value to the
+     * variable, either as a list element or as a string. Also, if appending,
+     * then if the variable's old value is unshared we can modify it directly,
+     * otherwise we must create a new copy to modify: this is "copy on write".
      */
 
+    oldValuePtr = varPtr->value.objPtr;
     if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
-	TclSetVarUndefined(varPtr);
+	varPtr->value.objPtr = NULL;
     }
-    oldValuePtr = varPtr->value.objPtr;
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
+#if 0
+	/*
+	 * Can't happen now!
+	 */
+
 	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
-	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
+	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
 	    varPtr->value.objPtr = NULL;
 	    oldValuePtr = NULL;
 	}
-	if (flags & TCL_LIST_ELEMENT) {	       /* append list element */
+#endif
+	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
 		varPtr->value.objPtr = oldValuePtr;
-		Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
+		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
 	    } else if (Tcl_IsShared(oldValuePtr)) {
 		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-		Tcl_DecrRefCount(oldValuePtr);
+		TclDecrRefCount(oldValuePtr);
 		oldValuePtr = varPtr->value.objPtr;
-		Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
+		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
 	    }
 	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
 		    newValuePtr);
 	    if (result != TCL_OK) {
-		return NULL;
+		goto earlyError;
 	    }
-	} else {		               /* append string */
+	} else {				/* Append string. */
 	    /*
 	     * We append newValuePtr's bytes but don't change its ref count.
 	     */
@@ -1657,51 +1875,45 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
 		varPtr->value.objPtr = newValuePtr;
 		Tcl_IncrRefCount(newValuePtr);
 	    } else {
-		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
+		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-#ifdef TCL_TIP280
+
 		    /*
 		     * TIP #280.
-		     * Ensure that the continuation line data for the
-		     * string is not lost and applies to the extended
-		     * script as well.
+		     * Ensure that the continuation line data for the string
+		     * is not lost and applies to the extended script as well.
 		     */
 		    TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr);
-#endif
+
 		    TclDecrRefCount(oldValuePtr);
 		    oldValuePtr = varPtr->value.objPtr;
-		    Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
+		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
 		}
 		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
 	    }
 	}
     } else if (newValuePtr != oldValuePtr) {
 	/*
-	 * In this case we are replacing the value, so we don't need to
-	 * do more than swap the objects.
+	 * In this case we are replacing the value, so we don't need to do
+	 * more than swap the objects.
 	 */
 
 	varPtr->value.objPtr = newValuePtr;
-	Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
+	Tcl_IncrRefCount(newValuePtr);		/* Var is another ref. */
 	if (oldValuePtr != NULL) {
-	    TclDecrRefCount(oldValuePtr);   /* discard old value */
+	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
 	}
     }
-    TclSetVarScalar(varPtr);
-    TclClearVarUndefined(varPtr);
-    if (arrayPtr != NULL) {
-	TclClearVarUndefined(arrayPtr);
-    }
 
     /*
      * Invoke any write traces for the variable.
      */
 
-    if ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
-	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
-		| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
+    if ((varPtr->flags & VAR_TRACED_WRITE)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
+		part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+		| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG), index)) {
 	    goto cleanup;
 	}
     }
@@ -1709,7 +1921,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
     /*
      * Return the variable's value unless the variable was changed in some
      * gross way by a trace (e.g. it was unset and then recreated as an
-     * array). 
+     * array).
      */
 
     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
@@ -1720,36 +1932,42 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
      * A trace changed the value in some gross way. Return an empty string
      * object.
      */
-    
+
     resultPtr = iPtr->emptyObjPtr;
 
     /*
-     * If the variable doesn't exist anymore and no-one's using it, then
-     * free up the relevant structures and hash table entries.
+     * If the variable doesn't exist anymore and no-one's using it, then free
+     * up the relevant structures and hash table entries.
      */
 
-    cleanup:
+  cleanup:
     if (TclIsVarUndefined(varPtr)) {
-	CleanupVar(varPtr, arrayPtr);
+	TclCleanupVar(varPtr, arrayPtr);
     }
     return resultPtr;
+
+  earlyError:
+    if (newValuePtr->refCount == 0) {
+	Tcl_DecrRefCount(newValuePtr);
+    }
+    goto cleanup;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclIncrVar2 --
+ * TclIncrObjVar2 --
  *
  *	Given a two-part variable name, which may refer either to a scalar
- *	variable or an element of an array, increment the Tcl object value
- *	of the variable by a specified amount.
+ *	variable or an element of an array, increment the Tcl object value of
+ *	the variable by a specified Tcl_Obj increment value.
  *
  * Results:
  *	Returns a pointer to the Tcl_Obj holding the new value of the
- *	variable. If the specified variable doesn't exist, or there is a
- *	clash in array usage, or an error occurs while executing variable
- *	traces, then NULL is returned and a message will be left in
- *	the interpreter's result.
+ *	variable. If the specified variable doesn't exist, or there is a clash
+ *	in array usage, or an error occurs while executing variable traces,
+ *	then NULL is returned and a message will be left in the interpreter's
+ *	result.
  *
  * Side effects:
  *	The value of the given variable is incremented by the specified
@@ -1757,58 +1975,55 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
  *	variable is created. The ref count for the returned object is _not_
  *	incremented to reflect the returned reference; if you want to keep a
  *	reference to the object you must increment its ref count yourself.
+ *	Callers must Incr part1Ptr if they plan to Decr it.
+ *	Callers must Incr part2Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
-TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be found. */
-    Tcl_Obj *part1Ptr;		/* Points to an object holding the name of
-				 * an array (if part2 is non-NULL) or the
-				 * name of a variable. */
-    Tcl_Obj *part2Ptr;		/* If non-null, points to an object holding
+TclIncrObjVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be found. */
+    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
+				 * array (if part2 is non-NULL) or the name of
+				 * a variable. */
+    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
 				 * the name of an element in the array
 				 * part1Ptr. */
-    long incrAmount;		/* Amount to be added to variable. */
-    int flags;                  /* Various flags that tell how to incr value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+    Tcl_Obj *incrPtr,		/* Amount to be added to variable. */
+    int flags)			/* Various flags that tell how to incr value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
+				 * TCL_LEAVE_ERR_MSG. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1, *part2;
-
-    part1 = TclGetString(part1Ptr);
-    part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
 
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
-	    0, 1, &arrayPtr);
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
+	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
 	Tcl_AddObjErrorInfo(interp,
 		"\n    (reading value of variable to increment)", -1);
 	return NULL;
     }
-    return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,
-	    incrAmount, flags);
+    return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    incrPtr, flags, -1);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclPtrIncrVar --
+ * TclPtrIncrObjVar --
  *
- *	Given the pointers to a variable and possible containing array, 
- *      increment the Tcl object value of the variable by a specified 
- *      amount.
+ *	Given the pointers to a variable and possible containing array,
+ *	increment the Tcl object value of the variable by a Tcl_Obj increment.
  *
  * Results:
  *	Returns a pointer to the Tcl_Obj holding the new value of the
- *	variable. If the specified variable doesn't exist, or there is a
- *	clash in array usage, or an error occurs while executing variable
- *	traces, then NULL is returned and a message will be left in
- *	the interpreter's result.
+ *	variable. If the specified variable doesn't exist, or there is a clash
+ *	in array usage, or an error occurs while executing variable traces,
+ *	then NULL is returned and a message will be left in the interpreter's
+ *	result.
  *
  * Side effects:
  *	The value of the given variable is incremented by the specified
@@ -1821,81 +2036,70 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
  */
 
 Tcl_Obj *
-TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which variable is
-				 * to be found. */
-    Var *varPtr;
-    Var *arrayPtr;
-    CONST char *part1;		/* Points to an object holding the name of
-				 * an array (if part2 is non-NULL) or the
-				 * name of a variable. */
-    CONST char *part2;		/* If non-null, points to an object holding
+TclPtrIncrObjVar(
+    Tcl_Interp *interp,		/* Command interpreter in which variable is to
+				 * be found. */
+    Var *varPtr,		/* Reference to the variable to set. */
+    Var *arrayPtr,		/* Reference to the array containing the
+				 * variable, or NULL if the variable is a
+				 * scalar. */
+    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
+				 * array (if part2 is non-NULL) or the name of
+				 * a variable. */
+    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
 				 * the name of an element in the array
 				 * part1Ptr. */
-    CONST long incrAmount;	/* Amount to be added to variable. */
-    CONST int flags;            /* Various flags that tell how to incr value:
-				 * any of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
-				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
+    Tcl_Obj *incrPtr,		/* Increment value. */
+/* TODO: Which of these flag values really make sense? */
+    const int flags,		/* Various flags that tell how to incr value:
+				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
+				 * TCL_LEAVE_ERR_MSG. */
+    int index)			/* Index into the local variable table of the
+				 * variable, or -1. Only used when part1Ptr is
+				 * NULL. */
 {
     register Tcl_Obj *varValuePtr;
-    int createdNewObj;		/* Set 1 if var's value object is shared
-				 * so we must increment a copy (i.e. copy
-				 * on write). */
-    long i;
-
-    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
 
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    flags, index);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
     if (varValuePtr == NULL) {
-	Tcl_AddObjErrorInfo(interp,
-		"\n    (reading value of variable to increment)", -1);
-	return NULL;
+	varValuePtr = Tcl_NewIntObj(0);
     }
-
-    /*
-     * Increment the variable's value. If the object is unshared we can
-     * modify it directly, otherwise we must create a new copy to modify:
-     * this is "copy on write". Then free the variable's old string
-     * representation, if any, since it will no longer be valid.
-     */
-
-    createdNewObj = 0;
     if (Tcl_IsShared(varValuePtr)) {
+	/* Copy on write */
 	varValuePtr = Tcl_DuplicateObj(varValuePtr);
-	createdNewObj = 1;
-    }
-    if (varValuePtr->typePtr == &tclWideIntType) {
-	Tcl_WideInt wide;
-	TclGetWide(wide,varValuePtr);
-	Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
-    } else if (varValuePtr->typePtr == &tclIntType) {
-	i = varValuePtr->internalRep.longValue;
-	Tcl_SetIntObj(varValuePtr, i + incrAmount);
-    } else {
-	/*
-	 * Not an integer or wide internal-rep...
-	 */
-	Tcl_WideInt wide;
-	if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
-	    if (createdNewObj) {
-		Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
-	    }
+	
+	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		    varValuePtr, flags, index);
+	} else {
+	    Tcl_DecrRefCount(varValuePtr);
 	    return NULL;
 	}
-	if (wide <= Tcl_LongAsWide(LONG_MAX)
-		&& wide >= Tcl_LongAsWide(LONG_MIN)) {
-	    Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);
+    } else {
+	/* Unshared - can Incr in place */
+	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+
+	    /*
+	     * This seems dumb to write the incremeted value into the var
+	     * after we just adjusted the value in place, but the spec for
+	     * [incr] requires that write traces fire, and making this call
+	     * is the way to make that happen.
+	     */
+
+	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		    varValuePtr, flags, index);
 	} else {
-	    Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
+	    return NULL;
 	}
     }
-
-    /*
-     * Store the variable's new value and run any write traces.
-     */
-    
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
-	    varValuePtr, flags);
 }
 
 /*
@@ -1906,30 +2110,30 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
  *	Delete a variable, so that it may not be accessed anymore.
  *
  * Results:
- *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
- *	if the variable can't be unset.  In the event of an error,
- *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
- *	is left in the interp's result.
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ *	the variable can't be unset. In the event of an error, if the
+ *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ *	interp's result.
  *
  * Side effects:
- *	If varName is defined as a local or global variable in interp,
- *	it is deleted.
+ *	If varName is defined as a local or global variable in interp, it is
+ *	deleted.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UnsetVar(interp, varName, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    CONST char *varName;	/* Name of a variable in interp.  May be
-				 * either a scalar name or an array name
-				 * or an element in an array. */
-    int flags;			/* OR-ed combination of any of
+Tcl_UnsetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    const char *varName,	/* Name of a variable in interp. May be either
+				 * a scalar name or an array name or an
+				 * element in an array. */
+    int flags)			/* OR-ed combination of any of
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
+    return Tcl_UnsetVar2(interp, varName, NULL, flags);
 }
 
 /*
@@ -1940,42 +2144,49 @@ Tcl_UnsetVar(interp, varName, flags)
  *	Delete a variable, given a 2-part name.
  *
  * Results:
- *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
- *	if the variable can't be unset.  In the event of an error,
- *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
- *	is left in the interp's result.
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ *	the variable can't be unset. In the event of an error, if the
+ *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ *	interp's result.
  *
  * Side effects:
- *	If part1 and part2 indicate a local or global variable in interp,
- *	it is deleted.  If part1 is an array name and part2 is NULL, then
- *	the whole array is deleted.
+ *	If part1 and part2 indicate a local or global variable in interp, it
+ *	is deleted. If part1 is an array name and part2 is NULL, then the
+ *	whole array is deleted.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UnsetVar2(interp, part1, part2, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    CONST char *part1;		/* Name of variable or array. */
-    CONST char *part2;		/* Name of element within array or NULL. */
-    int flags;			/* OR-ed combination of any of
+Tcl_UnsetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    const char *part1,		/* Name of variable or array. */
+    const char *part2,		/* Name of element within array or NULL. */
+    int flags)			/* OR-ed combination of any of
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part1Ptr;
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+    }
+
+    /*
+     * Filter to pass through only the flags this interface supports.
+     */
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    /* Filter to pass through only the flags this interface supports. */
     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
-    result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);
-    TclDecrRefCount(part1Ptr);
+    result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);
 
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
     return result;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -1985,26 +2196,26 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
  *	Delete a variable, given a 2-object name.
  *
  * Results:
- *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
- *	if the variable can't be unset.  In the event of an error,
- *	if the TCL_LEAVE_ERR_MSG flag is set then an error message
- *	is left in the interp's result.
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ *	the variable can't be unset. In the event of an error, if the
+ *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ *	interp's result.
  *
  * Side effects:
- *	If part1ptr and part2Ptr indicate a local or global variable in interp,
- *	it is deleted.  If part1Ptr is an array name and part2Ptr is NULL, then
- *	the whole array is deleted.
+ *	If part1ptr and part2Ptr indicate a local or global variable in
+ *	interp, it is deleted. If part1Ptr is an array name and part2Ptr is
+ *	NULL, then the whole array is deleted.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclObjUnsetVar2(interp, part1Ptr, part2, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    Tcl_Obj *part1Ptr;		/* Name of variable or array. */
-    CONST char *part2;		/* Name of element within array or NULL. */
-    int flags;			/* OR-ed combination of any of
+TclObjUnsetVar2(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    Tcl_Obj *part1Ptr,		/* Name of variable or array. */
+    Tcl_Obj *part2Ptr,		/* Name of element within array or NULL. */
+    int flags)			/* OR-ed combination of any of
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
@@ -2012,49 +2223,51 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
     Interp *iPtr = (Interp *) interp;
     Var *arrayPtr;
     int result;
-    char *part1;
 
-    part1 = TclGetString(part1Ptr);
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
- 
+
     result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
 
     /*
      * Keep the variable alive until we're done with it. We used to
-     * increase/decrease the refCount for each operation, making it
-     * hard to find [Bug 735335] - caused by unsetting the variable
-     * whose value was the variable's name.
+     * increase/decrease the refCount for each operation, making it hard to
+     * find [Bug 735335] - caused by unsetting the variable whose value was
+     * the variable's name.
      */
-    
-    varPtr->refCount++;
 
-    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);
 
     /*
      * It's an error to unset an undefined variable.
      */
-	
+
     if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    VarErrMsg(interp, part1, part2, "unset", 
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
 	}
     }
 
+#if ENABLE_NS_VARNAME_CACHING
     /*
-     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType 
+     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
      * keeping a reference. This removes some additional exteriorisations of
      * [Bug 736729], but may be a good thing independently of the bug.
      */
 
     if (part1Ptr->typePtr == &tclNsVarNameType) {
-	part1Ptr->typePtr->freeIntRepProc(part1Ptr);
+	TclFreeIntRep(part1Ptr);
 	part1Ptr->typePtr = NULL;
     }
+#endif
 
     /*
      * Finally, if the variable is truly not in use then free up its Var
@@ -2062,8 +2275,10 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
      * its value object, if any, was decremented above.
      */
 
-    varPtr->refCount--;
-    CleanupVar(varPtr, arrayPtr);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+	CleanupVar(varPtr, arrayPtr);
+    }
     return result;
 }
 
@@ -2081,492 +2296,166 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags)
  *
  * Side effects:
  *	If the arguments indicate a local or global variable in iPtr, it is
- *      unset and deleted.   
+ *	unset and deleted.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags)
-    Var *varPtr;
-    Var *arrayPtr;
-    Interp *iPtr;
-    CONST char *part1;
-    CONST char *part2;
-    int flags;
+UnsetVarStruct(
+    Var *varPtr,
+    Var *arrayPtr,
+    Interp *iPtr,
+    Tcl_Obj *part1Ptr,
+    Tcl_Obj *part2Ptr,
+    int flags)
 {
     Var dummyVar;
-    Var *dummyVarPtr;
-    ActiveVarTrace *activePtr;
+    int traced = TclIsVarTraced(varPtr)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET));
 
-    if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
-	DeleteSearches(arrayPtr);
+    if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
+	DeleteSearches(iPtr, arrayPtr);
+    } else if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	DeleteSearches(iPtr, varPtr);
     }
 
     /*
-     * For global/upvar variables referenced in procedures, decrement
-     * the reference count on the variable referred to, and free
-     * the referenced variable if it's no longer needed. 
-     */
-
-    if (TclIsVarLink(varPtr)) {
-	Var *linkPtr = varPtr->value.linkPtr;
-	linkPtr->refCount--;
-	if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
-		&& (linkPtr->tracePtr == NULL)
-		&& (linkPtr->flags & VAR_IN_HASHTABLE)) {
-	    if (linkPtr->hPtr != NULL) {
-		Tcl_DeleteHashEntry(linkPtr->hPtr);
-	    }
-	    ckfree((char *) linkPtr);
-	}
-    }
-
-    /*
-     * The code below is tricky, because of the possibility that
-     * a trace procedure might try to access a variable being
-     * deleted. To handle this situation gracefully, do things
-     * in three steps:
-     * 1. Copy the contents of the variable to a dummy variable
-     *    structure, and mark the original Var structure as undefined.
+     * The code below is tricky, because of the possibility that a trace
+     * function might try to access a variable being deleted. To handle this
+     * situation gracefully, do things in three steps:
+     * 1. Copy the contents of the variable to a dummy variable structure, and
+     *    mark the original Var structure as undefined.
      * 2. Invoke traces and clean up the variable, using the dummy copy.
-     * 3. If at the end of this the original variable is still
-     *    undefined and has no outstanding references, then delete
-     *	  it (but it could have gotten recreated by a trace).
+     * 3. If at the end of this the original variable is still undefined and
+     *    has no outstanding references, then delete it (but it could have
+     *    gotten recreated by a trace).
      */
 
     dummyVar = *varPtr;
+    dummyVar.flags &= ~VAR_ALL_HASH;
     TclSetVarUndefined(varPtr);
-    TclSetVarScalar(varPtr);
-    varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
-    varPtr->tracePtr = NULL;
-    varPtr->searchPtr = NULL;
 
     /*
-     * Call trace procedures for the variable being deleted. Then delete
-     * its traces. Be sure to abort any other traces for the variable
-     * that are still pending. Special tricks:
-     * 1. We need to increment varPtr's refCount around this: CallVarTraces
+     * Call trace functions for the variable being deleted. Then delete its
+     * traces. Be sure to abort any other traces for the variable that are
+     * still pending. Special tricks:
+     * 1. We need to increment varPtr's refCount around this: TclCallVarTraces
      *    will use dummyVar so it won't increment varPtr's refCount itself.
-     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
-     *    call unset traces even if other traces are pending.
+     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call
+     *    unset traces even if other traces are pending.
      */
 
-    if ((dummyVar.tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	dummyVar.flags &= ~VAR_TRACE_ACTIVE;
-	CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
-		| TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);
-	while (dummyVar.tracePtr != NULL) {
-	    VarTrace *tracePtr = dummyVar.tracePtr;
-	    dummyVar.tracePtr = tracePtr->nextPtr;
-	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
-	}
-	for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
-	     activePtr = activePtr->nextPtr) {
-	    if (activePtr->varPtr == varPtr) {
-		activePtr->nextTracePtr = NULL;
-	    }
-	}
-    }
-
-    /*
-     * If the variable is an array, delete all of its elements. This must be
-     * done after calling the traces on the array, above (that's the way
-     * traces are defined). If it is a scalar, "discard" its object
-     * (decrement the ref count of its object, if any).
-     */
+    if (traced) {
+	VarTrace *tracePtr = NULL;
+	Tcl_HashEntry *tPtr = NULL;
 
-    dummyVarPtr = &dummyVar;
-    if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
-	DeleteArray(iPtr, part1, dummyVarPtr, (flags
-		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
-    }
-    if (TclIsVarScalar(dummyVarPtr)
-	    && (dummyVarPtr->value.objPtr != NULL)) {
-	Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;
-	TclDecrRefCount(objPtr);
-	dummyVarPtr->value.objPtr = NULL;
-    }
-
-    /*
-     * If the variable was a namespace variable, decrement its reference count.
-     */
-    
-    if (varPtr->flags & VAR_NAMESPACE_VAR) {
-	varPtr->flags &= ~VAR_NAMESPACE_VAR;
-	varPtr->refCount--;
-    }
-
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_TraceVar --
- *
- *	Arrange for reads and/or writes to a variable to cause a
- *	procedure to be invoked, which can monitor the operations
- *	and/or change their actions.
- *
- * Results:
- *	A standard Tcl return value.
- *
- * Side effects:
- *	A trace is set up on the variable given by varName, such that
- *	future references to the variable will be intermediated by
- *	proc.  See the manual entry for complete details on the calling
- *	sequence for proc.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_TraceVar(interp, varName, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which variable is
-				 * to be traced. */
-    CONST char *varName;	/* Name of variable;  may end with "(index)"
-				 * to signify an array reference. */
-    int flags;			/* OR-ed collection of bits, including any
-				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
-				 * TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
-				 * invoked upon varName. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
-{
-    return Tcl_TraceVar2(interp, varName, (char *) NULL, 
-	    flags, proc, clientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_TraceVar2 --
- *
- *	Arrange for reads and/or writes to a variable to cause a
- *	procedure to be invoked, which can monitor the operations
- *	and/or change their actions.
- *
- * Results:
- *	A standard Tcl return value.
- *
- * Side effects:
- *	A trace is set up on the variable given by part1 and part2, such
- *	that future references to the variable will be intermediated by
- *	proc.  See the manual entry for complete details on the calling
- *	sequence for proc.
- *
- *----------------------------------------------------------------------
- */
+	if (TclIsVarTraced(&dummyVar)) {
+	    /*
+	     * Transfer any existing traces on var, IF there are unset traces.
+	     * Otherwise just delete them.
+	     */
 
-int
-Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which variable is
-				 * to be traced. */
-    CONST char *part1;		/* Name of scalar variable or array. */
-    CONST char *part2;		/* Name of element within array;  NULL means
-				 * trace applies to scalar variable or array
-				 * as-a-whole. */
-    int flags;			/* OR-ed collection of bits, including any
-				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
-				 * and TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are
-				 * invoked upon varName. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
-{
-    Var *varPtr, *arrayPtr;
-    register VarTrace *tracePtr;
-    int flagMask;
-    
-    /* 
-     * We strip 'flags' down to just the parts which are relevant to
-     * TclLookupVar, to avoid conflicts between trace flags and
-     * internal namespace flags such as 'FIND_ONLY_NS'.  This can
-     * now occur since we have trace flags with values 0x1000 and higher.
-     */
-    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
-    varPtr = TclLookupVar(interp, part1, part2,
-	    (flags & flagMask) | TCL_LEAVE_ERR_MSG,
-	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-    if (varPtr == NULL) {
-	return TCL_ERROR;
-    }
+	    int isNew;
+	    Tcl_HashEntry *tPtr =
+		    Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+
+	    tracePtr = Tcl_GetHashValue(tPtr);
+	    varPtr->flags &= ~VAR_ALL_TRACES;
+	    Tcl_DeleteHashEntry(tPtr);
+	    if (dummyVar.flags & VAR_TRACED_UNSET) {
+		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
+			(char *) &dummyVar, &isNew);
+		Tcl_SetHashValue(tPtr, tracePtr);
+	    } else {
+		tPtr = NULL;
+	    }
+	}
 
-    /*
-     * Check for a nonsense flag combination.  Note that this is a
-     * panic() because there should be no code path that ever sets
-     * both flags.
-     */
-    if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
-	panic("bad result flag combination");
-    }
+	if ((dummyVar.flags & VAR_TRACED_UNSET)
+		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
+	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
+	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
+		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+			    | TCL_TRACE_UNSETS,
+		    /* leaveErrMsg */ 0, -1);
 
-    /*
-     * Set up trace information.
-     */
+	    /*
+	     * The traces that we just called may have triggered a change in
+	     * the set of traces. [Bug 2629338]
+	     */
 
-    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
-	TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-    flagMask |= TCL_TRACE_OLD_STYLE;
-#endif
-    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
-    tracePtr->traceProc		= proc;
-    tracePtr->clientData	= clientData;
-    tracePtr->flags		= flags & flagMask;
-    tracePtr->nextPtr		= varPtr->tracePtr;
-    varPtr->tracePtr		= tracePtr;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_UntraceVar --
- *
- *	Remove a previously-created trace for a variable.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If there exists a trace for the variable given by varName
- *	with the given flags, proc, and clientData, then that trace
- *	is removed.
- *
- *----------------------------------------------------------------------
- */
+	    tracePtr = NULL;
+	    if (TclIsVarTraced(&dummyVar)) {
+		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) &dummyVar);
+		tracePtr = Tcl_GetHashValue(tPtr);
+	    }
 
-void
-Tcl_UntraceVar(interp, varName, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *varName;	/* Name of variable; may end with "(index)"
-				 * to signify an array reference. */
-    int flags;			/* OR-ed collection of bits describing
-				 * current trace, including any of
-				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY
-				 * and TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
-{
-    Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_UntraceVar2 --
- *
- *	Remove a previously-created trace for a variable.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If there exists a trace for the variable given by part1
- *	and part2 with the given flags, proc, and clientData, then
- *	that trace is removed.
- *
- *----------------------------------------------------------------------
- */
+	    if (tPtr) {
+		Tcl_DeleteHashEntry(tPtr);
+	    }
+	}
 
-void
-Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *part1;		/* Name of variable or array. */
-    CONST char *part2;		/* Name of element within array;  NULL means
-				 * trace applies to scalar variable or array
-				 * as-a-whole. */
-    int flags;			/* OR-ed collection of bits describing
-				 * current trace, including any of
-				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
-				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
-				 * and TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData clientData;	/* Arbitrary argument to pass to proc. */
-{
-    register VarTrace *tracePtr;
-    VarTrace *prevPtr;
-    Var *varPtr, *arrayPtr;
-    Interp *iPtr = (Interp *) interp;
-    ActiveVarTrace *activePtr;
-    int flagMask;
-    
-    /*
-     * Set up a mask to mask out the parts of the flags that we are not
-     * interested in now.
-     */
-    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
-    varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
-	    /*msg*/ (char *) NULL,
-	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-    if (varPtr == NULL) {
-	return;
-    }
+	if (tracePtr) {
+	    ActiveVarTrace *activePtr;
 
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
 
-    /*
-     * Set up a mask to mask out the parts of the flags that we are not
-     * interested in now.
-     */
-    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; 
-#ifndef TCL_REMOVE_OBSOLETE_TRACES
-    flagMask |= TCL_TRACE_OLD_STYLE;
-#endif
-    flags &= flagMask;
-    for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;
-	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
-	if (tracePtr == NULL) {
-	    return;
-	}
-	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
-		&& (tracePtr->clientData == clientData)) {
-	    break;
+		tracePtr = tracePtr->nextPtr;
+		prevPtr->nextPtr = NULL;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+	    }
+	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
+		    activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	    dummyVar.flags &= ~VAR_ALL_TRACES;
 	}
     }
 
-    /*
-     * The code below makes it possible to delete traces while traces
-     * are active: it makes sure that the deleted trace won't be
-     * processed by CallVarTraces.
-     */
-
-    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
-	 activePtr = activePtr->nextPtr) {
-	if (activePtr->nextTracePtr == tracePtr) {
-	    activePtr->nextTracePtr = tracePtr->nextPtr;
-	}
-    }
-    if (prevPtr == NULL) {
-	varPtr->tracePtr = tracePtr->nextPtr;
-    } else {
-	prevPtr->nextPtr = tracePtr->nextPtr;
-    }
-    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+    if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) {
+	/*
+	 * Decrement the ref count of the var's value.
+	 */
 
-    /*
-     * If this is the last trace on the variable, and the variable is
-     * unset and unused, then free up the variable.
-     */
+	Tcl_Obj *objPtr = dummyVar.value.objPtr;
 
-    if (TclIsVarUndefined(varPtr)) {
-	CleanupVar(varPtr, (Var *) NULL);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_VarTraceInfo --
- *
- *	Return the clientData value associated with a trace on a
- *	variable.  This procedure can also be used to step through
- *	all of the traces on a particular variable that have the
- *	same trace procedure.
- *
- * Results:
- *	The return value is the clientData value associated with
- *	a trace on the given variable.  Information will only be
- *	returned for a trace with proc as trace procedure.  If
- *	the clientData argument is NULL then the first such trace is
- *	returned;  otherwise, the next relevant one after the one
- *	given by clientData will be returned.  If the variable
- *	doesn't exist, or if there are no (more) traces for it,
- *	then NULL is returned.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	TclDecrRefCount(objPtr);
+    } else if (TclIsVarArray(&dummyVar)) {
+	/*
+	 * If the variable is an array, delete all of its elements. This must
+	 * be done after calling and deleting the traces on the array, above
+	 * (that's the way traces are defined). If the array name is not
+	 * present and is required for a trace on some element, it will be
+	 * computed at DeleteArray.
+	 */
 
-ClientData
-Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *varName;	/* Name of variable;  may end with "(index)"
-				 * to signify an array reference. */
-    int flags;			/* OR-ed combo or TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY (can be 0). */
-    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData prevClientData;	/* If non-NULL, gives last value returned
-				 * by this procedure, so this call will
-				 * return the next trace after that one.
-				 * If NULL, this call will return the
-				 * first trace. */
-{
-    return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
-	    flags, proc, prevClientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_VarTraceInfo2 --
- *
- *	Same as Tcl_VarTraceInfo, except takes name in two pieces
- *	instead of one.
- *
- * Results:
- *	Same as Tcl_VarTraceInfo.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
+		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+    } else if (TclIsVarLink(&dummyVar)) {
+	/*
+	 * For global/upvar variables referenced in procedures, decrement the
+	 * reference count on the variable referred to, and free the
+	 * referenced variable if it's no longer needed.
+	 */
 
-ClientData
-Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST char *part1;		/* Name of variable or array. */
-    CONST char *part2;		/* Name of element within array;  NULL means
-				 * trace applies to scalar variable or array
-				 * as-a-whole. */
-    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
-				 * TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */
-    ClientData prevClientData;	/* If non-NULL, gives last value returned
-				 * by this procedure, so this call will
-				 * return the next trace after that one.
-				 * If NULL, this call will return the
-				 * first trace. */
-{
-    register VarTrace *tracePtr;
-    Var *varPtr, *arrayPtr;
+	Var *linkPtr = dummyVar.value.linkPtr;
 
-    varPtr = TclLookupVar(interp, part1, part2,
-	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
-	    /*msg*/ (char *) NULL,
-	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-    if (varPtr == NULL) {
-	return NULL;
+	if (TclIsVarInHash(linkPtr)) {
+	    VarHashRefCount(linkPtr)--;
+	    CleanupVar(linkPtr, NULL);
+	}
     }
 
     /*
-     * Find the relevant trace, if any, and return its clientData.
+     * If the variable was a namespace variable, decrement its reference
+     * count.
      */
 
-    tracePtr = varPtr->tracePtr;
-    if (prevClientData != NULL) {
-	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
-	    if ((tracePtr->clientData == prevClientData)
-		    && (tracePtr->traceProc == proc)) {
-		tracePtr = tracePtr->nextPtr;
-		break;
-	    }
-	}
-    }
-    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
-	if (tracePtr->traceProc == proc) {
-	    return tracePtr->clientData;
-	}
-    }
-    return NULL;
+    TclClearVarNamespaceVar(varPtr);
 }
 
 /*
@@ -2574,7 +2463,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
  *
  * Tcl_UnsetObjCmd --
  *
- *	This object-based procedure is invoked to process the "unset" Tcl
+ *	This object-based function is invoked to process the "unset" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -2588,49 +2477,47 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
 
 	/* ARGSUSED */
 int
-Tcl_UnsetObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_UnsetObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register int i, flags = TCL_LEAVE_ERR_MSG;
     register char *name;
 
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-nocomplain? ?--? ?varName varName ...?");
-	return TCL_ERROR;
-    } else if (objc == 1) {
+    if (objc == 1) {
 	/*
-	 * Do nothing if no arguments supplied, so as to match
-	 * command documentation.
+	 * Do nothing if no arguments supplied, so as to match command
+	 * documentation.
 	 */
+
 	return TCL_OK;
     }
 
     /*
-     * Simple, restrictive argument parsing.  The only options are --
-     * and -nocomplain (which must come first and be given exactly to
-     * be an option).
+     * Simple, restrictive argument parsing. The only options are -- and
+     * -nocomplain (which must come first and be given exactly to be an
+     * option).
      */
+
     i = 1;
     name = TclGetString(objv[i]);
     if (name[0] == '-') {
- 	if (strcmp("-nocomplain", name) == 0) {
+	if (strcmp("-nocomplain", name) == 0) {
 	    i++;
- 	    if (i == objc) {
+	    if (i == objc) {
 		return TCL_OK;
 	    }
- 	    flags = 0;
- 	    name = TclGetString(objv[i]);
- 	}
- 	if (strcmp("--", name) == 0) {
- 	    i++;
- 	}
+	    flags = 0;
+	    name = TclGetString(objv[i]);
+	}
+	if (strcmp("--", name) == 0) {
+	    i++;
+	}
     }
 
-    for (; i < objc;  i++) {
+    for (; i < objc; i++) {
 	if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
 		&& (flags == TCL_LEAVE_ERR_MSG)) {
 	    return TCL_ERROR;
@@ -2644,8 +2531,8 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_AppendObjCmd --
  *
- *	This object-based procedure is invoked to process the "append" 
- *	Tcl command. See the user documentation for details on what it does.
+ *	This object-based function is invoked to process the "append" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -2658,18 +2545,15 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_AppendObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_AppendObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1;
-
     register Tcl_Obj *varValuePtr = NULL;
-    					/* Initialized to avoid compiler
-				         * warning. */
+				/* Initialized to avoid compiler warning. */
     int i;
 
     if (objc < 2) {
@@ -2678,27 +2562,26 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
     }
 
     if (objc == 2) {
-	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
 	if (varValuePtr == NULL) {
 	    return TCL_ERROR;
 	}
     } else {
-	varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	part1 = TclGetString(objv[1]);
 	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	for (i = 2;  i < objc;  i++) {	  
+	for (i=2 ; i<objc ; i++) {
 	    /*
-	     * Note that we do not need to increase the refCount of
-	     * the Var pointers: should a trace delete the variable,
-	     * the return value of TclPtrSetVar will be NULL, and we 
-	     * will not access the variable again.
+	     * Note that we do not need to increase the refCount of the Var
+	     * pointers: should a trace delete the variable, the return value
+	     * of TclPtrSetVar will be NULL or emptyObjPtr, and we will not
+	     * access the variable again.
 	     */
 
-	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
-	            objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
+	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1],
+		    NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1);
 	    if ((varValuePtr == NULL) ||
 		    (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
 		return TCL_ERROR;
@@ -2714,8 +2597,8 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_LappendObjCmd --
  *
- *	This object-based procedure is invoked to process the "lappend" 
- *	Tcl command. See the user documentation for details on what it does.
+ *	This object-based function is invoked to process the "lappend" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -2728,157 +2611,114 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_LappendObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_LappendObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *varValuePtr, *newValuePtr;
-    register List *listRepPtr;
-    register Tcl_Obj **elemPtrs;
-    int numElems, numRequired, createdNewObj, i, j;
+    int numElems, createdNewObj;
     Var *varPtr, *arrayPtr;
-    char *part1;
+    int result;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
 	return TCL_ERROR;
     }
     if (objc == 2) {
-	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0);
+	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
 	if (newValuePtr == NULL) {
 	    /*
 	     * The variable doesn't exist yet. Just create it with an empty
 	     * initial value.
 	     */
-	    
-	    varValuePtr = Tcl_NewObj();
-	    Tcl_IncrRefCount(varValuePtr);
+
+	    TclNewObj(varValuePtr);
 	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
 		    TCL_LEAVE_ERR_MSG);
-	    Tcl_DecrRefCount(varValuePtr);
 	    if (newValuePtr == NULL) {
 		return TCL_ERROR;
 	    }
 	} else {
-	    int result;
-	    
-	    result = Tcl_ListObjLength(interp, newValuePtr, &numElems);
+	    result = TclListObjLength(interp, newValuePtr, &numElems);
 	    if (result != TCL_OK) {
 		return result;
 	    }
-	}	    
+	}
     } else {
 	/*
-	 * We have arguments to append. We used to call Tcl_SetVar2 to
-	 * append each argument one at a time to ensure that traces were run
-	 * for each append step. We now append the arguments all at once
-	 * because it's faster. Note that a read trace and a write trace for
-	 * the variable will now each only be called once. Also, if the
-	 * variable's old value is unshared we modify it directly, otherwise
-	 * we create a new copy to modify: this is "copy on write".
-	 *
-	 * Note that you have to protect the variable pointers around
-	 * the TclPtrGetVar call to insure that they remain valid 
-	 * even if the variable was undefined and unused.
+	 * We have arguments to append. We used to call Tcl_SetVar2 to append
+	 * each argument one at a time to ensure that traces were run for each
+	 * append step. We now append the arguments all at once because it's
+	 * faster. Note that a read trace and a write trace for the variable
+	 * will now each only be called once. Also, if the variable's old
+	 * value is unshared we modify it directly, otherwise we create a new
+	 * copy to modify: this is "copy on write".
+	 */
+
+	createdNewObj = 0;
+
+	/*
+	 * Protect the variable pointers around the TclPtrGetVar call
+	 * to insure that they remain valid even if the variable was undefined
+	 * and unused.
 	 */
 
-	varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	varPtr->refCount++;
-	if (arrayPtr != NULL) {
-	    arrayPtr->refCount++;
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
 	}
-	part1 = TclGetString(objv[1]);
-	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, 
-	        TCL_LEAVE_ERR_MSG);
-	varPtr->refCount--;
-	if (arrayPtr != NULL) {
-	    arrayPtr->refCount--;
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)++;
+	}
+	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+		TCL_LEAVE_ERR_MSG, -1);
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)--;
 	}
 
-	createdNewObj = 0;
 	if (varValuePtr == NULL) {
 	    /*
 	     * We couldn't read the old value: either the var doesn't yet
-	     * exist or it's an array element.  If it's new, we will try to
+	     * exist or it's an array element. If it's new, we will try to
 	     * create it with Tcl_ObjSetVar2 below.
 	     */
-	    
-	    varValuePtr = Tcl_NewObj();
+
+	    TclNewObj(varValuePtr);
 	    createdNewObj = 1;
-	} else if (Tcl_IsShared(varValuePtr)) {	
+	} else if (Tcl_IsShared(varValuePtr)) {
 	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
 	    createdNewObj = 1;
 	}
 
-	/*
-	 * Convert the variable's old value to a list object if necessary.
-	 */
-
-	if (varValuePtr->typePtr != &tclListType) {
-	    int result = tclListType.setFromAnyProc(interp, varValuePtr);
-	    if (result != TCL_OK) {
-		if (createdNewObj) {
-		    Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
-		}
-		return result;
-	    }
+	result = TclListObjLength(interp, varValuePtr, &numElems);
+	if (result == TCL_OK) {
+	    result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
+		    (objc-2), (objv+2));
 	}
-	listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
-	elemPtrs = listRepPtr->elements;
-	numElems = listRepPtr->elemCount;
-
-	/*
-	 * If there is no room in the current array of element pointers,
-	 * allocate a new, larger array and copy the pointers to it.
-	 */
-	
-	numRequired = numElems + (objc-2);
-	if (numRequired > listRepPtr->maxElemCount) {
-	    int newMax = (2 * numRequired);
-	    Tcl_Obj **newElemPtrs = (Tcl_Obj **)
-		ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-	    
-	    memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
-		    (size_t) (numElems * sizeof(Tcl_Obj *)));
-	    listRepPtr->maxElemCount = newMax;
-	    listRepPtr->elements = newElemPtrs;
-	    ckfree((char *) elemPtrs);
-	    elemPtrs = newElemPtrs;
+	if (result != TCL_OK) {
+	    if (createdNewObj) {
+		TclDecrRefCount(varValuePtr); /* Free unneeded obj. */
+	    }
+	    return result;
 	}
 
 	/*
-	 * Insert the new elements at the end of the list.
-	 */
-
-	for (i = 2, j = numElems;  i < objc;  i++, j++) {
-            elemPtrs[j] = objv[i];
-            Tcl_IncrRefCount(objv[i]);
-        }
-	listRepPtr->elemCount = numRequired;
-
-	/*
-	 * Invalidate and free any old string representation since it no
-	 * longer reflects the list's internal representation.
-	 */
-
-	Tcl_InvalidateStringRep(varValuePtr);
-
-	/*
 	 * Now store the list object back into the variable. If there is an
-	 * error setting the new value, decrement its ref count if it
-	 * was new and we didn't create the variable.
+	 * error setting the new value, decrement its ref count if it was new
+	 * and we didn't create the variable.
 	 */
-	
-	Tcl_IncrRefCount(varValuePtr);
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
-	            varValuePtr, TCL_LEAVE_ERR_MSG);	
-	Tcl_DecrRefCount(varValuePtr);
+
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+		varValuePtr, TCL_LEAVE_ERR_MSG, -1);
 	if (newValuePtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -2898,7 +2738,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_ArrayObjCmd --
  *
- *	This object-based procedure is invoked to process the "array" Tcl
+ *	This object-based function is invoked to process the "array" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -2912,34 +2752,34 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_ArrayObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_ArrayObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     /*
      * The list of constants below should match the arrayOptions string array
      * below.
      */
 
-    enum {ARRAY_ANYMORE, ARRAY_DONESEARCH,  ARRAY_EXISTS, ARRAY_GET,
-	  ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
-	  ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; 
-    static CONST char *arrayOptions[] = {
+    enum {
+	ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
+	ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
+	ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET
+    };
+    static const char *arrayOptions[] = {
 	"anymore", "donesearch", "exists", "get", "names", "nextelement",
-	"set", "size", "startsearch", "statistics", "unset", (char *) NULL
+	"set", "size", "startsearch", "statistics", "unset", NULL
     };
 
     Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
     Tcl_HashEntry *hPtr;
-    Tcl_Obj *resultPtr, *varNamePtr;
+    Tcl_Obj *varNamePtr;
     int notArray;
-    char *varName;
     int index, result;
 
-
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
 	return TCL_ERROR;
@@ -2947,36 +2787,35 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 
     if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
 	    0, &index) != TCL_OK) {
-    	return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Locate the array variable
      */
-    
+
     varNamePtr = objv[2];
-    varName = TclGetString(varNamePtr);
-    varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0,
-            /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
     /*
-     * Special array trace used to keep the env array in sync for
-     * array names, array get, etc.
+     * Special array trace used to keep the env array in sync for array names,
+     * array get, etc.
      */
 
-    if (varPtr != NULL && varPtr->tracePtr != NULL
+    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL,
+	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, NULL,
 		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
+		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Verify that it is indeed an array variable. This test comes after
-     * the traces - the variable may actually become an array as an effect 
-     * of said traces.
+     * Verify that it is indeed an array variable. This test comes after the
+     * traces - the variable may actually become an array as an effect of said
+     * traces.
      */
 
     notArray = 0;
@@ -2985,424 +2824,505 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 	notArray = 1;
     }
 
-    /*
-     * We have to wait to get the resultPtr until here because
-     * CallVarTraces can affect the result.
-     */
+    switch (index) {
+    case ARRAY_ANYMORE: {
+	ArraySearch *searchPtr;
 
-    resultPtr = Tcl_GetObjResult(interp);
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    goto error;
+	}
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
+	if (searchPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	while (1) {
+	    Var *varPtr2;
 
-    switch (index) {
-        case ARRAY_ANYMORE: {
-	    ArraySearch *searchPtr;
-	    
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, 
-                        "arrayName searchId");
-		return TCL_ERROR;
-	    }
-	    if (notArray) {
-	        goto error;
+	    if (searchPtr->nextEntry != NULL) {
+		varPtr2 = VarHashGetValue(searchPtr->nextEntry);
+		if (!TclIsVarUndefined(varPtr2)) {
+		    break;
+		}
 	    }
-	    searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
-	    if (searchPtr == NULL) {
-	        return TCL_ERROR;
+	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
+	    if (searchPtr->nextEntry == NULL) {
+		Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
+		return TCL_OK;
 	    }
-	    while (1) {
-	        Var *varPtr2;
+	}
+	Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]);
+	break;
+    }
+    case ARRAY_DONESEARCH: {
+	ArraySearch *searchPtr, *prevPtr;
 
-		if (searchPtr->nextEntry != NULL) {
-		    varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
-		    if (!TclIsVarUndefined(varPtr2)) {
-		        break;
-		    }
-		}
-		searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
-		if (searchPtr->nextEntry == NULL) {
-		    Tcl_SetIntObj(resultPtr, 0);
-		    return TCL_OK;
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    goto error;
+	}
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
+	if (searchPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	hPtr = Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
+	if (searchPtr == Tcl_GetHashValue(hPtr)) {
+	    if (searchPtr->nextPtr) {
+		Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
+	    } else {
+		varPtr->flags &= ~VAR_SEARCH_ACTIVE;
+		Tcl_DeleteHashEntry(hPtr);
+	    }
+	} else {
+	    for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+		if (prevPtr->nextPtr == searchPtr) {
+		    prevPtr->nextPtr = searchPtr->nextPtr;
+		    break;
 		}
 	    }
-	    Tcl_SetIntObj(resultPtr, 1);
-	    break;
 	}
-        case ARRAY_DONESEARCH: {
-	    ArraySearch *searchPtr, *prevPtr;
+	ckfree((char *) searchPtr);
+	break;
+    }
+    case ARRAY_NEXTELEMENT: {
+	ArraySearch *searchPtr;
+	Tcl_HashEntry *hPtr;
+	Var *varPtr2;
 
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, 
-                        "arrayName searchId");
-		return TCL_ERROR;
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    goto error;
+	}
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
+	if (searchPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	while (1) {
+	    hPtr = searchPtr->nextEntry;
+	    if (hPtr == NULL) {
+		hPtr = Tcl_NextHashEntry(&searchPtr->search);
+		if (hPtr == NULL) {
+		    return TCL_OK;
+		}
+	    } else {
+		searchPtr->nextEntry = NULL;
 	    }
-	    if (notArray) {
-	        goto error;
+	    varPtr2 = VarHashGetValue(hPtr);
+	    if (!TclIsVarUndefined(varPtr2)) {
+		break;
 	    }
-	    searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
-	    if (searchPtr == NULL) {
-	        return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, VarHashGetKey(varPtr2));
+	break;
+    }
+    case ARRAY_STARTSEARCH: {
+	ArraySearch *searchPtr;
+	int isNew;
+	char *varName = TclGetString(varNamePtr);
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    goto error;
+	}
+	searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
+	hPtr = Tcl_CreateHashEntry(&iPtr->varSearches,
+		(char *) varPtr, &isNew);
+	if (isNew) {
+	    searchPtr->id = 1;
+	    Tcl_AppendResult(interp, "s-1-", varName, NULL);
+	    varPtr->flags |= VAR_SEARCH_ACTIVE;
+	    searchPtr->nextPtr = NULL;
+	} else {
+	    char string[TCL_INTEGER_SPACE];
+
+	    searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
+	    TclFormatInt(string, searchPtr->id);
+	    Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
+	    searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+	}
+	searchPtr->varPtr = varPtr;
+	searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
+		&searchPtr->search);
+	Tcl_SetHashValue(hPtr, searchPtr);
+	break;
+    }
+
+    case ARRAY_EXISTS:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
+	break;
+    case ARRAY_GET: {
+	Tcl_HashSearch search;
+	Var *varPtr2;
+	char *pattern = NULL;
+	char *name;
+	Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
+	int i, count;
+
+	if ((objc != 3) && (objc != 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    return TCL_OK;
+	}
+	if (objc == 4) {
+	    pattern = TclGetString(objv[3]);
+	}
+
+	/*
+	 * Store the array names in a new object.
+	 */
+
+	TclNewObj(nameLstPtr);
+	Tcl_IncrRefCount(nameLstPtr);
+	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
+	    if (varPtr2 == NULL) {
+		goto searchDone;
 	    }
-	    if (varPtr->searchPtr == searchPtr) {
-	        varPtr->searchPtr = searchPtr->nextPtr;
-	    } else {
-	        for (prevPtr = varPtr->searchPtr;  ;
-		     prevPtr = prevPtr->nextPtr) {
-		    if (prevPtr->nextPtr == searchPtr) {
-		        prevPtr->nextPtr = searchPtr->nextPtr;
-			break;
-		    }
-		}
+	    if (TclIsVarUndefined(varPtr2)) {
+		goto searchDone;
 	    }
-	    ckfree((char *) searchPtr);
-	    break;
-	}
-        case ARRAY_EXISTS: {
-	    if (objc != 3) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
-	        return TCL_ERROR;
+	    result = Tcl_ListObjAppendElement(interp, nameLstPtr,
+		    VarHashGetKey(varPtr2));
+	    if (result != TCL_OK) {
+		TclDecrRefCount(nameLstPtr);
+		return result;
 	    }
-	    Tcl_SetIntObj(resultPtr, !notArray);
-	    break;
+	    goto searchDone;
 	}
-        case ARRAY_GET: {
-	    Tcl_HashSearch search;
-	    Var *varPtr2;
-	    char *pattern = NULL;
-	    char *name;
-	    Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
-	    int i, count;
-	    
-	    if ((objc != 3) && (objc != 4)) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
-		return TCL_ERROR;
-	    }
-	    if (notArray) {
-	        return TCL_OK;
+	for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
+		varPtr2; varPtr2 = VarHashNextVar(&search)) {
+	    if (TclIsVarUndefined(varPtr2)) {
+		continue;
 	    }
-	    if (objc == 4) {
-	        pattern = TclGetString(objv[3]);
+	    namePtr = VarHashGetKey(varPtr2);
+	    name = TclGetString(namePtr);
+	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
+		continue;	/* Element name doesn't match pattern. */
 	    }
 
-	    /*
-	     * Store the array names in a new object.
-	     */
+	    result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr);
+	    if (result != TCL_OK) {
+		TclDecrRefCount(nameLstPtr);
+		return result;
+	    }
+	}
 
-	    nameLstPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount(nameLstPtr);
+    searchDone:
+	/*
+	 * Make sure the Var structure of the array is not removed by a trace
+	 * while we're working.
+	 */
 
-	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
-	        varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		if (TclIsVarUndefined(varPtr2)) {
-		    continue;
-		}
-		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-		if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
-		    continue;	/* element name doesn't match pattern */
-		}
-		
-		namePtr = Tcl_NewStringObj(name, -1);
-		result = Tcl_ListObjAppendElement(interp, nameLstPtr,
-		        namePtr);
-		if (result != TCL_OK) {
-		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
-		    Tcl_DecrRefCount(nameLstPtr);
-		    return result;
-		}
-	    }
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
+	}
 
-	    /*
-	     * Make sure the Var structure of the array is not removed by
-	     * a trace while we're working.
-	     */
+	/*
+	 * Get the array values corresponding to each element name.
+	 */
 
-	    varPtr->refCount++;
+	TclNewObj(tmpResPtr);
+	result = Tcl_ListObjGetElements(interp, nameLstPtr, &count,
+		&namePtrPtr);
+	if (result != TCL_OK) {
+	    goto errorInArrayGet;
+	}
 
-	    /*
-	     * Get the array values corresponding to each element name 
-	     */
+	for (i=0 ; i<count ; i++) {
+	    namePtr = *namePtrPtr++;
+	    valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
+		    TCL_LEAVE_ERR_MSG);
+	    if (valuePtr == NULL) {
+		/*
+		 * Some trace played a trick on us; we need to diagnose to
+		 * adapt our behaviour: was the array element unset, or did
+		 * the modification modify the complete array?
+		 */
 
-	    tmpResPtr = Tcl_NewObj();
-	    result = Tcl_ListObjGetElements(interp, nameLstPtr,
-		    &count, &namePtrPtr);
-	    if (result != TCL_OK) {
-		goto errorInArrayGet;
-	    }
-	    
-	    for (i = 0; i < count; i++) { 
-		namePtr = *namePtrPtr++;
-		valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
-	                TCL_LEAVE_ERR_MSG);
-		if (valuePtr == NULL) {
+		if (TclIsVarArray(varPtr)) {
 		    /*
-		     * Some trace played a trick on us; we need to diagnose to
-		     * adapt our behaviour: was the array element unset, or did
-		     * the modification modify the complete array?
+		     * The array itself looks OK, the variable was undefined:
+		     * forget it.
 		     */
 
-		    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
-			/*
-			 * The array itself looks OK, the variable was
-			 * undefined: forget it.
-			 */
-			
-			continue;
-		    } else {
-			result = TCL_ERROR;
-			goto errorInArrayGet;
-		    }
-		}
-		result = Tcl_ListObjAppendElement(interp, tmpResPtr, namePtr);
-		if (result != TCL_OK) {
-		    goto errorInArrayGet;
-		}
-		result = Tcl_ListObjAppendElement(interp, tmpResPtr, valuePtr);
-		if (result != TCL_OK) {
+		    continue;
+		} else {
+		    result = TCL_ERROR;
 		    goto errorInArrayGet;
 		}
 	    }
-	    varPtr->refCount--;
-	    Tcl_SetObjResult(interp, tmpResPtr);
-	    Tcl_DecrRefCount(nameLstPtr);
-	    break;
+	    result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr);
+	    if (result != TCL_OK) {
+		goto errorInArrayGet;
+	    }
+	}
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
+	Tcl_SetObjResult(interp, tmpResPtr);
+	TclDecrRefCount(nameLstPtr);
+	break;
 
-	    errorInArrayGet:
-	    varPtr->refCount--;
-	    Tcl_DecrRefCount(nameLstPtr);
-	    Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */
-	    return result;
+    errorInArrayGet:
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
 	}
-        case ARRAY_NAMES: {
-	    Tcl_HashSearch search;
-	    Var *varPtr2;
-	    char *pattern = NULL;
-	    char *name;
-	    Tcl_Obj *namePtr;
-	    int mode, matched = 0;
-	    static CONST char *options[] = {
-		"-exact", "-glob", "-regexp", (char *) NULL
-	    };
-	    enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
-
-	    mode = OPT_GLOB;
-	    
-	    if ((objc < 3) || (objc > 5)) {
-  	        Tcl_WrongNumArgs(interp, 2, objv,
-			"arrayName ?mode? ?pattern?");
+	TclDecrRefCount(nameLstPtr);
+	TclDecrRefCount(tmpResPtr);	/* Free unneeded temp result. */
+	return result;
+    }
+    case ARRAY_NAMES: {
+	Tcl_HashSearch search;
+	Var *varPtr2;
+	char *pattern;
+	char *name;
+	Tcl_Obj *namePtr, *resultPtr, *patternPtr;
+	int mode, matched = 0;
+	static const char *options[] = {
+	    "-exact", "-glob", "-regexp", NULL
+	};
+	enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
+
+	mode = OPT_GLOB;
+
+	if ((objc < 3) || (objc > 5)) {
+	    Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    return TCL_OK;
+	}
+	if (objc == 4) {
+	    patternPtr = objv[3];
+	    pattern = TclGetString(patternPtr);
+	} else if (objc == 5) {
+	    patternPtr = objv[4];
+	    pattern = TclGetString(patternPtr);
+	    if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0,
+		    &mode) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (notArray) {
-	        return TCL_OK;
-	    }
-	    if (objc == 4) {
-	        pattern = Tcl_GetString(objv[3]);
-	    } else if (objc == 5) {
-		pattern = Tcl_GetString(objv[4]);
-		if (Tcl_GetIndexFromObj(interp, objv[3], options, "option",
-			0, &mode) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-	    }       		
-	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	        varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		if (TclIsVarUndefined(varPtr2)) {
-		    continue;
-		}
-		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-		if (objc > 3) {
-		    switch ((enum options) mode) {
-			case OPT_EXACT:
-			    matched = (strcmp(name, pattern) == 0);
-			    break;
-			case OPT_GLOB:
-			    matched = Tcl_StringMatch(name, pattern);
-			    break;
-			case OPT_REGEXP:
-			    matched = Tcl_RegExpMatch(interp, name,
-				    pattern);
-			    if (matched < 0) {
-				return TCL_ERROR;
-			    }
-			    break;
-		    }
-		    if (matched == 0) {
-			continue;
-		    }
-		}
-		
-		namePtr = Tcl_NewStringObj(name, -1);
-		result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
+	} else {
+	    patternPtr = NULL;
+	    pattern = NULL;
+	}
+	TclNewObj(resultPtr);
+	if (((enum options) mode)==OPT_GLOB && pattern!=NULL &&
+		TclMatchIsTrivial(pattern)) {
+	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternPtr);
+	    if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
+		result = Tcl_ListObjAppendElement(interp, resultPtr,
+			VarHashGetKey(varPtr2));
 		if (result != TCL_OK) {
-		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    TclDecrRefCount(resultPtr);
 		    return result;
 		}
 	    }
-	    break;
+	    Tcl_SetObjResult(interp, resultPtr);
+	    return TCL_OK;
 	}
-        case ARRAY_NEXTELEMENT: {
-	    ArraySearch *searchPtr;
-	    Tcl_HashEntry *hPtr;
-	    
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, 
-                        "arrayName searchId");
-		return TCL_ERROR;
-	    }
-	    if (notArray) {
-  	        goto error;
-	    }
-	    searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
-	    if (searchPtr == NULL) {
-	        return TCL_ERROR;
+	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+	    if (TclIsVarUndefined(varPtr2)) {
+		continue;
 	    }
-	    while (1) {
-	        Var *varPtr2;
-
-		hPtr = searchPtr->nextEntry;
-		if (hPtr == NULL) {
-		    hPtr = Tcl_NextHashEntry(&searchPtr->search);
-		    if (hPtr == NULL) {
-		        return TCL_OK;
+	    namePtr = VarHashGetKey(varPtr2);
+	    name = TclGetString(namePtr);
+	    if (objc > 3) {
+		switch ((enum options) mode) {
+		case OPT_EXACT:
+		    matched = (strcmp(name, pattern) == 0);
+		    break;
+		case OPT_GLOB:
+		    matched = Tcl_StringMatch(name, pattern);
+		    break;
+		case OPT_REGEXP:
+		    matched = Tcl_RegExpMatch(interp, name, pattern);
+		    if (matched < 0) {
+			TclDecrRefCount(resultPtr);
+			return TCL_ERROR;
 		    }
-		} else {
-		    searchPtr->nextEntry = NULL;
-		}
-		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		if (!TclIsVarUndefined(varPtr2)) {
 		    break;
 		}
+		if (matched == 0) {
+		    continue;
+		}
 	    }
-	    Tcl_SetStringObj(resultPtr,
-	            Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
-	    break;
-	}
-        case ARRAY_SET: {
-	    if (objc != 4) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
-		return TCL_ERROR;
+
+	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
+	    if (result != TCL_OK) {
+		TclDecrRefCount(namePtr);	/* Free unneeded name obj. */
+		return result;
 	    }
-	    return(TclArraySet(interp, objv[2], objv[3]));
 	}
-        case ARRAY_SIZE: {
+	Tcl_SetObjResult(interp, resultPtr);
+	break;
+    }
+    case ARRAY_SET:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
+	    return TCL_ERROR;
+	}
+	return TclArraySet(interp, objv[2], objv[3]);
+    case ARRAY_UNSET:
+	if ((objc != 3) && (objc != 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+	    return TCL_ERROR;
+	}
+	if (notArray) {
+	    return TCL_OK;
+	}
+	if (objc == 3) {
+	    /*
+	     * When no pattern is given, just unset the whole array.
+	     */
+
+	    return TclObjUnsetVar2(interp, varNamePtr, NULL, 0);
+	} else {
 	    Tcl_HashSearch search;
-	    Var *varPtr2;
-	    int size;
+	    Var *varPtr2, *protectedVarPtr;
+	    const char *pattern = TclGetString(objv[3]);
 
-	    if (objc != 3) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
-		return TCL_ERROR;
-	    }
-	    size = 0;
-	    if (!notArray) {
-	        for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, 
-                        &search);
-		     hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
-		    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		    if (TclIsVarUndefined(varPtr2)) {
-		        continue;
-		    }
-		    size++;
-		}
-	    }
-	    Tcl_SetIntObj(resultPtr, size);
-	    break;
-	}
-        case ARRAY_STARTSEARCH: {
-	    ArraySearch *searchPtr;
+	    /*
+	     * With a trivial pattern, we can just unset.
+	     */
 
-	    if (objc != 3) {
-	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
-		return TCL_ERROR;
-	    }
-	    if (notArray) {
-	        goto error;
+	    if (TclMatchIsTrivial(pattern)) {
+		varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
+		if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) {
+		    return TclObjUnsetVar2(interp, varNamePtr, objv[3], 0);
+		}
+		return TCL_OK;
 	    }
-	    searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
-	    if (varPtr->searchPtr == NULL) {
-	        searchPtr->id = 1;
-		Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
-		        (char *) NULL);
-	    } else {
-	        char string[TCL_INTEGER_SPACE];
 
-		searchPtr->id = varPtr->searchPtr->id + 1;
-		TclFormatInt(string, searchPtr->id);
-		Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
-			(char *) NULL);
-	    }
-	    searchPtr->varPtr = varPtr;
-	    searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
-		    &searchPtr->search);
-	    searchPtr->nextPtr = varPtr->searchPtr;
-	    varPtr->searchPtr = searchPtr;
-	    break;
-	}
+	    /*
+	     * Non-trivial case (well, deeply tricky really). We peek inside
+	     * the hash iterator in order to allow us to guarantee that the
+	     * following element in the array will not be scrubbed until we
+	     * have dealt with it. This stops the overall iterator from ending
+	     * up pointing into deallocated memory. [Bug 2939073]
+	     */
 
-	case ARRAY_STATISTICS: {
-	    char *stats;
+	    protectedVarPtr = NULL;
+	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+		/*
+		 * Drop the extra ref immediately. We don't need to free it at
+		 * this point though; we'll be unsetting it if necessary soon.
+		 */
 
-	    if (notArray) {
-		goto error;
-	    }
+		if (varPtr2 == protectedVarPtr) {
+		    VarHashRefCount(varPtr2)--;
+		}
 
-	    stats = Tcl_HashStats(varPtr->value.tablePtr);
-	    if (stats != NULL) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp), stats, -1);
-		ckfree((void *)stats);
-	    } else {
-		Tcl_SetResult(interp, "error reading array statistics",
-			TCL_STATIC);
-		return TCL_ERROR;
-	    }
-	    break;
-        }
-	
-	case ARRAY_UNSET: {
-	    Tcl_HashSearch search;
-	    Var *varPtr2;
-	    char *pattern = NULL;
-	    char *name;
-          
-	    if ((objc != 3) && (objc != 4)) {
-		Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
-		return TCL_ERROR;
-	    }
-	    if (notArray) {
-		return TCL_OK;
-	    }
-	    if (objc == 3) {
 		/*
-		 * When no pattern is given, just unset the whole array
+		 * Guard the next item in the search chain by incrementing its
+		 * refcount. This guarantees that the hash table iterator
+		 * won't be dangling on the next time through the loop.
 		 */
-		if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0)
-			!= TCL_OK) {
-		    return TCL_ERROR;
+
+		if (search.nextEntryPtr != NULL) {
+		    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
+		    VarHashRefCount(protectedVarPtr)++;
+		} else {
+		    protectedVarPtr = NULL;
 		}
-	    } else {
-		pattern = Tcl_GetString(objv[3]);
-		for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
-			&search);
-		     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-		    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
-		    if (TclIsVarUndefined(varPtr2)) {
-			continue;
-		    }
-		    name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-		    if (Tcl_StringMatch(name, pattern) &&
-			    (TclObjUnsetVar2(interp, varNamePtr, name, 0)
-				    != TCL_OK)) {
+
+		if (!TclIsVarUndefined(varPtr2)) {
+		    Tcl_Obj *namePtr = VarHashGetKey(varPtr2);
+
+		    if (Tcl_StringMatch(TclGetString(namePtr), pattern)
+			    && TclObjUnsetVar2(interp, varNamePtr, namePtr,
+				    0) != TCL_OK) {
+			/*
+			 * If we incremented a refcount, we must decrement it
+			 * here as we will not be coming back properly due to
+			 * the error.
+			 */
+
+			if (protectedVarPtr) {
+			    VarHashRefCount(protectedVarPtr)--;
+			    CleanupVar(protectedVarPtr, varPtr);
+			}
 			return TCL_ERROR;
 		    }
+		} else {
+		    CleanupVar(varPtr2, varPtr);
 		}
 	    }
 	    break;
 	}
+
+    case ARRAY_SIZE: {
+	Tcl_HashSearch search;
+	Var *varPtr2;
+	int size;
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+	size = 0;
+
+	/*
+	 * Must iterate in order to get chance to check for present but
+	 * "undefined" entries.
+	 */
+
+	if (!notArray) {
+	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+		if (TclIsVarUndefined(varPtr2)) {
+		    continue;
+		}
+		size++;
+	    }
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+	break;
+    }
+
+    case ARRAY_STATISTICS: {
+	const char *stats;
+
+	if (notArray) {
+	    goto error;
+	}
+
+	stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
+	if (stats != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
+	    ckfree((void *)stats);
+	} else {
+	    Tcl_SetResult(interp,"error reading array statistics",TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	break;
+    }
     }
     return TCL_OK;
 
-    error:
-    Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
-	    (char *) NULL);
+  error:
+    Tcl_AppendResult(interp, "\"", TclGetString(varNamePtr),
+	    "\" isn't an array", NULL);
     return TCL_ERROR;
 }
 
@@ -3411,118 +3331,164 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
  *
  * TclArraySet --
  *
- *	Set the elements of an array.  If there are no elements to
- *	set, create an empty array.  This routine is used by the
- *	Tcl_ArrayObjCmd and by the TclSetupEnv routine.
+ *	Set the elements of an array. If there are no elements to set, create
+ *	an empty array. This routine is used by the Tcl_ArrayObjCmd and by the
+ *	TclSetupEnv routine.
  *
  * Results:
  *	A standard Tcl result object.
  *
  * Side effects:
  *	A variable will be created if one does not already exist.
+ *	Callers must Incr arrayNameObj if they pland to Decr it.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclArraySet(interp, arrayNameObj, arrayElemObj)
-    Tcl_Interp *interp;		/* Current interpreter. */
-    Tcl_Obj *arrayNameObj;	/* The array name. */
-    Tcl_Obj *arrayElemObj;	/* The array elements list.  If this is
+TclArraySet(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *arrayNameObj,	/* The array name. */
+    Tcl_Obj *arrayElemObj)	/* The array elements list or dict. If this is
 				 * NULL, create an empty array. */
 {
     Var *varPtr, *arrayPtr;
-    Tcl_Obj **elemPtrs;
-    int result, elemLen, i, nameLen;
-    char *varName, *p;
-    
-    varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen);
-    p = varName + nameLen - 1;
-    if (*p == ')') {
-	while (--p >= varName) {
-	    if (*p == '(') {
-		VarErrMsg(interp, varName, NULL, "set", needArray);
-		return TCL_ERROR;
-	    }
-	}
-    }
+    int result, i;
 
-    varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
+    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
 	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
-	    /*createPart2*/ 0, &arrayPtr);
+	    /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
+    if (arrayPtr) {
+	CleanupVar(varPtr, arrayPtr);
+	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
+	return TCL_ERROR;
+    }
+
+    if (arrayElemObj == NULL) {
+	goto ensureArray;
+    }
+
+    /*
+     * Install the contents of the dictionary or list into the array.
+     */
+
+    if (arrayElemObj->typePtr == &tclDictType) {
+	Tcl_Obj *keyPtr, *valuePtr;
+	Tcl_DictSearch search;
+	int done;
+
+	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (done == 0) {
+	    /*
+	     * Empty, so we'll just force the array to be properly existing
+	     * instead.
+	     */
+
+	    goto ensureArray;
+	}
+
+	/*
+	 * Don't need to look at result of Tcl_DictObjFirst as we've just
+	 * successfully used a dictionary operation on the same object.
+	 */
 
-    if (arrayElemObj != NULL) {
-	result = Tcl_ListObjGetElements(interp, arrayElemObj,
+	for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
+		&keyPtr, &valuePtr, &done) ; !done ;
+		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
+	    /*
+	     * At this point, it would be nice if the key was directly usable
+	     * by the array. This isn't the case though.
+	     */
+
+	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+	    if ((elemVarPtr == NULL) ||
+		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
+		Tcl_DictObjDone(&search);
+		return TCL_ERROR;
+	    }
+	}
+	return TCL_OK;
+    } else {
+	/*
+	 * Not a dictionary, so assume (and convert to, for backward-
+	 * -compatability reasons) a list.
+	 */
+
+	int elemLen;
+	Tcl_Obj **elemPtrs, *copyListObj;
+
+	result = TclListObjGetElements(interp, arrayElemObj,
 		&elemLen, &elemPtrs);
 	if (result != TCL_OK) {
 	    return result;
 	}
 	if (elemLen & 1) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		    "list must have an even number of elements", -1);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "list must have an even number of elements", -1));
 	    return TCL_ERROR;
 	}
-	if (elemLen > 0) {
-	    /*
-	     * We needn't worry about traces invalidating arrayPtr:
-	     * should that be the case, TclPtrSetVar will return NULL
-	     * so that we break out of the loop and return an error.
-	     */
+	if (elemLen == 0) {
+	    goto ensureArray;
+	}
 
-	    for (i = 0;  i < elemLen;  i += 2) {
-		char *part2 = TclGetString(elemPtrs[i]);
-		Var *elemVarPtr = TclLookupArrayElement(interp, varName, 
-                        part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
-		if ((elemVarPtr == NULL) ||
-		        (TclPtrSetVar(interp, elemVarPtr, varPtr, varName,
-			 part2, elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) {
-		    result = TCL_ERROR;
-		    break;
-		}
+	/*
+	 * We needn't worry about traces invalidating arrayPtr: should that be
+	 * the case, TclPtrSetVar will return NULL so that we break out of the
+	 * loop and return an error.
+	 */
 
-		/*
-		 * The TclPtrSetVar call might have shimmered
-		 * arrayElemObj to another type, so re-fetch
-		 * the pointers for safety.
-		 */
-		Tcl_ListObjGetElements(NULL, arrayElemObj,
-			&elemLen, &elemPtrs);
+	copyListObj = TclListObjCopy(NULL, arrayElemObj);
+	for (i=0 ; i<elemLen ; i+=2) {
+	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+	    if ((elemVarPtr == NULL) ||
+		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+		    elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
+		result = TCL_ERROR;
+		break;
 	    }
-	    return result;
 	}
+	Tcl_DecrRefCount(copyListObj);
+	return result;
     }
-    
+
     /*
-     * The list is empty make sure we have an array, or create
-     * one if necessary.
+     * The list is empty make sure we have an array, or create one if
+     * necessary.
      */
-    
+
+  ensureArray:
     if (varPtr != NULL) {
-	if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+	if (TclIsVarArray(varPtr)) {
 	    /*
 	     * Already an array, done.
 	     */
-	    
+
 	    return TCL_OK;
 	}
 	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
 	    /*
 	     * Either an array element, or a scalar: lose!
 	     */
-	    
-	    VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
+
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
+		    needArray, -1);
 	    return TCL_ERROR;
 	}
     }
     TclSetVarArray(varPtr);
-    TclClearVarUndefined(varPtr);
-    varPtr->value.tablePtr =
-	(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+    varPtr->value.tablePtr = (TclVarHashTable *)
+	    ckalloc(sizeof(TclVarHashTable));
+    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
     return TCL_OK;
 }
 
@@ -3531,56 +3497,61 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
  *
  * ObjMakeUpvar --
  *
- *	This procedure does all of the work of the "global" and "upvar"
+ *	This function does all of the work of the "global" and "upvar"
  *	commands.
  *
  * Results:
- *	A standard Tcl completion code. If an error occurs then an
- *	error message is left in iPtr->result.
+ *	A standard Tcl completion code. If an error occurs then an error
+ *	message is left in iPtr->result.
  *
  * Side effects:
  *	The variable given by myName is linked to the variable in framePtr
  *	given by otherP1 and otherP2, so that references to myName are
  *	redirected to the other variable like a symbolic link.
+ *	Callers must Incr myNamePtr if they plan to Decr it.
+ *	Callers must Incr otherP1Ptr if they plan to Decr it.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, index)
-    Tcl_Interp *interp;		/* Interpreter containing variables. Used
-			         * for error messages, too. */
-    CallFrame *framePtr;	/* Call frame containing "other" variable.
+ObjMakeUpvar(
+    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
+				 * error messages, too. */
+    CallFrame *framePtr,	/* Call frame containing "other" variable.
 				 * NULL means use global :: context. */
-    Tcl_Obj *otherP1Ptr;
-    CONST char *otherP2;	/* Two-part name of variable in framePtr. */
-    CONST int otherFlags;	/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+    Tcl_Obj *otherP1Ptr,
+    const char *otherP2,	/* Two-part name of variable in framePtr. */
+    const int otherFlags,	/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of "other" variable. */
-    CONST char *myName;		/* Name of variable which will refer to
+    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
 				 * otherP1/otherP2. Must be a scalar. */
-    int myFlags;		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of myName. */
-    int index;                  /* If the variable to be linked is an indexed
-				 * scalar, this is its index. Otherwise, -1. */
+    int index)			/* If the variable to be linked is an indexed
+				 * scalar, this is its index. Otherwise, -1 */
 {
     Interp *iPtr = (Interp *) interp;
-    Var *otherPtr, *varPtr, *arrayPtr;
+    Var *otherPtr, *arrayPtr;
     CallFrame *varFramePtr;
-    CONST char *errMsg;
 
     /*
-     * Find "other" in "framePtr". If not looking up other in just the
-     * current namespace, temporarily replace the current var frame
-     * pointer in the interpreter in order to use TclObjLookupVar.
+     * Find "other" in "framePtr". If not looking up other in just the current
+     * namespace, temporarily replace the current var frame pointer in the
+     * interpreter in order to use TclObjLookupVar.
      */
 
+    if (framePtr == NULL) {
+	framePtr = iPtr->rootFramePtr;
+    }
+
     varFramePtr = iPtr->varFramePtr;
     if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
 	iPtr->varFramePtr = framePtr;
     }
     otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2,
 	    (otherFlags | TCL_LEAVE_ERR_MSG), "access",
-            /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
 	iPtr->varFramePtr = varFramePtr;
     }
@@ -3588,63 +3559,161 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags,
 	return TCL_ERROR;
     }
 
+    /*
+     * Check that we are not trying to create a namespace var linked to a
+     * local variable in a procedure. If we allowed this, the local
+     * variable in the shorter-lived procedure frame could go away leaving
+     * the namespace var's reference invalid.
+     */
+
+    if (index < 0) {
+	if (!(arrayPtr != NULL
+		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
+		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
+		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+			|| (varFramePtr == NULL)
+			|| !HasLocalVars(varFramePtr)
+			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+		    TclGetString(myNamePtr), "\": upvar won't create "
+		    "namespace variable that refers to procedure variable",
+		    NULL);
+	    return TCL_ERROR;
+	}
+    }
+
+    return TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrMakeUpvar --
+ *
+ *	This procedure does all of the work of the "global" and "upvar"
+ *	commands.
+ *
+ * Results:
+ *	A standard Tcl completion code. If an error occurs then an error
+ *	message is left in iPtr->result.
+ *
+ * Side effects:
+ *	The variable given by myName is linked to the variable in framePtr
+ *	given by otherP1 and otherP2, so that references to myName are
+ *	redirected to the other variable like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPtrMakeUpvar(
+    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
+				 * error messages, too. */
+    Var *otherPtr,		/* Pointer to the variable being linked-to. */
+    const char *myName,		/* Name of variable which will refer to
+				 * otherP1/otherP2. Must be a scalar. */
+    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of myName. */
+    int index)			/* If the variable to be linked is an indexed
+				 * scalar, this is its index. Otherwise, -1 */
+{
+    Tcl_Obj *myNamePtr = NULL;
+    int result;
+
+    if (myName) {
+	myNamePtr = Tcl_NewStringObj(myName, -1);
+	Tcl_IncrRefCount(myNamePtr);
+    }
+    result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
+    if (myNamePtr) {
+	Tcl_DecrRefCount(myNamePtr);
+    }
+    return result;
+}
+
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+ 
+int
+TclPtrObjMakeUpvar(
+    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
+				 * error messages, too. */
+    Var *otherPtr,		/* Pointer to the variable being linked-to. */
+    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
+				 * otherP1/otherP2. Must be a scalar. */
+    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of myName. */
+    int index)			/* If the variable to be linked is an indexed
+				 * scalar, this is its index. Otherwise, -1 */
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
+    const char *errMsg, *p, *myName;
+    Var *varPtr;
+
     if (index >= 0) {
-	if (!varFramePtr->isProcCallFrame) {
-	    panic("ObjMakeUpvar called with an index outside from a proc.\n");
+	if (!HasLocalVars(varFramePtr)) {
+	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
 	}
-	varPtr = &(varFramePtr->compiledLocals[index]);
+	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
+	myNamePtr = localName(iPtr->varFramePtr, index);
+	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
     } else {
 	/*
-	 * Check that we are not trying to create a namespace var linked to
-	 * a local variable in a procedure. If we allowed this, the local
-	 * variable in the shorter-lived procedure frame could go away
-	 * leaving the namespace var's reference invalid.
+	 * Do not permit the new variable to look like an array reference, as
+	 * it will not be reachable in that case [Bug 600812, TIP 184]. The
+	 * "definition" of what "looks like an array reference" is consistent
+	 * (and must remain consistent) with the code in TclObjLookupVar().
 	 */
-	
-	if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) 
-	    && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
-		|| (varFramePtr == NULL)
-		|| !varFramePtr->isProcCallFrame
-		|| (strstr(myName, "::") != NULL))) {
-	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
-		    myName, "\": upvar won't create namespace variable that ",
-		    "refers to procedure variable", (char *) NULL);
-	    return TCL_ERROR;
+
+	myName = TclGetString(myNamePtr);
+	p = strstr(myName, "(");
+	if (p != NULL) {
+	    p += strlen(p)-1;
+	    if (*p == ')') {
+		/*
+		 * myName looks like an array reference.
+		 */
+
+		Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
+			myName, "\": upvar won't create a scalar variable "
+			"that looks like an array element", NULL);
+		return TCL_ERROR;
+	    }
 	}
-	
+
 	/*
 	 * Lookup and eventually create the new variable. Set the flag bit
-	 * LOOKUP_FOR_UPVAR to indicate the special resolution rules for 
-	 * upvar purposes: 
+	 * AVOID_RESOLVERS to indicate the special resolution rules for upvar
+	 * purposes:
 	 *   - Bug #696893 - variable is either proc-local or in the current
-	 *     namespace; never follow the second (global) resolution path 
-	 *   - Bug #631741 - do not use special namespace or interp resolvers
+	 *     namespace; never follow the second (global) resolution path.
+	 *   - Bug #631741 - do not use special namespace or interp resolvers.
 	 */
-	
-	varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), 
-	        /* create */ 1, &errMsg, &index);
+
+	varPtr = TclLookupSimpleVar(interp, myNamePtr,
+		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
 	if (varPtr == NULL) {
-	    VarErrMsg(interp, myName, NULL, "create", errMsg);
+	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
 	    return TCL_ERROR;
 	}
     }
 
     if (varPtr == otherPtr) {
 	Tcl_SetResult((Tcl_Interp *) iPtr,
-		      "can't upvar from variable to itself", TCL_STATIC);
+		"can't upvar from variable to itself", TCL_STATIC);
 	return TCL_ERROR;
     }
 
-    if (varPtr->tracePtr != NULL) {
+    if (TclIsVarTraced(varPtr)) {
 	Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-	        "\" has traces: can't use for upvar", (char *) NULL);
+		"\" has traces: can't use for upvar", NULL);
 	return TCL_ERROR;
     } else if (!TclIsVarUndefined(varPtr)) {
 	/*
 	 * The variable already existed. Make sure this variable "varPtr"
-	 * isn't the same as "otherPtr" (avoid circular links). Also, if
-	 * it's not an upvar then it's an error. If it is an upvar, then
-	 * just disconnect it from the thing it currently refers to.
+	 * isn't the same as "otherPtr" (avoid circular links). Also, if it's
+	 * not an upvar then it's an error. If it is an upvar, then just
+	 * disconnect it from the thing it currently refers to.
 	 */
 
 	if (TclIsVarLink(varPtr)) {
@@ -3652,20 +3721,23 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags,
 	    if (linkPtr == otherPtr) {
 		return TCL_OK;
 	    }
-	    linkPtr->refCount--;
-	    if (TclIsVarUndefined(linkPtr)) {
-		CleanupVar(linkPtr, (Var *) NULL);
+	    if (TclIsVarInHash(linkPtr)) {
+		VarHashRefCount(linkPtr)--;
+		if (TclIsVarUndefined(linkPtr)) {
+		    CleanupVar(linkPtr, NULL);
+		}
 	    }
 	} else {
 	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-		    "\" already exists", (char *) NULL);
+		    "\" already exists", NULL);
 	    return TCL_ERROR;
 	}
     }
     TclSetVarLink(varPtr);
-    TclClearVarUndefined(varPtr);
     varPtr->value.linkPtr = otherPtr;
-    otherPtr->refCount++;
+    if (TclIsVarInHash(otherPtr)) {
+	VarHashRefCount(otherPtr)++;
+    }
     return TCL_OK;
 }
 
@@ -3674,33 +3746,32 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags,
  *
  * Tcl_UpVar --
  *
- *	This procedure links one variable to another, just like
- *	the "upvar" command.
+ *	This function links one variable to another, just like the "upvar"
+ *	command.
  *
  * Results:
- *	A standard Tcl completion code.  If an error occurs then
- *	an error message is left in the interp's result.
+ *	A standard Tcl completion code. If an error occurs then an error
+ *	message is left in the interp's result.
  *
  * Side effects:
  *	The variable in frameName whose name is given by varName becomes
- *	accessible under the name localName, so that references to
- *	localName are redirected to the other variable like a symbolic
- *	link.
+ *	accessible under the name localName, so that references to localName
+ *	are redirected to the other variable like a symbolic link.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UpVar(interp, frameName, varName, localName, flags)
-    Tcl_Interp *interp;		/* Command interpreter in which varName is
-				 * to be looked up. */
-    CONST char *frameName;	/* Name of the frame containing the source
+Tcl_UpVar(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    const char *frameName,	/* Name of the frame containing the source
 				 * variable, such as "1" or "#0". */
-    CONST char *varName;	/* Name of a variable in interp to link to.
-				 * May be either a scalar name or an
-				 * element in an array. */
-    CONST char *localName;	/* Name of link variable. */
-    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+    const char *varName,	/* Name of a variable in interp to link to.
+				 * May be either a scalar name or an element
+				 * in an array. */
+    const char *localName,	/* Name of link variable. */
+    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of localName. */
 {
     return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
@@ -3711,38 +3782,37 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
  *
  * Tcl_UpVar2 --
  *
- *	This procedure links one variable to another, just like
- *	the "upvar" command.
+ *	This function links one variable to another, just like the "upvar"
+ *	command.
  *
  * Results:
- *	A standard Tcl completion code.  If an error occurs then
- *	an error message is left in the interp's result.
+ *	A standard Tcl completion code. If an error occurs then an error
+ *	message is left in the interp's result.
  *
  * Side effects:
- *	The variable in frameName whose name is given by part1 and
- *	part2 becomes accessible under the name localName, so that
- *	references to localName are redirected to the other variable
- *	like a symbolic link.
+ *	The variable in frameName whose name is given by part1 and part2
+ *	becomes accessible under the name localName, so that references to
+ *	localName are redirected to the other variable like a symbolic link.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
-    Tcl_Interp *interp;		/* Interpreter containing variables.  Used
-				 * for error messages too. */
-    CONST char *frameName;	/* Name of the frame containing the source
+Tcl_UpVar2(
+    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
+				 * error messages too. */
+    const char *frameName,	/* Name of the frame containing the source
 				 * variable, such as "1" or "#0". */
-    CONST char *part1;
-    CONST char *part2;		/* Two parts of source variable name to
-				 * link to. */
-    CONST char *localName;	/* Name of link variable. */
-    int flags;			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+    const char *part1,
+    const char *part2,		/* Two parts of source variable name to link
+				 * to. */
+    const char *localName,	/* Name of link variable. */
+    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of localName. */
 {
     int result;
     CallFrame *framePtr;
-    Tcl_Obj *part1Ptr;
+    Tcl_Obj *part1Ptr, *localNamePtr;
 
     if (TclGetFrame(interp, frameName, &framePtr) == -1) {
 	return TCL_ERROR;
@@ -3750,10 +3820,13 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
-    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
-	    localName, flags, -1);
-    TclDecrRefCount(part1Ptr);
+    localNamePtr = Tcl_NewStringObj(localName, -1);
+    Tcl_IncrRefCount(localNamePtr);
 
+    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
+	    localNamePtr, flags, -1);
+    Tcl_DecrRefCount(part1Ptr);
+    Tcl_DecrRefCount(localNamePtr);
     return result;
 }
 
@@ -3762,50 +3835,59 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
  *
  * Tcl_GetVariableFullName --
  *
- *	Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this
- *	procedure appends to an object the namespace variable's full
- *	name, qualified by a sequence of parent namespace names.
+ *	Given a Tcl_Var token returned by Tcl_FindNamespaceVar, this function
+ *	appends to an object the namespace variable's full name, qualified by
+ *	a sequence of parent namespace names.
  *
  * Results:
- *      None.
+ *	None.
  *
  * Side effects:
- *      The variable's fully-qualified name is appended to the string
+ *	The variable's fully-qualified name is appended to the string
  *	representation of objPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_GetVariableFullName(interp, variable, objPtr)
-    Tcl_Interp *interp;	        /* Interpreter containing the variable. */
-    Tcl_Var variable;		/* Token for the variable returned by a
+Tcl_GetVariableFullName(
+    Tcl_Interp *interp,		/* Interpreter containing the variable. */
+    Tcl_Var variable,		/* Token for the variable returned by a
 				 * previous call to Tcl_FindNamespaceVar. */
-    Tcl_Obj *objPtr;		/* Points to the object onto which the
+    Tcl_Obj *objPtr)		/* Points to the object onto which the
 				 * variable's full name is appended. */
 {
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr = (Var *) variable;
-    char *name;
+    Tcl_Obj *namePtr;
+    Namespace *nsPtr;
 
     /*
-     * Add the full name of the containing namespace (if any), followed by
-     * the "::" separator, then the variable name.
+     * Add the full name of the containing namespace (if any), followed by the
+     * "::" separator, then the variable name.
      */
 
-    if (varPtr != NULL) {
+    if (varPtr) {
 	if (!TclIsVarArrayElement(varPtr)) {
-	    if (varPtr->nsPtr != NULL) {
-		Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
-		if (varPtr->nsPtr != iPtr->globalNsPtr) {
+	    nsPtr = TclGetVarNsPtr(varPtr);
+	    if (nsPtr) {
+		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
+		if (nsPtr != iPtr->globalNsPtr) {
 		    Tcl_AppendToObj(objPtr, "::", 2);
 		}
 	    }
-	    if (varPtr->name != NULL) {
-		Tcl_AppendToObj(objPtr, varPtr->name, -1);
-	    } else if (varPtr->hPtr != NULL) {
-		name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
-		Tcl_AppendToObj(objPtr, name, -1);
+	    if (TclIsVarInHash(varPtr)) {
+		if (!TclIsVarDeadHash(varPtr)) {
+		    namePtr = VarHashGetKey(varPtr);
+		    Tcl_AppendObjToObj(objPtr, namePtr);
+		}
+	    } else if (iPtr->varFramePtr->procPtr) {
+		int index = varPtr - iPtr->varFramePtr->compiledLocals;
+
+		if (index < iPtr->varFramePtr->numCompiledLocals) {
+		    namePtr = localName(iPtr->varFramePtr, index);
+		    Tcl_AppendObjToObj(objPtr, namePtr);
+		}
 	    }
 	}
     }
@@ -3816,7 +3898,7 @@ Tcl_GetVariableFullName(interp, variable, objPtr)
  *
  * Tcl_GlobalObjCmd --
  *
- *	This object-based procedure is invoked to process the "global" Tcl
+ *	This object-based function is invoked to process the "global" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -3829,14 +3911,14 @@ Tcl_GetVariableFullName(interp, variable, objPtr)
  */
 
 int
-Tcl_GlobalObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_GlobalObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    register Tcl_Obj *objPtr;
+    register Tcl_Obj *objPtr, *tailPtr;
     char *varName;
     register char *tail;
     int result, i;
@@ -3849,43 +3931,53 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
     /*
      * If we are not executing inside a Tcl procedure, just return.
      */
-    
-    if ((iPtr->varFramePtr == NULL)
-	    || !iPtr->varFramePtr->isProcCallFrame) {
+
+    if (!HasLocalVars(iPtr->varFramePtr)) {
 	return TCL_OK;
     }
 
-    for (i = 1;  i < objc;  i++) {
+    for (i=1 ; i<objc ; i++) {
 	/*
 	 * Make a local variable linked to its counterpart in the global ::
 	 * namespace.
 	 */
-	
+
 	objPtr = objv[i];
 	varName = TclGetString(objPtr);
 
 	/*
 	 * The variable name might have a scope qualifier, but the name for
-         * the local "link" variable must be the simple name at the tail.
+	 * the local "link" variable must be the simple name at the tail.
 	 */
 
-	for (tail = varName;  *tail != '\0';  tail++) {
+	for (tail=varName ; *tail!='\0' ; tail++) {
 	    /* empty body */
 	}
-        while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
-            tail--;
+	while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+	    tail--;
 	}
-        if ((*tail == ':') && (tail > varName)) {
-            tail++;
+	if ((*tail == ':') && (tail > varName)) {
+	    tail++;
+	}
+
+	if (tail == varName) {
+	    tailPtr = objPtr;
+	} else {
+	    tailPtr = Tcl_NewStringObj(tail, -1);
+	    Tcl_IncrRefCount(tailPtr);
 	}
 
 	/*
 	 * Link to the variable "varName" in the global :: namespace.
 	 */
-	
-	result = ObjMakeUpvar(interp, (CallFrame *) NULL,
-		objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
-	        /*myName*/ tail, /*myFlags*/ 0, -1);
+
+	result = ObjMakeUpvar(interp, NULL, objPtr, NULL,
+		TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+	if (tail != varName) {
+	    Tcl_DecrRefCount(tailPtr);
+	}
+
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -3908,104 +4000,100 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
  *	optional.
  *
  *	If the variable does not exist, it is created and given the optional
- *	value. If it already exists, it is simply set to the optional
- *	value. Normally, "name" is an unqualified name, so it is created in
- *	the current namespace. If it includes namespace qualifiers, it can
- *	be created in another namespace.
+ *	value. If it already exists, it is simply set to the optional value.
+ *	Normally, "name" is an unqualified name, so it is created in the
+ *	current namespace. If it includes namespace qualifiers, it can be
+ *	created in another namespace.
  *
- *	If the variable command is executed inside a Tcl procedure, it
- *	creates a local variable linked to the newly-created namespace
- *	variable.
+ *	If the variable command is executed inside a Tcl procedure, it creates
+ *	a local variable linked to the newly-created namespace variable.
  *
  * Results:
- *	Returns TCL_OK if the variable is found or created. Returns
- *	TCL_ERROR if anything goes wrong.
+ *	Returns TCL_OK if the variable is found or created. Returns TCL_ERROR
+ *	if anything goes wrong.
  *
  * Side effects:
- *	If anything goes wrong, this procedure returns an error message
- *	as the result in the interpreter's result object.
+ *	If anything goes wrong, this function returns an error message as the
+ *	result in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_VariableObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_VariableObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
     char *varName, *tail, *cp;
     Var *varPtr, *arrayPtr;
     Tcl_Obj *varValuePtr;
     int i, result;
-    Tcl_Obj *varNamePtr;
+    Tcl_Obj *varNamePtr, *tailPtr;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
 	return TCL_ERROR;
     }
 
-    for (i = 1;  i < objc;  i = i+2) {
+    for (i=1 ; i<objc ; i+=2) {
 	/*
-	 * Look up each variable in the current namespace context, creating
-	 * it if necessary.
+	 * Look up each variable in the current namespace context, creating it
+	 * if necessary.
 	 */
-	
+
 	varNamePtr = objv[i];
 	varName = TclGetString(varNamePtr);
-	varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
-                (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
-                /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
-	
-        if (arrayPtr != NULL) {
-            /*
-             * Variable cannot be an element in an array.  If arrayPtr is
-             * non-null, it is, so throw up an error and return.
-             */
-            VarErrMsg(interp, varName, NULL, "define", isArrayElement);
-            return TCL_ERROR;
-        }
+	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
+		/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+
+	if (arrayPtr != NULL) {
+	    /*
+	     * Variable cannot be an element in an array. If arrayPtr is
+	     * non-NULL, it is, so throw up an error and return.
+	     */
+
+	    TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
+		    isArrayElement, -1);
+	    return TCL_ERROR;
+	}
 
 	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
 
 	/*
-	 * Mark the variable as a namespace variable and increment its 
+	 * Mark the variable as a namespace variable and increment its
 	 * reference count so that it will persist until its namespace is
 	 * destroyed or until the variable is unset.
 	 */
 
-	if (!(varPtr->flags & VAR_NAMESPACE_VAR)) {
-	    varPtr->flags |= VAR_NAMESPACE_VAR;
-	    varPtr->refCount++;
-	}
+	TclSetVarNamespaceVar(varPtr);
 
 	/*
 	 * If a value was specified, set the variable to that value.
-	 * Otherwise, if the variable is new, leave it undefined.
-	 * (If the variable already exists and no value was specified,
-	 * leave its value unchanged; just create the local link if
-	 * we're in a Tcl procedure).
+	 * Otherwise, if the variable is new, leave it undefined. (If the
+	 * variable already exists and no value was specified, leave its value
+	 * unchanged; just create the local link if we're in a Tcl procedure).
 	 */
 
-	if (i+1 < objc) {	/* a value was specified */
-	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL,
-		    objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+	if (i+1 < objc) {	/* A value was specified. */
+	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varNamePtr,
+		    NULL, objv[i+1], TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG,-1);
 	    if (varValuePtr == NULL) {
 		return TCL_ERROR;
 	    }
 	}
 
 	/*
-	 * If we are executing inside a Tcl procedure, create a local
-	 * variable linked to the new namespace variable "varName".
+	 * If we are executing inside a Tcl procedure, create a local variable
+	 * linked to the new namespace variable "varName".
 	 */
 
-	if ((iPtr->varFramePtr != NULL)
-	        && iPtr->varFramePtr->isProcCallFrame) {
+	if (HasLocalVars(iPtr->varFramePtr)) {
 	    /*
 	     * varName might have a scope qualifier, but the name for the
 	     * local "link" variable must be the simple name at the tail.
@@ -4014,23 +4102,34 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
 	     * consecutive ":" characters).
 	     */
 
-	    for (tail = cp = varName;  *cp != '\0'; ) {
+	    for (tail=cp=varName ; *cp!='\0' ;) {
 		if (*cp++ == ':') {
 		    while (*cp == ':') {
 			tail = ++cp;
 		    }
 		}
 	    }
-	    
+
 	    /*
 	     * Create a local link "tail" to the variable "varName" in the
 	     * current namespace.
 	     */
-	    
-	    result = ObjMakeUpvar(interp, (CallFrame *) NULL,
-		    /*otherP1*/ varNamePtr, /*otherP2*/ NULL,
-                    /*otherFlags*/ TCL_NAMESPACE_ONLY,
-		    /*myName*/ tail, /*myFlags*/ 0, -1);
+
+	    if (tail == varName) {
+		tailPtr = varNamePtr;
+	    } else {
+		tailPtr = Tcl_NewStringObj(tail, -1);
+		Tcl_IncrRefCount(tailPtr);
+	    }
+
+	    result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL,
+		    /*otherFlags*/ TCL_NAMESPACE_ONLY,
+		    /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+	    if (tail != varName) {
+		Tcl_DecrRefCount(tailPtr);
+	    }
+
 	    if (result != TCL_OK) {
 		return result;
 	    }
@@ -4044,8 +4143,8 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
  *
  * Tcl_UpvarObjCmd --
  *
- *	This object-based procedure is invoked to process the "upvar"
- *	Tcl command. See the user documentation for details on what it does.
+ *	This object-based function is invoked to process the "upvar" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -4058,18 +4157,17 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
 
 	/* ARGSUSED */
 int
-Tcl_UpvarObjCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* Argument objects. */
+Tcl_UpvarObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     CallFrame *framePtr;
-    char *frameSpec, *localName;
     int result;
 
     if (objc < 3) {
-	upvarSyntax:
+    upvarSyntax:
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"?level? otherVar localVar ?otherVar localVar ...?");
 	return TCL_ERROR;
@@ -4077,11 +4175,10 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
 
     /*
      * Find the call frame containing each of the "other variables" to be
-     * linked to. 
+     * linked to.
      */
 
-    frameSpec = TclGetString(objv[1]);
-    result = TclGetFrame(interp, frameSpec, &framePtr);
+    result = TclObjGetFrame(interp, objv[1], &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
@@ -4092,15 +4189,14 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
     objv += result+1;
 
     /*
-     * Iterate over each (other variable, local variable) pair.
-     * Divide the other variable name into two parts, then call
-     * MakeUpvar to do all the work of linking it to the local variable.
+     * Iterate over each (other variable, local variable) pair. Divide the
+     * other variable name into two parts, then call MakeUpvar to do all the
+     * work of linking it to the local variable.
      */
 
-    for ( ;  objc > 0;  objc -= 2, objv += 2) {
-	localName = TclGetString(objv[1]);
+    for (; objc>0 ; objc-=2, objv+=2) {
 	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
-		NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
+		NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
 	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -4111,321 +4207,27 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * DisposeTraceResult--
- *
- *	This procedure is called to dispose of the result returned from
- *	a trace procedure.  The disposal method appropriate to the type
- *	of result is determined by flags.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The memory allocated for the trace result may be freed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DisposeTraceResult(flags, result)
-    int flags;			/* Indicates type of result to determine
-				 * proper disposal method */
-    char *result;		/* The result returned from a trace
-				 * procedure to be disposed */
-{
-    if (flags & TCL_TRACE_RESULT_DYNAMIC) {
-	ckfree(result);
-    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
-	Tcl_DecrRefCount((Tcl_Obj *) result);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CallVarTraces --
- *
- *	This procedure is invoked to find and invoke relevant
- *	trace procedures associated with a particular operation on
- *	a variable. This procedure invokes traces both on the
- *	variable and on its containing array (where relevant).
- *
- * Results:
- *      Returns TCL_OK to indicate normal operation.  Returns TCL_ERROR
- *      if invocation of a trace procedure indicated an error.  When
- *      TCL_ERROR is returned and leaveErrMsg is true, then the
- *      ::errorInfo variable of iPtr has information about the error
- *      appended to it.
- *
- * Side effects:
- *	Almost anything can happen, depending on trace; this procedure
- *	itself doesn't have any side effects.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
-    Interp *iPtr;		/* Interpreter containing variable. */
-    register Var *arrayPtr;	/* Pointer to array variable that contains
-				 * the variable, or NULL if the variable
-				 * isn't an element of an array. */
-    Var *varPtr;		/* Variable whose traces are to be
-				 * invoked. */
-    CONST char *part1;
-    CONST char *part2;		/* Variable's two-part name. */
-    int flags;			/* Flags passed to trace procedures:
-				 * indicates what's happening to variable,
-				 * plus other stuff like TCL_GLOBAL_ONLY,
-				 * or TCL_NAMESPACE_ONLY. */
-    CONST int leaveErrMsg;	/* If true, and one of the traces indicates an
-				 * error, then leave an error message and stack
-				 * trace information in *iPTr. */
-{
-    register VarTrace *tracePtr;
-    ActiveVarTrace active;
-    char *result;
-    CONST char *openParen, *p;
-    Tcl_DString nameCopy;
-    int copiedName;
-    int code = TCL_OK;
-    int disposeFlags = 0;
-    int saveErrFlags = iPtr->flags 
-	    & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
-
-    /*
-     * If there are already similar trace procedures active for the
-     * variable, don't call them again.
-     */
-
-    if (varPtr->flags & VAR_TRACE_ACTIVE) {
-	return code;
-    }
-    varPtr->flags |= VAR_TRACE_ACTIVE;
-    varPtr->refCount++;
-    if (arrayPtr != NULL) {
-	arrayPtr->refCount++;
-    }
-
-    /*
-     * If the variable name hasn't been parsed into array name and
-     * element, do it here.  If there really is an array element,
-     * make a copy of the original name so that NULLs can be
-     * inserted into it to separate the names (can't modify the name
-     * string in place, because the string might get used by the
-     * callbacks we invoke).
-     */
-
-    copiedName = 0;
-    if (part2 == NULL) {
-	for (p = part1; *p ; p++) {
-	    if (*p == '(') {
-		openParen = p;
-		do {
-		    p++;
-		} while (*p != '\0');
-		p--;
-		if (*p == ')') {
-		    int offset = (openParen - part1);
-		    char *newPart1;
-		    Tcl_DStringInit(&nameCopy);
-		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
-		    newPart1 = Tcl_DStringValue(&nameCopy);
-		    newPart1[offset] = 0;
-		    part1 = newPart1;
-		    part2 = newPart1 + offset + 1;
-		    copiedName = 1;
-		}
-		break;
-	    }
-	}
-    }
-
-    /*
-     * Invoke traces on the array containing the variable, if relevant.
-     */
-
-    result = NULL;
-    active.nextPtr = iPtr->activeVarTracePtr;
-    iPtr->activeVarTracePtr = &active;
-    Tcl_Preserve((ClientData) iPtr);
-    if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) {
-	active.varPtr = arrayPtr;
-	for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
-	     tracePtr = active.nextTracePtr) {
-	    active.nextTracePtr = tracePtr->nextPtr;
-	    if (!(tracePtr->flags & flags)) {
-		continue;
-	    }
-	    Tcl_Preserve((ClientData) tracePtr);
-	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
-		flags |= TCL_INTERP_DESTROYED;
-	    }
-	    result = (*tracePtr->traceProc)(tracePtr->clientData,
-		    (Tcl_Interp *) iPtr, part1, part2, flags);
-	    if (result != NULL) {
-		if (flags & TCL_TRACE_UNSETS) {
-		    /* Ignore errors in unset traces */
-		    DisposeTraceResult(tracePtr->flags, result);
-		} else {
-	            disposeFlags = tracePtr->flags;
-		    code = TCL_ERROR;
-		}
-	    }
-	    Tcl_Release((ClientData) tracePtr);
-	    if (code == TCL_ERROR) {
-		goto done;
-	    }
-	}
-    }
-
-    /*
-     * Invoke traces on the variable itself.
-     */
-
-    if (flags & TCL_TRACE_UNSETS) {
-	flags |= TCL_TRACE_DESTROYED;
-    }
-    active.varPtr = varPtr;
-    for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
-	 tracePtr = active.nextTracePtr) {
-	active.nextTracePtr = tracePtr->nextPtr;
-	if (!(tracePtr->flags & flags)) {
-	    continue;
-	}
-	Tcl_Preserve((ClientData) tracePtr);
-	if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
-	    flags |= TCL_INTERP_DESTROYED;
-	}
-	result = (*tracePtr->traceProc)(tracePtr->clientData,
-		(Tcl_Interp *) iPtr, part1, part2, flags);
-	if (result != NULL) {
-	    if (flags & TCL_TRACE_UNSETS) {
-		/* Ignore errors in unset traces */
-		DisposeTraceResult(tracePtr->flags, result);
-	    } else {
-		disposeFlags = tracePtr->flags;
-		code = TCL_ERROR;
-	    }
-	}
-	Tcl_Release((ClientData) tracePtr);
-	if (code == TCL_ERROR) {
-	    goto done;
-	}
-    }
-
-    /*
-     * Restore the variable's flags, remove the record of our active
-     * traces, and then return.
-     */
-
-    done:
-    if (code == TCL_OK) {
-	iPtr->flags |= saveErrFlags;
-    }
-    if (code == TCL_ERROR) {
-	if (leaveErrMsg) {
-	    CONST char *type = "";
-	    switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
-		case TCL_TRACE_READS: {
-		    type = "read";
-		    break;
-		}
-		case TCL_TRACE_WRITES: {
-		    type = "set";
-		    break;
-		}
-		case TCL_TRACE_ARRAY: {
-		    type = "trace array";
-		    break;
-		}
-	    }
-	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
-		VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
-			Tcl_GetString((Tcl_Obj *) result));
-	    } else {
-		VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result);
-	    }
-	}
-	DisposeTraceResult(disposeFlags,result);
-    }
-
-    if (arrayPtr != NULL) {
-	arrayPtr->refCount--;
-    }
-    if (copiedName) {
-	Tcl_DStringFree(&nameCopy);
-    }
-    varPtr->flags &= ~VAR_TRACE_ACTIVE;
-    varPtr->refCount--;
-    iPtr->activeVarTracePtr = active.nextPtr;
-    Tcl_Release((ClientData) iPtr);
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NewVar --
- *
- *	Create a new heap-allocated variable that will eventually be
- *	entered into a hashtable.
- *
- * Results:
- *	The return value is a pointer to the new variable structure. It is
- *	marked as a scalar variable (and not a link or array variable). Its
- *	value initially is NULL. The variable is not part of any hash table
- *	yet. Since it will be in a hashtable and not in a call frame, its
- *	name field is set NULL. It is initially marked as undefined.
- *
- * Side effects:
- *	Storage gets allocated.
- *
- *----------------------------------------------------------------------
- */
-
-static Var *
-NewVar()
-{
-    register Var *varPtr;
-
-    varPtr = (Var *) ckalloc(sizeof(Var));
-    varPtr->value.objPtr = NULL;
-    varPtr->name = NULL;
-    varPtr->nsPtr = NULL;
-    varPtr->hPtr = NULL;
-    varPtr->refCount = 0;
-    varPtr->tracePtr = NULL;
-    varPtr->searchPtr = NULL;
-    varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
-    return varPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * SetArraySearchObj --
  *
- *	This function converts the given tcl object into one that
- *	has the "array search" internal type.
+ *	This function converts the given tcl object into one that has the
+ *	"array search" internal type.
  *
  * Results:
- *	TCL_OK if the conversion succeeded, and TCL_ERROR if it failed
- *	(when an error message will be placed in the interpreter's
- *	result.)
+ *	TCL_OK if the conversion succeeded, and TCL_ERROR if it failed (when
+ *	an error message will be placed in the interpreter's result.)
  *
  * Side effects:
- *	Updates the internal type and representation of the object to
- *	make this an array-search object.  See the tclArraySearchType
- *	declaration above for details of the internal representation.
+ *	Updates the internal type and representation of the object to make
+ *	this an array-search object. See the tclArraySearchType declaration
+ *	above for details of the internal representation.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-SetArraySearchObj(interp, objPtr)
-    Tcl_Interp *interp;
-    Tcl_Obj *objPtr;
+SetArraySearchObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
 {
     char *string;
     char *end;
@@ -4436,35 +4238,37 @@ SetArraySearchObj(interp, objPtr)
      * Get the string representation. Make it up-to-date if necessary.
      */
 
-    string = Tcl_GetString(objPtr);
+    string = TclGetString(objPtr);
 
     /*
      * Parse the id into the three parts separated by dashes.
      */
+
     if ((string[0] != 's') || (string[1] != '-')) {
-	syntax:
-	Tcl_AppendResult(interp, "illegal search identifier \"", string,
-		"\"", (char *) NULL);
-	return TCL_ERROR;
+	goto syntax;
     }
     id = strtoul(string+2, &end, 10);
     if ((end == (string+2)) || (*end != '-')) {
 	goto syntax;
     }
+
     /*
-     * Can't perform value check in this context, so place reference
-     * to place in string to use for the check in the object instead.
+     * Can't perform value check in this context, so place reference to place
+     * in string to use for the check in the object instead.
      */
+
     end++;
     offset = end - string;
 
-    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
-	objPtr->typePtr->freeIntRepProc(objPtr);
-    }
+    TclFreeIntRep(objPtr);
     objPtr->typePtr = &tclArraySearchType;
-    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id);
-    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset);
+    objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
+    objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
     return TCL_OK;
+
+  syntax:
+    Tcl_AppendResult(interp, "illegal search identifier \"",string,"\"",NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -4472,13 +4276,13 @@ SetArraySearchObj(interp, objPtr)
  *
  * ParseSearchId --
  *
- *	This procedure translates from a tcl object to a pointer to an
- *	active array search (if there is one that matches the string).
+ *	This function translates from a tcl object to a pointer to an active
+ *	array search (if there is one that matches the string).
  *
  * Results:
- *	The return value is a pointer to the array search indicated
- *	by string, or NULL if there isn't one.  If NULL is returned,
- *	the interp's result contains an error message.
+ *	The return value is a pointer to the array search indicated by string,
+ *	or NULL if there isn't one. If NULL is returned, the interp's result
+ *	contains an error message.
  *
  * Side effects:
  *	The tcl object might have its internal type and representation
@@ -4488,62 +4292,81 @@ SetArraySearchObj(interp, objPtr)
  */
 
 static ArraySearch *
-ParseSearchId(interp, varPtr, varName, handleObj)
-    Tcl_Interp *interp;		/* Interpreter containing variable. */
-    CONST Var *varPtr;		/* Array variable search is for. */
-    CONST char *varName;	/* Name of array variable that search is
+ParseSearchId(
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const Var *varPtr,		/* Array variable search is for. */
+    Tcl_Obj *varNamePtr,	/* Name of array variable that search is
 				 * supposed to be for. */
-    Tcl_Obj *handleObj;		/* Object containing id of search. Must have
+    Tcl_Obj *handleObj)		/* Object containing id of search. Must have
 				 * form "search-num-var" where "num" is a
 				 * decimal number and "var" is a variable
 				 * name. */
 {
+    Interp *iPtr = (Interp *) interp;
     register char *string;
     register size_t offset;
     int id;
     ArraySearch *searchPtr;
+    char *varName = TclGetString(varNamePtr);
 
     /*
      * Parse the id.
      */
+
     if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
 	return NULL;
     }
+
     /*
-     * Cast is safe, since always came from an int in the first place.
+     * Extract the information out of the Tcl_Obj.
      */
-    id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
-	       ((char*)NULL));
-    string = Tcl_GetString(handleObj);
-    offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
-	      ((char*)NULL));
+
+#if 1
+    id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
+    string = TclGetString(handleObj);
+    offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
+#else
+    id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) -
+	    ((char *) NULL));
+    string = TclGetString(handleObj);
+    offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) -
+	    ((char *) NULL));
+#endif
+
     /*
-     * This test cannot be placed inside the Tcl_Obj machinery, since
-     * it is dependent on the variable context.
+     * This test cannot be placed inside the Tcl_Obj machinery, since it is
+     * dependent on the variable context.
      */
+
     if (strcmp(string+offset, varName) != 0) {
 	Tcl_AppendResult(interp, "search identifier \"", string,
-		"\" isn't for variable \"", varName, "\"", (char *) NULL);
-	return NULL;
+		"\" isn't for variable \"", varName, "\"", NULL);
+	goto badLookup;
     }
 
     /*
-     * Search through the list of active searches on the interpreter
-     * to see if the desired one exists.
+     * Search through the list of active searches on the interpreter to see if
+     * the desired one exists.
      *
-     * Note that we cannot store the searchPtr directly in the Tcl_Obj
-     * as that would run into trouble when DeleteSearches() was called
-     * so we must scan this list every time.
+     * Note that we cannot store the searchPtr directly in the Tcl_Obj as that
+     * would run into trouble when DeleteSearches() was called so we must scan
+     * this list every time.
      */
 
-    for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
-	 searchPtr = searchPtr->nextPtr) {
-	if (searchPtr->id == id) {
-	    return searchPtr;
+    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	Tcl_HashEntry *hPtr =
+		Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr);
+
+	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
+		searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
+	    if (searchPtr->id == id) {
+		return searchPtr;
+	    }
 	}
     }
-    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
-	    (char *) NULL);
+    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+  badLookup:
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
     return NULL;
 }
 
@@ -4552,8 +4375,8 @@ ParseSearchId(interp, varPtr, varName, handleObj)
  *
  * DeleteSearches --
  *
- *	This procedure is called to free up all of the searches
- *	associated with an array variable.
+ *	This function is called to free up all of the searches associated
+ *	with an array variable.
  *
  * Results:
  *	None.
@@ -4565,16 +4388,23 @@ ParseSearchId(interp, varPtr, varName, handleObj)
  */
 
 static void
-DeleteSearches(arrayVarPtr)
-    register Var *arrayVarPtr;		/* Variable whose searches are
-					 * to be deleted. */
+DeleteSearches(
+    Interp *iPtr,
+    register Var *arrayVarPtr)	/* Variable whose searches are to be
+				 * deleted. */
 {
-    ArraySearch *searchPtr;
-
-    while (arrayVarPtr->searchPtr != NULL) {
-	searchPtr = arrayVarPtr->searchPtr;
-	arrayVarPtr->searchPtr = searchPtr->nextPtr;
-	ckfree((char *) searchPtr);
+    ArraySearch *searchPtr, *nextPtr;
+    Tcl_HashEntry *sPtr;
+
+    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
+	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
+	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
+		searchPtr != NULL; searchPtr = nextPtr) {
+	    nextPtr = searchPtr->nextPtr;
+	    ckfree((char *) searchPtr);
+	}
+	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
+	Tcl_DeleteHashEntry(sPtr);
     }
 }
 
@@ -4583,108 +4413,118 @@ DeleteSearches(arrayVarPtr)
  *
  * TclDeleteNamespaceVars --
  *
- *	This procedure is called to recycle all the storage space
- *	associated with a namespace's table of variables. 
+ *	This function is called to recycle all the storage space associated
+ *	with a namespace's table of variables.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Variables are deleted and trace procedures are invoked, if
- *	any are declared.
+ *	Variables are deleted and trace functions are invoked, if any are
+ *	declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteNamespaceVars(nsPtr)
-    Namespace *nsPtr;
+TclDeleteNamespaceVars(
+    Namespace *nsPtr)
 {
-    Tcl_HashTable *tablePtr = &nsPtr->varTable;
+    TclVarHashTable *tablePtr = &nsPtr->varTable;
     Tcl_Interp *interp = nsPtr->interp;
     Interp *iPtr = (Interp *)interp;
     Tcl_HashSearch search;
-    Tcl_HashEntry *hPtr;
     int flags = 0;
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Var *varPtr;
 
     /*
-     * Determine what flags to pass to the trace callback procedures.
+     * Determine what flags to pass to the trace callback functions.
      */
 
     if (nsPtr == iPtr->globalNsPtr) {
 	flags = TCL_GLOBAL_ONLY;
-    } else if (nsPtr == currNsPtr) {
+    } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) {
 	flags = TCL_NAMESPACE_ONLY;
     }
 
-    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
-	 hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
-	register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
+    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
+	    varPtr = VarHashFirstVar(tablePtr, &search)) {
 	Tcl_Obj *objPtr = Tcl_NewObj();
-	varPtr->refCount++;	/* Make sure we get to remove from hash */
-	Tcl_IncrRefCount(objPtr); 
+
+	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
+					 * hash. */
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
-	UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags);
+	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
+		NULL, flags);
 	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
-	varPtr->refCount--;
 
-	/* Remove the variable from the table and force it undefined
-	 * in case an unset trace brought it back from the dead */
-	Tcl_DeleteHashEntry(hPtr);
-	varPtr->hPtr = NULL;
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-	while (varPtr->tracePtr != NULL) {
-	    VarTrace *tracePtr = varPtr->tracePtr;
-	    varPtr->tracePtr = tracePtr->nextPtr;
-	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+	/*
+	 * Remove the variable from the table and force it undefined in case
+	 * an unset trace brought it back from the dead.
+	 */
+
+	if (TclIsVarTraced(varPtr)) {
+	    ActiveVarTrace *activePtr;
+	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		    (char *) varPtr);
+	    VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
+
+		tracePtr = tracePtr->nextPtr;
+		prevPtr->nextPtr = NULL;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+	    }
+	    Tcl_DeleteHashEntry(tPtr);
+	    varPtr->flags &= ~VAR_ALL_TRACES;
+	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
+		    activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
 	}
-	CleanupVar(varPtr, NULL);
+	VarHashRefCount(varPtr)--;
+	VarHashDeleteEntry(varPtr);
     }
-    Tcl_DeleteHashTable(tablePtr);
+    VarHashDeleteTable(tablePtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * TclDeleteVars --
  *
- *	This procedure is called to recycle all the storage space
- *	associated with a table of variables. For this procedure
- *	to work correctly, it must not be possible for any of the
- *	variables in the table to be accessed from Tcl commands
- *	(e.g. from trace procedures).
+ *	This function is called to recycle all the storage space associated
+ *	with a table of variables. For this function to work correctly, it
+ *	must not be possible for any of the variables in the table to be
+ *	accessed from Tcl commands (e.g. from trace functions).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Variables are deleted and trace procedures are invoked, if
- *	any are declared.
+ *	Variables are deleted and trace functions are invoked, if any are
+ *	declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteVars(iPtr, tablePtr)
-    Interp *iPtr;		/* Interpreter to which variables belong. */
-    Tcl_HashTable *tablePtr;	/* Hash table containing variables to
+TclDeleteVars(
+    Interp *iPtr,		/* Interpreter to which variables belong. */
+    TclVarHashTable *tablePtr)	/* Hash table containing variables to
 				 * delete. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) iPtr;
     Tcl_HashSearch search;
-    Tcl_HashEntry *hPtr;
     register Var *varPtr;
-    Var *linkPtr;
     int flags;
-    ActiveVarTrace *activePtr;
-    Tcl_Obj *objPtr;
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
 
     /*
-     * Determine what flags to pass to the trace callback procedures.
+     * Determine what flags to pass to the trace callback functions.
      */
 
     flags = TCL_TRACE_UNSETS;
@@ -4694,102 +4534,13 @@ TclDeleteVars(iPtr, tablePtr)
 	flags |= TCL_NAMESPACE_ONLY;
     }
 
-    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
-	 hPtr = Tcl_NextHashEntry(&search)) {
-	varPtr = (Var *) Tcl_GetHashValue(hPtr);
-
-	/*
-	 * For global/upvar variables referenced in procedures, decrement
-	 * the reference count on the variable referred to, and free
-	 * the referenced variable if it's no longer needed. Don't delete
-	 * the hash entry for the other variable if it's in the same table
-	 * as us: this will happen automatically later on.
-	 */
-
-	if (TclIsVarLink(varPtr)) {
-	    linkPtr = varPtr->value.linkPtr;
-	    linkPtr->refCount--;
-	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
-		    && (linkPtr->tracePtr == NULL)
-		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
-		if (linkPtr->hPtr == NULL) {
-		    ckfree((char *) linkPtr);
-		} else if (linkPtr->hPtr->tablePtr != tablePtr) {
-		    Tcl_DeleteHashEntry(linkPtr->hPtr);
-		    ckfree((char *) linkPtr);
-		}
-	    }
-	}
+    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
+	     varPtr = VarHashFirstVar(tablePtr, &search)) {
 
-	/*
-	 * Invoke traces on the variable that is being deleted, then
-	 * free up the variable's space (no need to free the hash entry
-	 * here, unless we're dealing with a global variable: the
-	 * hash entries will be deleted automatically when the whole
-	 * table is deleted). Note that we give CallVarTraces the variable's
-	 * fully-qualified name so that any called trace procedures can
-	 * refer to these variables being deleted.
-	 */
-
-	if (varPtr->tracePtr != NULL) {
-	    objPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount(objPtr); /* until done with traces */
-	    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
-	    CallVarTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr),
-		    NULL, flags, /* leaveErrMsg */ 0);
-	    Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
-
-	    while (varPtr->tracePtr != NULL) {
-		VarTrace *tracePtr = varPtr->tracePtr;
-		varPtr->tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
-	    }
-	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
-		 activePtr = activePtr->nextPtr) {
-		if (activePtr->varPtr == varPtr) {
-		    activePtr->nextTracePtr = NULL;
-		}
-	    }
-	}
-	    
-	if (TclIsVarArray(varPtr)) {
-	    DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
-	            flags);
-	    varPtr->value.tablePtr = NULL;
-	}
-	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
-	    objPtr = varPtr->value.objPtr;
-	    TclDecrRefCount(objPtr);
-	    varPtr->value.objPtr = NULL;
-	}
-	varPtr->hPtr = NULL;
-	varPtr->tracePtr = NULL;
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-
-	/*
-	 * If the variable was a namespace variable, decrement its 
-	 * reference count. We are in the process of destroying its
-	 * namespace so that namespace will no longer "refer" to the
-	 * variable.
-	 */
-
-	if (varPtr->flags & VAR_NAMESPACE_VAR) {
-	    varPtr->flags &= ~VAR_NAMESPACE_VAR;
-	    varPtr->refCount--;
-	}
-
-	/*
-	 * Recycle the variable's memory space if there aren't any upvar's
-	 * pointing to it. If there are upvars to this variable, then the
-	 * variable will get freed when the last upvar goes away.
-	 */
-
-	if (varPtr->refCount == 0) {
-	    ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
-	}
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
+	VarHashDeleteEntry(varPtr);
     }
-    Tcl_DeleteHashTable(tablePtr);
+    VarHashDeleteTable(tablePtr);
 }
 
 /*
@@ -4797,104 +4548,41 @@ TclDeleteVars(iPtr, tablePtr)
  *
  * TclDeleteCompiledLocalVars --
  *
- *	This procedure is called to recycle storage space associated with
- *	the compiler-allocated array of local variables in a procedure call
- *	frame. This procedure resembles TclDeleteVars above except that each
- *	variable is stored in a call frame and not a hash table. For this
- *	procedure to work correctly, it must not be possible for any of the
- *	variable in the table to be accessed from Tcl commands (e.g. from
- *	trace procedures).
+ *	This function is called to recycle storage space associated with the
+ *	compiler-allocated array of local variables in a procedure call frame.
+ *	This function resembles TclDeleteVars above except that each variable
+ *	is stored in a call frame and not a hash table. For this function to
+ *	work correctly, it must not be possible for any of the variable in the
+ *	table to be accessed from Tcl commands (e.g. from trace functions).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Variables are deleted and trace procedures are invoked, if
- *	any are declared.
+ *	Variables are deleted and trace functions are invoked, if any are
+ *	declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteCompiledLocalVars(iPtr, framePtr)
-    Interp *iPtr;		/* Interpreter to which variables belong. */
-    CallFrame *framePtr;	/* Procedure call frame containing
-				 * compiler-assigned local variables to
-				 * delete. */
+TclDeleteCompiledLocalVars(
+    Interp *iPtr,		/* Interpreter to which variables belong. */
+    CallFrame *framePtr)	/* Procedure call frame containing compiler-
+				 * assigned local variables to delete. */
 {
     register Var *varPtr;
-    int flags;			/* Flags passed to trace procedures. */
-    Var *linkPtr;
-    ActiveVarTrace *activePtr;
     int numLocals, i;
+    Tcl_Obj **namePtrPtr;
 
-    flags = TCL_TRACE_UNSETS;
     numLocals = framePtr->numCompiledLocals;
     varPtr = framePtr->compiledLocals;
-    for (i = 0;  i < numLocals;  i++) {
-	/*
-	 * For global/upvar variables referenced in procedures, decrement
-	 * the reference count on the variable referred to, and free
-	 * the referenced variable if it's no longer needed. Don't delete
-	 * the hash entry for the other variable if it's in the same table
-	 * as us: this will happen automatically later on.
-	 */
-
-	if (TclIsVarLink(varPtr)) {
-	    linkPtr = varPtr->value.linkPtr;
-	    linkPtr->refCount--;
-	    if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
-		    && (linkPtr->tracePtr == NULL)
-		    && (linkPtr->flags & VAR_IN_HASHTABLE)) {
-		if (linkPtr->hPtr == NULL) {
-		    ckfree((char *) linkPtr);
-		} else {
-		    Tcl_DeleteHashEntry(linkPtr->hPtr);
-		    ckfree((char *) linkPtr);
-		}
-	    }
-	}
-
-	/*
-	 * Invoke traces on the variable that is being deleted. Then delete
-	 * the variable's trace records.
-	 */
-
-	if (varPtr->tracePtr != NULL) {
-	    CallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL,
-		    flags, /* leaveErrMsg */ 0);
-	    while (varPtr->tracePtr != NULL) {
-		VarTrace *tracePtr = varPtr->tracePtr;
-		varPtr->tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
-	    }
-	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
-		 activePtr = activePtr->nextPtr) {
-		if (activePtr->varPtr == varPtr) {
-		    activePtr->nextTracePtr = NULL;
-		}
-	    }
-	}
-
-        /*
-	 * Now if the variable is an array, delete its element hash table.
-	 * Otherwise, if it's a scalar variable, decrement the ref count
-	 * of its value.
-	 */
-	    
-	if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) {
-	    DeleteArray(iPtr, varPtr->name, varPtr, flags);
-	}
-	if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
-	    TclDecrRefCount(varPtr->value.objPtr);
-	    varPtr->value.objPtr = NULL;
-	}
-	varPtr->hPtr = NULL;
-	varPtr->tracePtr = NULL;
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-	varPtr++;
+    namePtrPtr = &localName(framePtr, 0);
+    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
+	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
+		TCL_TRACE_UNSETS);
     }
+    framePtr->numCompiledLocals = 0;
 }
 
 /*
@@ -4902,384 +4590,303 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
  *
  * DeleteArray --
  *
- *	This procedure is called to free up everything in an array
- *	variable.  It's the caller's responsibility to make sure
- *	that the array is no longer accessible before this procedure
- *	is called.
+ *	This function is called to free up everything in an array variable.
+ *	It's the caller's responsibility to make sure that the array is no
+ *	longer accessible before this function is called.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	All storage associated with varPtr's array elements is deleted
- *	(including the array's hash table). Deletion trace procedures for
- *	array elements are invoked, then deleted. Any pending traces for
- *	array elements are also deleted.
+ *	(including the array's hash table). Deletion trace functions for
+ *	array elements are invoked, then deleted. Any pending traces for array
+ *	elements are also deleted.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DeleteArray(iPtr, arrayName, varPtr, flags)
-    Interp *iPtr;			/* Interpreter containing array. */
-    CONST char *arrayName;	        /* Name of array (used for trace
-					 * callbacks). */
-    Var *varPtr;			/* Pointer to variable structure. */
-    int flags;				/* Flags to pass to CallVarTraces:
-					 * TCL_TRACE_UNSETS and sometimes
-					 * TCL_NAMESPACE_ONLY, or
-					 * TCL_GLOBAL_ONLY. */
+DeleteArray(
+    Interp *iPtr,		/* Interpreter containing array. */
+    Tcl_Obj *arrayNamePtr,	/* Name of array (used for trace callbacks),
+				 * or NULL if it is to be computed on
+				 * demand. */
+    Var *varPtr,		/* Pointer to variable structure. */
+    int flags)			/* Flags to pass to TclCallVarTraces:
+				 * TCL_TRACE_UNSETS and sometimes
+				 * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */
 {
     Tcl_HashSearch search;
-    register Tcl_HashEntry *hPtr;
+    Tcl_HashEntry *tPtr;
     register Var *elPtr;
     ActiveVarTrace *activePtr;
     Tcl_Obj *objPtr;
+    VarTrace *tracePtr;
 
-    DeleteSearches(varPtr);
-    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
-	elPtr = (Var *) Tcl_GetHashValue(hPtr);
+    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	DeleteSearches(iPtr, varPtr);
+    }
+    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
+	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
 	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
 	    objPtr = elPtr->value.objPtr;
 	    TclDecrRefCount(objPtr);
 	    elPtr->value.objPtr = NULL;
 	}
-	elPtr->hPtr = NULL;
-	if (elPtr->tracePtr != NULL) {
-	    elPtr->flags &= ~VAR_TRACE_ACTIVE;
-	    CallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName,
-		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags,
-		    /* leaveErrMsg */ 0);
-	    while (elPtr->tracePtr != NULL) {
-		VarTrace *tracePtr = elPtr->tracePtr;
-		elPtr->tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC);
+
+	/*
+	 * Lie about the validity of the hashtable entry. In this way the
+	 * variables will be deleted by VarHashDeleteTable.
+	 */
+
+	VarHashInvalidateEntry(elPtr);
+	if (TclIsVarTraced(elPtr)) {
+	    /*
+	     * Compute the array name if it was not supplied.
+	     */
+
+	    if (elPtr->flags & VAR_TRACED_UNSET) {
+		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);
+
+		elPtr->flags &= ~VAR_TRACE_ACTIVE;
+		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
+			elNamePtr, flags,/* leaveErrMsg */ 0, -1);
+	    }
+	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr);
+	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
+
+		tracePtr = tracePtr->nextPtr;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
 	    }
+	    Tcl_DeleteHashEntry(tPtr);
+	    elPtr->flags &= ~VAR_ALL_TRACES;
 	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
-		 activePtr = activePtr->nextPtr) {
+		    activePtr = activePtr->nextPtr) {
 		if (activePtr->varPtr == elPtr) {
 		    activePtr->nextTracePtr = NULL;
 		}
 	    }
 	}
 	TclSetVarUndefined(elPtr);
-	TclSetVarScalar(elPtr);
 
 	/*
 	 * Even though array elements are not supposed to be namespace
-	 * variables, some combinations of [upvar] and [variable] may
-	 * create such beasts - see [Bug 604239]. This is necessary to
-	 * avoid leaking the corresponding Var struct, and is otherwise
-	 * harmless. 
+	 * variables, some combinations of [upvar] and [variable] may create
+	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
+	 * the corresponding Var struct, and is otherwise harmless.
 	 */
 
-	if (elPtr->flags & VAR_NAMESPACE_VAR) {
-	    elPtr->flags &= ~VAR_NAMESPACE_VAR;
-	    elPtr->refCount--;
-	}
-	if (elPtr->refCount == 0) {
-	    ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
-	}
+	TclClearVarNamespaceVar(elPtr);
     }
-    Tcl_DeleteHashTable(varPtr->value.tablePtr);
+    VarHashDeleteTable(varPtr->value.tablePtr);
     ckfree((char *) varPtr->value.tablePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CleanupVar --
+ * TclTclObjVarErrMsg --
  *
- *	This procedure is called when it looks like it may be OK to free up
- *	a variable's storage. If the variable is in a hashtable, its Var
- *	structure and hash table entry will be freed along with those of its
- *	containing array, if any. This procedure is called, for example,
- *	when a trace on a variable deletes a variable.
+ *	Generate a reasonable error message describing why a variable
+ *	operation failed.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	If the variable (or its containing array) really is dead and in a
- *	hashtable, then its Var structure, and possibly its hash table
- *	entry, is freed up.
+ *	The interp's result is set to hold a message identifying the variable
+ *	given by part1 and part2 and describing why the variable operation
+ *	failed.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-CleanupVar(varPtr, arrayPtr)
-    Var *varPtr;		/* Pointer to variable that may be a
-				 * candidate for being expunged. */
-    Var *arrayPtr;		/* Array that contains the variable, or
-				 * NULL if this variable isn't an array
-				 * element. */
+void
+TclVarErrMsg(
+    Tcl_Interp *interp,		/* Interpreter in which to record message. */
+    const char *part1,
+    const char *part2,		/* Variable's two-part name. */
+    const char *operation,	/* String describing operation that failed,
+				 * e.g. "read", "set", or "unset". */
+    const char *reason)		/* String describing why operation failed. */
 {
-    if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
-	    && (varPtr->tracePtr == NULL)
-	    && (varPtr->flags & VAR_IN_HASHTABLE)) {
-	if (varPtr->hPtr != NULL) {
-	    Tcl_DeleteHashEntry(varPtr->hPtr);
-	}
-	ckfree((char *) varPtr);
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
+
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
     }
-    if (arrayPtr != NULL) {
-	if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
-		&& (arrayPtr->tracePtr == NULL)
-	        && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
-	    if (arrayPtr->hPtr != NULL) {
-		Tcl_DeleteHashEntry(arrayPtr->hPtr);
-	    }
-	    ckfree((char *) arrayPtr);
-	}
+
+    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
+
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
     }
 }
-/*
- *----------------------------------------------------------------------
- *
- * VarErrMsg --
- *
- *      Generate a reasonable error message describing why a variable
- *      operation failed.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      The interp's result is set to hold a message identifying the
- *      variable given by part1 and part2 and describing why the
- *      variable operation failed.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-VarErrMsg(interp, part1, part2, operation, reason)
-    Tcl_Interp *interp;         /* Interpreter in which to record message. */
-    CONST char *part1;
-    CONST char *part2;		/* Variable's two-part name. */
-    CONST char *operation;      /* String describing operation that failed,
-                                 * e.g. "read", "set", or "unset". */
-    CONST char *reason;         /* String describing why operation failed. */
+void
+TclObjVarErrMsg(
+    Tcl_Interp *interp,		/* Interpreter in which to record message. */
+    Tcl_Obj *part1Ptr,		/* (may be NULL, if index >= 0) */
+    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
+    const char *operation,	/* String describing operation that failed,
+				 * e.g. "read", "set", or "unset". */
+    const char *reason,		/* String describing why operation failed. */
+    int index)			/* Index into the local variable table of the
+				 * variable, or -1. Only used when part1Ptr is
+				 * NULL. */
 {
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
-	    (char *) NULL);
-    if (part2 != NULL) {
-        Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
+    if (!part1Ptr) {
+	part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
     }
-    Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
+	    operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
+	    (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
+	    reason));
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclTraceVarExists --
- *
- *	This is called from info exists.  We need to trigger read
- *	and/or array traces because they may end up creating a
- *	variable that doesn't currently exist.
- *
- * Results:
- *	A pointer to the Var structure, or NULL.
- *
- * Side effects:
- *	May fill in error messages in the interp.
+ * Internal functions for variable name object types --
  *
  *----------------------------------------------------------------------
  */
 
-Var *
-TclVarTraceExists(interp, varName)
-    Tcl_Interp *interp;		/* The interpreter */
-    CONST char *varName;	/* The variable name */
-{
-    Var *varPtr;
-    Var *arrayPtr;
-
-    /*
-     * The choice of "create" flag values is delicate here, and
-     * matches the semantics of GetVar.  Things are still not perfect,
-     * however, because if you do "info exists x" you get a varPtr
-     * and therefore trigger traces.  However, if you do 
-     * "info exists x(i)", then you only get a varPtr if x is already
-     * known to be an array.  Otherwise you get NULL, and no trace
-     * is triggered.  This matches Tcl 7.6 semantics.
-     */
-
-    varPtr = TclLookupVar(interp, varName, (char *) NULL,
-            0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
-
-    if (varPtr == NULL) {
-	return NULL;
-    }
-
-    if ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
-		TCL_TRACE_READS, /* leaveErrMsg */ 0);
-    }
-
-    /*
-     * If the variable doesn't exist anymore and no-one's using
-     * it, then free up the relevant structures and hash table entries.
-     */
+/*
+ * Panic functions that should never be called in normal operation.
+ */
 
-    if (TclIsVarUndefined(varPtr)) {
-	CleanupVar(varPtr, arrayPtr);
-	return NULL;
-    }
+static void
+PanicOnUpdateVarName(
+    Tcl_Obj *objPtr)
+{
+    Tcl_Panic("%s of type %s should not be called", "updateStringProc",
+	    objPtr->typePtr->name);
+}
 
-    return varPtr;
+static int
+PanicOnSetVarName(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
+{
+    Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
+	    objPtr->typePtr->name);
+    return TCL_ERROR;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * Internal functions for variable name object types --
- *
- *----------------------------------------------------------------------
- */
 
-/* 
+/*
  * localVarName -
  *
  * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1 = pointer to the corresponding Proc 
- *   twoPtrValue.ptr2 = index into locals table
-*/
-
-static void 
-FreeLocalVarName(objPtr)
-    Tcl_Obj *objPtr;
-{
-    register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
-    procPtr->refCount--;
-    if (procPtr->refCount <= 0) {
-	TclProcCleanupProc(procPtr);
-    }
-}
+ *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
+ *                        or NULL if it is this same obj
+ *   ptrAndLongRep.value: index into locals table
+ */
 
 static void
-DupLocalVarName(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr;
-    Tcl_Obj *dupPtr;
+FreeLocalVarName(
+    Tcl_Obj *objPtr)
 {
-    register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1;
-
-    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
-    procPtr->refCount++;
-    dupPtr->typePtr = &tclLocalVarNameType;
+    Tcl_Obj *namePtr = (Tcl_Obj *) objPtr->internalRep.ptrAndLongRep.ptr;
+    if (namePtr) {
+	Tcl_DecrRefCount(namePtr);
+    }
+    objPtr->typePtr = NULL;
 }
 
 static void
-UpdateLocalVarName(objPtr)
-    Tcl_Obj *objPtr;
+DupLocalVarName(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dupPtr)
 {
-    Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
-    unsigned int index = (unsigned int) objPtr->internalRep.twoPtrValue.ptr2;
-    CompiledLocal *localPtr = procPtr->firstLocalPtr;
-    unsigned int nameLen;
+    Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
 
-    if (localPtr == NULL) {
-	goto emptyName;
-    }
-    while (index--) {
-	localPtr = localPtr->nextPtr;
-	if (localPtr == NULL) {
-	    goto emptyName;
-	}
+    if (!namePtr) {
+	namePtr = srcPtr;
     }
+    dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
+    Tcl_IncrRefCount(namePtr);
 
-    nameLen = (unsigned int) localPtr->nameLength;
-    objPtr->bytes = ckalloc(nameLen + 1);
-    memcpy(objPtr->bytes, localPtr->name, nameLen + 1);
-    objPtr->length = nameLen;
-    return;
-
-    emptyName:
-    objPtr->bytes = ckalloc(1);
-    *(objPtr->bytes) = '\0';
-    objPtr->length = 0;
+    dupPtr->internalRep.ptrAndLongRep.value =
+	    srcPtr->internalRep.ptrAndLongRep.value;
+    dupPtr->typePtr = &localVarNameType;
 }
 
-/* 
+#if ENABLE_NS_VARNAME_CACHING
+/*
  * nsVarName -
  *
  * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1: pointer to the namespace containing the 
- *                     reference.
- *   twoPtrValue.ptr2: pointer to the corresponding Var 
-*/
+ *   twoPtrValue.ptr1: pointer to the namespace containing the reference.
+ *   twoPtrValue.ptr2: pointer to the corresponding Var
+ */
 
-static void 
-FreeNsVarName(objPtr)
-    Tcl_Obj *objPtr;
+static void
+FreeNsVarName(
+    Tcl_Obj *objPtr)
 {
-    register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2;
+    register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
 
-    varPtr->refCount--;
-    if (TclIsVarUndefined(varPtr) && (varPtr->refCount <= 0)) {
-	if (TclIsVarLink(varPtr)) {
-	    Var *linkPtr = varPtr->value.linkPtr;
-	    linkPtr->refCount--;
-	    if (TclIsVarUndefined(linkPtr) && (linkPtr->refCount <= 0)) {
-		CleanupVar(linkPtr, (Var *) NULL);
-	    }
+    if (TclIsVarInHash(varPtr)) {
+	varPtr->refCount--;
+	if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
+	    CleanupVar(varPtr, NULL);
 	}
-	CleanupVar(varPtr, NULL);
     }
+    objPtr->typePtr = NULL;
 }
 
 static void
-DupNsVarName(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr;
-    Tcl_Obj *dupPtr;
+DupNsVarName(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dupPtr)
 {
-    Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1;
-    register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2;
+    Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;
 
-    dupPtr->internalRep.twoPtrValue.ptr1 =  (VOID *) nsPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
-    varPtr->refCount++;
+    dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
+    dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
+    if (TclIsVarInHash(varPtr)) {
+	varPtr->refCount++;
+    }
     dupPtr->typePtr = &tclNsVarNameType;
 }
+#endif
 
-/* 
+/*
  * parsedVarName -
  *
  * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1 = pointer to the array name Tcl_Obj
- *                      (NULL if scalar)
- *   twoPtrValue.ptr2 = pointer to the element name string
- *                      (owned by this Tcl_Obj), or NULL if 
- *                      it is a scalar variable
+ *   twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar)
+ *   twoPtrValue.ptr2 = pointer to the element name string (owned by this
+ *			Tcl_Obj), or NULL if it is a scalar variable
  */
 
-static void 
-FreeParsedVarName(objPtr)
-    Tcl_Obj *objPtr;
+static void
+FreeParsedVarName(
+    Tcl_Obj *objPtr)
 {
-    register Tcl_Obj *arrayPtr =
-	    (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
-    register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2;
-    
+    register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
+
     if (arrayPtr != NULL) {
 	TclDecrRefCount(arrayPtr);
 	ckfree(elem);
     }
+    objPtr->typePtr = NULL;
 }
 
 static void
-DupParsedVarName(srcPtr, dupPtr)
-    Tcl_Obj *srcPtr;
-    Tcl_Obj *dupPtr;
+DupParsedVarName(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dupPtr)
 {
-    register Tcl_Obj *arrayPtr =
-	    (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1;
-    register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2;
+    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
     char *elemCopy;
     unsigned int elemLen;
 
@@ -5292,30 +4899,31 @@ DupParsedVarName(srcPtr, dupPtr)
 	elem = elemCopy;
     }
 
-    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arrayPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) elem;
+    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
+    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
     dupPtr->typePtr = &tclParsedVarNameType;
 }
 
 static void
-UpdateParsedVarName(objPtr)
-    Tcl_Obj *objPtr;
+UpdateParsedVarName(
+    Tcl_Obj *objPtr)
 {
-    Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
-    char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+    Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
     char *part1, *p;
     int len1, len2, totalLen;
 
     if (arrayPtr == NULL) {
 	/*
-	 * This is a parsed scalar name: what is it
-	 * doing here?
+	 * This is a parsed scalar name: what is it doing here?
 	 */
-	panic("ERROR: scalar parsedVarName without a string rep.\n");
+
+	Tcl_Panic("scalar parsedVarName without a string rep");
     }
-    part1 = Tcl_GetStringFromObj(arrayPtr, &len1);
+
+    part1 = TclGetStringFromObj(arrayPtr, &len1);
     len2 = strlen(part2);
-	
+
     totalLen = len1 + len2 + 2;
     p = ckalloc((unsigned int) totalLen + 1);
     objPtr->bytes = p;
@@ -5327,5 +4935,749 @@ UpdateParsedVarName(objPtr)
     memcpy(p, part2, (unsigned int) len2);
     p += len2;
     *p++ = ')';
-    *p   = '\0';
+    *p = '\0';
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
+ *
+ *	Searches for a namespace variable, a variable not local to a
+ *	procedure. The variable can be either a scalar or an array, but may
+ *	not be an element of an array.
+ *
+ * Results:
+ *	Returns a token for the variable if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an error
+ *	message in the interpreter's result object if "flags" contains
+ *	TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Var
+Tcl_FindNamespaceVar(
+    Tcl_Interp *interp,		/* The interpreter in which to find the
+				 * variable. */
+    const char *name,		/* Variable's name. If it starts with "::",
+				 * will be looked up in global namespace.
+				 * Else, looked up first in contextNsPtr
+				 * (current namespace if contextNsPtr is
+				 * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+				 * Otherwise, points to namespace in which to
+				 * resolve name. If NULL, look up name in the
+				 * current namespace. */
+    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,
+				 * TCL_GLOBAL_ONLY (look up name only in
+				 * global namespace), TCL_NAMESPACE_ONLY (look
+				 * up only in contextNsPtr, or the current
+				 * namespace if contextNsPtr is NULL), and
+				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY are given,
+				 * TCL_GLOBAL_ONLY is ignored. */
+{
+    Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
+    Tcl_Var var;
+
+    var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
+    Tcl_DecrRefCount(namePtr);
+    return var;
+}
+
+static Tcl_Var
+ObjFindNamespaceVar(
+    Tcl_Interp *interp,		/* The interpreter in which to find the
+				 * variable. */
+    Tcl_Obj *namePtr,		/* Variable's name. If it starts with "::",
+				 * will be looked up in global namespace.
+				 * Else, looked up first in contextNsPtr
+				 * (current namespace if contextNsPtr is
+				 * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+				 * Otherwise, points to namespace in which to
+				 * resolve name. If NULL, look up name in the
+				 * current namespace. */
+    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,
+				 * TCL_GLOBAL_ONLY (look up name only in
+				 * global namespace), TCL_NAMESPACE_ONLY (look
+				 * up only in contextNsPtr, or the current
+				 * namespace if contextNsPtr is NULL), and
+				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY are given,
+				 * TCL_GLOBAL_ONLY is ignored. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    const char *simpleName;
+    Var *varPtr;
+    register int search;
+    int result;
+    Tcl_Var var;
+    Tcl_Obj *simpleNamePtr;
+    char *name = TclGetString(namePtr);
+
+    /*
+     * If this namespace has a variable resolver, then give it first crack at
+     * the variable resolution. It may return a Tcl_Var value, it may signal
+     * to continue onward, or it may signal an error.
+     */
+
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
+    } else if (contextNsPtr != NULL) {
+	cxtNsPtr = (Namespace *) contextNsPtr;
+    } else {
+	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    }
+
+    if (!(flags & AVOID_RESOLVERS) &&
+	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
+	resPtr = iPtr->resolverPtr;
+
+	if (cxtNsPtr->varResProc) {
+	    result = (*cxtNsPtr->varResProc)(interp, name,
+		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+	} else {
+	    result = TCL_CONTINUE;
+	}
+
+	while (result == TCL_CONTINUE && resPtr) {
+	    if (resPtr->varResProc) {
+		result = (*resPtr->varResProc)(interp, name,
+			(Tcl_Namespace *) cxtNsPtr, flags, &var);
+	    }
+	    resPtr = resPtr->nextPtr;
+	}
+
+	if (result == TCL_OK) {
+	    return var;
+	} else if (result != TCL_CONTINUE) {
+	    return (Tcl_Var) NULL;
+	}
+    }
+
+    /*
+     * Find the namespace(s) that contain the variable.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+
+    /*
+     * Look for the variable in the variable table of its namespace. Be sure
+     * to check both possible search paths: from the specified namespace
+     * context and from the global namespace.
+     */
+
+    varPtr = NULL;
+    if (simpleName != name) {
+	simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
+    } else {
+	simpleNamePtr = namePtr;
+    }
+
+    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
+	if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+	    varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
+	}
+    }
+    if (simpleName != name) {
+	Tcl_DecrRefCount(simpleNamePtr);
+    }
+    if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
+    }
+    return (Tcl_Var) varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoVarsCmd -- (moved over from tclCmdIL.c)
+ *
+ *	Called to implement the "info vars" command that returns the list of
+ *	variables in the interpreter that match an optional pattern. The
+ *	pattern, if any, consists of an optional sequence of namespace names
+ *	separated by "::" qualifiers, which is followed by a glob-style
+ *	pattern that restricts which variables are returned. Handles the
+ *	following syntax:
+ *
+ *	    info vars ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoVarsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *pattern;
+    const char *simplePattern;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
+    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;
+
+    /*
+     * Get the pattern and find the "effective namespace" in which to list
+     * variables. We only use this effective namespace if there's no active
+     * Tcl procedure frame.
+     */
+
+    if (objc == 1) {
+	simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 2) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
+	 * was found while parsing the pattern, return it. Otherwise, if the
+	 * namespace wasn't found, just leave nsPtr NULL: we will return an
+	 * empty list since no variables there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+	pattern = TclGetString(objv[1]);
+	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
+		&simplePattern);
+
+	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	    if (simplePattern == pattern) {
+		simplePatternPtr = objv[1];
+	    } else {
+		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
+	    }
+	    Tcl_IncrRefCount(simplePatternPtr);
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+
+    listPtr = Tcl_NewListObj(0, NULL);
+
+    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+	    || specificNsInPattern) {
+	/*
+	 * There is no frame pointer, the frame pointer was pushed only to
+	 * activate a namespace, or we are in a procedure call frame but a
+	 * specific namespace was specified. Create a list containing only the
+	 * variables in the effective namespace's variable table.
+	 */
+
+	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
+	    /*
+	     * If we can just do hash lookups, that simplifies things a lot.
+	     */
+
+	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
+	    if (varPtr) {
+		if (!TclIsVarUndefined(varPtr)
+			|| TclIsVarNamespaceVar(varPtr)) {
+		    if (specificNsInPattern) {
+			elemObjPtr = Tcl_NewObj();
+			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+				elemObjPtr);
+		    } else {
+			elemObjPtr = VarHashGetKey(varPtr);
+		    }
+		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		}
+	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		varPtr = VarHashFindVar(&globalNsPtr->varTable,
+			simplePatternPtr);
+		if (varPtr) {
+		    if (!TclIsVarUndefined(varPtr)
+			    || TclIsVarNamespaceVar(varPtr)) {
+			Tcl_ListObjAppendElement(interp, listPtr,
+				VarHashGetKey(varPtr));
+		    }
+		}
+	    }
+	} else {
+	    /*
+	     * Have to scan the tables of variables.
+	     */
+
+	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
+	    while (varPtr) {
+		if (!TclIsVarUndefined(varPtr)
+			|| TclIsVarNamespaceVar(varPtr)) {
+		    varNamePtr = VarHashGetKey(varPtr);
+		    varName = TclGetString(varNamePtr);
+		    if ((simplePattern == NULL)
+			    || Tcl_StringMatch(varName, simplePattern)) {
+			if (specificNsInPattern) {
+			    elemObjPtr = Tcl_NewObj();
+			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+				    elemObjPtr);
+			} else {
+			    elemObjPtr = varNamePtr;
+			}
+			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		    }
+		}
+		varPtr = VarHashNextVar(&search);
+	    }
+
+	    /*
+	     * If the effective namespace isn't the global :: namespace, and a
+	     * specific namespace wasn't requested in the pattern (i.e., the
+	     * pattern only specifies variable names), then add in all global
+	     * :: variables that match the simple pattern. Of course, add in
+	     * only those variables that aren't hidden by a variable in the
+	     * effective namespace.
+	     */
+
+	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
+		while (varPtr) {
+		    if (!TclIsVarUndefined(varPtr)
+			    || TclIsVarNamespaceVar(varPtr)) {
+			varNamePtr = VarHashGetKey(varPtr);
+			varName = TclGetString(varNamePtr);
+			if ((simplePattern == NULL)
+				|| Tcl_StringMatch(varName, simplePattern)) {
+			    if (VarHashFindVar(&nsPtr->varTable,
+				    varNamePtr) == NULL) {
+				Tcl_ListObjAppendElement(interp, listPtr,
+					varNamePtr);
+			    }
+			}
+		    }
+		    varPtr = VarHashNextVar(&search);
+		}
+	    }
+	}
+    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+	AppendLocals(interp, listPtr, simplePatternPtr, 1);
+    }
+
+    if (simplePatternPtr) {
+	Tcl_DecrRefCount(simplePatternPtr);
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoGlobalsCmd -- (moved over from tclCmdIL.c)
+ *
+ *	Called to implement the "info globals" command that returns the list
+ *	of global variables matching an optional pattern. Handles the
+ *	following syntax:
+ *
+ *	    info globals ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoGlobalsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    char *varName, *pattern;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
+
+    if (objc == 1) {
+	pattern = NULL;
+    } else if (objc == 2) {
+	pattern = TclGetString(objv[1]);
+
+	/*
+	 * Strip leading global-namespace qualifiers. [Bug 1057461]
+	 */
+
+	if (pattern[0] == ':' && pattern[1] == ':') {
+	    while (*pattern == ':') {
+		pattern++;
+	    }
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the global :: namespace's variable table and create a list
+     * of all global variables that match the pattern.
+     */
+
+    listPtr = Tcl_NewListObj(0, NULL);
+    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
+	if (pattern == TclGetString(objv[1])) {
+	    patternPtr = objv[1];
+	} else {
+	    patternPtr = Tcl_NewStringObj(pattern, -1);
+	}
+	Tcl_IncrRefCount(patternPtr);
+
+	varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr);
+	if (varPtr) {
+	    if (!TclIsVarUndefined(varPtr)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			VarHashGetKey(varPtr));
+	    }
+	}
+	Tcl_DecrRefCount(patternPtr);
+    } else {
+	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
+		varPtr != NULL;
+		varPtr = VarHashNextVar(&search)) {
+	    if (TclIsVarUndefined(varPtr)) {
+		continue;
+	    }
+	    varNamePtr = VarHashGetKey(varPtr);
+	    varName = TclGetString(varNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
+	    }
+	}
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoLocalsCmd -- (moved over from tclCmdIl.c)
+ *
+ *	Called to implement the "info locals" command to return a list of
+ *	local variables that match an optional pattern. Handles the following
+ *	syntax:
+ *
+ *	    info locals ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoLocalsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *patternPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 1) {
+	patternPtr = NULL;
+    } else if (objc == 2) {
+	patternPtr = objv[1];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
+	return TCL_OK;
+    }
+
+    /*
+     * Return a list containing names of first the compiled locals (i.e. the
+     * ones stored in the call frame), then the variables in the local hash
+     * table (if one exists).
+     */
+
+    listPtr = Tcl_NewListObj(0, NULL);
+    AppendLocals(interp, listPtr, patternPtr, 0);
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendLocals --
+ *
+ *	Append the local variables for the current frame to the specified list
+ *	object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendLocals(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *listPtr,		/* List object to append names to. */
+    Tcl_Obj *patternPtr,	/* Pattern to match against. */
+    int includeLinks)		/* 1 if upvars should be included, else 0. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr;
+    int i, localVarCt;
+    Tcl_Obj **varNamePtr;
+    char *varName;
+    TclVarHashTable *localVarTablePtr;
+    Tcl_HashSearch search;
+    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
+    Tcl_Obj *objNamePtr;
+
+    localVarCt = iPtr->varFramePtr->numCompiledLocals;
+    varPtr = iPtr->varFramePtr->compiledLocals;
+    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
+    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
+
+    for (i = 0; i < localVarCt; i++, varNamePtr++) {
+	/*
+	 * Skip nameless (temporary) variables and undefined variables.
+	 */
+
+	if (*varNamePtr && !TclIsVarUndefined(varPtr)
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
+	    varName = TclGetString(*varNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+	    }
+	}
+	varPtr++;
+    }
+
+    /*
+     * Do nothing if no local variables.
+     */
+
+    if (localVarTablePtr == NULL) {
+	return;
+    }
+
+    /*
+     * Check for the simple and fast case.
+     */
+
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
+	if (varPtr != NULL) {
+	    if (!TclIsVarUndefined(varPtr)
+		    && (includeLinks || !TclIsVarLink(varPtr))) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			VarHashGetKey(varPtr));
+	    }
+	}
+	return;
+    }
+
+    /*
+     * Scan over and process all local variables.
+     */
+
+    for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
+	    varPtr != NULL;
+	    varPtr = VarHashNextVar(&search)) {
+	if (!TclIsVarUndefined(varPtr)
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
+	    objNamePtr = VarHashGetKey(varPtr);
+	    varName = TclGetString(objNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+	    }
+	}
+    }
+}
+
+/*
+ * Hash table implementation - first, just copy and adapt the obj key stuff
+ */
+
+void
+TclInitVarHashTable(
+    TclVarHashTable *tablePtr,
+    Namespace *nsPtr)
+{
+    Tcl_InitCustomHashTable(&tablePtr->table,
+	    TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType);
+    tablePtr->nsPtr = nsPtr;
+}
+
+static Tcl_HashEntry *
+AllocVarEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    void *keyPtr)		/* Key to store in the hash table entry. */
+{
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    Tcl_HashEntry *hPtr;
+    Var *varPtr;
+
+    varPtr = (Var *) ckalloc(sizeof(VarInHash));
+    varPtr->flags = VAR_IN_HASHTABLE;
+    varPtr->value.objPtr = NULL;
+    VarHashRefCount(varPtr) = 1;
+
+    hPtr = &(((VarInHash *)varPtr)->entry);
+    Tcl_SetHashValue(hPtr, varPtr);
+    hPtr->key.objPtr = objPtr;
+    Tcl_IncrRefCount(objPtr);
+
+    return hPtr;
+}
+
+static void
+FreeVarEntry(
+    Tcl_HashEntry *hPtr)
+{
+    Var *varPtr = VarHashGetValue(hPtr);
+    Tcl_Obj *objPtr = hPtr->key.objPtr;
+
+    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
+	    && (VarHashRefCount(varPtr) == 1)) {
+	ckfree((char *) varPtr);
+    } else {
+	VarHashInvalidateEntry(varPtr);
+	TclSetVarUndefined(varPtr);
+	VarHashRefCount(varPtr)--;
+    }
+    Tcl_DecrRefCount(objPtr);
+}
+
+static int
+CompareVarKeys(
+    void *keyPtr,		/* New key to compare. */
+    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+{
+    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
+    register const char *p1, *p2;
+    register int l1, l2;
+
+    /*
+     * If the object pointers are the same then they match.
+     */
+
+    if (objPtr1 == objPtr2) {
+	return 1;
+    }
+
+    /*
+     * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
+     * register.
+     */
+
+    p1 = TclGetString(objPtr1);
+    l1 = objPtr1->length;
+    p2 = TclGetString(objPtr2);
+    l2 = objPtr2->length;
+
+    /*
+     * Only compare if the string representations are of the same length.
+     */
+
+    if (l1 == l2) {
+	for (;; p1++, p2++, l1--) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (l1 == 0) {
+		return 1;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+static unsigned int
+HashVarKey(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    void *keyPtr)		/* Key from which to compute hash value. */
+{
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    const char *string = TclGetString(objPtr);
+    int length = objPtr->length;
+    unsigned int result = 0;
+    int i;
+
+    /*
+     * I tried a zillion different hash functions and asked many other people
+     * for advice. Many people had their own favorite functions, all
+     * different, but no-one had much idea why they were good ones. I chose
+     * the one below (multiply by 9 and add new character) because of the
+     * following reasons:
+     *
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
+     *	  multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old). This means that each
+     *	  character's bits hang around in the low-order bits of the hash value
+     *	  for ever, plus they spread fairly rapidly up to the high-order bits
+     *	  to fill out the hash value. This seems works well both for decimal
+     *	  and non-decimal strings.
+     */
+
+    for (i=0 ; i<length ; i++) {
+	result += (result << 3) + string[i];
+    }
+    return result;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tommath.h b/generic/tommath.h
new file mode 100644
index 0000000..028a84d
--- /dev/null
+++ b/generic/tommath.h
@@ -0,0 +1 @@
+#include "tclTomMathInt.h"